Commit | Line | Data |
---|---|---|
0f458a37 AW |
1 | /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009 |
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" | |
28 | #include "libguile/lang.h" | |
29 | ||
30 | #include "libguile/validate.h" | |
31 | #include "libguile/list.h" | |
32 | #include "libguile/vectors.h" | |
33 | #include "libguile/srcprop.h" | |
34 | #include "libguile/trees.h" | |
35 | ||
36 | #include <stdarg.h> | |
37 | ||
38 | ||
39 | /* scm_copy_tree creates deep copies of pairs and vectors, but not of any other | |
40 | * data types. | |
41 | * | |
42 | * To avoid infinite recursion due to cyclic structures, the hare-and-tortoise | |
43 | * pattern is used to detect cycles. In fact, the pattern is used in two | |
44 | * dimensions, vertical (indicated in the code by the variable names 'hare' | |
45 | * and 'tortoise') and horizontal ('rabbit' and 'turtle'). In both | |
46 | * dimensions, the hare/rabbit will take two steps when the tortoise/turtle | |
47 | * takes one. | |
48 | * | |
49 | * The vertical dimension corresponds to recursive calls to function | |
50 | * copy_tree: This happens when descending into vector elements, into cars of | |
51 | * lists and into the cdr of an improper list. In this dimension, the | |
52 | * tortoise follows the hare by using the processor stack: Every stack frame | |
53 | * will hold an instance of struct t_trace. These instances are connected in | |
54 | * a way that represents the trace of the hare, which thus can be followed by | |
55 | * the tortoise. The tortoise will always point to struct t_trace instances | |
56 | * relating to SCM objects that have already been copied. Thus, a cycle is | |
57 | * detected if the tortoise and the hare point to the same object, | |
58 | * | |
59 | * The horizontal dimension is within one execution of copy_tree, when the | |
60 | * function cdr's along the pairs of a list. This is the standard | |
61 | * hare-and-tortoise implementation, found several times in guile. */ | |
62 | ||
63 | struct t_trace { | |
64 | struct t_trace *trace; /* These pointers form a trace along the stack. */ | |
65 | SCM obj; /* The object handled at the respective stack frame.*/ | |
66 | }; | |
67 | ||
68 | static SCM | |
69 | copy_tree (struct t_trace *const hare, | |
70 | struct t_trace *tortoise, | |
71 | unsigned int tortoise_delay); | |
72 | ||
73 | SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0, | |
74 | (SCM obj), | |
75 | "Recursively copy the data tree that is bound to @var{obj}, and return a\n" | |
76 | "the new data structure. @code{copy-tree} recurses down the\n" | |
77 | "contents of both pairs and vectors (since both cons cells and vector\n" | |
78 | "cells may point to arbitrary objects), and stops recursing when it hits\n" | |
79 | "any other object.") | |
80 | #define FUNC_NAME s_scm_copy_tree | |
81 | { | |
82 | /* Prepare the trace along the stack. */ | |
83 | struct t_trace trace; | |
84 | trace.obj = obj; | |
85 | ||
86 | /* In function copy_tree, if the tortoise makes its step, it will do this | |
87 | * before the hare has the chance to move. Thus, we have to make sure that | |
88 | * the very first step of the tortoise will not happen after the hare has | |
89 | * really made two steps. This is achieved by passing '2' as the initial | |
90 | * delay for the tortoise. NOTE: Since cycles are unlikely, giving the hare | |
91 | * a bigger advantage may improve performance slightly. */ | |
92 | return copy_tree (&trace, &trace, 2); | |
93 | } | |
94 | #undef FUNC_NAME | |
95 | ||
96 | ||
97 | static SCM | |
98 | copy_tree (struct t_trace *const hare, | |
99 | struct t_trace *tortoise, | |
100 | unsigned int tortoise_delay) | |
101 | #define FUNC_NAME s_scm_copy_tree | |
102 | { | |
103 | if (!scm_is_pair (hare->obj) && !scm_is_simple_vector (hare->obj)) | |
104 | { | |
105 | return hare->obj; | |
106 | } | |
107 | else | |
108 | { | |
109 | /* Prepare the trace along the stack. */ | |
110 | struct t_trace new_hare; | |
111 | hare->trace = &new_hare; | |
112 | ||
113 | /* The tortoise will make its step after the delay has elapsed. Note | |
114 | * that in contrast to the typical hare-and-tortoise pattern, the step | |
115 | * of the tortoise happens before the hare takes its steps. This is, in | |
116 | * principle, no problem, except for the start of the algorithm: Then, | |
117 | * it has to be made sure that the hare actually gets its advantage of | |
118 | * two steps. */ | |
119 | if (tortoise_delay == 0) | |
120 | { | |
121 | tortoise_delay = 1; | |
122 | tortoise = tortoise->trace; | |
123 | if (SCM_UNLIKELY (scm_is_eq (hare->obj, tortoise->obj))) | |
124 | scm_wrong_type_arg_msg (FUNC_NAME, 1, hare->obj, | |
125 | "expected non-circular data structure"); | |
126 | } | |
127 | else | |
128 | { | |
129 | --tortoise_delay; | |
130 | } | |
131 | ||
132 | if (scm_is_simple_vector (hare->obj)) | |
133 | { | |
134 | size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj); | |
135 | SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED); | |
136 | ||
137 | /* Each vector element is copied by recursing into copy_tree, having | |
138 | * the tortoise follow the hare into the depths of the stack. */ | |
139 | unsigned long int i; | |
140 | for (i = 0; i < length; ++i) | |
141 | { | |
142 | SCM new_element; | |
143 | new_hare.obj = SCM_SIMPLE_VECTOR_REF (hare->obj, i); | |
144 | new_element = copy_tree (&new_hare, tortoise, tortoise_delay); | |
145 | SCM_SIMPLE_VECTOR_SET (new_vector, i, new_element); | |
146 | } | |
147 | ||
148 | return new_vector; | |
149 | } | |
150 | else /* scm_is_pair (hare->obj) */ | |
151 | { | |
152 | SCM result; | |
153 | SCM tail; | |
154 | ||
155 | SCM rabbit = hare->obj; | |
156 | SCM turtle = hare->obj; | |
157 | ||
158 | SCM copy; | |
159 | ||
160 | /* The first pair of the list is treated specially, in order to | |
161 | * preserve a potential source code position. */ | |
162 | result = tail = scm_cons_source (rabbit, SCM_EOL, SCM_EOL); | |
163 | new_hare.obj = SCM_CAR (rabbit); | |
164 | copy = copy_tree (&new_hare, tortoise, tortoise_delay); | |
165 | SCM_SETCAR (tail, copy); | |
166 | ||
167 | /* The remaining pairs of the list are copied by, horizontally, | |
168 | * having the turtle follow the rabbit, and, vertically, having the | |
169 | * tortoise follow the hare into the depths of the stack. */ | |
170 | rabbit = SCM_CDR (rabbit); | |
171 | while (scm_is_pair (rabbit)) | |
172 | { | |
173 | new_hare.obj = SCM_CAR (rabbit); | |
174 | copy = copy_tree (&new_hare, tortoise, tortoise_delay); | |
175 | SCM_SETCDR (tail, scm_cons (copy, SCM_UNDEFINED)); | |
176 | tail = SCM_CDR (tail); | |
177 | ||
178 | rabbit = SCM_CDR (rabbit); | |
179 | if (scm_is_pair (rabbit)) | |
180 | { | |
181 | new_hare.obj = SCM_CAR (rabbit); | |
182 | copy = copy_tree (&new_hare, tortoise, tortoise_delay); | |
183 | SCM_SETCDR (tail, scm_cons (copy, SCM_UNDEFINED)); | |
184 | tail = SCM_CDR (tail); | |
185 | rabbit = SCM_CDR (rabbit); | |
186 | ||
187 | turtle = SCM_CDR (turtle); | |
188 | if (SCM_UNLIKELY (scm_is_eq (rabbit, turtle))) | |
189 | scm_wrong_type_arg_msg (FUNC_NAME, 1, rabbit, | |
190 | "expected non-circular data structure"); | |
191 | } | |
192 | } | |
193 | ||
194 | /* We have to recurse into copy_tree again for the last cdr, in | |
195 | * order to handle the situation that it holds a vector. */ | |
196 | new_hare.obj = rabbit; | |
197 | copy = copy_tree (&new_hare, tortoise, tortoise_delay); | |
198 | SCM_SETCDR (tail, copy); | |
199 | ||
200 | return result; | |
201 | } | |
202 | } | |
203 | } | |
204 | #undef FUNC_NAME | |
205 | ||
206 | \f | |
207 | void | |
208 | scm_init_trees () | |
209 | { | |
210 | #include "libguile/trees.x" | |
211 | } |