1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
2 * Free Software Foundation, Inc.
4 * This library is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU Lesser General Public License
6 * as published by the Free Software Foundation; either version 3 of
7 * the License, or (at your option) any later version.
9 * This library is distributed in the hope that it will be useful, but
10 * WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 * Lesser General Public License for more details.
14 * You should have received a copy of the GNU Lesser General Public
15 * License along with this library; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 #include "libguile/_scm.h"
27 #include "libguile/eq.h"
29 #include "libguile/validate.h"
30 #include "libguile/list.h"
31 #include "libguile/vectors.h"
32 #include "libguile/srcprop.h"
33 #include "libguile/trees.h"
38 /* scm_copy_tree creates deep copies of pairs and vectors, but not of any other
41 * To avoid infinite recursion due to cyclic structures, the hare-and-tortoise
42 * pattern is used to detect cycles. In fact, the pattern is used in two
43 * dimensions, vertical (indicated in the code by the variable names 'hare'
44 * and 'tortoise') and horizontal ('rabbit' and 'turtle'). In both
45 * dimensions, the hare/rabbit will take two steps when the tortoise/turtle
48 * The vertical dimension corresponds to recursive calls to function
49 * copy_tree: This happens when descending into vector elements, into cars of
50 * lists and into the cdr of an improper list. In this dimension, the
51 * tortoise follows the hare by using the processor stack: Every stack frame
52 * will hold an instance of struct t_trace. These instances are connected in
53 * a way that represents the trace of the hare, which thus can be followed by
54 * the tortoise. The tortoise will always point to struct t_trace instances
55 * relating to SCM objects that have already been copied. Thus, a cycle is
56 * detected if the tortoise and the hare point to the same object,
58 * The horizontal dimension is within one execution of copy_tree, when the
59 * function cdr's along the pairs of a list. This is the standard
60 * hare-and-tortoise implementation, found several times in guile. */
63 struct t_trace
*trace
; /* These pointers form a trace along the stack. */
64 SCM obj
; /* The object handled at the respective stack frame.*/
68 copy_tree (struct t_trace
*const hare
,
69 struct t_trace
*tortoise
,
70 unsigned int tortoise_delay
);
72 SCM_DEFINE (scm_copy_tree
, "copy-tree", 1, 0, 0,
74 "Recursively copy the data tree that is bound to @var{obj}, and return a\n"
75 "the new data structure. @code{copy-tree} recurses down the\n"
76 "contents of both pairs and vectors (since both cons cells and vector\n"
77 "cells may point to arbitrary objects), and stops recursing when it hits\n"
79 #define FUNC_NAME s_scm_copy_tree
81 /* Prepare the trace along the stack. */
85 /* In function copy_tree, if the tortoise makes its step, it will do this
86 * before the hare has the chance to move. Thus, we have to make sure that
87 * the very first step of the tortoise will not happen after the hare has
88 * really made two steps. This is achieved by passing '2' as the initial
89 * delay for the tortoise. NOTE: Since cycles are unlikely, giving the hare
90 * a bigger advantage may improve performance slightly. */
91 return copy_tree (&trace
, &trace
, 2);
97 copy_tree (struct t_trace
*const hare
,
98 struct t_trace
*tortoise
,
99 unsigned int tortoise_delay
)
100 #define FUNC_NAME s_scm_copy_tree
102 if (!scm_is_pair (hare
->obj
) && !scm_is_simple_vector (hare
->obj
))
108 /* Prepare the trace along the stack. */
109 struct t_trace new_hare
;
110 hare
->trace
= &new_hare
;
112 /* The tortoise will make its step after the delay has elapsed. Note
113 * that in contrast to the typical hare-and-tortoise pattern, the step
114 * of the tortoise happens before the hare takes its steps. This is, in
115 * principle, no problem, except for the start of the algorithm: Then,
116 * it has to be made sure that the hare actually gets its advantage of
118 if (tortoise_delay
== 0)
121 tortoise
= tortoise
->trace
;
122 if (SCM_UNLIKELY (scm_is_eq (hare
->obj
, tortoise
->obj
)))
123 scm_wrong_type_arg_msg (FUNC_NAME
, 1, hare
->obj
,
124 "expected non-circular data structure");
131 if (scm_is_simple_vector (hare
->obj
))
133 size_t length
= SCM_SIMPLE_VECTOR_LENGTH (hare
->obj
);
134 SCM new_vector
= scm_c_make_vector (length
, SCM_UNSPECIFIED
);
136 /* Each vector element is copied by recursing into copy_tree, having
137 * the tortoise follow the hare into the depths of the stack. */
139 for (i
= 0; i
< length
; ++i
)
142 new_hare
.obj
= SCM_SIMPLE_VECTOR_REF (hare
->obj
, i
);
143 new_element
= copy_tree (&new_hare
, tortoise
, tortoise_delay
);
144 SCM_SIMPLE_VECTOR_SET (new_vector
, i
, new_element
);
149 else /* scm_is_pair (hare->obj) */
154 SCM rabbit
= hare
->obj
;
155 SCM turtle
= hare
->obj
;
159 /* The first pair of the list is treated specially, in order to
160 * preserve a potential source code position. */
161 result
= tail
= scm_cons_source (rabbit
, SCM_EOL
, SCM_EOL
);
162 new_hare
.obj
= SCM_CAR (rabbit
);
163 copy
= copy_tree (&new_hare
, tortoise
, tortoise_delay
);
164 SCM_SETCAR (tail
, copy
);
166 /* The remaining pairs of the list are copied by, horizontally,
167 * having the turtle follow the rabbit, and, vertically, having the
168 * tortoise follow the hare into the depths of the stack. */
169 rabbit
= SCM_CDR (rabbit
);
170 while (scm_is_pair (rabbit
))
172 new_hare
.obj
= SCM_CAR (rabbit
);
173 copy
= copy_tree (&new_hare
, tortoise
, tortoise_delay
);
174 SCM_SETCDR (tail
, scm_cons (copy
, SCM_UNDEFINED
));
175 tail
= SCM_CDR (tail
);
177 rabbit
= SCM_CDR (rabbit
);
178 if (scm_is_pair (rabbit
))
180 new_hare
.obj
= SCM_CAR (rabbit
);
181 copy
= copy_tree (&new_hare
, tortoise
, tortoise_delay
);
182 SCM_SETCDR (tail
, scm_cons (copy
, SCM_UNDEFINED
));
183 tail
= SCM_CDR (tail
);
184 rabbit
= SCM_CDR (rabbit
);
186 turtle
= SCM_CDR (turtle
);
187 if (SCM_UNLIKELY (scm_is_eq (rabbit
, turtle
)))
188 scm_wrong_type_arg_msg (FUNC_NAME
, 1, rabbit
,
189 "expected non-circular data structure");
193 /* We have to recurse into copy_tree again for the last cdr, in
194 * order to handle the situation that it holds a vector. */
195 new_hare
.obj
= rabbit
;
196 copy
= copy_tree (&new_hare
, tortoise
, tortoise_delay
);
197 SCM_SETCDR (tail
, copy
);
209 #include "libguile/trees.x"