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         a->auto_remove_nodes = 0;
 144
 145         EMOD_ASE_DEBUG_DIGRAPH("h:0x%08x shall be created...\n",
 146                             (unsigned int)a);
 147         return a;
 148 }
 149
 150 Lisp_Object
 151 _ase_wrap_digraph(ase_digraph_t a)
 152 {
 153         Lisp_Object result;
 154
 155         result = make_dynacat(a);
 156         XDYNACAT(result)->type = Qase_digraph;
 157
 158         set_dynacat_printer(result, ase_digraph_prnt);
 159         set_dynacat_marker(result, ase_digraph_mark);
 160         set_dynacat_finaliser(result, ase_digraph_fini);
 161         set_dynacat_intprinter(
 162                 result, (dynacat_intprinter_f)_ase_digraph_prnt);
 163
 164         EMOD_ASE_DEBUG_DIGRAPH("h:0x%016lx shall be wrapped to 0x%016lx...\n",
 165                                (long unsigned int)a,
 166                                (long unsigned int)result);
 167
 168         return result;
 169 }
 170
 171 Lisp_Object ase_make_digraph(void)
 172 {
 173         ase_digraph_t a = _ase_make_digraph();
 174         return _ase_wrap_digraph(a);
 175 }
 176
 177 \f
 178 static inline skiplist_t
 179 _ase_digraph_get_edges(ase_digraph_t dg, Lisp_Object node)
 180 {
 181         skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
 182         Lisp_Object e = get_skiplist(sle, node, Qnil);
 183         if (!NILP(e))
 184                 return XSKIPLIST(e);
 185         return NULL;
 186 }
 187
 188 static inline skiplist_t
 189 _ase_digraph_get_redges(ase_digraph_t dg, Lisp_Object node)
 190 {
 191         skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
 192         Lisp_Object e = get_skiplist(slr, node, Qnil);
 193         if (!NILP(e))
 194                 return XSKIPLIST(e);
 195         return NULL;
 196 }
 197
 198 static inline Lisp_Object
 199 __ase_digraph_add_node(skiplist_t sl, Lisp_Object node)
 200 {
 201         Lisp_Object n = get_skiplist(sl, node, Qnil);
 202
 203         if (!NILP(n))
 204                 return n;
 205
 206         n = make_skiplist();
 207         put_skiplist(sl, node, n);
 208         return n;
 209 }
 210
 211 static inline void
 212 _ase_digraph_add_node(Lisp_Object *e, Lisp_Object *r,
 213                       ase_digraph_t dg, Lisp_Object node)
 214 {
 215         skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
 216         skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
 217
 218         *e = __ase_digraph_add_node(sle, node);
 219         *r = __ase_digraph_add_node(slr, node);
 220         return;
 221 }
 222
 223 inline Lisp_Object
 224 ase_digraph_add_node(ase_digraph_t dg, Lisp_Object node)
 225 {
 226         skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
 227         skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
 228
 229         __ase_digraph_add_node(slr, node);
 230         return __ase_digraph_add_node(sle, node);
 231 }
 232
 233 void
 234 ase_digraph_add_edge_aa(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 235 {
 236 /* auto-add nodes if necessary */
 237         Lisp_Object n1sle, n2slr;
 238         skiplist_t n1e = NULL, n2r = NULL;
 239
 240         _ase_digraph_add_node(&n1sle, &n2slr, dg, n1);
 241         n1e = XSKIPLIST(n1sle);
 242         _ase_digraph_add_node(&n1sle, &n2slr, dg, n2);
 243         n2r = XSKIPLIST(n2slr);
 244
 245         put_skiplist(n1e, n2, Qt);
 246         put_skiplist(n2r, n1, Qt);
 247         return;
 248 }
 249
 250 void
 251 ase_digraph_add_edge(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 252 {
 253         skiplist_t n1e = NULL, n2r = NULL;
 254
 255         if (!(n1e = _ase_digraph_get_edges(dg, n1)) ||
 256             !(n2r = _ase_digraph_get_redges(dg, n2))) {
 257                 error("no such nodes");
 258         }
 259         put_skiplist(n1e, n2, Qt);
 260         put_skiplist(n2r, n1, Qt);
 261         return;
 262 }
 263
 264 void
 265 ase_digraph_remove_edge_ar(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 266 {
 267         return;
 268 }
 269
 270 void
 271 ase_digraph_remove_edge(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 272 {
 273         skiplist_t n1e = NULL, n2r = NULL;
 274
 275         if ((n1e = _ase_digraph_get_edges(dg, n1)) == NULL ||
 276             (n2r = _ase_digraph_get_redges(dg, n2)) == NULL) {
 277                 error("no such edge");
 278         }
 279         remove_skiplist(n1e, n2);
 280         remove_skiplist(n2r, n1);
 281         return;
 282 }
 283
 284 int
 285 ase_digraph_has_edge_p(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
 286 {
 287         skiplist_t sl = XSKIPLIST(ase_digraph_edges(dg));
 288         Lisp_Object n1e = get_skiplist(sl, n1, Qnil);
 289
 290         if (NILP(n1e)) {
 291                 return 0;
 292         }
 293         if (!NILP(get_skiplist(XSKIPLIST(n1e), n2, Qnil))) {
 294                 return 1;
 295         }
 296         return 0;
 297 }
 298
 299 \f
 300 /* ###autoload */
 301 DEFUN("ase-digraph", Fase_digraph, 0, 1, 0, /*
 302 Return an empty directed graph.
 303 */
 304       (options))
 305 {
 306         return ase_make_digraph();
 307 }
 308
 309 DEFUN("ase-digraph-add-node", Fase_digraph_add_node, 2, 2, 0, /*
 310 Add NODE to DIGRAPH.
 311 */
 312       (digraph, node))
 313 {
 314         CHECK_ASE_DIGRAPH(digraph);
 315         ase_digraph_add_node(XASE_DIGRAPH(digraph), node);
 316         return digraph;
 317 }
 318
 319 DEFUN("ase-digraph-add-edge", Fase_digraph_add_edge, 3, 3, 0, /*
 320 Add edge between NODE1 and NODE2 (in that direction) to DIGRAPH.
 321 */
 322       (digraph, node1, node2))
 323 {
 324         ase_digraph_t dg = NULL;
 325
 326         CHECK_ASE_DIGRAPH(digraph);
 327
 328         dg = XASE_DIGRAPH(digraph);
 329         if (dg->auto_add_nodes) {
 330                 ase_digraph_add_edge_aa(dg, node1, node2);
 331         } else {
 332                 ase_digraph_add_edge(dg, node1, node2);
 333         }
 334         return digraph;
 335 }
 336
 337 DEFUN("ase-digraph-remove-edge", Fase_digraph_remove_edge, 3, 3, 0, /*
 338 Remove edge NODE1->NODE2 from DIGRAPH.
 339 */
 340       (digraph, node1, node2))
 341 {
 342         ase_digraph_t dg = NULL;
 343
 344         CHECK_ASE_DIGRAPH(digraph);
 345
 346         dg = XASE_DIGRAPH(digraph);
 347         if (dg->auto_remove_nodes) {
 348                 ase_digraph_remove_edge_ar(dg, node1, node2);
 349         } else {
 350                 ase_digraph_remove_edge(dg, node1, node2);
 351         }
 352         return digraph;
 353 }
 354
 355 DEFUN("ase-digraph-has-edge-p", Fase_digraph_has_edge_p, 3, 3, 0, /*
 356 Return non-`nil' if an edge between NODE1 and NODE2 exists in DIGRAPH.
 357 */
 358       (digraph, node1, node2))
 359 {
 360         CHECK_ASE_DIGRAPH(digraph);
 361         if (ase_digraph_has_edge_p(XASE_DIGRAPH(digraph), node1, node2))
 362                 return Qt;
 363         else
 364                 return Qnil;
 365 }
 366
 367 \f
 368 /* initialiser code */
 369 #define EMODNAME        ase_digraph
 370
 371 void
 372 EMOD_PUBINIT(void)
 373 {
 374         DEFSUBR(Fase_digraph);
 375         DEFSUBR(Fase_digraph_add_node);
 376         DEFSUBR(Fase_digraph_add_edge);
 377         DEFSUBR(Fase_digraph_remove_edge);
 378         DEFSUBR(Fase_digraph_has_edge_p);
 379
 380         DEFASETYPE_WITH_OPS(Qase_digraph, "ase:digraph");
 381         defsymbol(&Qase_digraphp, "ase:digraphp");
 382         DEFKEYWORD(Q_auto_add_nodes);
 383
 384         Fprovide(intern("ase-digraph"));
 385 }
 386
 387 void
 388 EMOD_PUBREINIT(void)
 389 {
 390 }
 391
 392 void
 393 EMOD_PUBDEINIT(void)
 394 {
 395         Frevoke(intern("ase-digraph"));
 396 }
 397
 398 /* ase-digraph.c ends here */