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

   1 /*
   2   ase-digraph.c -- Directed 2-ary Graphs
   3   Copyright (C) 2006, 2007 Sebastian Freundt
   4
   5   Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6
   7   * This file is part of SXEmacs.
   8   *
   9   * Redistribution and use in source and binary forms, with or without
  10   * modification, are permitted provided that the following conditions
  11   * are met:
  12   *
  13   * 1. Redistributions of source code must retain the above copyright
  14   *    notice, this list of conditions and the following disclaimer.
  15   *
  16   * 2. Redistributions in binary form must reproduce the above copyright
  17   *    notice, this list of conditions and the following disclaimer in the
  18   *    documentation and/or other materials provided with the distribution.
  19   *
  20   * 3. Neither the name of the author nor the names of any contributors
  21   *    may be used to endorse or promote products derived from this
  22   *    software without specific prior written permission.
  23   *
  24   * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25   * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26   * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27   * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28   * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29   * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30   * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31   * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32   * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33   * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34   * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35   */
  36
  37 /* Synched up with: Not in FSF. */
  38
  39 #include "config.h"
  40 #include "sxemacs.h"
  41 #include "ent/ent.h"
  42 #include "ase-digraph.h"
  43
  44 #ifdef ALL_DEBUG_FLAGS
  45 #undef EMOD_ASE_DEBUG_FLAG
  46 #define EMOD_ASE_DEBUG_FLAG
  47 #endif
  48
  49 #define EMOD_ASE_DEBUG_DIGRAPH(args...) EMOD_ASE_DEBUG("[DIGRAPH]: " args)
  50
  51 PROVIDE(ase_digraph);
  52 REQUIRE(ase_digraph, "ase");
  53
  54 Lisp_Object Qase_digraph, Qase_digraphp;
  55 static Lisp_Object Q_auto_add_nodes;
  56
  57 \f
  58 /* stuff for the dynacat, printers */
  59 static inline Lisp_Object
  60 nodf(Lisp_Object k, Lisp_Object v, void *ptr)
  61 {
  62         Lisp_Object pcf = (Lisp_Object)ptr;
  63         write_c_string(" ", pcf);
  64         print_internal(k, pcf, 0);
  65         return Qnil;
  66 }
  67
  68 static inline Lisp_Object
  69 edgf(Lisp_Object k, Lisp_Object v, void *ptr)
  70 {
  71         Lisp_Object pcf = (Lisp_Object)ptr;
  72         skiplist_t esl;
  73
  74         if (!SKIPLISTP(v)) {
  75                 return Qnil;
  76         }
  77         esl = XSKIPLIST(v);
  78         write_c_string(" (", pcf);
  79         print_internal(k, pcf, 0);
  80         write_c_string("->", pcf);
  81         map2_skiplist(esl, nodf, ptr);
  82         write_c_string(")", pcf);
  83         return Qnil;
  84 }
  85
  86 static void
  87 _ase_digraph_prnt(ase_digraph_t a, Lisp_Object pcf)
  88 {
  89         skiplist_t sl = XSKIPLIST(ase_digraph_edges(a));
  90
  91         write_c_string(" :nodes", pcf);
  92         if (skiplist_empty_p(sl)) {
  93                 write_c_string(" none", pcf);
  94                 return;
  95         } else {
  96                 map2_skiplist(sl, nodf, (void*)pcf);
  97                 write_c_string(" :edges", pcf);
  98                 map2_skiplist(sl, edgf, (void*)pcf);
  99         }
 100         return;
 101 }
 102
 103 static void
 104 ase_digraph_prnt(Lisp_Object obj, Lisp_Object pcf, int SXE_UNUSED(foo))
 105 {
 106         EMOD_ASE_DEBUG_DIGRAPH("h:0x%016lx@0x%016lx\n",
 107                                (long unsigned int)(XASE_DIGRAPH(obj)),
 108                                (long unsigned int)obj);
 109         write_c_string("#<ase:digraph", pcf);
 110         _ase_digraph_prnt(XASE_DIGRAPH(obj), pcf);
 111         write_c_string(">", pcf);
 112 }
 113
 114 static void
 115 ase_digraph_fini(Lisp_Object SXE_UNUSED(obj), int SXE_UNUSED(foo))
 116 {
 117 }
 118
 119 static void
 120 ase_digraph_mark(Lisp_Object obj)
 121 {
 122         ase_digraph_t a = XASE_DIGRAPH(obj);
 123
 124         EMOD_ASE_DEBUG_DIGRAPH("g:0x%016lx@0x%016lx shall be marked...\n",
 125                                (long unsigned int)(XASE_DIGRAPH(obj)),
 126                                (long unsigned int)obj);
 127
 128         mark_object(ase_digraph_edges(a));
 129         mark_object(ase_digraph_redges(a));
 130         return;
 131 }
 132
 133 \f
 134 static inline ase_digraph_t
 135 _ase_make_digraph(void)
 136 {
 137         ase_digraph_t a = xnew(struct ase_digraph_s);
 138
 139         ase_digraph_edges(a) = make_skiplist();
 140         ase_digraph_redges(a) = make_skiplist();
 141
 142         a->auto_add_nodes = 0;
 143
 144         EMOD_ASE_DEBUG_DIGRAPH("h:0x%08x shall be created...\n",
 145                             (unsigned int)a);
 146         return a;
 147 }
 148
 149 Lisp_Object
 150 _ase_wrap_digraph(ase_digraph_t a)
 151 {
 152         Lisp_Object result;
 153
 154         result = make_dynacat(a);
 155         XDYNACAT(result)->type = Qase_digraph;
 156
 157         set_dynacat_printer(result, ase_digraph_prnt);
 158         set_dynacat_marker(result, ase_digraph_mark);
 159         set_dynacat_finaliser(result, ase_digraph_fini);
 160         set_dynacat_intprinter(
 161                 result, (dynacat_intprinter_f)_ase_digraph_prnt);
 162
 163         EMOD_ASE_DEBUG_DIGRAPH("h:0x%016lx shall be wrapped to 0x%016lx...\n",
 164                                (long unsigned int)a,
 165                                (long unsigned int)result);
 166
 167         return result;
 168 }
 169
 170 Lisp_Object ase_make_digraph(void)
 171 {
 172         ase_digraph_t a = _ase_make_digraph();
 173         return _ase_wrap_digraph(a);
 174 }
 175
 176 \f
 177 static inline skiplist_t
 178 _ase_digraph_get_edges(ase_digraph_t dg, Lisp_Object node)
 179 {
 180         skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
 181         Lisp_Object e = get_skiplist(sle, node, Qnil);
 182         if (!NILP(e))
 183                 return XSKIPLIST(e);
 184         return NULL;
 185 }
 186
 187 static inline skiplist_t
 188 _ase_digraph_get_redges(ase_digraph_t dg, Lisp_Object node)
 189 {
 190         skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
 191         Lisp_Object e = get_skiplist(slr, node, Qnil);
 192         if (!NILP(e))
 193                 return XSKIPLIST(e);
 194         return NULL;
 195 }
 196
 197 static inline Lisp_Object
 198 __ase_digraph_add_node(skiplist_t sl, Lisp_Object node)
 199 {
 200         Lisp_Object n = get_skiplist(sl, node, Qnil);
 201
 202         if (!NILP(n))
 203                 return n;
 204
 205         n = make_skiplist();
 206         put_skiplist(sl, node, n);
 207         return n;
 208 }
 209
 210 static inline void
 211 _ase_digraph_add_node(Lisp_Object *e, Lisp_Object *r,
 212                       ase_digraph_t dg, Lisp_Object node)
 213 {
 214         skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
 215         skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
 216
 217         *e = __ase_digraph_add_node(sle, node);
 218         *r = __ase_digraph_add_node(slr, node);
 219         return;
 220 }
 221
 222 inline Lisp_Object
 223 ase_digraph_add_node(ase_digraph_t dg, Lisp_Object node)
 224 {
 225         skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
 226         skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
 227
 228         __ase_digraph_add_node(slr, node);
 229         return __ase_digraph_add_node(sle, node);
 230 }
 231
 232 void
 233 ase_digraph_add_edge_aa(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 234 {
 235 /* auto-add nodes if necessary */
 236         Lisp_Object n1sle, n2slr;
 237         skiplist_t n1e = NULL, n2r = NULL;
 238
 239         _ase_digraph_add_node(&n1sle, &n2slr, dg, n1);
 240         n1e = XSKIPLIST(n1sle);
 241         _ase_digraph_add_node(&n1sle, &n2slr, dg, n2);
 242         n2r = XSKIPLIST(n2slr);
 243
 244         put_skiplist(n1e, n2, Qt);
 245         put_skiplist(n2r, n1, Qt);
 246         return;
 247 }
 248
 249 void
 250 ase_digraph_add_edge(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 251 {
 252         skiplist_t n1e = NULL, n2r = NULL;
 253
 254         if (!(n1e = _ase_digraph_get_edges(dg, n1)) ||
 255             !(n2r = _ase_digraph_get_redges(dg, n2))) {
 256                 error("no such nodes");
 257         }
 258         put_skiplist(n1e, n2, Qt);
 259         put_skiplist(n2r, n1, Qt);
 260         return;
 261 }
 262
 263 void
 264 ase_digraph_remove_edge_ar(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 265 {
 266         return;
 267 }
 268
 269 void
 270 ase_digraph_remove_edge(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 271 {
 272         skiplist_t n1e = NULL, n2r = NULL;
 273
 274         if ((n1e = _ase_digraph_get_edges(dg, n1)) == NULL ||
 275             (n2r = _ase_digraph_get_redges(dg, n2)) == NULL) {
 276                 error("no such edge");
 277         }
 278         remove_skiplist(n1e, n2);
 279         remove_skiplist(n2r, n1);
 280         return;
 281 }
 282
 283 int
 284 ase_digraph_has_edge_p(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 285 {
 286         skiplist_t sl = XSKIPLIST(ase_digraph_edges(dg));
 287         Lisp_Object n1e = get_skiplist(sl, n1, Qnil);
 288
 289         if (NILP(n1e)) {
 290                 return 0;
 291         }
 292         if (!NILP(get_skiplist(XSKIPLIST(n1e), n2, Qnil))) {
 293                 return 1;
 294         }
 295         return 0;
 296 }
 297
 298 \f
 299 /* ###autoload */
 300 DEFUN("ase-digraph", Fase_digraph, 0, 1, 0, /*
 301 Return an empty directed graph.
 302 */
 303       (options))
 304 {
 305         return ase_make_digraph();
 306 }
 307
 308 DEFUN("ase-digraph-add-node", Fase_digraph_add_node, 2, 2, 0, /*
 309 Add NODE to DIGRAPH.
 310 */
 311       (digraph, node))
 312 {
 313         CHECK_ASE_DIGRAPH(digraph);
 314         ase_digraph_add_node(XASE_DIGRAPH(digraph), node);
 315         return digraph;
 316 }
 317
 318 DEFUN("ase-digraph-add-edge", Fase_digraph_add_edge, 3, 3, 0, /*
 319 Add edge between NODE1 and NODE2 (in that direction) to DIGRAPH.
 320 */
 321       (digraph, node1, node2))
 322 {
 323         ase_digraph_t dg = NULL;
 324
 325         CHECK_ASE_DIGRAPH(digraph);
 326
 327         dg = XASE_DIGRAPH(digraph);
 328         if (dg->auto_add_nodes) {
 329                 ase_digraph_add_edge_aa(dg, node1, node2);
 330         } else {
 331                 ase_digraph_add_edge(dg, node1, node2);
 332         }
 333         return digraph;
 334 }
 335
 336 DEFUN("ase-digraph-remove-edge", Fase_digraph_remove_edge, 3, 3, 0, /*
 337 Remove edge NODE1->NODE2 from DIGRAPH.
 338 */
 339       (digraph, node1, node2))
 340 {
 341         ase_digraph_t dg = NULL;
 342
 343         CHECK_ASE_DIGRAPH(digraph);
 344
 345         dg = XASE_DIGRAPH(digraph);
 346         if (dg->auto_remove_nodes) {
 347                 ase_digraph_remove_edge_ar(dg, node1, node2);
 348         } else {
 349                 ase_digraph_remove_edge(dg, node1, node2);
 350         }
 351         return digraph;
 352 }
 353
 354 DEFUN("ase-digraph-has-edge-p", Fase_digraph_has_edge_p, 3, 3, 0, /*
 355 Return non-`nil' if an edge between NODE1 and NODE2 exists in DIGRAPH.
 356 */
 357       (digraph, node1, node2))
 358 {
 359         CHECK_ASE_DIGRAPH(digraph);
 360         if (ase_digraph_has_edge_p(XASE_DIGRAPH(digraph), node1, node2))
 361                 return Qt;
 362         else
 363                 return Qnil;
 364 }
 365
 366 \f
 367 /* initialiser code */
 368 #define EMODNAME        ase_digraph
 369
 370 void
 371 EMOD_PUBINIT(void)
 372 {
 373         DEFSUBR(Fase_digraph);
 374         DEFSUBR(Fase_digraph_add_node);
 375         DEFSUBR(Fase_digraph_add_edge);
 376         DEFSUBR(Fase_digraph_remove_edge);
 377         DEFSUBR(Fase_digraph_has_edge_p);
 378
 379         DEFASETYPE_WITH_OPS(Qase_digraph, "ase:digraph");
 380         defsymbol(&Qase_digraphp, "ase:digraphp");
 381         DEFKEYWORD(Q_auto_add_nodes);
 382
 383         Fprovide(intern("ase-digraph"));
 384 }
 385
 386 void
 387 EMOD_PUBREINIT(void)
 388 {
 389 }
 390
 391 void
 392 EMOD_PUBDEINIT(void)
 393 {
 394         Frevoke(intern("ase-digraph"));
 395 }
 396
 397 /* ase-digraph.c ends here */