mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Move copy-tree to (ice-9 copy-tree); deprecate main binding
* doc/ref/api-data.texi (List Constructors): * doc/ref/api-utility.texi (Copying): Update docs to mention module. * libguile.h: Remove trees.h inclusion. * libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES): (DOT_X_FILES, DOT_DOC_FILES, modinclude_HEADERS): Remove trees.c, trees.h, and related files. * libguile/init.c (scm_i_init_guile): Remove trees.h and the scm_init_trees call. * libguile/trees.c: * libguile/trees.h: Remove. * module/Makefile.am (SOURCES): Add ice-9/copy-tree.scm. * module/ice-9/copy-tree.scm: New file. * module/ice-9/deprecated.scm (copy-tree*): Export as copy-tree, proxying to (ice-9 copy-tree). * module/system/repl/common.scm: * module/web/client.scm: * test-suite/tests/elisp.test: * test-suite/tests/srfi-1.test: * module/oop/goops/save.scm: Use (ice-9 copy-tree). * test-suite/Makefile.am (SCM_TESTS): Add copy-tree.test. * test-suite/tests/copy-tree.test: New file; test pulled from eval.test. * libguile/deprecated.h: * libguile/deprecated.c (scm_copy_tree): Deprecate.
This commit is contained in:
parent
433b701a23
commit
e9c5a1719b
20 changed files with 174 additions and 290 deletions
|
@ -5924,7 +5924,8 @@ that modifying the elements of the new list also modifies the elements
|
|||
of the old list. On the other hand, applying procedures like
|
||||
@code{set-cdr!} or @code{delv!} to the new list will not alter the old
|
||||
list. If you also need to copy the list elements (making a deep copy),
|
||||
use the procedure @code{copy-tree} (@pxref{Copying}).
|
||||
use the procedure @code{copy-tree} from @code{(ice-9 copy-tree)}
|
||||
(@pxref{Copying}).
|
||||
|
||||
@node List Selection
|
||||
@subsubsection List Selection
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
@c -*-texinfo-*-
|
||||
@c This is part of the GNU Guile Reference Manual.
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2012, 2013, 2014
|
||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011, 2012, 2013, 2014, 2020
|
||||
@c Free Software Foundation, Inc.
|
||||
@c See the file guile.texi for copying conditions.
|
||||
|
||||
|
@ -378,13 +378,16 @@ is not specified.
|
|||
@node Copying
|
||||
@subsection Copying Deep Structures
|
||||
|
||||
@c FIXME::martin: Review me!
|
||||
|
||||
The procedures for copying lists (@pxref{Lists}) only produce a flat
|
||||
copy of the input list, and currently Guile does not even contain
|
||||
procedures for copying vectors. @code{copy-tree} can be used for these
|
||||
application, as it does not only copy the spine of a list, but also
|
||||
copies any pairs in the cars of the input lists.
|
||||
procedures for copying vectors. The @code{(ice-9 copy-tree)} module
|
||||
contains a @code{copy-tree} function that can be used for this purpose,
|
||||
as it does not only copy the spine of a list, but also copies any pairs
|
||||
in the cars of the input lists.
|
||||
|
||||
@example
|
||||
(use-modules (ice-9 copy-tree))
|
||||
@end example
|
||||
|
||||
@deffn {Scheme Procedure} copy-tree obj
|
||||
@deffnx {C Function} scm_copy_tree (obj)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#ifndef SCM_LIBGUILE_H
|
||||
#define SCM_LIBGUILE_H
|
||||
|
||||
/* Copyright 1995-1998,2000-2004,2006,2008-2014,2018
|
||||
/* Copyright 1995-1998,2000-2004,2006,2008-2014,2018,2020
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
@ -112,7 +112,6 @@ extern "C" {
|
|||
#include "libguile/struct.h"
|
||||
#include "libguile/symbols.h"
|
||||
#include "libguile/throw.h"
|
||||
#include "libguile/trees.h"
|
||||
#include "libguile/uniform.h"
|
||||
#include "libguile/values.h"
|
||||
#include "libguile/variable.h"
|
||||
|
|
|
@ -225,7 +225,6 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \
|
|||
syntax.c \
|
||||
threads.c \
|
||||
throw.c \
|
||||
trees.c \
|
||||
unicode.c \
|
||||
uniform.c \
|
||||
values.c \
|
||||
|
@ -336,7 +335,6 @@ DOT_X_FILES = \
|
|||
syntax.x \
|
||||
threads.x \
|
||||
throw.x \
|
||||
trees.x \
|
||||
unicode.x \
|
||||
uniform.x \
|
||||
values.x \
|
||||
|
@ -440,7 +438,6 @@ DOT_DOC_FILES = \
|
|||
syntax.doc \
|
||||
threads.doc \
|
||||
throw.doc \
|
||||
trees.doc \
|
||||
unicode.doc \
|
||||
uniform.doc \
|
||||
values.doc \
|
||||
|
@ -702,7 +699,6 @@ modinclude_HEADERS = \
|
|||
tags.h \
|
||||
threads.h \
|
||||
throw.h \
|
||||
trees.h \
|
||||
validate.h \
|
||||
unicode.h \
|
||||
uniform.h \
|
||||
|
|
|
@ -31,8 +31,10 @@
|
|||
#include "boolean.h"
|
||||
#include "bitvectors.h"
|
||||
#include "deprecation.h"
|
||||
#include "eval.h"
|
||||
#include "gc.h"
|
||||
#include "gsubr.h"
|
||||
#include "modules.h"
|
||||
#include "procprop.h"
|
||||
#include "srcprop.h"
|
||||
#include "srfi-4.h"
|
||||
|
@ -586,6 +588,16 @@ scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
|
|||
filename, alist);
|
||||
}
|
||||
|
||||
SCM
|
||||
scm_copy_tree (SCM obj)
|
||||
{
|
||||
scm_c_issue_deprecation_warning
|
||||
("scm_copy_tree is deprecated; use copy-tree from (ice-9 copy-tree) "
|
||||
"instead.");
|
||||
|
||||
return scm_call_1 (scm_c_public_ref ("ice-9 copy-tree", "copy-tree"), obj);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -138,6 +138,8 @@ SCM_DEPRECATED SCM scm_sym_copy;
|
|||
SCM_DEPRECATED SCM scm_make_srcprops (long line, int col, SCM filename,
|
||||
SCM copy, SCM alist);
|
||||
|
||||
SCM_DEPRECATED SCM scm_copy_tree (SCM obj);
|
||||
|
||||
void scm_i_init_deprecated (void);
|
||||
|
||||
#endif
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright 1995-2004,2006,2009-2014,2016-2019
|
||||
/* Copyright 1995-2004,2006,2009-2014,2016-2020
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
@ -137,7 +137,6 @@
|
|||
#include "symbols.h"
|
||||
#include "syntax.h"
|
||||
#include "throw.h"
|
||||
#include "trees.h"
|
||||
#include "unicode.h"
|
||||
#include "uniform.h"
|
||||
#include "values.h"
|
||||
|
@ -462,7 +461,6 @@ scm_i_init_guile (void *base)
|
|||
scm_init_srfi_14 (); /* Requires smob_prehistory */
|
||||
scm_init_exceptions ();
|
||||
scm_init_throw (); /* Requires smob_prehistory */
|
||||
scm_init_trees ();
|
||||
scm_init_version ();
|
||||
scm_init_weak_set ();
|
||||
scm_init_weak_table ();
|
||||
|
|
210
libguile/trees.c
210
libguile/trees.c
|
@ -1,210 +0,0 @@
|
|||
/* Copyright 1995-2010,2018
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#ifdef HAVE_CONFIG_H
|
||||
# include <config.h>
|
||||
#endif
|
||||
|
||||
#include <stdarg.h>
|
||||
|
||||
#include "eq.h"
|
||||
#include "gsubr.h"
|
||||
#include "list.h"
|
||||
#include "pairs.h"
|
||||
#include "srcprop.h"
|
||||
#include "vectors.h"
|
||||
|
||||
#include "trees.h"
|
||||
|
||||
|
||||
/* scm_copy_tree creates deep copies of pairs and vectors, but not of any other
|
||||
* data types.
|
||||
*
|
||||
* To avoid infinite recursion due to cyclic structures, the hare-and-tortoise
|
||||
* pattern is used to detect cycles. In fact, the pattern is used in two
|
||||
* dimensions, vertical (indicated in the code by the variable names 'hare'
|
||||
* and 'tortoise') and horizontal ('rabbit' and 'turtle'). In both
|
||||
* dimensions, the hare/rabbit will take two steps when the tortoise/turtle
|
||||
* takes one.
|
||||
*
|
||||
* The vertical dimension corresponds to recursive calls to function
|
||||
* copy_tree: This happens when descending into vector elements, into cars of
|
||||
* lists and into the cdr of an improper list. In this dimension, the
|
||||
* tortoise follows the hare by using the processor stack: Every stack frame
|
||||
* will hold an instance of struct t_trace. These instances are connected in
|
||||
* a way that represents the trace of the hare, which thus can be followed by
|
||||
* the tortoise. The tortoise will always point to struct t_trace instances
|
||||
* relating to SCM objects that have already been copied. Thus, a cycle is
|
||||
* detected if the tortoise and the hare point to the same object,
|
||||
*
|
||||
* The horizontal dimension is within one execution of copy_tree, when the
|
||||
* function cdr's along the pairs of a list. This is the standard
|
||||
* hare-and-tortoise implementation, found several times in guile. */
|
||||
|
||||
struct t_trace {
|
||||
struct t_trace *trace; /* These pointers form a trace along the stack. */
|
||||
SCM obj; /* The object handled at the respective stack frame.*/
|
||||
};
|
||||
|
||||
static SCM
|
||||
copy_tree (struct t_trace *const hare,
|
||||
struct t_trace *tortoise,
|
||||
unsigned int tortoise_delay);
|
||||
|
||||
SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"Recursively copy the data tree that is bound to @var{obj}, and return a\n"
|
||||
"the new data structure. @code{copy-tree} recurses down the\n"
|
||||
"contents of both pairs and vectors (since both cons cells and vector\n"
|
||||
"cells may point to arbitrary objects), and stops recursing when it hits\n"
|
||||
"any other object.")
|
||||
#define FUNC_NAME s_scm_copy_tree
|
||||
{
|
||||
/* Prepare the trace along the stack. */
|
||||
struct t_trace trace;
|
||||
trace.obj = obj;
|
||||
|
||||
/* In function copy_tree, if the tortoise makes its step, it will do this
|
||||
* before the hare has the chance to move. Thus, we have to make sure that
|
||||
* the very first step of the tortoise will not happen after the hare has
|
||||
* really made two steps. This is achieved by passing '2' as the initial
|
||||
* delay for the tortoise. NOTE: Since cycles are unlikely, giving the hare
|
||||
* a bigger advantage may improve performance slightly. */
|
||||
return copy_tree (&trace, &trace, 2);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
static SCM
|
||||
copy_tree (struct t_trace *const hare,
|
||||
struct t_trace *tortoise,
|
||||
unsigned int tortoise_delay)
|
||||
#define FUNC_NAME s_scm_copy_tree
|
||||
{
|
||||
if (!scm_is_pair (hare->obj) && !scm_is_vector (hare->obj))
|
||||
{
|
||||
return hare->obj;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Prepare the trace along the stack. */
|
||||
struct t_trace new_hare;
|
||||
hare->trace = &new_hare;
|
||||
|
||||
/* The tortoise will make its step after the delay has elapsed. Note
|
||||
* that in contrast to the typical hare-and-tortoise pattern, the step
|
||||
* of the tortoise happens before the hare takes its steps. This is, in
|
||||
* principle, no problem, except for the start of the algorithm: Then,
|
||||
* it has to be made sure that the hare actually gets its advantage of
|
||||
* two steps. */
|
||||
if (tortoise_delay == 0)
|
||||
{
|
||||
tortoise_delay = 1;
|
||||
tortoise = tortoise->trace;
|
||||
if (SCM_UNLIKELY (scm_is_eq (hare->obj, tortoise->obj)))
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 1, hare->obj,
|
||||
"expected non-circular data structure");
|
||||
}
|
||||
else
|
||||
{
|
||||
--tortoise_delay;
|
||||
}
|
||||
|
||||
if (scm_is_vector (hare->obj))
|
||||
{
|
||||
size_t length = SCM_SIMPLE_VECTOR_LENGTH (hare->obj);
|
||||
SCM new_vector = scm_c_make_vector (length, SCM_UNSPECIFIED);
|
||||
|
||||
/* Each vector element is copied by recursing into copy_tree, having
|
||||
* the tortoise follow the hare into the depths of the stack. */
|
||||
unsigned long int i;
|
||||
for (i = 0; i < length; ++i)
|
||||
{
|
||||
SCM new_element;
|
||||
new_hare.obj = SCM_SIMPLE_VECTOR_REF (hare->obj, i);
|
||||
new_element = copy_tree (&new_hare, tortoise, tortoise_delay);
|
||||
SCM_SIMPLE_VECTOR_SET (new_vector, i, new_element);
|
||||
}
|
||||
|
||||
return new_vector;
|
||||
}
|
||||
else /* scm_is_pair (hare->obj) */
|
||||
{
|
||||
SCM result;
|
||||
SCM tail;
|
||||
|
||||
SCM rabbit = hare->obj;
|
||||
SCM turtle = hare->obj;
|
||||
|
||||
SCM copy;
|
||||
|
||||
/* The first pair of the list is treated specially, in order to
|
||||
* preserve a potential source code position. */
|
||||
result = tail = scm_cons_source (rabbit, SCM_EOL, SCM_EOL);
|
||||
new_hare.obj = SCM_CAR (rabbit);
|
||||
copy = copy_tree (&new_hare, tortoise, tortoise_delay);
|
||||
SCM_SETCAR (tail, copy);
|
||||
|
||||
/* The remaining pairs of the list are copied by, horizontally,
|
||||
* having the turtle follow the rabbit, and, vertically, having the
|
||||
* tortoise follow the hare into the depths of the stack. */
|
||||
rabbit = SCM_CDR (rabbit);
|
||||
while (scm_is_pair (rabbit))
|
||||
{
|
||||
new_hare.obj = SCM_CAR (rabbit);
|
||||
copy = copy_tree (&new_hare, tortoise, tortoise_delay);
|
||||
SCM_SETCDR (tail, scm_cons (copy, SCM_UNDEFINED));
|
||||
tail = SCM_CDR (tail);
|
||||
|
||||
rabbit = SCM_CDR (rabbit);
|
||||
if (scm_is_pair (rabbit))
|
||||
{
|
||||
new_hare.obj = SCM_CAR (rabbit);
|
||||
copy = copy_tree (&new_hare, tortoise, tortoise_delay);
|
||||
SCM_SETCDR (tail, scm_cons (copy, SCM_UNDEFINED));
|
||||
tail = SCM_CDR (tail);
|
||||
rabbit = SCM_CDR (rabbit);
|
||||
|
||||
turtle = SCM_CDR (turtle);
|
||||
if (SCM_UNLIKELY (scm_is_eq (rabbit, turtle)))
|
||||
scm_wrong_type_arg_msg (FUNC_NAME, 1, rabbit,
|
||||
"expected non-circular data structure");
|
||||
}
|
||||
}
|
||||
|
||||
/* We have to recurse into copy_tree again for the last cdr, in
|
||||
* order to handle the situation that it holds a vector. */
|
||||
new_hare.obj = rabbit;
|
||||
copy = copy_tree (&new_hare, tortoise, tortoise_delay);
|
||||
SCM_SETCDR (tail, copy);
|
||||
|
||||
return result;
|
||||
}
|
||||
}
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_init_trees ()
|
||||
{
|
||||
#include "trees.x"
|
||||
}
|
|
@ -1,37 +0,0 @@
|
|||
#ifndef SCM_TREES_H
|
||||
#define SCM_TREES_H
|
||||
|
||||
/* Copyright 2009,2018
|
||||
Free Software Foundation, Inc.
|
||||
|
||||
This file is part of Guile.
|
||||
|
||||
Guile is free software: you can redistribute it and/or modify it
|
||||
under the terms of the GNU Lesser General Public License as published
|
||||
by the Free Software Foundation, either version 3 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||||
License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with Guile. If not, see
|
||||
<https://www.gnu.org/licenses/>. */
|
||||
|
||||
|
||||
|
||||
#include "libguile/scm.h"
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_copy_tree (SCM obj);
|
||||
|
||||
|
||||
|
||||
/* Guile internal functions */
|
||||
|
||||
SCM_INTERNAL void scm_init_trees (void);
|
||||
|
||||
#endif /* SCM_TREES_H */
|
|
@ -104,6 +104,7 @@ SOURCES = \
|
|||
ice-9/command-line.scm \
|
||||
ice-9/common-list.scm \
|
||||
ice-9/control.scm \
|
||||
ice-9/copy-tree.scm \
|
||||
ice-9/curried-definitions.scm \
|
||||
ice-9/deprecated.scm \
|
||||
ice-9/documentation.scm \
|
||||
|
|
87
module/ice-9/copy-tree.scm
Normal file
87
module/ice-9/copy-tree.scm
Normal file
|
@ -0,0 +1,87 @@
|
|||
;;; copy-tree
|
||||
;;; Copyright (C) 1995-2010,2018,2020 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software: you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU Lesser General Public License as
|
||||
;;; published by the Free Software Foundation, either version 3 of the
|
||||
;;; License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This library is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;; Lesser General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU Lesser General Public
|
||||
;;; License along with this program. If not, see
|
||||
;;; <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; Copying pairs and vectors of data, while detecting cycles.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
|
||||
(define-module (ice-9 copy-tree)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:replace (copy-tree))
|
||||
|
||||
;;; copy-tree creates deep copies of pairs and vectors, but not of any
|
||||
;;; other data types.
|
||||
;;;
|
||||
;;; To avoid infinite recursion due to cyclic structures, the
|
||||
;;; hare-and-tortoise pattern is used to detect cycles.
|
||||
|
||||
(define (make-race obj)
|
||||
(define (make-race advance-tortoise? tortoise-path hare-tail)
|
||||
(define (advance! hare)
|
||||
(let ((tail (list hare)))
|
||||
(set-cdr! hare-tail tail)
|
||||
(set! hare-tail tail))
|
||||
(when (eq? hare (car tortoise-path))
|
||||
(scm-error 'wrong-type-arg "copy-tree"
|
||||
"Expected non-circular data structure: ~S" (list hare) #f))
|
||||
(when advance-tortoise?
|
||||
(set! tortoise-path (cdr tortoise-path)))
|
||||
(set! advance-tortoise? (not advance-tortoise?)))
|
||||
(define (split!)
|
||||
(make-race advance-tortoise? tortoise-path hare-tail))
|
||||
(values advance! split!))
|
||||
(let ((path (cons obj '())))
|
||||
(make-race #f path path)))
|
||||
|
||||
(define (copy-tree obj)
|
||||
"Recursively copy the data tree that is bound to @var{obj}, and return a\n"
|
||||
"the new data structure. @code{copy-tree} recurses down the\n"
|
||||
"contents of both pairs and vectors (since both cons cells and vector\n"
|
||||
"cells may point to arbitrary objects), and stops recursing when it hits\n"
|
||||
"any other object."
|
||||
(define (trace? x) (or (pair? x) (vector? x)))
|
||||
(define (visit obj advance! split!)
|
||||
(define (visit-head obj)
|
||||
(if (trace? obj)
|
||||
(let-values (((advance! split!) (split!)))
|
||||
(advance! obj)
|
||||
(visit obj advance! split!))
|
||||
obj))
|
||||
(define (visit-tail obj)
|
||||
(when (trace? obj) (advance! obj))
|
||||
(visit obj advance! split!))
|
||||
(cond
|
||||
((pair? obj)
|
||||
(let* ((head (visit-head (car obj)))
|
||||
(tail (visit-tail (cdr obj))))
|
||||
(cons head tail)))
|
||||
((vector? obj)
|
||||
(let* ((len (vector-length obj))
|
||||
(v (make-vector len)))
|
||||
(let lp ((i 0))
|
||||
(when (< i len)
|
||||
(vector-set! v i (visit-head (vector-ref obj i)))
|
||||
(lp (1+ i))))
|
||||
v))
|
||||
(else
|
||||
obj)))
|
||||
(let-values (((advance! split!) (make-race obj)))
|
||||
(visit obj advance! split!)))
|
|
@ -1,4 +1,4 @@
|
|||
;;;; Copyright (C) 2003, 2005, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2017, 2020 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -15,7 +15,9 @@
|
|||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
;;;;
|
||||
|
||||
(define-module (ice-9 deprecated))
|
||||
(define-module (ice-9 deprecated)
|
||||
#:use-module (ice-9 copy-tree)
|
||||
#:export ((copy-tree* . copy-tree)))
|
||||
|
||||
(define-syntax-rule (define-deprecated name message exp)
|
||||
(begin
|
||||
|
@ -31,3 +33,9 @@
|
|||
"allow-legacy-syntax-objects? is deprecated and has no effect. Guile
|
||||
3.0 has no legacy syntax objects."
|
||||
%allow-legacy-syntax-objects?)
|
||||
|
||||
(define (copy-tree* x)
|
||||
(issue-deprecation-warning
|
||||
"copy-tree in the default environment is deprecated. Import it
|
||||
from (ice-9 copy-tree) instead.")
|
||||
(copy-tree x))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;; installed-scm-file
|
||||
|
||||
;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013, 2015 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013, 2015, 2020 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -19,8 +19,9 @@
|
|||
|
||||
|
||||
(define-module (oop goops save)
|
||||
:use-module (oop goops internal)
|
||||
:export (make-unbound save-objects load-objects restore
|
||||
#:use-module (ice-9 copy-tree)
|
||||
#:use-module (oop goops internal)
|
||||
#:export (make-unbound save-objects load-objects restore
|
||||
enumerate! enumerate-component!
|
||||
write-readably write-component write-component-procedure
|
||||
literal? readable make-readable))
|
||||
|
|
|
@ -26,6 +26,7 @@
|
|||
#:use-module (system vm program)
|
||||
#:use-module (system vm loader)
|
||||
#:use-module (ice-9 control)
|
||||
#:use-module (ice-9 copy-tree)
|
||||
#:use-module (ice-9 history)
|
||||
#:export (<repl> make-repl repl-language repl-options
|
||||
repl-tm-stats repl-gc-stats repl-debug
|
||||
|
|
|
@ -34,6 +34,7 @@
|
|||
(define-module (web client)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
#:use-module (ice-9 copy-tree)
|
||||
#:use-module (ice-9 iconv)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (web request)
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
## Process this file with automake to produce Makefile.in.
|
||||
##
|
||||
## Copyright 2001-2019 Software Foundation, Inc.
|
||||
## Copyright 2001-2020 Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
|
@ -38,6 +38,7 @@ SCM_TESTS = tests/00-initial-env.test \
|
|||
tests/compiler.test \
|
||||
tests/control.test \
|
||||
tests/continuations.test \
|
||||
tests/copy-tree.test \
|
||||
tests/coverage.test \
|
||||
tests/cross-compilation.test \
|
||||
tests/curried-definitions.test \
|
||||
|
|
33
test-suite/tests/copy-tree.test
Normal file
33
test-suite/tests/copy-tree.test
Normal file
|
@ -0,0 +1,33 @@
|
|||
;;;; Copyright (C) 2000-2001,2003-2015,2017,2019,2020
|
||||
;;;; Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;;; License as published by the Free Software Foundation; either
|
||||
;;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; This library is distributed in the hope that it will be useful,
|
||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;;;; Lesser General Public License for more details.
|
||||
;;;;
|
||||
;;;; You should have received a copy of the GNU Lesser General Public
|
||||
;;;; License along with this library; if not, write to the Free Software
|
||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
(define-module (test-suite test-copy-tree)
|
||||
:use-module (test-suite lib)
|
||||
:use-module (ice-9 copy-tree))
|
||||
|
||||
(with-test-prefix "copy-tree"
|
||||
(pass-if "(#t . #(#t))"
|
||||
(let* ((foo (cons #t (vector #t)))
|
||||
(bar (copy-tree foo)))
|
||||
(vector-set! (cdr foo) 0 #f)
|
||||
(equal? bar '(#t . #(#t)))))
|
||||
|
||||
(pass-if-exception "circular lists in forms"
|
||||
'(wrong-type-arg . "")
|
||||
(let ((foo (list #f)))
|
||||
(set-cdr! foo foo)
|
||||
(copy-tree foo))))
|
|
@ -1,5 +1,5 @@
|
|||
;;;; elisp.test --- tests guile's elisp support -*- scheme -*-
|
||||
;;;; Copyright (C) 2002, 2003, 2006, 2009, 2010 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2002, 2003, 2006, 2009, 2010, 2020 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -16,6 +16,7 @@
|
|||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
(define-module (test-suite test-elisp)
|
||||
#:use-module (ice-9 copy-tree)
|
||||
#:use-module (test-suite lib)
|
||||
#:use-module (system base compile)
|
||||
#:use-module (ice-9 weak-vector))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;;; eval.test --- tests guile's evaluator -*- scheme -*-
|
||||
;;;; Copyright (C) 2000-2001,2003-2015,2017,2019
|
||||
;;;; Copyright (C) 2000-2001,2003-2015,2017,2019,2020
|
||||
;;;; Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
|
@ -50,21 +50,6 @@
|
|||
;;;
|
||||
|
||||
(with-test-prefix "memoization"
|
||||
|
||||
(with-test-prefix "copy-tree"
|
||||
|
||||
(pass-if "(#t . #(#t))"
|
||||
(let* ((foo (cons #t (vector #t)))
|
||||
(bar (copy-tree foo)))
|
||||
(vector-set! (cdr foo) 0 #f)
|
||||
(equal? bar '(#t . #(#t)))))
|
||||
|
||||
(pass-if-exception "circular lists in forms"
|
||||
exception:wrong-type-arg
|
||||
(let ((foo (list #f)))
|
||||
(set-cdr! foo foo)
|
||||
(copy-tree foo))))
|
||||
|
||||
(pass-if "transparency"
|
||||
(let ((x '(begin 1)))
|
||||
(eval x (current-module))
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*-
|
||||
;;;;
|
||||
;;;; Copyright 2003-2006, 2008-2011, 2014 Free Software Foundation, Inc.
|
||||
;;;; Copyright 2003-2006, 2008-2011, 2014, 2020 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -18,6 +18,7 @@
|
|||
|
||||
(define-module (test-srfi-1)
|
||||
#:use-module (test-suite lib)
|
||||
#:use-module (ice-9 copy-tree)
|
||||
#:use-module (srfi srfi-1))
|
||||
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue