2 ase-digraph.c -- Directed 2-ary Graphs
3 Copyright (C) 2006, 2007 Sebastian Freundt
5 Author: Sebastian Freundt <hroptatyr@sxemacs.org>
7 * This file is part of SXEmacs.
9 * Redistribution and use in source and binary forms, with or without
10 * modification, are permitted provided that the following conditions
13 * 1. Redistributions of source code must retain the above copyright
14 * notice, this list of conditions and the following disclaimer.
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.
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.
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.
37 /* Synched up with: Not in FSF. */
42 #include "ase-digraph.h"
44 #ifdef ALL_DEBUG_FLAGS
45 #undef EMOD_ASE_DEBUG_FLAG
46 #define EMOD_ASE_DEBUG_FLAG
49 #define EMOD_ASE_DEBUG_DIGRAPH(args...) EMOD_ASE_DEBUG("[DIGRAPH]: " args)
52 REQUIRE(ase_digraph, "ase");
54 Lisp_Object Qase_digraph, Qase_digraphp;
55 static Lisp_Object Q_auto_add_nodes;
58 /* stuff for the dynacat, printers */
59 static inline Lisp_Object
60 nodf(Lisp_Object k, Lisp_Object v, void *ptr)
62 Lisp_Object pcf = (Lisp_Object)ptr;
63 write_c_string(" ", pcf);
64 print_internal(k, pcf, 0);
68 static inline Lisp_Object
69 edgf(Lisp_Object k, Lisp_Object v, void *ptr)
71 Lisp_Object pcf = (Lisp_Object)ptr;
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);
87 _ase_digraph_prnt(ase_digraph_t a, Lisp_Object pcf)
89 skiplist_t sl = XSKIPLIST(ase_digraph_edges(a));
91 write_c_string(" :nodes", pcf);
92 if (skiplist_empty_p(sl)) {
93 write_c_string(" none", pcf);
96 map2_skiplist(sl, nodf, (void*)pcf);
97 write_c_string(" :edges", pcf);
98 map2_skiplist(sl, edgf, (void*)pcf);
104 ase_digraph_prnt(Lisp_Object obj, Lisp_Object pcf, int SXE_UNUSED(foo))
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);
115 ase_digraph_fini(Lisp_Object SXE_UNUSED(obj), int SXE_UNUSED(foo))
120 ase_digraph_mark(Lisp_Object obj)
122 ase_digraph_t a = XASE_DIGRAPH(obj);
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);
128 mark_object(ase_digraph_edges(a));
129 mark_object(ase_digraph_redges(a));
134 static inline ase_digraph_t
135 _ase_make_digraph(void)
137 ase_digraph_t a = xnew(struct ase_digraph_s);
139 ase_digraph_edges(a) = make_skiplist();
140 ase_digraph_redges(a) = make_skiplist();
142 a->auto_add_nodes = 0;
144 EMOD_ASE_DEBUG_DIGRAPH("h:0x%08x shall be created...\n",
150 _ase_wrap_digraph(ase_digraph_t a)
154 result = make_dynacat(a);
155 XDYNACAT(result)->type = Qase_digraph;
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);
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);
170 Lisp_Object ase_make_digraph(void)
172 ase_digraph_t a = _ase_make_digraph();
173 return _ase_wrap_digraph(a);
177 static inline skiplist_t
178 _ase_digraph_get_edges(ase_digraph_t dg, Lisp_Object node)
180 skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
181 Lisp_Object e = get_skiplist(sle, node, Qnil);
187 static inline skiplist_t
188 _ase_digraph_get_redges(ase_digraph_t dg, Lisp_Object node)
190 skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
191 Lisp_Object e = get_skiplist(slr, node, Qnil);
197 static inline Lisp_Object
198 __ase_digraph_add_node(skiplist_t sl, Lisp_Object node)
200 Lisp_Object n = get_skiplist(sl, node, Qnil);
206 put_skiplist(sl, node, n);
211 _ase_digraph_add_node(Lisp_Object *e, Lisp_Object *r,
212 ase_digraph_t dg, Lisp_Object node)
214 skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
215 skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
217 *e = __ase_digraph_add_node(sle, node);
218 *r = __ase_digraph_add_node(slr, node);
223 ase_digraph_add_node(ase_digraph_t dg, Lisp_Object node)
225 skiplist_t sle = XSKIPLIST(ase_digraph_edges(dg));
226 skiplist_t slr = XSKIPLIST(ase_digraph_redges(dg));
228 __ase_digraph_add_node(slr, node);
229 return __ase_digraph_add_node(sle, node);
233 ase_digraph_add_edge_aa(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
235 /* auto-add nodes if necessary */
236 Lisp_Object n1sle, n2slr;
237 skiplist_t n1e = NULL, n2r = NULL;
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);
244 put_skiplist(n1e, n2, Qt);
245 put_skiplist(n2r, n1, Qt);
250 ase_digraph_add_edge(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
252 skiplist_t n1e = NULL, n2r = NULL;
254 if (!(n1e = _ase_digraph_get_edges(dg, n1)) ||
255 !(n2r = _ase_digraph_get_redges(dg, n2))) {
256 error("no such nodes");
258 put_skiplist(n1e, n2, Qt);
259 put_skiplist(n2r, n1, Qt);
264 ase_digraph_remove_edge_ar(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
270 ase_digraph_remove_edge(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
272 skiplist_t n1e = NULL, n2r = NULL;
274 if ((n1e = _ase_digraph_get_edges(dg, n1)) == NULL ||
275 (n2r = _ase_digraph_get_redges(dg, n2)) == NULL) {
276 error("no such edge");
278 remove_skiplist(n1e, n2);
279 remove_skiplist(n2r, n1);
284 ase_digraph_has_edge_p(ase_digraph_t dg, Lisp_Object n1, Lisp_Object n2)
286 skiplist_t sl = XSKIPLIST(ase_digraph_edges(dg));
287 Lisp_Object n1e = get_skiplist(sl, n1, Qnil);
292 if (!NILP(get_skiplist(XSKIPLIST(n1e), n2, Qnil))) {
300 DEFUN("ase-digraph", Fase_digraph, 0, 1, 0, /*
301 Return an empty directed graph.
305 return ase_make_digraph();
308 DEFUN("ase-digraph-add-node", Fase_digraph_add_node, 2, 2, 0, /*
313 CHECK_ASE_DIGRAPH(digraph);
314 ase_digraph_add_node(XASE_DIGRAPH(digraph), node);
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.
321 (digraph, node1, node2))
323 ase_digraph_t dg = NULL;
325 CHECK_ASE_DIGRAPH(digraph);
327 dg = XASE_DIGRAPH(digraph);
328 if (dg->auto_add_nodes) {
329 ase_digraph_add_edge_aa(dg, node1, node2);
331 ase_digraph_add_edge(dg, node1, node2);
336 DEFUN("ase-digraph-remove-edge", Fase_digraph_remove_edge, 3, 3, 0, /*
337 Remove edge NODE1->NODE2 from DIGRAPH.
339 (digraph, node1, node2))
341 ase_digraph_t dg = NULL;
343 CHECK_ASE_DIGRAPH(digraph);
345 dg = XASE_DIGRAPH(digraph);
346 if (dg->auto_remove_nodes) {
347 ase_digraph_remove_edge_ar(dg, node1, node2);
349 ase_digraph_remove_edge(dg, node1, node2);
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.
357 (digraph, node1, node2))
359 CHECK_ASE_DIGRAPH(digraph);
360 if (ase_digraph_has_edge_p(XASE_DIGRAPH(digraph), node1, node2))
367 /* initialiser code */
368 #define EMODNAME ase_digraph
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);
379 DEFASETYPE_WITH_OPS(Qase_digraph, "ase:digraph");
380 defsymbol(&Qase_digraphp, "ase:digraphp");
381 DEFKEYWORD(Q_auto_add_nodes);
383 Fprovide(intern("ase-digraph"));
394 Frevoke(intern("ase-digraph"));
397 /* ase-digraph.c ends here */