Commit | Line | Data |
---|---|---|
cd038da5 | 1 | /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010 |
0f458a37 AW |
2 | * Free Software Foundation, Inc. |
3 | * | |
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. | |
8 | * | |
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. | |
13 | * | |
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 | |
17 | * 02110-1301 USA | |
18 | */ | |
19 | ||
20 | ||
21 | \f | |
22 | #ifdef HAVE_CONFIG_H | |
23 | # include <config.h> | |
24 | #endif | |
25 | ||
26 | #include "libguile/_scm.h" | |
27 | #include "libguile/eq.h" | |
0f458a37 AW |
28 | |
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" | |
34 | ||
35 | #include <stdarg.h> | |
36 | ||
37 | ||
38 | /* scm_copy_tree creates deep copies of pairs and vectors, but not of any other | |
39 | * data types. | |
40 | * | |
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 | |
46 | * takes one. | |
47 | * | |
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, | |
57 | * | |
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. */ | |
61 | ||
62 | struct t_trace { | |
63 | struct t_trace *trace; /* These pointers form a trace along the stack. */ | |
64 | SCM obj; /* The object handled at the respective stack frame.*/ | |
65 | }; | |
66 | ||
67 | static SCM | |
68 | copy_tree (struct t_trace *const hare, | |
69 | struct t_trace *tortoise, | |
70 | unsigned int tortoise_delay); | |
71 | ||
72 | SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0, | |
73 | (SCM obj), | |
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" | |
78 | "any other object.") | |
79 | #define FUNC_NAME s_scm_copy_tree | |
80 | { | |
81 | /* Prepare the trace along the stack. */ | |
82 | struct t_trace trace; | |
83 | trace.obj = obj; | |
84 | ||
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); | |
92 | } | |
93 | #undef FUNC_NAME | |
94 | ||
95 | ||
96 | static SCM | |
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 | |
101 | { | |
102 | if (!scm_is_pair (hare->obj) && !scm_is_simple_vector (hare->obj)) | |
103 | { | |
104 | return hare->obj; | |
105 | } | |
106 | else | |
107 | { | |
108 | /* Prepare the trace along the stack. */ | |
109 | struct t_trace new_hare; | |
110 | hare->trace = &new_hare; | |
111 | ||
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 | |
117 | * two steps. */ | |
118 | if (tortoise_delay == 0) | |
119 | { | |
120 | tortoise_delay = 1; | |
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"); | |
125 | } | |
126 | else | |
127 | { | |
128 | --tortoise_delay; | |
129 | } | |
130 | ||
131 | if (scm_is_simple_vector (hare->obj)) | |
132 | { | |
133 | size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj); | |
134 | SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED); | |
135 | ||
136 | /* Each vector element is copied by recursing into copy_tree, having | |
137 | * the tortoise follow the hare into the depths of the stack. */ | |
138 | unsigned long int i; | |
139 | for (i = 0; i < length; ++i) | |
140 | { | |
141 | SCM new_element; | |
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); | |
145 | } | |
146 | ||
147 | return new_vector; | |
148 | } | |
149 | else /* scm_is_pair (hare->obj) */ | |
150 | { | |
151 | SCM result; | |
152 | SCM tail; | |
153 | ||
154 | SCM rabbit = hare->obj; | |
155 | SCM turtle = hare->obj; | |
156 | ||
157 | SCM copy; | |
158 | ||
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); | |
165 | ||
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)) | |
171 | { | |
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); | |
176 | ||
177 | rabbit = SCM_CDR (rabbit); | |
178 | if (scm_is_pair (rabbit)) | |
179 | { | |
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); | |
185 | ||
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"); | |
190 | } | |
191 | } | |
192 | ||
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); | |
198 | ||
199 | return result; | |
200 | } | |
201 | } | |
202 | } | |
203 | #undef FUNC_NAME | |
204 | ||
205 | \f | |
206 | void | |
207 | scm_init_trees () | |
208 | { | |
209 | #include "libguile/trees.x" | |
210 | } |