mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: libguile/__scm.h libguile/array-map.c libguile/procprop.c libguile/tags.h module/ice-9/deprecated.scm module/ice-9/psyntax-pp.scm module/ice-9/psyntax.scm test-suite/standalone/test-num2integral.c test-suite/tests/regexp.test
This commit is contained in:
commit
91ee7515da
64 changed files with 1024 additions and 648 deletions
1
.x-sc_bindtextdomain
Normal file
1
.x-sc_bindtextdomain
Normal file
|
@ -0,0 +1 @@
|
||||||
|
*
|
|
@ -4,3 +4,4 @@
|
||||||
^emacs/
|
^emacs/
|
||||||
^NEWS
|
^NEWS
|
||||||
^doc/
|
^doc/
|
||||||
|
^test-suite/tests/ports.test
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
doc/*
|
doc/*
|
||||||
lib/flock.c
|
lib/flock.c
|
||||||
|
lib/fcntl.in.h
|
||||||
libguile/filesys.c
|
libguile/filesys.c
|
||||||
libguile/ChangeLog-2008
|
libguile/ChangeLog-2008
|
||||||
|
|
7
.x-sc_prohibit_doubled_word
Normal file
7
.x-sc_prohibit_doubled_word
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
^AUTHORS
|
||||||
|
^gc-benchmarks/larceny/
|
||||||
|
^module/ice-9/format.scm
|
||||||
|
^module/ice-9/match.upstream.scm
|
||||||
|
^module/sxml/upstream
|
||||||
|
compile.scm
|
||||||
|
ChangeLog
|
5
.x-sc_prohibit_have_config_h
Normal file
5
.x-sc_prohibit_have_config_h
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
libguile/*
|
||||||
|
srfi/*
|
||||||
|
test-suite/*
|
||||||
|
guile-readline/*
|
||||||
|
lib/*
|
|
@ -2,3 +2,4 @@ configure.ac
|
||||||
NEWS
|
NEWS
|
||||||
doc/ref/api-init.texi
|
doc/ref/api-init.texi
|
||||||
libguile/ChangeLog*
|
libguile/ChangeLog*
|
||||||
|
m4/*
|
||||||
|
|
2
.x-sc_prohibit_path_max_allocation
Normal file
2
.x-sc_prohibit_path_max_allocation
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
libguile/win32-socket.c
|
||||||
|
lib/stat.c
|
3
.x-sc_prohibit_strcmp
Normal file
3
.x-sc_prohibit_strcmp
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
m4/*
|
||||||
|
lib/*
|
||||||
|
test-suite/*
|
4
HACKING
4
HACKING
|
@ -1,6 +1,6 @@
|
||||||
-*-text-*-
|
-*-text-*-
|
||||||
Guile Hacking Guide
|
Guile Hacking Guide
|
||||||
Copyright (c) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2008 Free software Foundation, Inc.
|
Copyright (c) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2008, 2012 Free software Foundation, Inc.
|
||||||
|
|
||||||
Permission is granted to anyone to make or distribute verbatim copies
|
Permission is granted to anyone to make or distribute verbatim copies
|
||||||
of this document as received, in any medium, provided that the
|
of this document as received, in any medium, provided that the
|
||||||
|
@ -222,7 +222,7 @@ When deprecating a definition, always follow this procedure:
|
||||||
manage without the deprecated definition.
|
manage without the deprecated definition.
|
||||||
|
|
||||||
4. Add an entry that the definition has been deprecated in NEWS and
|
4. Add an entry that the definition has been deprecated in NEWS and
|
||||||
explain what do do instead.
|
explain what to do instead.
|
||||||
|
|
||||||
5. In file TODO, there is a list of releases with reminders about what
|
5. In file TODO, there is a list of releases with reminders about what
|
||||||
to do at each release. Add a reminder about the removal of the
|
to do at each release. Add a reminder about the removal of the
|
||||||
|
|
8
NEWS
8
NEWS
|
@ -1,5 +1,5 @@
|
||||||
Guile NEWS --- history of user-visible changes.
|
Guile NEWS --- history of user-visible changes.
|
||||||
Copyright (C) 1996-2011 Free Software Foundation, Inc.
|
Copyright (C) 1996-2012 Free Software Foundation, Inc.
|
||||||
See the end for copying conditions.
|
See the end for copying conditions.
|
||||||
|
|
||||||
Please send Guile bug reports to bug-guile@gnu.org.
|
Please send Guile bug reports to bug-guile@gnu.org.
|
||||||
|
@ -1386,7 +1386,7 @@ Arguments", and "Case-lambda" in the manual.
|
||||||
|
|
||||||
Instead of accessing a procedure's arity as a property, use the new
|
Instead of accessing a procedure's arity as a property, use the new
|
||||||
`procedure-minimum-arity' function, which gives the most permissive
|
`procedure-minimum-arity' function, which gives the most permissive
|
||||||
arity that the the function has, in the same format as the old arity
|
arity that the function has, in the same format as the old arity
|
||||||
accessor.
|
accessor.
|
||||||
|
|
||||||
** `lambda*' and `define*' are now available in the default environment
|
** `lambda*' and `define*' are now available in the default environment
|
||||||
|
@ -2156,7 +2156,7 @@ allocated to primitive procedures, each with its own calling convention.
|
||||||
Now there is only one, the gsubr. This may affect user code if you were
|
Now there is only one, the gsubr. This may affect user code if you were
|
||||||
defining a procedure using scm_c_make_subr rather scm_c_make_gsubr. The
|
defining a procedure using scm_c_make_subr rather scm_c_make_gsubr. The
|
||||||
solution is to switch to use scm_c_make_gsubr. This solution works well
|
solution is to switch to use scm_c_make_gsubr. This solution works well
|
||||||
both with the old 1.8 and and with the current 1.9 branch.
|
both with the old 1.8 and with the current 1.9 branch.
|
||||||
|
|
||||||
Guile's old evaluator used to have special cases for applying "gsubrs",
|
Guile's old evaluator used to have special cases for applying "gsubrs",
|
||||||
primitive procedures with specified numbers of required, optional, and
|
primitive procedures with specified numbers of required, optional, and
|
||||||
|
@ -6193,7 +6193,7 @@ incrementally add to the innermost environment, without checking
|
||||||
whether the restrictions specified in RnRS were met. This lead to the
|
whether the restrictions specified in RnRS were met. This lead to the
|
||||||
correct behaviour when these restriction actually were met, but didn't
|
correct behaviour when these restriction actually were met, but didn't
|
||||||
catch all illegal uses. Such an illegal use could lead to crashes of
|
catch all illegal uses. Such an illegal use could lead to crashes of
|
||||||
the Guile interpreter or or other unwanted results. An example of
|
the Guile interpreter or other unwanted results. An example of
|
||||||
incorrect internal defines that made Guile behave erratically:
|
incorrect internal defines that made Guile behave erratically:
|
||||||
|
|
||||||
(let ()
|
(let ()
|
||||||
|
|
|
@ -7132,7 +7132,7 @@ with the strings in the list @var{ls}.
|
||||||
@deffn {Scheme Procedure} string-concatenate-reverse/shared ls [final_string [end]]
|
@deffn {Scheme Procedure} string-concatenate-reverse/shared ls [final_string [end]]
|
||||||
@deffnx {C Function} scm_string_concatenate_reverse_shared (ls, final_string, end)
|
@deffnx {C Function} scm_string_concatenate_reverse_shared (ls, final_string, end)
|
||||||
Like @code{string-concatenate-reverse}, but the result may
|
Like @code{string-concatenate-reverse}, but the result may
|
||||||
share memory with the the strings in the @var{ls} arguments.
|
share memory with the strings in the @var{ls} arguments.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
string-map
|
string-map
|
||||||
|
|
|
@ -1560,7 +1560,7 @@ same type, and have corresponding elements which are either
|
||||||
@c FIXME: array-for-each doesn't say what happens if the sources have
|
@c FIXME: array-for-each doesn't say what happens if the sources have
|
||||||
@c different index ranges. The code currently iterates over the
|
@c different index ranges. The code currently iterates over the
|
||||||
@c indices of the first and expects the others to cover those. That
|
@c indices of the first and expects the others to cover those. That
|
||||||
@c at least vaguely matches array-map!, but is is meant to be a
|
@c at least vaguely matches array-map!, but is it meant to be a
|
||||||
@c documented feature?
|
@c documented feature?
|
||||||
|
|
||||||
@deffn {Scheme Procedure} array-map! dst proc src1 @dots{} srcN
|
@deffn {Scheme Procedure} array-map! dst proc src1 @dots{} srcN
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011, 2012
|
||||||
@c Free Software Foundation, Inc.
|
@c Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
|
@ -1712,14 +1712,6 @@ leave it unspecified which argument's type is incorrect. Again,
|
||||||
@code{SCM_ARGn} should be preferred over a raw zero constant.
|
@code{SCM_ARGn} should be preferred over a raw zero constant.
|
||||||
@end deftypefn
|
@end deftypefn
|
||||||
|
|
||||||
The @code{SCM_ASRTGO} macro provides another strategy for handling
|
|
||||||
incorrect types.
|
|
||||||
|
|
||||||
@deftypefn Macro void SCM_ASRTGO (int @var{test}, label)
|
|
||||||
If @var{test} is zero, use @code{goto} to jump to the given @var{label}.
|
|
||||||
@var{label} must appear within the current function.
|
|
||||||
@end deftypefn
|
|
||||||
|
|
||||||
@node Continuation Barriers
|
@node Continuation Barriers
|
||||||
@subsection Continuation Barriers
|
@subsection Continuation Barriers
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011, 2012
|
||||||
@c Free Software Foundation, Inc.
|
@c Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
|
@ -40,6 +40,7 @@ languages}, or EDSLs.}.
|
||||||
* Syntax Case:: Procedural, hygienic macros.
|
* Syntax Case:: Procedural, hygienic macros.
|
||||||
* Defmacros:: Lisp-style macros.
|
* Defmacros:: Lisp-style macros.
|
||||||
* Identifier Macros:: Identifier macros.
|
* Identifier Macros:: Identifier macros.
|
||||||
|
* Syntax Parameters:: Syntax Parameters
|
||||||
* Eval When:: Affecting the expand-time environment.
|
* Eval When:: Affecting the expand-time environment.
|
||||||
* Internal Macros:: Macros as first-class values.
|
* Internal Macros:: Macros as first-class values.
|
||||||
@end menu
|
@end menu
|
||||||
|
@ -861,6 +862,81 @@ wrapping in @code{#'} syntax forms.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
|
@node Syntax Parameters
|
||||||
|
@subsection Syntax Parameters
|
||||||
|
|
||||||
|
Syntax parameters@footnote{Described in the paper @cite{Keeping it Clean
|
||||||
|
with Syntax Parameters} by Barzilay, Culpepper and Flatt.} are a
|
||||||
|
mechanism for rebinding a macro definition within the dynamic extent of
|
||||||
|
a macro expansion. This provides a convenient solution to one of the
|
||||||
|
most common types of unhygienic macro: those that introduce a unhygienic
|
||||||
|
binding each time the macro is used. Examples include a @code{lambda}
|
||||||
|
form with a @code{return} keyword, or class macros that introduce a
|
||||||
|
special @code{self} binding.
|
||||||
|
|
||||||
|
With syntax parameters, instead of introducing the binding
|
||||||
|
unhygienically each time, we instead create one binding for the keyword,
|
||||||
|
which we can then adjust later when we want the keyword to have a
|
||||||
|
different meaning. As no new bindings are introduced, hygiene is
|
||||||
|
preserved. This is similar to the dynamic binding mechanisms we have at
|
||||||
|
run-time (@pxref{SRFI-39, parameters}), except that the dynamic binding
|
||||||
|
only occurs during macro expansion. The code after macro expansion
|
||||||
|
remains lexically scoped.
|
||||||
|
|
||||||
|
@deffn {Syntax} define-syntax-parameter keyword transformer
|
||||||
|
Binds @var{keyword} to the value obtained by evaluating
|
||||||
|
@var{transformer}. The @var{transformer} provides the default expansion
|
||||||
|
for the syntax parameter, and in the absence of
|
||||||
|
@code{syntax-parameterize}, is functionally equivalent to
|
||||||
|
@code{define-syntax}. Usually, you will just want to have the
|
||||||
|
@var{transformer} throw a syntax error indicating that the @var{keyword}
|
||||||
|
is supposed to be used in conjunction with another macro, for example:
|
||||||
|
@example
|
||||||
|
(define-syntax-parameter return
|
||||||
|
(lambda (stx)
|
||||||
|
(syntax-violation 'return "return used outside of a lambda^" stx)))
|
||||||
|
@end example
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Syntax} syntax-parameterize ((keyword transformer) @dots{}) exp @dots{}
|
||||||
|
Adjusts @var{keyword} @dots{} to use the values obtained by evaluating
|
||||||
|
their @var{transformer} @dots{}, in the expansion of the @var{exp}
|
||||||
|
@dots{} forms. Each @var{keyword} must be bound to a syntax-parameter.
|
||||||
|
@code{syntax-parameterize} differs from @code{let-syntax}, in that the
|
||||||
|
binding is not shadowed, but adjusted, and so uses of the keyword in the
|
||||||
|
expansion of @var{exp} @dots{} use the new transformers. This is
|
||||||
|
somewhat similar to how @code{parameterize} adjusts the values of
|
||||||
|
regular parameters, rather than creating new bindings.
|
||||||
|
|
||||||
|
@example
|
||||||
|
(define-syntax lambda^
|
||||||
|
(syntax-rules ()
|
||||||
|
[(lambda^ argument-list body body* ...)
|
||||||
|
(lambda argument-list
|
||||||
|
(call-with-current-continuation
|
||||||
|
(lambda (escape)
|
||||||
|
;; In the body we adjust the 'return' keyword so that calls
|
||||||
|
;; to 'return' are replaced with calls to the escape
|
||||||
|
;; continuation.
|
||||||
|
(syntax-parameterize ([return (syntax-rules ()
|
||||||
|
[(return vals (... ...))
|
||||||
|
(escape vals (... ...))])])
|
||||||
|
body body* ...))))]))
|
||||||
|
|
||||||
|
;; Now we can write functions that return early. Here, 'product' will
|
||||||
|
;; return immediately if it sees any 0 element.
|
||||||
|
(define product
|
||||||
|
(lambda^ (list)
|
||||||
|
(fold (lambda (n o)
|
||||||
|
(if (zero? n)
|
||||||
|
(return 0)
|
||||||
|
(* n o)))
|
||||||
|
1
|
||||||
|
list)))
|
||||||
|
@end example
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
@node Eval When
|
@node Eval When
|
||||||
@subsection Eval-when
|
@subsection Eval-when
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, 2009, 2010, 2011
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, 2009, 2010, 2011, 2012
|
||||||
@c Free Software Foundation, Inc.
|
@c Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
|
@ -44,12 +44,13 @@ be used for interacting with the module system.
|
||||||
* General Information about Modules:: Guile module basics.
|
* General Information about Modules:: Guile module basics.
|
||||||
* Using Guile Modules:: How to use existing modules.
|
* Using Guile Modules:: How to use existing modules.
|
||||||
* Creating Guile Modules:: How to package your code into modules.
|
* Creating Guile Modules:: How to package your code into modules.
|
||||||
* Module System Reflection:: Accessing module objects at run-time.
|
* Modules and the File System:: Installing modules in the file system.
|
||||||
* Included Guile Modules:: Which modules come with Guile?
|
|
||||||
* R6RS Version References:: Using version numbers with modules.
|
* R6RS Version References:: Using version numbers with modules.
|
||||||
* R6RS Libraries:: The library and import forms.
|
* R6RS Libraries:: The library and import forms.
|
||||||
* Accessing Modules from C:: How to work with modules with C code.
|
|
||||||
* Variables:: First-class variables.
|
* Variables:: First-class variables.
|
||||||
|
* Module System Reflection:: First-class modules.
|
||||||
|
* Accessing Modules from C:: How to work with modules with C code.
|
||||||
|
* Included Guile Modules:: Which modules come with Guile?
|
||||||
* provide and require:: The SLIB feature mechanism.
|
* provide and require:: The SLIB feature mechanism.
|
||||||
* Environments:: R5RS top-level environments.
|
* Environments:: R5RS top-level environments.
|
||||||
@end menu
|
@end menu
|
||||||
|
@ -61,12 +62,6 @@ A Guile module can be thought of as a collection of named procedures,
|
||||||
variables and macros. More precisely, it is a set of @dfn{bindings}
|
variables and macros. More precisely, it is a set of @dfn{bindings}
|
||||||
of symbols (names) to Scheme objects.
|
of symbols (names) to Scheme objects.
|
||||||
|
|
||||||
An environment is a mapping from identifiers (or symbols) to locations,
|
|
||||||
i.e., a set of bindings.
|
|
||||||
There are top-level environments and lexical environments.
|
|
||||||
The environment in which a lambda is executed is remembered as part of its
|
|
||||||
definition.
|
|
||||||
|
|
||||||
Within a module, all bindings are visible. Certain bindings
|
Within a module, all bindings are visible. Certain bindings
|
||||||
can be declared @dfn{public}, in which case they are added to the
|
can be declared @dfn{public}, in which case they are added to the
|
||||||
module's so-called @dfn{export list}; this set of public bindings is
|
module's so-called @dfn{export list}; this set of public bindings is
|
||||||
|
@ -81,42 +76,18 @@ algorithmically @dfn{rename} bindings. In contrast, when using the
|
||||||
providing module's public interface, the entire export list is available
|
providing module's public interface, the entire export list is available
|
||||||
without renaming (@pxref{Using Guile Modules}).
|
without renaming (@pxref{Using Guile Modules}).
|
||||||
|
|
||||||
To use a module, it must be found and loaded. All Guile modules have a
|
All Guile modules have a unique @dfn{module name}, for example
|
||||||
unique @dfn{module name}, which is a list of one or more symbols.
|
@code{(ice-9 popen)} or @code{(srfi srfi-11)}. Module names are lists
|
||||||
Examples are @code{(ice-9 popen)} or @code{(srfi srfi-11)}. When Guile
|
of one or more symbols.
|
||||||
searches for the code of a module, it constructs the name of the file to
|
|
||||||
load by concatenating the name elements with slashes between the
|
|
||||||
elements and appending a number of file name extensions from the list
|
|
||||||
@code{%load-extensions} (@pxref{Loading}). The resulting file name is
|
|
||||||
then searched in all directories in the variable @code{%load-path}
|
|
||||||
(@pxref{Build Config}). For example, the @code{(ice-9 popen)} module
|
|
||||||
would result in the filename @code{ice-9/popen.scm} and searched in the
|
|
||||||
installation directories of Guile and in all other directories in the
|
|
||||||
load path.
|
|
||||||
|
|
||||||
A slightly different search mechanism is used when a client module
|
When Guile goes to use an interface from a module, for example
|
||||||
specifies a version reference as part of a request to load a module
|
@code{(ice-9 popen)}, Guile first looks to see if it has loaded
|
||||||
(@pxref{R6RS Version References}). Instead of searching the directories
|
@code{(ice-9 popen)} for any reason. If the module has not been loaded
|
||||||
in the load path for a single filename, Guile uses the elements of the
|
yet, Guile searches a @dfn{load path} for a file that might define it,
|
||||||
version reference to locate matching, numbered subdirectories of a
|
and loads that file.
|
||||||
constructed base path. For example, a request for the
|
|
||||||
@code{(rnrs base)} module with version reference @code{(6)} would cause
|
|
||||||
Guile to discover the @code{rnrs/6} subdirectory (if it exists in any of
|
|
||||||
the directories in the load path) and search its contents for the
|
|
||||||
filename @code{base.scm}.
|
|
||||||
|
|
||||||
When multiple modules are found that match a version reference, Guile
|
|
||||||
sorts these modules by version number, followed by the length of their
|
|
||||||
version specifications, in order to choose a ``best'' match.
|
|
||||||
|
|
||||||
@c FIXME::martin: Not sure about this, maybe someone knows better?
|
|
||||||
Every module has a so-called syntax transformer associated with it.
|
|
||||||
This is a procedure which performs all syntax transformation for the
|
|
||||||
time the module is read in and evaluated. When working with modules,
|
|
||||||
you can manipulate the current syntax transformer using the
|
|
||||||
@code{use-syntax} syntactic form or the @code{#:use-syntax} module
|
|
||||||
definition option (@pxref{Creating Guile Modules}).
|
|
||||||
|
|
||||||
|
The following subsections go into more detail on using, creating,
|
||||||
|
installing, and otherwise manipulating modules and the module system.
|
||||||
|
|
||||||
@node Using Guile Modules
|
@node Using Guile Modules
|
||||||
@subsection Using Guile Modules
|
@subsection Using Guile Modules
|
||||||
|
@ -198,14 +169,11 @@ has not yet been loaded yet will be loaded when referenced by a
|
||||||
You can also use the @code{@@} and @code{@@@@} syntaxes as the target
|
You can also use the @code{@@} and @code{@@@@} syntaxes as the target
|
||||||
of a @code{set!} when the binding refers to a variable.
|
of a @code{set!} when the binding refers to a variable.
|
||||||
|
|
||||||
@c begin (scm-doc-string "boot-9.scm" "symbol-prefix-proc")
|
|
||||||
@deffn {Scheme Procedure} symbol-prefix-proc prefix-sym
|
@deffn {Scheme Procedure} symbol-prefix-proc prefix-sym
|
||||||
Return a procedure that prefixes its arg (a symbol) with
|
Return a procedure that prefixes its arg (a symbol) with
|
||||||
@var{prefix-sym}.
|
@var{prefix-sym}.
|
||||||
@c Insert gratuitous C++ slam here. --ttn
|
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@c begin (scm-doc-string "boot-9.scm" "use-modules")
|
|
||||||
@deffn syntax use-modules spec @dots{}
|
@deffn syntax use-modules spec @dots{}
|
||||||
Resolve each interface specification @var{spec} into an interface and
|
Resolve each interface specification @var{spec} into an interface and
|
||||||
arrange for these to be accessible by the current module. The return
|
arrange for these to be accessible by the current module. The return
|
||||||
|
@ -218,7 +186,7 @@ whose public interface is found and used.
|
||||||
|
|
||||||
@cindex binding renamer
|
@cindex binding renamer
|
||||||
@lisp
|
@lisp
|
||||||
(MODULE-NAME [:select SELECTION] [:renamer RENAMER])
|
(MODULE-NAME [#:select SELECTION] [#:renamer RENAMER])
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
in which case a custom interface is newly created and used.
|
in which case a custom interface is newly created and used.
|
||||||
|
@ -229,37 +197,26 @@ a pair of symbols @code{(ORIG . SEEN)}, where @var{orig} is the name in
|
||||||
the used module and @var{seen} is the name in the using module. Note
|
the used module and @var{seen} is the name in the using module. Note
|
||||||
that @var{seen} is also passed through @var{renamer}.
|
that @var{seen} is also passed through @var{renamer}.
|
||||||
|
|
||||||
The @code{:select} and @code{:renamer} clauses are optional. If both are
|
The @code{#:select} and @code{#:renamer} clauses are optional. If both are
|
||||||
omitted, the returned interface has no bindings. If the @code{:select}
|
omitted, the returned interface has no bindings. If the @code{#:select}
|
||||||
clause is omitted, @var{renamer} operates on the used module's public
|
clause is omitted, @var{renamer} operates on the used module's public
|
||||||
interface.
|
interface.
|
||||||
|
|
||||||
In addition to the above, @var{spec} can also include a @code{:version}
|
In addition to the above, @var{spec} can also include a @code{#:version}
|
||||||
clause, of the form:
|
clause, of the form:
|
||||||
|
|
||||||
@lisp
|
@lisp
|
||||||
:version VERSION-SPEC
|
#:version VERSION-SPEC
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
where @var{version-spec} is an R6RS-compatible version reference. The
|
where @var{version-spec} is an R6RS-compatible version reference. An
|
||||||
presence of this clause changes Guile's search behavior as described in
|
error will be signaled in the case in which a module with the same name
|
||||||
the section on module name resolution
|
has already been loaded, if that module specifies a version and that
|
||||||
(@pxref{General Information about Modules}). An error will be signaled
|
version is not compatible with @var{version-spec}. @xref{R6RS Version
|
||||||
in the case in which a module with the same name has already been
|
References}, for more on version references.
|
||||||
loaded, if that module specifies a version and that version is not
|
|
||||||
compatible with @var{version-spec}.
|
|
||||||
|
|
||||||
Signal error if module name is not resolvable.
|
If the module name is not resolvable, @code{use-modules} will signal an
|
||||||
@end deffn
|
error.
|
||||||
|
|
||||||
|
|
||||||
@c FIXME::martin: Is this correct, and is there more to say?
|
|
||||||
@c FIXME::martin: Define term and concept `syntax transformer' somewhere.
|
|
||||||
|
|
||||||
@deffn syntax use-syntax module-name
|
|
||||||
Load the module @code{module-name} and use its syntax
|
|
||||||
transformer as the syntax transformer for the currently defined module,
|
|
||||||
as well as installing it as the current syntax transformer.
|
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn syntax @@ module-name binding-name
|
@deffn syntax @@ module-name binding-name
|
||||||
|
@ -293,10 +250,8 @@ Export all bindings which should be in the public interface, either
|
||||||
by using @code{define-public} or @code{export} (both documented below).
|
by using @code{define-public} or @code{export} (both documented below).
|
||||||
@end itemize
|
@end itemize
|
||||||
|
|
||||||
@c begin (scm-doc-string "boot-9.scm" "define-module")
|
|
||||||
@deffn syntax define-module module-name [options @dots{}]
|
@deffn syntax define-module module-name [options @dots{}]
|
||||||
@var{module-name} is of the form @code{(hierarchy file)}. One
|
@var{module-name} is a list of one or more symbols.
|
||||||
example of this is
|
|
||||||
|
|
||||||
@lisp
|
@lisp
|
||||||
(define-module (ice-9 popen))
|
(define-module (ice-9 popen))
|
||||||
|
@ -309,17 +264,11 @@ The @var{options} are keyword/value pairs which specify more about the
|
||||||
defined module. The recognized options and their meaning is shown in
|
defined module. The recognized options and their meaning is shown in
|
||||||
the following table.
|
the following table.
|
||||||
|
|
||||||
@c fixme: Should we use "#:" or ":"?
|
|
||||||
|
|
||||||
@table @code
|
@table @code
|
||||||
@item #:use-module @var{interface-specification}
|
@item #:use-module @var{interface-specification}
|
||||||
Equivalent to a @code{(use-modules @var{interface-specification})}
|
Equivalent to a @code{(use-modules @var{interface-specification})}
|
||||||
(@pxref{Using Guile Modules}).
|
(@pxref{Using Guile Modules}).
|
||||||
|
|
||||||
@item #:use-syntax @var{module}
|
|
||||||
Use @var{module} when loading the currently defined module, and install
|
|
||||||
it as the syntax transformer.
|
|
||||||
|
|
||||||
@item #:autoload @var{module} @var{symbol-list}
|
@item #:autoload @var{module} @var{symbol-list}
|
||||||
@cindex autoload
|
@cindex autoload
|
||||||
Load @var{module} when any of @var{symbol-list} are accessed. For
|
Load @var{module} when any of @var{symbol-list} are accessed. For
|
||||||
|
@ -357,20 +306,6 @@ symbols or pairs of symbols. The symbols in @var{list} must be
|
||||||
imported by the current module from other modules. This is equivalent
|
imported by the current module from other modules. This is equivalent
|
||||||
to @code{re-export} below.
|
to @code{re-export} below.
|
||||||
|
|
||||||
@item #:export-syntax @var{list}
|
|
||||||
@cindex export-syntax
|
|
||||||
Export all identifiers in @var{list} which must be a list of symbols
|
|
||||||
or pairs of symbols. The identifiers in @var{list} must refer to
|
|
||||||
macros (@pxref{Macros}) defined in the current module. This is
|
|
||||||
equivalent to @code{(export-syntax @var{list})} in the module body.
|
|
||||||
|
|
||||||
@item #:re-export-syntax @var{list}
|
|
||||||
@cindex re-export-syntax
|
|
||||||
Re-export all identifiers in @var{list} which must be a list of
|
|
||||||
symbols or pairs of symbols. The symbols in @var{list} must refer to
|
|
||||||
macros imported by the current module from other modules. This is
|
|
||||||
equivalent to @code{(re-export-syntax @var{list})} in the module body.
|
|
||||||
|
|
||||||
@item #:replace @var{list}
|
@item #:replace @var{list}
|
||||||
@cindex replace
|
@cindex replace
|
||||||
@cindex replacing binding
|
@cindex replacing binding
|
||||||
|
@ -400,6 +335,9 @@ function (@pxref{Time}). Guile assumes that a user importing a module
|
||||||
knows what she is doing, and uses @code{#:replace} for this binding
|
knows what she is doing, and uses @code{#:replace} for this binding
|
||||||
rather than @code{#:export}.
|
rather than @code{#:export}.
|
||||||
|
|
||||||
|
A @code{#:replace} clause is equivalent to @code{(export! @var{list})}
|
||||||
|
in the module body.
|
||||||
|
|
||||||
The @code{#:duplicates} (see below) provides fine-grain control about
|
The @code{#:duplicates} (see below) provides fine-grain control about
|
||||||
duplicate binding handling on the module-user side.
|
duplicate binding handling on the module-user side.
|
||||||
|
|
||||||
|
@ -464,6 +402,10 @@ a duplicate binding situation. As mentioned above, some resolution
|
||||||
policies may explicitly leave the responsibility of handling the
|
policies may explicitly leave the responsibility of handling the
|
||||||
duplication to the next handler in @var{list}.
|
duplication to the next handler in @var{list}.
|
||||||
|
|
||||||
|
If GOOPS has been loaded before the @code{#:duplicates} clause is
|
||||||
|
processed, there are additional strategies available for dealing with
|
||||||
|
generic functions. @xref{Merging Generics}, for more information.
|
||||||
|
|
||||||
@findex default-duplicate-binding-handler
|
@findex default-duplicate-binding-handler
|
||||||
The default duplicate binding resolution policy is given by the
|
The default duplicate binding resolution policy is given by the
|
||||||
@code{default-duplicate-binding-handler} procedure, and is
|
@code{default-duplicate-binding-handler} procedure, and is
|
||||||
|
@ -472,11 +414,6 @@ The default duplicate binding resolution policy is given by the
|
||||||
(replace warn-override-core warn last)
|
(replace warn-override-core warn last)
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
@item #:no-backtrace
|
|
||||||
@cindex no backtrace
|
|
||||||
Tell Guile not to record information for procedure backtraces when
|
|
||||||
executing the procedures in this module.
|
|
||||||
|
|
||||||
@item #:pure
|
@item #:pure
|
||||||
@cindex pure module
|
@cindex pure module
|
||||||
Create a @dfn{pure} module, that is a module which does not contain any
|
Create a @dfn{pure} module, that is a module which does not contain any
|
||||||
|
@ -486,7 +423,6 @@ do not know anything about dangerous procedures.
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
@end deffn
|
@end deffn
|
||||||
@c end
|
|
||||||
|
|
||||||
@deffn syntax export variable @dots{}
|
@deffn syntax export variable @dots{}
|
||||||
Add all @var{variable}s (which must be symbols or pairs of symbols) to
|
Add all @var{variable}s (which must be symbols or pairs of symbols) to
|
||||||
|
@ -496,11 +432,9 @@ current module and its @code{cdr} specifies a name for the binding in
|
||||||
the current module's public interface.
|
the current module's public interface.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@c begin (scm-doc-string "boot-9.scm" "define-public")
|
|
||||||
@deffn syntax define-public @dots{}
|
@deffn syntax define-public @dots{}
|
||||||
Equivalent to @code{(begin (define foo ...) (export foo))}.
|
Equivalent to @code{(begin (define foo ...) (export foo))}.
|
||||||
@end deffn
|
@end deffn
|
||||||
@c end
|
|
||||||
|
|
||||||
@deffn syntax re-export variable @dots{}
|
@deffn syntax re-export variable @dots{}
|
||||||
Add all @var{variable}s (which must be symbols or pairs of symbols) to
|
Add all @var{variable}s (which must be symbols or pairs of symbols) to
|
||||||
|
@ -509,184 +443,47 @@ symbols are handled as in @code{export}. Re-exported bindings must be
|
||||||
imported by the current module from some other module.
|
imported by the current module from some other module.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@node Module System Reflection
|
@deffn syntax export! variable @dots{}
|
||||||
@subsection Module System Reflection
|
Like @code{export}, but marking the exported variables as replacing.
|
||||||
|
Using a module with replacing bindings will cause any existing bindings
|
||||||
The previous sections have described a declarative view of the module
|
to be replaced without issuing any warnings. See the discussion of
|
||||||
system. You can also work with it programmatically by accessing and
|
@code{#:replace} above.
|
||||||
modifying various parts of the Scheme objects that Guile uses to
|
|
||||||
implement the module system.
|
|
||||||
|
|
||||||
At any time, there is a @dfn{current module}. This module is the one
|
|
||||||
where a top-level @code{define} and similar syntax will add new
|
|
||||||
bindings. You can find other module objects with @code{resolve-module},
|
|
||||||
for example.
|
|
||||||
|
|
||||||
These module objects can be used as the second argument to @code{eval}.
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} current-module
|
|
||||||
Return the current module object.
|
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@deffn {Scheme Procedure} set-current-module module
|
@node Modules and the File System
|
||||||
Set the current module to @var{module} and return
|
@subsection Modules and the File System
|
||||||
the previous current module.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} save-module-excursion thunk
|
Typical programs only use a small subset of modules installed on a Guile
|
||||||
Call @var{thunk} within a @code{dynamic-wind} such that the module that
|
system. In order to keep startup time down, Guile only loads modules
|
||||||
is current at invocation time is restored when @var{thunk}'s dynamic
|
when a program uses them, on demand.
|
||||||
extent is left (@pxref{Dynamic Wind}).
|
|
||||||
|
|
||||||
More precisely, if @var{thunk} escapes non-locally, the current module
|
When a program evaluates @code{(use-modules (ice-9 popen))}, and the
|
||||||
(at the time of escape) is saved, and the original current module (at
|
module is not loaded, Guile searches for a conventionally-named file
|
||||||
the time @var{thunk}'s dynamic extent was last entered) is restored. If
|
from in the @dfn{load path}.
|
||||||
@var{thunk}'s dynamic extent is re-entered, then the current module is
|
|
||||||
saved, and the previously saved inner module is set current again.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} resolve-module name
|
In this case, loading @code{(ice-9 popen)} will eventually cause Guile
|
||||||
Find the module named @var{name} and return it. When it has not already
|
to run @code{(primitive-load-path "ice-9/popen")}.
|
||||||
been defined, try to auto-load it. When it can't be found that way
|
@code{primitive-load-path} will search for a file @file{ice-9/popen} in
|
||||||
either, create an empty module. The name is a list of symbols.
|
the @code{%load-path} (@pxref{Build Config}). For each directory in
|
||||||
@end deffn
|
@code{%load-path}, Guile will try to find the file name, concatenated
|
||||||
|
with the extensions from @code{%load-extensions}. By default, this will
|
||||||
|
cause Guile to @code{stat} @file{ice-9/popen.scm}, and then
|
||||||
|
@file{ice-9/popen}. @xref{Loading}, for more on
|
||||||
|
@code{primitive-load-path}.
|
||||||
|
|
||||||
@deffn {Scheme Procedure} resolve-interface name
|
If a corresponding compiled @file{.go} file is found in the
|
||||||
Find the module named @var{name} as with @code{resolve-module} and
|
@code{%load-compiled-path} or in the fallback path, and is as fresh as
|
||||||
return its interface. The interface of a module is also a module
|
the source file, it will be loaded instead of the source file. If no
|
||||||
object, but it contains only the exported bindings.
|
compiled file is found, Guile may try to compile the source file and
|
||||||
@end deffn
|
cache away the resulting @file{.go} file. @xref{Compilation}, for more
|
||||||
|
on compilation.
|
||||||
|
|
||||||
@deffn {Scheme Procedure} module-use! module interface
|
Once Guile finds a suitable source or compiled file is found, the file
|
||||||
Add @var{interface} to the front of the use-list of @var{module}. Both
|
will be loaded. If, after loading the file, the module under
|
||||||
arguments should be module objects, and @var{interface} should very
|
consideration is still not defined, Guile will signal an error.
|
||||||
likely be a module returned by @code{resolve-interface}.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} reload-module module
|
For more information on where and how to install Scheme modules,
|
||||||
Revisit the source file that corresponds to @var{module}. Raises an
|
@xref{Installing Site Packages}.
|
||||||
error if no source file is associated with the given module.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
|
|
||||||
@node Included Guile Modules
|
|
||||||
@subsection Included Guile Modules
|
|
||||||
|
|
||||||
@c FIXME::martin: Review me!
|
|
||||||
|
|
||||||
Some modules are included in the Guile distribution; here are references
|
|
||||||
to the entries in this manual which describe them in more detail:
|
|
||||||
|
|
||||||
@table @strong
|
|
||||||
@item boot-9
|
|
||||||
boot-9 is Guile's initialization module, and it is always loaded when
|
|
||||||
Guile starts up.
|
|
||||||
|
|
||||||
@item (ice-9 expect)
|
|
||||||
Actions based on matching input from a port (@pxref{Expect}).
|
|
||||||
|
|
||||||
@item (ice-9 format)
|
|
||||||
Formatted output in the style of Common Lisp (@pxref{Formatted
|
|
||||||
Output}).
|
|
||||||
|
|
||||||
@item (ice-9 ftw)
|
|
||||||
File tree walker (@pxref{File Tree Walk}).
|
|
||||||
|
|
||||||
@item (ice-9 getopt-long)
|
|
||||||
Command line option processing (@pxref{getopt-long}).
|
|
||||||
|
|
||||||
@item (ice-9 history)
|
|
||||||
Refer to previous interactive expressions (@pxref{Value History}).
|
|
||||||
|
|
||||||
@item (ice-9 popen)
|
|
||||||
Pipes to and from child processes (@pxref{Pipes}).
|
|
||||||
|
|
||||||
@item (ice-9 pretty-print)
|
|
||||||
Nicely formatted output of Scheme expressions and objects
|
|
||||||
(@pxref{Pretty Printing}).
|
|
||||||
|
|
||||||
@item (ice-9 q)
|
|
||||||
First-in first-out queues (@pxref{Queues}).
|
|
||||||
|
|
||||||
@item (ice-9 rdelim)
|
|
||||||
Line- and character-delimited input (@pxref{Line/Delimited}).
|
|
||||||
|
|
||||||
@item (ice-9 readline)
|
|
||||||
@code{readline} interactive command line editing (@pxref{Readline
|
|
||||||
Support}).
|
|
||||||
|
|
||||||
@item (ice-9 receive)
|
|
||||||
Multiple-value handling with @code{receive} (@pxref{Multiple Values}).
|
|
||||||
|
|
||||||
@item (ice-9 regex)
|
|
||||||
Regular expression matching (@pxref{Regular Expressions}).
|
|
||||||
|
|
||||||
@item (ice-9 rw)
|
|
||||||
Block string input/output (@pxref{Block Reading and Writing}).
|
|
||||||
|
|
||||||
@item (ice-9 streams)
|
|
||||||
Sequence of values calculated on-demand (@pxref{Streams}).
|
|
||||||
|
|
||||||
@item (ice-9 syncase)
|
|
||||||
R5RS @code{syntax-rules} macro system (@pxref{Syntax Rules}).
|
|
||||||
|
|
||||||
@item (ice-9 threads)
|
|
||||||
Guile's support for multi threaded execution (@pxref{Scheduling}).
|
|
||||||
|
|
||||||
@item (ice-9 documentation)
|
|
||||||
Online documentation (REFFIXME).
|
|
||||||
|
|
||||||
@item (srfi srfi-1)
|
|
||||||
A library providing a lot of useful list and pair processing
|
|
||||||
procedures (@pxref{SRFI-1}).
|
|
||||||
|
|
||||||
@item (srfi srfi-2)
|
|
||||||
Support for @code{and-let*} (@pxref{SRFI-2}).
|
|
||||||
|
|
||||||
@item (srfi srfi-4)
|
|
||||||
Support for homogeneous numeric vectors (@pxref{SRFI-4}).
|
|
||||||
|
|
||||||
@item (srfi srfi-6)
|
|
||||||
Support for some additional string port procedures (@pxref{SRFI-6}).
|
|
||||||
|
|
||||||
@item (srfi srfi-8)
|
|
||||||
Multiple-value handling with @code{receive} (@pxref{SRFI-8}).
|
|
||||||
|
|
||||||
@item (srfi srfi-9)
|
|
||||||
Record definition with @code{define-record-type} (@pxref{SRFI-9}).
|
|
||||||
|
|
||||||
@item (srfi srfi-10)
|
|
||||||
Read hash extension @code{#,()} (@pxref{SRFI-10}).
|
|
||||||
|
|
||||||
@item (srfi srfi-11)
|
|
||||||
Multiple-value handling with @code{let-values} and @code{let*-values}
|
|
||||||
(@pxref{SRFI-11}).
|
|
||||||
|
|
||||||
@item (srfi srfi-13)
|
|
||||||
String library (@pxref{SRFI-13}).
|
|
||||||
|
|
||||||
@item (srfi srfi-14)
|
|
||||||
Character-set library (@pxref{SRFI-14}).
|
|
||||||
|
|
||||||
@item (srfi srfi-16)
|
|
||||||
@code{case-lambda} procedures of variable arity (@pxref{SRFI-16}).
|
|
||||||
|
|
||||||
@item (srfi srfi-17)
|
|
||||||
Getter-with-setter support (@pxref{SRFI-17}).
|
|
||||||
|
|
||||||
@item (srfi srfi-19)
|
|
||||||
Time/Date library (@pxref{SRFI-19}).
|
|
||||||
|
|
||||||
@item (srfi srfi-26)
|
|
||||||
Convenient syntax for partial application (@pxref{SRFI-26})
|
|
||||||
|
|
||||||
@item (srfi srfi-31)
|
|
||||||
@code{rec} convenient recursive expressions (@pxref{SRFI-31})
|
|
||||||
|
|
||||||
@item (ice-9 slib)
|
|
||||||
This module contains hooks for using Aubrey Jaffer's portable Scheme
|
|
||||||
library SLIB from Guile (@pxref{SLIB}).
|
|
||||||
@end table
|
|
||||||
|
|
||||||
|
|
||||||
@node R6RS Version References
|
@node R6RS Version References
|
||||||
|
@ -910,6 +707,196 @@ same form as in the @code{library} form described above.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
|
@node Variables
|
||||||
|
@subsection Variables
|
||||||
|
@tpindex Variables
|
||||||
|
|
||||||
|
Each module has its own hash table, sometimes known as an @dfn{obarray},
|
||||||
|
that maps the names defined in that module to their corresponding
|
||||||
|
variable objects.
|
||||||
|
|
||||||
|
A variable is a box-like object that can hold any Scheme value. It is
|
||||||
|
said to be @dfn{undefined} if its box holds a special Scheme value that
|
||||||
|
denotes undefined-ness (which is different from all other Scheme values,
|
||||||
|
including for example @code{#f}); otherwise the variable is
|
||||||
|
@dfn{defined}.
|
||||||
|
|
||||||
|
On its own, a variable object is anonymous. A variable is said to be
|
||||||
|
@dfn{bound} when it is associated with a name in some way, usually a
|
||||||
|
symbol in a module obarray. When this happens, the name is said to be
|
||||||
|
bound to the variable, in that module.
|
||||||
|
|
||||||
|
(That's the theory, anyway. In practice, defined-ness and bound-ness
|
||||||
|
sometimes get confused, because Lisp and Scheme implementations have
|
||||||
|
often conflated --- or deliberately drawn no distinction between --- a
|
||||||
|
name that is unbound and a name that is bound to a variable whose value
|
||||||
|
is undefined. We will try to be clear about the difference and explain
|
||||||
|
any confusion where it is unavoidable.)
|
||||||
|
|
||||||
|
Variables do not have a read syntax. Most commonly they are created and
|
||||||
|
bound implicitly by @code{define} expressions: a top-level @code{define}
|
||||||
|
expression of the form
|
||||||
|
|
||||||
|
@lisp
|
||||||
|
(define @var{name} @var{value})
|
||||||
|
@end lisp
|
||||||
|
|
||||||
|
@noindent
|
||||||
|
creates a variable with initial value @var{value} and binds it to the
|
||||||
|
name @var{name} in the current module. But they can also be created
|
||||||
|
dynamically by calling one of the constructor procedures
|
||||||
|
@code{make-variable} and @code{make-undefined-variable}.
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} make-undefined-variable
|
||||||
|
@deffnx {C Function} scm_make_undefined_variable ()
|
||||||
|
Return a variable that is initially unbound.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} make-variable init
|
||||||
|
@deffnx {C Function} scm_make_variable (init)
|
||||||
|
Return a variable initialized to value @var{init}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} variable-bound? var
|
||||||
|
@deffnx {C Function} scm_variable_bound_p (var)
|
||||||
|
Return @code{#t} iff @var{var} is bound to a value.
|
||||||
|
Throws an error if @var{var} is not a variable object.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} variable-ref var
|
||||||
|
@deffnx {C Function} scm_variable_ref (var)
|
||||||
|
Dereference @var{var} and return its value.
|
||||||
|
@var{var} must be a variable object; see @code{make-variable}
|
||||||
|
and @code{make-undefined-variable}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} variable-set! var val
|
||||||
|
@deffnx {C Function} scm_variable_set_x (var, val)
|
||||||
|
Set the value of the variable @var{var} to @var{val}.
|
||||||
|
@var{var} must be a variable object, @var{val} can be any
|
||||||
|
value. Return an unspecified value.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} variable-unset! var
|
||||||
|
@deffnx {C Function} scm_variable_unset_x (var)
|
||||||
|
Unset the value of the variable @var{var}, leaving @var{var} unbound.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} variable? obj
|
||||||
|
@deffnx {C Function} scm_variable_p (obj)
|
||||||
|
Return @code{#t} iff @var{obj} is a variable object, else
|
||||||
|
return @code{#f}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
|
||||||
|
@node Module System Reflection
|
||||||
|
@subsection Module System Reflection
|
||||||
|
|
||||||
|
The previous sections have described a declarative view of the module
|
||||||
|
system. You can also work with it programmatically by accessing and
|
||||||
|
modifying various parts of the Scheme objects that Guile uses to
|
||||||
|
implement the module system.
|
||||||
|
|
||||||
|
At any time, there is a @dfn{current module}. This module is the one
|
||||||
|
where a top-level @code{define} and similar syntax will add new
|
||||||
|
bindings. You can find other module objects with @code{resolve-module},
|
||||||
|
for example.
|
||||||
|
|
||||||
|
These module objects can be used as the second argument to @code{eval}.
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} current-module
|
||||||
|
@deffnx {C Function} scm_current_module ()
|
||||||
|
Return the current module object.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} set-current-module module
|
||||||
|
@deffnx {C Function} scm_set_current_module (module)
|
||||||
|
Set the current module to @var{module} and return
|
||||||
|
the previous current module.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} save-module-excursion thunk
|
||||||
|
Call @var{thunk} within a @code{dynamic-wind} such that the module that
|
||||||
|
is current at invocation time is restored when @var{thunk}'s dynamic
|
||||||
|
extent is left (@pxref{Dynamic Wind}).
|
||||||
|
|
||||||
|
More precisely, if @var{thunk} escapes non-locally, the current module
|
||||||
|
(at the time of escape) is saved, and the original current module (at
|
||||||
|
the time @var{thunk}'s dynamic extent was last entered) is restored. If
|
||||||
|
@var{thunk}'s dynamic extent is re-entered, then the current module is
|
||||||
|
saved, and the previously saved inner module is set current again.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} resolve-module name [autoload=#t] [version=#f] [#:ensure=#t]
|
||||||
|
@deffnx {C Function} scm_resolve_module (name)
|
||||||
|
Find the module named @var{name} and return it. When it has not already
|
||||||
|
been defined and @var{autoload} is true, try to auto-load it. When it
|
||||||
|
can't be found that way either, create an empty module if @var{ensure}
|
||||||
|
is true, otherwise return @code{#f}. If @var{version} is true, ensure
|
||||||
|
that the resulting module is compatible with the given version reference
|
||||||
|
(@pxref{R6RS Version References}). The name is a list of symbols.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} resolve-interface name [#:select=#f] [#:hide='()] [#:select=()] [#:prefix=#f] [#:renamer] [#:version=#f]
|
||||||
|
Find the module named @var{name} as with @code{resolve-module} and
|
||||||
|
return its interface. The interface of a module is also a module
|
||||||
|
object, but it contains only the exported bindings.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-uses module
|
||||||
|
Return a list of the interfaces used by @var{module}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-use! module interface
|
||||||
|
Add @var{interface} to the front of the use-list of @var{module}. Both
|
||||||
|
arguments should be module objects, and @var{interface} should very
|
||||||
|
likely be a module returned by @code{resolve-interface}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} reload-module module
|
||||||
|
Revisit the source file that corresponds to @var{module}. Raises an
|
||||||
|
error if no source file is associated with the given module.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
As mentioned in the previous section, modules contain a mapping between
|
||||||
|
identifiers (as symbols) and storage locations (as variables). Guile
|
||||||
|
defines a number of procedures to allow access to this mapping. If you
|
||||||
|
are programming in C, @ref{Accessing Modules from C}.
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-variable module name
|
||||||
|
Return the variable bound to @var{name} (a symbol) in @var{module}, or
|
||||||
|
@code{#f} if @var{name} is unbound.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-add! module name var
|
||||||
|
Define a new binding between @var{name} (a symbol) and @var{var} (a
|
||||||
|
variable) in @var{module}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-ref module name
|
||||||
|
Look up the value bound to @var{name} in @var{module}. Like
|
||||||
|
@code{module-variable}, but also does a @code{variable-ref} on the
|
||||||
|
resulting variable, raising an error if @var{name} is unbound.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-define! module name value
|
||||||
|
Locally bind @var{name} to @var{value} in @var{module}. If @var{name}
|
||||||
|
was already locally bound in @var{module}, i.e., defined locally and not
|
||||||
|
by an imported module, the value stored in the existing variable will be
|
||||||
|
updated. Otherwise, a new variable will be added to the module, via
|
||||||
|
@code{module-add!}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} module-set! module name value
|
||||||
|
Update the binding of @var{name} in @var{module} to @var{value}, raising
|
||||||
|
an error if @var{name} is not already bound in @var{module}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
There are many other reflective procedures available in the default
|
||||||
|
environment. If you find yourself using one of them, please contact the
|
||||||
|
Guile developers so that we can commit to stability for that interface.
|
||||||
|
|
||||||
|
|
||||||
@node Accessing Modules from C
|
@node Accessing Modules from C
|
||||||
@subsection Accessing Modules from C
|
@subsection Accessing Modules from C
|
||||||
|
|
||||||
|
@ -919,15 +906,6 @@ can also work with modules from C, but it is more cumbersome.
|
||||||
|
|
||||||
The following procedures are available.
|
The following procedures are available.
|
||||||
|
|
||||||
@deftypefn {C Function} SCM scm_current_module ()
|
|
||||||
Return the module that is the @emph{current module}.
|
|
||||||
@end deftypefn
|
|
||||||
|
|
||||||
@deftypefn {C Function} SCM scm_set_current_module (SCM @var{module})
|
|
||||||
Set the current module to @var{module} and return the previous current
|
|
||||||
module.
|
|
||||||
@end deftypefn
|
|
||||||
|
|
||||||
@deftypefn {C Function} SCM scm_c_call_with_current_module (SCM @var{module}, SCM (*@var{func})(void *), void *@var{data})
|
@deftypefn {C Function} SCM scm_c_call_with_current_module (SCM @var{module}, SCM (*@var{func})(void *), void *@var{data})
|
||||||
Call @var{func} and make @var{module} the current module during the
|
Call @var{func} and make @var{module} the current module during the
|
||||||
call. The argument @var{data} is passed to @var{func}. The return
|
call. The argument @var{data} is passed to @var{func}. The return
|
||||||
|
@ -1053,11 +1031,6 @@ that way either, create an empty module. The name is interpreted as
|
||||||
for @code{scm_c_define_module}.
|
for @code{scm_c_define_module}.
|
||||||
@end deftypefn
|
@end deftypefn
|
||||||
|
|
||||||
@deftypefn {C Function} SCM scm_resolve_module (SCM @var{name})
|
|
||||||
Like @code{scm_c_resolve_module}, but the name is given as a real list
|
|
||||||
of symbols.
|
|
||||||
@end deftypefn
|
|
||||||
|
|
||||||
@deftypefn {C Function} SCM scm_c_use_module ({const char *}@var{name})
|
@deftypefn {C Function} SCM scm_c_use_module ({const char *}@var{name})
|
||||||
Add the module named @var{name} to the uses list of the current
|
Add the module named @var{name} to the uses list of the current
|
||||||
module, as with @code{(use-modules @var{name})}. The name is
|
module, as with @code{(use-modules @var{name})}. The name is
|
||||||
|
@ -1071,87 +1044,122 @@ of the current module. The list of names is terminated by
|
||||||
@end deftypefn
|
@end deftypefn
|
||||||
|
|
||||||
|
|
||||||
@node Variables
|
@node Included Guile Modules
|
||||||
@subsection Variables
|
@subsection Included Guile Modules
|
||||||
@tpindex Variables
|
|
||||||
|
|
||||||
Each module has its own hash table, sometimes known as an @dfn{obarray},
|
Some modules are included in the Guile distribution; here are references
|
||||||
that maps the names defined in that module to their corresponding
|
to the entries in this manual which describe them in more detail:
|
||||||
variable objects.
|
|
||||||
|
|
||||||
A variable is a box-like object that can hold any Scheme value. It is
|
@table @strong
|
||||||
said to be @dfn{undefined} if its box holds a special Scheme value that
|
@item boot-9
|
||||||
denotes undefined-ness (which is different from all other Scheme values,
|
boot-9 is Guile's initialization module, and it is always loaded when
|
||||||
including for example @code{#f}); otherwise the variable is
|
Guile starts up.
|
||||||
@dfn{defined}.
|
|
||||||
|
|
||||||
On its own, a variable object is anonymous. A variable is said to be
|
@item (ice-9 expect)
|
||||||
@dfn{bound} when it is associated with a name in some way, usually a
|
Actions based on matching input from a port (@pxref{Expect}).
|
||||||
symbol in a module obarray. When this happens, the relationship is
|
|
||||||
mutual: the variable is bound to the name (in that module), and the name
|
|
||||||
(in that module) is bound to the variable.
|
|
||||||
|
|
||||||
(That's the theory, anyway. In practice, defined-ness and bound-ness
|
@item (ice-9 format)
|
||||||
sometimes get confused, because Lisp and Scheme implementations have
|
Formatted output in the style of Common Lisp (@pxref{Formatted
|
||||||
often conflated --- or deliberately drawn no distinction between --- a
|
Output}).
|
||||||
name that is unbound and a name that is bound to a variable whose value
|
|
||||||
is undefined. We will try to be clear about the difference and explain
|
|
||||||
any confusion where it is unavoidable.)
|
|
||||||
|
|
||||||
Variables do not have a read syntax. Most commonly they are created and
|
@item (ice-9 ftw)
|
||||||
bound implicitly by @code{define} expressions: a top-level @code{define}
|
File tree walker (@pxref{File Tree Walk}).
|
||||||
expression of the form
|
|
||||||
|
|
||||||
@lisp
|
@item (ice-9 getopt-long)
|
||||||
(define @var{name} @var{value})
|
Command line option processing (@pxref{getopt-long}).
|
||||||
@end lisp
|
|
||||||
|
|
||||||
@noindent
|
@item (ice-9 history)
|
||||||
creates a variable with initial value @var{value} and binds it to the
|
Refer to previous interactive expressions (@pxref{Value History}).
|
||||||
name @var{name} in the current module. But they can also be created
|
|
||||||
dynamically by calling one of the constructor procedures
|
|
||||||
@code{make-variable} and @code{make-undefined-variable}.
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} make-undefined-variable
|
@item (ice-9 popen)
|
||||||
@deffnx {C Function} scm_make_undefined_variable ()
|
Pipes to and from child processes (@pxref{Pipes}).
|
||||||
Return a variable that is initially unbound.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} make-variable init
|
@item (ice-9 pretty-print)
|
||||||
@deffnx {C Function} scm_make_variable (init)
|
Nicely formatted output of Scheme expressions and objects
|
||||||
Return a variable initialized to value @var{init}.
|
(@pxref{Pretty Printing}).
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} variable-bound? var
|
@item (ice-9 q)
|
||||||
@deffnx {C Function} scm_variable_bound_p (var)
|
First-in first-out queues (@pxref{Queues}).
|
||||||
Return @code{#t} iff @var{var} is bound to a value.
|
|
||||||
Throws an error if @var{var} is not a variable object.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} variable-ref var
|
@item (ice-9 rdelim)
|
||||||
@deffnx {C Function} scm_variable_ref (var)
|
Line- and character-delimited input (@pxref{Line/Delimited}).
|
||||||
Dereference @var{var} and return its value.
|
|
||||||
@var{var} must be a variable object; see @code{make-variable}
|
|
||||||
and @code{make-undefined-variable}.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} variable-set! var val
|
@item (ice-9 readline)
|
||||||
@deffnx {C Function} scm_variable_set_x (var, val)
|
@code{readline} interactive command line editing (@pxref{Readline
|
||||||
Set the value of the variable @var{var} to @var{val}.
|
Support}).
|
||||||
@var{var} must be a variable object, @var{val} can be any
|
|
||||||
value. Return an unspecified value.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} variable-unset! var
|
@item (ice-9 receive)
|
||||||
@deffnx {C Function} scm_variable_unset_x (var)
|
Multiple-value handling with @code{receive} (@pxref{Multiple Values}).
|
||||||
Unset the value of the variable @var{var}, leaving @var{var} unbound.
|
|
||||||
@end deffn
|
|
||||||
|
|
||||||
@deffn {Scheme Procedure} variable? obj
|
@item (ice-9 regex)
|
||||||
@deffnx {C Function} scm_variable_p (obj)
|
Regular expression matching (@pxref{Regular Expressions}).
|
||||||
Return @code{#t} iff @var{obj} is a variable object, else
|
|
||||||
return @code{#f}.
|
@item (ice-9 rw)
|
||||||
@end deffn
|
Block string input/output (@pxref{Block Reading and Writing}).
|
||||||
|
|
||||||
|
@item (ice-9 streams)
|
||||||
|
Sequence of values calculated on-demand (@pxref{Streams}).
|
||||||
|
|
||||||
|
@item (ice-9 syncase)
|
||||||
|
R5RS @code{syntax-rules} macro system (@pxref{Syntax Rules}).
|
||||||
|
|
||||||
|
@item (ice-9 threads)
|
||||||
|
Guile's support for multi threaded execution (@pxref{Scheduling}).
|
||||||
|
|
||||||
|
@item (ice-9 documentation)
|
||||||
|
Online documentation (REFFIXME).
|
||||||
|
|
||||||
|
@item (srfi srfi-1)
|
||||||
|
A library providing a lot of useful list and pair processing
|
||||||
|
procedures (@pxref{SRFI-1}).
|
||||||
|
|
||||||
|
@item (srfi srfi-2)
|
||||||
|
Support for @code{and-let*} (@pxref{SRFI-2}).
|
||||||
|
|
||||||
|
@item (srfi srfi-4)
|
||||||
|
Support for homogeneous numeric vectors (@pxref{SRFI-4}).
|
||||||
|
|
||||||
|
@item (srfi srfi-6)
|
||||||
|
Support for some additional string port procedures (@pxref{SRFI-6}).
|
||||||
|
|
||||||
|
@item (srfi srfi-8)
|
||||||
|
Multiple-value handling with @code{receive} (@pxref{SRFI-8}).
|
||||||
|
|
||||||
|
@item (srfi srfi-9)
|
||||||
|
Record definition with @code{define-record-type} (@pxref{SRFI-9}).
|
||||||
|
|
||||||
|
@item (srfi srfi-10)
|
||||||
|
Read hash extension @code{#,()} (@pxref{SRFI-10}).
|
||||||
|
|
||||||
|
@item (srfi srfi-11)
|
||||||
|
Multiple-value handling with @code{let-values} and @code{let*-values}
|
||||||
|
(@pxref{SRFI-11}).
|
||||||
|
|
||||||
|
@item (srfi srfi-13)
|
||||||
|
String library (@pxref{SRFI-13}).
|
||||||
|
|
||||||
|
@item (srfi srfi-14)
|
||||||
|
Character-set library (@pxref{SRFI-14}).
|
||||||
|
|
||||||
|
@item (srfi srfi-16)
|
||||||
|
@code{case-lambda} procedures of variable arity (@pxref{SRFI-16}).
|
||||||
|
|
||||||
|
@item (srfi srfi-17)
|
||||||
|
Getter-with-setter support (@pxref{SRFI-17}).
|
||||||
|
|
||||||
|
@item (srfi srfi-19)
|
||||||
|
Time/Date library (@pxref{SRFI-19}).
|
||||||
|
|
||||||
|
@item (srfi srfi-26)
|
||||||
|
Convenient syntax for partial application (@pxref{SRFI-26})
|
||||||
|
|
||||||
|
@item (srfi srfi-31)
|
||||||
|
@code{rec} convenient recursive expressions (@pxref{SRFI-31})
|
||||||
|
|
||||||
|
@item (ice-9 slib)
|
||||||
|
This module contains hooks for using Aubrey Jaffer's portable Scheme
|
||||||
|
library SLIB from Guile (@pxref{SLIB}).
|
||||||
|
@end table
|
||||||
|
|
||||||
|
|
||||||
@node provide and require
|
@node provide and require
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010, 2011
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2010,
|
||||||
@c Free Software Foundation, Inc.
|
@c 2011, 2012 Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
@node Procedures
|
@node Procedures
|
||||||
|
@ -838,7 +838,7 @@ demonstrably improves performance in a crucial way.
|
||||||
In general, only small procedures should be considered for inlining, as
|
In general, only small procedures should be considered for inlining, as
|
||||||
making large procedures inlinable will probably result in an increase in
|
making large procedures inlinable will probably result in an increase in
|
||||||
code size. Additionally, the elimination of the call overhead rarely
|
code size. Additionally, the elimination of the call overhead rarely
|
||||||
matters for for large procedures.
|
matters for large procedures.
|
||||||
|
|
||||||
@deffn {Scheme Syntax} define-inlinable (name parameter ...) body ...
|
@deffn {Scheme Syntax} define-inlinable (name parameter ...) body ...
|
||||||
Define @var{name} as a procedure with parameters @var{parameter}s and
|
Define @var{name} as a procedure with parameters @var{parameter}s and
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2012
|
||||||
@c Free Software Foundation, Inc.
|
@c Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
|
@ -82,10 +82,10 @@ The @code{SCM_DEFINE} declaration says that the C function
|
||||||
rest argument. The string @code{"Clear the image."} provides a short
|
rest argument. The string @code{"Clear the image."} provides a short
|
||||||
help text for the function, it is called a @dfn{docstring}.
|
help text for the function, it is called a @dfn{docstring}.
|
||||||
|
|
||||||
For historical reasons, the @code{SCM_DEFINE} macro also defines a
|
@code{SCM_DEFINE} macro also defines a static array of characters
|
||||||
static array of characters named @code{s_clear_image}, initialized to
|
initialized to the Scheme name of the function. In this case,
|
||||||
the string "clear-image". You shouldn't use this array, but you might
|
@code{s_clear_image} is set to the C string, "clear-image". You might
|
||||||
need to be aware that it exists.
|
want to use this symbol when generating error messages.
|
||||||
|
|
||||||
Assuming the text above lives in a file named @file{image-type.c}, you
|
Assuming the text above lives in a file named @file{image-type.c}, you
|
||||||
will need to execute the following command to prepare this file for
|
will need to execute the following command to prepare this file for
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
@c -*-texinfo-*-
|
@c -*-texinfo-*-
|
||||||
@c This is part of the GNU Guile Reference Manual.
|
@c This is part of the GNU Guile Reference Manual.
|
||||||
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2009, 2010, 2011
|
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2009,
|
||||||
@c Free Software Foundation, Inc.
|
@c 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
@c See the file guile.texi for copying conditions.
|
@c See the file guile.texi for copying conditions.
|
||||||
|
|
||||||
@node Pretty Printing
|
@node Pretty Printing
|
||||||
|
@ -1180,7 +1180,7 @@ than building up a tree of entries in memory, like
|
||||||
directly as a directory tree is traversed; in fact,
|
directly as a directory tree is traversed; in fact,
|
||||||
@code{file-system-tree} is implemented in terms of it.
|
@code{file-system-tree} is implemented in terms of it.
|
||||||
|
|
||||||
@deffn {Scheme Procedure} file-system-fold enter? leaf down up skip init file-name [stat]
|
@deffn {Scheme Procedure} file-system-fold enter? leaf down up skip error init file-name [stat]
|
||||||
Traverse the directory at @var{file-name}, recursively, and return the
|
Traverse the directory at @var{file-name}, recursively, and return the
|
||||||
result of the successive applications of the @var{leaf}, @var{down},
|
result of the successive applications of the @var{leaf}, @var{down},
|
||||||
@var{up}, and @var{skip} procedures as described below.
|
@var{up}, and @var{skip} procedures as described below.
|
||||||
|
@ -1202,6 +1202,12 @@ encountered, call @code{(@var{skip} @var{path} @var{stat}
|
||||||
When @var{file-name} names a flat file, @code{(@var{leaf} @var{path}
|
When @var{file-name} names a flat file, @code{(@var{leaf} @var{path}
|
||||||
@var{stat} @var{init})} is returned.
|
@var{stat} @var{init})} is returned.
|
||||||
|
|
||||||
|
When an @code{opendir} or @var{stat} call fails, call @code{(@var{error}
|
||||||
|
@var{path} @var{stat} @var{errno} @var{result})}, with @var{errno} being
|
||||||
|
the operating system error number that was raised---e.g.,
|
||||||
|
@code{EACCES}---and @var{stat} either @code{#f} or the result of the
|
||||||
|
@var{stat} call for that entry, when available.
|
||||||
|
|
||||||
The special @file{.} and @file{..} entries are not passed to these
|
The special @file{.} and @file{..} entries are not passed to these
|
||||||
procedures. The @var{path} argument to the procedures is a full file
|
procedures. The @var{path} argument to the procedures is a full file
|
||||||
name---e.g., @code{"../foo/bar/gnu"}; if @var{file-name} is an absolute
|
name---e.g., @code{"../foo/bar/gnu"}; if @var{file-name} is an absolute
|
||||||
|
@ -1235,7 +1241,13 @@ to `du --apparent-size' with GNU Coreutils.)"
|
||||||
;; Likewise for skipped directories.
|
;; Likewise for skipped directories.
|
||||||
(define (skip name stat result) result)
|
(define (skip name stat result) result)
|
||||||
|
|
||||||
(file-system-fold enter? leaf down up skip
|
;; Ignore unreadable files/directories but warn the user.
|
||||||
|
(define (error name stat errno result)
|
||||||
|
(format (current-error-port) "warning: ~a: ~a~%"
|
||||||
|
name (strerror errno))
|
||||||
|
result)
|
||||||
|
|
||||||
|
(file-system-fold enter? leaf down up skip error
|
||||||
0 ; initial counter is zero bytes
|
0 ; initial counter is zero bytes
|
||||||
file-name))
|
file-name))
|
||||||
|
|
||||||
|
|
|
@ -21,7 +21,7 @@
|
||||||
[[add refs for all conditions signalled]]
|
[[add refs for all conditions signalled]]
|
||||||
|
|
||||||
@ifinfo
|
@ifinfo
|
||||||
Copyright 1999, 2006 Free Software Foundation, Inc.
|
Copyright 1999, 2006, 2012 Free Software Foundation, Inc.
|
||||||
@end ifinfo
|
@end ifinfo
|
||||||
|
|
||||||
@titlepage
|
@titlepage
|
||||||
|
@ -204,7 +204,7 @@ can implement any module system you like, as long as its efforts produce
|
||||||
an environment object the interpreter can consult.
|
an environment object the interpreter can consult.
|
||||||
|
|
||||||
Finally, environments may prove a convenient way for Guile to access the
|
Finally, environments may prove a convenient way for Guile to access the
|
||||||
features of other systems. For example, one might export the The GIMP's
|
features of other systems. For example, one might export The GIMP's
|
||||||
Procedural Database to Guile as a custom environment type; this
|
Procedural Database to Guile as a custom environment type; this
|
||||||
environment could create Scheme procedure objects corresponding to GIMP
|
environment could create Scheme procedure objects corresponding to GIMP
|
||||||
procedures, as the user referenced them.
|
procedures, as the user referenced them.
|
||||||
|
|
|
@ -4,7 +4,7 @@
|
||||||
#define SCM___SCM_H
|
#define SCM___SCM_H
|
||||||
|
|
||||||
/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2006,
|
/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2006,
|
||||||
* 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
* 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -892,7 +892,6 @@ SCM_DEFINE (scm_i_array_equal_p, "array-equal?", 0, 2, 1,
|
||||||
void
|
void
|
||||||
scm_init_array_map (void)
|
scm_init_array_map (void)
|
||||||
{
|
{
|
||||||
scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_array_equal_p;
|
|
||||||
#include "libguile/array-map.x"
|
#include "libguile/array-map.x"
|
||||||
scm_add_feature (s_scm_array_for_each);
|
scm_add_feature (s_scm_array_for_each);
|
||||||
}
|
}
|
||||||
|
|
|
@ -33,7 +33,6 @@
|
||||||
#include "libguile/chars.h"
|
#include "libguile/chars.h"
|
||||||
#include "libguile/eval.h"
|
#include "libguile/eval.h"
|
||||||
#include "libguile/fports.h"
|
#include "libguile/fports.h"
|
||||||
#include "libguile/smob.h"
|
|
||||||
#include "libguile/feature.h"
|
#include "libguile/feature.h"
|
||||||
#include "libguile/root.h"
|
#include "libguile/root.h"
|
||||||
#include "libguile/strings.h"
|
#include "libguile/strings.h"
|
||||||
|
@ -54,11 +53,10 @@
|
||||||
#include "libguile/uniform.h"
|
#include "libguile/uniform.h"
|
||||||
|
|
||||||
|
|
||||||
scm_t_bits scm_i_tc16_array;
|
|
||||||
#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
|
#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
|
||||||
(SCM_SET_SMOB_FLAGS ((x), SCM_SMOB_FLAGS (x) | SCM_I_ARRAY_FLAG_CONTIGUOUS))
|
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
|
||||||
#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
|
#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
|
||||||
(SCM_SET_SMOB_FLAGS ((x), SCM_SMOB_FLAGS (x) & ~SCM_I_ARRAY_FLAG_CONTIGUOUS))
|
(SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & ~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
|
||||||
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
|
SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
|
||||||
|
@ -115,9 +113,9 @@ SCM
|
||||||
scm_i_make_array (int ndim)
|
scm_i_make_array (int ndim)
|
||||||
{
|
{
|
||||||
SCM ra;
|
SCM ra;
|
||||||
SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_i_tc16_array,
|
ra = scm_cell (((scm_t_bits) ndim << 17) + scm_tc7_array,
|
||||||
scm_gc_malloc ((sizeof (scm_i_t_array) +
|
(scm_t_bits) scm_gc_malloc (sizeof (scm_i_t_array) +
|
||||||
ndim * sizeof (scm_t_array_dim)),
|
ndim * sizeof (scm_t_array_dim),
|
||||||
"array"));
|
"array"));
|
||||||
SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
|
SCM_I_ARRAY_V (ra) = SCM_BOOL_F;
|
||||||
return ra;
|
return ra;
|
||||||
|
@ -743,7 +741,7 @@ scm_i_print_array_dimension (scm_t_array_handle *h, int dim, int pos,
|
||||||
/* Print an array.
|
/* Print an array.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
static int
|
int
|
||||||
scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
|
scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
|
||||||
{
|
{
|
||||||
scm_t_array_handle h;
|
scm_t_array_handle h;
|
||||||
|
@ -1015,18 +1013,14 @@ array_get_handle (SCM array, scm_t_array_handle *h)
|
||||||
h->base = SCM_I_ARRAY_BASE (array);
|
h->base = SCM_I_ARRAY_BASE (array);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_ARRAY_IMPLEMENTATION (SCM_SMOB_TYPE_BITS (scm_i_tc16_array),
|
SCM_ARRAY_IMPLEMENTATION (scm_tc7_array,
|
||||||
SCM_SMOB_TYPE_MASK,
|
0x7f,
|
||||||
array_handle_ref, array_handle_set,
|
array_handle_ref, array_handle_set,
|
||||||
array_get_handle)
|
array_get_handle)
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_init_arrays ()
|
scm_init_arrays ()
|
||||||
{
|
{
|
||||||
scm_i_tc16_array = scm_make_smob_type ("array", 0);
|
|
||||||
scm_set_smob_print (scm_i_tc16_array, scm_i_print_array);
|
|
||||||
scm_set_smob_equalp (scm_i_tc16_array, scm_array_equal_p);
|
|
||||||
|
|
||||||
scm_add_feature ("array");
|
scm_add_feature ("array");
|
||||||
|
|
||||||
#include "libguile/arrays.x"
|
#include "libguile/arrays.x"
|
||||||
|
|
|
@ -59,21 +59,20 @@ typedef struct scm_i_t_array
|
||||||
unsigned long base;
|
unsigned long base;
|
||||||
} scm_i_t_array;
|
} scm_i_t_array;
|
||||||
|
|
||||||
SCM_INTERNAL scm_t_bits scm_i_tc16_array;
|
|
||||||
|
|
||||||
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
|
#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)
|
||||||
|
|
||||||
#define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
|
#define SCM_I_ARRAYP(a) SCM_TYP16_PREDICATE (scm_tc7_array, a)
|
||||||
#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_SMOB_FLAGS (x)>>1))
|
#define SCM_I_ARRAY_NDIM(x) ((size_t) (SCM_CELL_WORD_0 (x)>>17))
|
||||||
#define SCM_I_ARRAY_CONTP(x) (SCM_SMOB_FLAGS(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
|
#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & (SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))
|
||||||
|
|
||||||
#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_SMOB_DATA_1 (a))
|
#define SCM_I_ARRAY_MEM(a) ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
|
||||||
#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v)
|
#define SCM_I_ARRAY_V(a) (SCM_I_ARRAY_MEM (a)->v)
|
||||||
#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
|
#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
|
||||||
#define SCM_I_ARRAY_DIMS(a) \
|
#define SCM_I_ARRAY_DIMS(a) \
|
||||||
((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
|
((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
|
||||||
|
|
||||||
SCM_INTERNAL SCM scm_i_make_array (int ndim);
|
SCM_INTERNAL SCM scm_i_make_array (int ndim);
|
||||||
|
SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate);
|
||||||
SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
|
SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
|
||||||
|
|
||||||
SCM_INTERNAL void scm_init_arrays (void);
|
SCM_INTERNAL void scm_init_arrays (void);
|
||||||
|
|
|
@ -144,6 +144,19 @@ SCM_DEFINE (scm_display_error, "display-error", 6, 0, 0,
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_OUTPUT_PORT (2, port);
|
SCM_VALIDATE_OUTPUT_PORT (2, port);
|
||||||
|
|
||||||
|
#if SCM_ENABLE_DEPRECATED
|
||||||
|
if (SCM_STACKP (frame))
|
||||||
|
{
|
||||||
|
scm_c_issue_deprecation_warning
|
||||||
|
("Passing a stack as the first argument to `scm_display_error' is "
|
||||||
|
"deprecated. Pass a frame instead.");
|
||||||
|
if (SCM_STACK_LENGTH (frame))
|
||||||
|
frame = scm_stack_ref (frame, SCM_INUM0);
|
||||||
|
else
|
||||||
|
frame = SCM_BOOL_F;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
scm_i_display_error (frame, port, subr, message, args, rest);
|
scm_i_display_error (frame, port, subr, message, args, rest);
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -27,7 +27,6 @@
|
||||||
|
|
||||||
#include "libguile/_scm.h"
|
#include "libguile/_scm.h"
|
||||||
#include "libguile/__scm.h"
|
#include "libguile/__scm.h"
|
||||||
#include "libguile/smob.h"
|
|
||||||
#include "libguile/strings.h"
|
#include "libguile/strings.h"
|
||||||
#include "libguile/array-handle.h"
|
#include "libguile/array-handle.h"
|
||||||
#include "libguile/bitvectors.h"
|
#include "libguile/bitvectors.h"
|
||||||
|
@ -39,14 +38,12 @@
|
||||||
* but alack, all we have is this crufty C.
|
* but alack, all we have is this crufty C.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
static scm_t_bits scm_tc16_bitvector;
|
#define IS_BITVECTOR(obj) SCM_TYP16_PREDICATE(scm_tc7_bitvector,(obj))
|
||||||
|
#define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_CELL_WORD_1(obj))
|
||||||
|
#define BITVECTOR_LENGTH(obj) ((size_t)SCM_CELL_WORD_2(obj))
|
||||||
|
|
||||||
#define IS_BITVECTOR(obj) SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
|
int
|
||||||
#define BITVECTOR_BITS(obj) ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
|
scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate)
|
||||||
#define BITVECTOR_LENGTH(obj) ((size_t)SCM_SMOB_DATA_2(obj))
|
|
||||||
|
|
||||||
static int
|
|
||||||
bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
|
|
||||||
{
|
{
|
||||||
size_t bit_len = BITVECTOR_LENGTH (vec);
|
size_t bit_len = BITVECTOR_LENGTH (vec);
|
||||||
size_t word_len = (bit_len+31)/32;
|
size_t word_len = (bit_len+31)/32;
|
||||||
|
@ -64,8 +61,8 @@ bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static SCM
|
SCM
|
||||||
bitvector_equalp (SCM vec1, SCM vec2)
|
scm_i_bitvector_equal_p (SCM vec1, SCM vec2)
|
||||||
{
|
{
|
||||||
size_t bit_len = BITVECTOR_LENGTH (vec1);
|
size_t bit_len = BITVECTOR_LENGTH (vec1);
|
||||||
size_t word_len = (bit_len + 31) / 32;
|
size_t word_len = (bit_len + 31) / 32;
|
||||||
|
@ -113,7 +110,7 @@ scm_c_make_bitvector (size_t len, SCM fill)
|
||||||
|
|
||||||
bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
|
bits = scm_gc_malloc_pointerless (sizeof (scm_t_uint32) * word_len,
|
||||||
"bitvector");
|
"bitvector");
|
||||||
SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
|
res = scm_double_cell (scm_tc7_bitvector, (scm_t_bits)bits, len, 0);
|
||||||
|
|
||||||
if (!SCM_UNBNDP (fill))
|
if (!SCM_UNBNDP (fill))
|
||||||
scm_bitvector_fill_x (res, fill);
|
scm_bitvector_fill_x (res, fill);
|
||||||
|
@ -145,7 +142,8 @@ SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
|
||||||
size_t
|
size_t
|
||||||
scm_c_bitvector_length (SCM vec)
|
scm_c_bitvector_length (SCM vec)
|
||||||
{
|
{
|
||||||
scm_assert_smob_type (scm_tc16_bitvector, vec);
|
if (!IS_BITVECTOR (vec))
|
||||||
|
scm_wrong_type_arg_msg (NULL, 0, vec, "bitvector");
|
||||||
return BITVECTOR_LENGTH (vec);
|
return BITVECTOR_LENGTH (vec);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -880,8 +878,8 @@ bitvector_get_handle (SCM bv, scm_t_array_handle *h)
|
||||||
h->elements = h->writable_elements = BITVECTOR_BITS (bv);
|
h->elements = h->writable_elements = BITVECTOR_BITS (bv);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_ARRAY_IMPLEMENTATION (SCM_SMOB_TYPE_BITS (scm_tc16_bitvector),
|
SCM_ARRAY_IMPLEMENTATION (scm_tc7_bitvector,
|
||||||
SCM_SMOB_TYPE_MASK,
|
0x7f,
|
||||||
bitvector_handle_ref, bitvector_handle_set,
|
bitvector_handle_ref, bitvector_handle_set,
|
||||||
bitvector_get_handle)
|
bitvector_get_handle)
|
||||||
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
|
SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
|
||||||
|
@ -889,10 +887,6 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector)
|
||||||
void
|
void
|
||||||
scm_init_bitvectors ()
|
scm_init_bitvectors ()
|
||||||
{
|
{
|
||||||
scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
|
|
||||||
scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
|
|
||||||
scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
|
|
||||||
|
|
||||||
#include "libguile/bitvectors.x"
|
#include "libguile/bitvectors.x"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -70,6 +70,8 @@ SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec,
|
||||||
size_t *lenp,
|
size_t *lenp,
|
||||||
ssize_t *incp);
|
ssize_t *incp);
|
||||||
|
|
||||||
|
SCM_INTERNAL int scm_i_print_bitvector (SCM vec, SCM port, scm_print_state *pstate);
|
||||||
|
SCM_INTERNAL SCM scm_i_bitvector_equal_p (SCM vec1, SCM vec2);
|
||||||
SCM_INTERNAL void scm_init_bitvectors (void);
|
SCM_INTERNAL void scm_init_bitvectors (void);
|
||||||
|
|
||||||
#endif /* SCM_BITVECTORS_H */
|
#endif /* SCM_BITVECTORS_H */
|
||||||
|
|
|
@ -302,10 +302,6 @@ scm_equal_p (SCM x, SCM y)
|
||||||
y = SCM_CDR(y);
|
y = SCM_CDR(y);
|
||||||
goto tailrecurse;
|
goto tailrecurse;
|
||||||
}
|
}
|
||||||
if (SCM_TYP7 (x) == scm_tc7_string && SCM_TYP7 (y) == scm_tc7_string)
|
|
||||||
return scm_string_equal_p (x, y);
|
|
||||||
if (SCM_TYP7 (x) == scm_tc7_bytevector && SCM_TYP7 (y) == scm_tc7_bytevector)
|
|
||||||
return scm_bytevector_eq_p (x, y);
|
|
||||||
if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y))
|
if (SCM_TYP7 (x) == scm_tc7_smob && SCM_TYP16 (x) == SCM_TYP16 (y))
|
||||||
{
|
{
|
||||||
int i = SCM_SMOBNUM (x);
|
int i = SCM_SMOBNUM (x);
|
||||||
|
@ -316,8 +312,6 @@ scm_equal_p (SCM x, SCM y)
|
||||||
else
|
else
|
||||||
goto generic_equal;
|
goto generic_equal;
|
||||||
}
|
}
|
||||||
if (SCM_POINTER_P (x) && SCM_POINTER_P (y))
|
|
||||||
return scm_from_bool (SCM_POINTER_VALUE (x) == SCM_POINTER_VALUE (y));
|
|
||||||
|
|
||||||
/* This ensures that types and scm_length are the same. */
|
/* This ensures that types and scm_length are the same. */
|
||||||
if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
|
if (SCM_CELL_TYPE (x) != SCM_CELL_TYPE (y))
|
||||||
|
@ -352,7 +346,20 @@ scm_equal_p (SCM x, SCM y)
|
||||||
return scm_complex_equalp (x, y);
|
return scm_complex_equalp (x, y);
|
||||||
case scm_tc16_fraction:
|
case scm_tc16_fraction:
|
||||||
return scm_i_fraction_equalp (x, y);
|
return scm_i_fraction_equalp (x, y);
|
||||||
|
default:
|
||||||
|
/* assert not reached? */
|
||||||
|
return SCM_BOOL_F;
|
||||||
}
|
}
|
||||||
|
case scm_tc7_pointer:
|
||||||
|
return scm_from_bool (SCM_POINTER_VALUE (x) == SCM_POINTER_VALUE (y));
|
||||||
|
case scm_tc7_string:
|
||||||
|
return scm_string_equal_p (x, y);
|
||||||
|
case scm_tc7_bytevector:
|
||||||
|
return scm_bytevector_eq_p (x, y);
|
||||||
|
case scm_tc7_array:
|
||||||
|
return scm_array_equal_p (x, y);
|
||||||
|
case scm_tc7_bitvector:
|
||||||
|
return scm_i_bitvector_equal_p (x, y);
|
||||||
case scm_tc7_vector:
|
case scm_tc7_vector:
|
||||||
case scm_tc7_wvect:
|
case scm_tc7_wvect:
|
||||||
return scm_i_vector_equal_p (x, y);
|
return scm_i_vector_equal_p (x, y);
|
||||||
|
|
|
@ -89,6 +89,8 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
||||||
case scm_tc7_smob:
|
case scm_tc7_smob:
|
||||||
case scm_tc7_program:
|
case scm_tc7_program:
|
||||||
case scm_tc7_bytevector:
|
case scm_tc7_bytevector:
|
||||||
|
case scm_tc7_array:
|
||||||
|
case scm_tc7_bitvector:
|
||||||
case scm_tcs_struct:
|
case scm_tcs_struct:
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
default:
|
default:
|
||||||
|
|
|
@ -20,6 +20,7 @@
|
||||||
|
|
||||||
|
|
||||||
#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
|
#define _LARGEFILE64_SOURCE /* ask for stat64 etc */
|
||||||
|
#define _GNU_SOURCE /* ask for LONG_LONG_MAX/LONG_LONG_MIN */
|
||||||
|
|
||||||
#ifdef HAVE_CONFIG_H
|
#ifdef HAVE_CONFIG_H
|
||||||
# include <config.h>
|
# include <config.h>
|
||||||
|
|
|
@ -160,6 +160,8 @@ static SCM class_vm;
|
||||||
static SCM class_vm_cont;
|
static SCM class_vm_cont;
|
||||||
static SCM class_bytevector;
|
static SCM class_bytevector;
|
||||||
static SCM class_uvec;
|
static SCM class_uvec;
|
||||||
|
static SCM class_array;
|
||||||
|
static SCM class_bitvector;
|
||||||
|
|
||||||
static SCM vtable_class_map = SCM_BOOL_F;
|
static SCM vtable_class_map = SCM_BOOL_F;
|
||||||
|
|
||||||
|
@ -275,6 +277,10 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
||||||
return class_bytevector;
|
return class_bytevector;
|
||||||
else
|
else
|
||||||
return class_uvec;
|
return class_uvec;
|
||||||
|
case scm_tc7_array:
|
||||||
|
return class_array;
|
||||||
|
case scm_tc7_bitvector:
|
||||||
|
return class_bitvector;
|
||||||
case scm_tc7_string:
|
case scm_tc7_string:
|
||||||
return scm_class_string;
|
return scm_class_string;
|
||||||
case scm_tc7_number:
|
case scm_tc7_number:
|
||||||
|
@ -2519,6 +2525,10 @@ create_standard_classes (void)
|
||||||
scm_class_class, scm_class_top, SCM_EOL);
|
scm_class_class, scm_class_top, SCM_EOL);
|
||||||
make_stdcls (&class_uvec, "<uvec>",
|
make_stdcls (&class_uvec, "<uvec>",
|
||||||
scm_class_class, class_bytevector, SCM_EOL);
|
scm_class_class, class_bytevector, SCM_EOL);
|
||||||
|
make_stdcls (&class_array, "<array>",
|
||||||
|
scm_class_class, scm_class_top, SCM_EOL);
|
||||||
|
make_stdcls (&class_bitvector, "<bitvector>",
|
||||||
|
scm_class_class, scm_class_top, SCM_EOL);
|
||||||
make_stdcls (&scm_class_number, "<number>",
|
make_stdcls (&scm_class_number, "<number>",
|
||||||
scm_class_class, scm_class_top, SCM_EOL);
|
scm_class_class, scm_class_top, SCM_EOL);
|
||||||
make_stdcls (&scm_class_complex, "<complex>",
|
make_stdcls (&scm_class_complex, "<complex>",
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -196,22 +196,11 @@ typedef struct scm_locale
|
||||||
int category_mask;
|
int category_mask;
|
||||||
} *scm_t_locale;
|
} *scm_t_locale;
|
||||||
|
|
||||||
|
|
||||||
/* Free the resources used by LOCALE. */
|
|
||||||
static inline void
|
|
||||||
scm_i_locale_free (scm_t_locale locale)
|
|
||||||
{
|
|
||||||
free (locale->locale_name);
|
|
||||||
locale->locale_name = NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
#else /* USE_GNU_LOCALE_API */
|
#else /* USE_GNU_LOCALE_API */
|
||||||
|
|
||||||
/* Alias for glibc's locale type. */
|
/* Alias for glibc's locale type. */
|
||||||
typedef locale_t scm_t_locale;
|
typedef locale_t scm_t_locale;
|
||||||
|
|
||||||
#define scm_i_locale_free freelocale
|
|
||||||
|
|
||||||
#endif /* USE_GNU_LOCALE_API */
|
#endif /* USE_GNU_LOCALE_API */
|
||||||
|
|
||||||
|
|
||||||
|
@ -244,16 +233,20 @@ SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
|
||||||
|
|
||||||
SCM_SMOB (scm_tc16_locale_smob_type, "locale", 0);
|
SCM_SMOB (scm_tc16_locale_smob_type, "locale", 0);
|
||||||
|
|
||||||
|
#ifdef USE_GNU_LOCALE_API
|
||||||
|
|
||||||
SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale)
|
SCM_SMOB_FREE (scm_tc16_locale_smob_type, smob_locale_free, locale)
|
||||||
{
|
{
|
||||||
scm_t_locale c_locale;
|
scm_t_locale c_locale;
|
||||||
|
|
||||||
c_locale = (scm_t_locale) SCM_SMOB_DATA (locale);
|
c_locale = (scm_t_locale) SCM_SMOB_DATA (locale);
|
||||||
scm_i_locale_free (c_locale);
|
freelocale (c_locale);
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#endif /* USE_GNU_LOCALE_API */
|
||||||
|
|
||||||
|
|
||||||
static void inline scm_locale_error (const char *, int) SCM_NORETURN;
|
static void inline scm_locale_error (const char *, int) SCM_NORETURN;
|
||||||
|
|
||||||
|
@ -667,7 +660,8 @@ SCM_DEFINE (scm_make_locale, "make-locale", 2, 1, 0,
|
||||||
c_locale = scm_gc_malloc (sizeof (* c_locale), "locale");
|
c_locale = scm_gc_malloc (sizeof (* c_locale), "locale");
|
||||||
|
|
||||||
c_locale->category_mask = c_category_mask;
|
c_locale->category_mask = c_category_mask;
|
||||||
c_locale->locale_name = c_locale_name;
|
c_locale->locale_name = scm_gc_strdup (c_locale_name, "locale");
|
||||||
|
free (c_locale_name);
|
||||||
|
|
||||||
if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale)))
|
if (scm_is_eq (base_locale, SCM_VARIABLE_REF (scm_global_locale)))
|
||||||
{
|
{
|
||||||
|
|
|
@ -87,7 +87,9 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
|
||||||
#define FUNC_NAME s_scm_primitive_load
|
#define FUNC_NAME s_scm_primitive_load
|
||||||
{
|
{
|
||||||
SCM hook = *scm_loc_load_hook;
|
SCM hook = *scm_loc_load_hook;
|
||||||
|
SCM ret = SCM_UNSPECIFIED;
|
||||||
char *encoding;
|
char *encoding;
|
||||||
|
|
||||||
SCM_VALIDATE_STRING (1, filename);
|
SCM_VALIDATE_STRING (1, filename);
|
||||||
if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
|
if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
|
||||||
SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
|
SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
|
||||||
|
@ -96,8 +98,10 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
|
||||||
if (!scm_is_false (hook))
|
if (!scm_is_false (hook))
|
||||||
scm_call_1 (hook, filename);
|
scm_call_1 (hook, filename);
|
||||||
|
|
||||||
{ /* scope */
|
{
|
||||||
SCM port = scm_open_file (filename, scm_from_locale_string ("r"));
|
SCM port;
|
||||||
|
|
||||||
|
port = scm_open_file (filename, scm_from_locale_string ("r"));
|
||||||
scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
|
scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
|
||||||
scm_i_dynwind_current_load_port (port);
|
scm_i_dynwind_current_load_port (port);
|
||||||
|
|
||||||
|
@ -124,13 +128,13 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
|
||||||
if (SCM_EOF_OBJECT_P (form))
|
if (SCM_EOF_OBJECT_P (form))
|
||||||
break;
|
break;
|
||||||
|
|
||||||
scm_primitive_eval_x (form);
|
ret = scm_primitive_eval_x (form);
|
||||||
}
|
}
|
||||||
|
|
||||||
scm_dynwind_end ();
|
scm_dynwind_end ();
|
||||||
scm_close_port (port);
|
scm_close_port (port);
|
||||||
}
|
}
|
||||||
return SCM_UNSPECIFIED;
|
return ret;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -145,7 +145,7 @@ verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr)
|
||||||
- scm_tc7_objcode | type | flags
|
- scm_tc7_objcode | type | flags
|
||||||
- the struct scm_objcode C object
|
- the struct scm_objcode C object
|
||||||
- the parent of this objcode: either another objcode, a bytevector,
|
- the parent of this objcode: either another objcode, a bytevector,
|
||||||
or, in the case of mmap types, file descriptors (as an inum)
|
or, in the case of mmap types, #f
|
||||||
- "native code" -- not currently used.
|
- "native code" -- not currently used.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
@ -203,12 +203,11 @@ make_objcode_from_file (int fd)
|
||||||
scm_from_size_t (total_len)));
|
scm_from_size_t (total_len)));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* FIXME: we leak ourselves and the file descriptor. but then again so does
|
(void) close (fd);
|
||||||
dlopen(). */
|
|
||||||
return scm_permanent_object
|
return scm_permanent_object
|
||||||
(scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0),
|
(scm_double_cell (SCM_MAKE_OBJCODE_TAG (SCM_OBJCODE_TYPE_MMAP, 0),
|
||||||
(scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
|
(scm_t_bits)(addr + strlen (SCM_OBJCODE_COOKIE)),
|
||||||
SCM_UNPACK (scm_from_int (fd)), 0));
|
SCM_BOOL_F_BITS, 0));
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
{
|
{
|
||||||
|
|
|
@ -651,14 +651,20 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
||||||
case scm_tc7_with_fluids:
|
case scm_tc7_with_fluids:
|
||||||
scm_i_with_fluids_print (exp, port, pstate);
|
scm_i_with_fluids_print (exp, port, pstate);
|
||||||
break;
|
break;
|
||||||
|
case scm_tc7_array:
|
||||||
|
ENTER_NESTED_DATA (pstate, exp, circref);
|
||||||
|
scm_i_print_array (exp, port, pstate);
|
||||||
|
break;
|
||||||
|
case scm_tc7_bytevector:
|
||||||
|
scm_i_print_bytevector (exp, port, pstate);
|
||||||
|
break;
|
||||||
|
case scm_tc7_bitvector:
|
||||||
|
scm_i_print_bitvector (exp, port, pstate);
|
||||||
|
break;
|
||||||
case scm_tc7_wvect:
|
case scm_tc7_wvect:
|
||||||
ENTER_NESTED_DATA (pstate, exp, circref);
|
ENTER_NESTED_DATA (pstate, exp, circref);
|
||||||
scm_puts_unlocked ("#w(", port);
|
scm_puts_unlocked ("#w(", port);
|
||||||
goto common_vector_printer;
|
goto common_vector_printer;
|
||||||
|
|
||||||
case scm_tc7_bytevector:
|
|
||||||
scm_i_print_bytevector (exp, port, pstate);
|
|
||||||
break;
|
|
||||||
case scm_tc7_vector:
|
case scm_tc7_vector:
|
||||||
ENTER_NESTED_DATA (pstate, exp, circref);
|
ENTER_NESTED_DATA (pstate, exp, circref);
|
||||||
scm_puts_unlocked ("#(", port);
|
scm_puts_unlocked ("#(", port);
|
||||||
|
|
|
@ -546,6 +546,8 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
|
||||||
MY_VALIDATE_SUBSTRING_SPEC (3, s,
|
MY_VALIDATE_SUBSTRING_SPEC (3, s,
|
||||||
4, start, cstart,
|
4, start, cstart,
|
||||||
5, end, cend);
|
5, end, cend);
|
||||||
|
if (cstart < cend)
|
||||||
|
{
|
||||||
len = cend - cstart;
|
len = cend - cstart;
|
||||||
SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
|
SCM_ASSERT_RANGE (3, s, len <= scm_i_string_length (target) - ctstart);
|
||||||
|
|
||||||
|
@ -557,6 +559,7 @@ SCM_DEFINE (scm_string_copy_x, "string-copy!", 3, 2, 0,
|
||||||
}
|
}
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
scm_remember_upto_here_1 (target);
|
scm_remember_upto_here_1 (target);
|
||||||
|
}
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
@ -970,11 +973,13 @@ SCM_DEFINE (scm_substring_fill_x, "string-fill!", 2, 2, 0,
|
||||||
4, end, cend);
|
4, end, cend);
|
||||||
SCM_VALIDATE_CHAR (2, chr);
|
SCM_VALIDATE_CHAR (2, chr);
|
||||||
|
|
||||||
|
if (cstart < cend)
|
||||||
|
{
|
||||||
str = scm_i_string_start_writing (str);
|
str = scm_i_string_start_writing (str);
|
||||||
for (k = cstart; k < cend; k++)
|
for (k = cstart; k < cend; k++)
|
||||||
scm_i_string_set_x (str, k, SCM_CHAR (chr));
|
scm_i_string_set_x (str, k, SCM_CHAR (chr));
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
|
}
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
|
@ -2089,11 +2094,14 @@ string_upcase_x (SCM v, size_t start, size_t end)
|
||||||
{
|
{
|
||||||
size_t k;
|
size_t k;
|
||||||
|
|
||||||
|
if (start < end)
|
||||||
|
{
|
||||||
v = scm_i_string_start_writing (v);
|
v = scm_i_string_start_writing (v);
|
||||||
for (k = start; k < end; ++k)
|
for (k = start; k < end; ++k)
|
||||||
scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
|
scm_i_string_set_x (v, k, uc_toupper (scm_i_string_ref (v, k)));
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
scm_remember_upto_here_1 (v);
|
scm_remember_upto_here_1 (v);
|
||||||
|
}
|
||||||
|
|
||||||
return v;
|
return v;
|
||||||
}
|
}
|
||||||
|
@ -2152,11 +2160,14 @@ string_downcase_x (SCM v, size_t start, size_t end)
|
||||||
{
|
{
|
||||||
size_t k;
|
size_t k;
|
||||||
|
|
||||||
|
if (start < end)
|
||||||
|
{
|
||||||
v = scm_i_string_start_writing (v);
|
v = scm_i_string_start_writing (v);
|
||||||
for (k = start; k < end; ++k)
|
for (k = start; k < end; ++k)
|
||||||
scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
|
scm_i_string_set_x (v, k, uc_tolower (scm_i_string_ref (v, k)));
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
scm_remember_upto_here_1 (v);
|
scm_remember_upto_here_1 (v);
|
||||||
|
}
|
||||||
|
|
||||||
return v;
|
return v;
|
||||||
}
|
}
|
||||||
|
@ -2219,6 +2230,8 @@ string_titlecase_x (SCM str, size_t start, size_t end)
|
||||||
size_t i;
|
size_t i;
|
||||||
int in_word = 0;
|
int in_word = 0;
|
||||||
|
|
||||||
|
if (start < end)
|
||||||
|
{
|
||||||
str = scm_i_string_start_writing (str);
|
str = scm_i_string_start_writing (str);
|
||||||
for(i = start; i < end; i++)
|
for(i = start; i < end; i++)
|
||||||
{
|
{
|
||||||
|
@ -2240,6 +2253,7 @@ string_titlecase_x (SCM str, size_t start, size_t end)
|
||||||
}
|
}
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
scm_remember_upto_here_1 (str);
|
scm_remember_upto_here_1 (str);
|
||||||
|
}
|
||||||
|
|
||||||
return str;
|
return str;
|
||||||
}
|
}
|
||||||
|
@ -2309,11 +2323,13 @@ SCM_DEFINE (scm_string_capitalize, "string-capitalize", 1, 0, 0,
|
||||||
static void
|
static void
|
||||||
string_reverse_x (SCM str, size_t cstart, size_t cend)
|
string_reverse_x (SCM str, size_t cstart, size_t cend)
|
||||||
{
|
{
|
||||||
SCM tmp;
|
if (cstart < cend)
|
||||||
|
{
|
||||||
str = scm_i_string_start_writing (str);
|
str = scm_i_string_start_writing (str);
|
||||||
if (cend > 0)
|
if (cend > 0)
|
||||||
{
|
{
|
||||||
|
SCM tmp;
|
||||||
|
|
||||||
cend--;
|
cend--;
|
||||||
while (cstart < cend)
|
while (cstart < cend)
|
||||||
{
|
{
|
||||||
|
@ -2326,6 +2342,7 @@ string_reverse_x (SCM str, size_t cstart, size_t cend)
|
||||||
}
|
}
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 0,
|
SCM_DEFINE (scm_string_reverse, "string-reverse", 1, 2, 0,
|
||||||
|
@ -2866,7 +2883,9 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 0,
|
||||||
csto = csfrom + (cend - cstart);
|
csto = csfrom + (cend - cstart);
|
||||||
else
|
else
|
||||||
csto = scm_to_int (sto);
|
csto = scm_to_int (sto);
|
||||||
if (cstart == cend && csfrom != csto)
|
if (csfrom < csto)
|
||||||
|
{
|
||||||
|
if (cstart == cend)
|
||||||
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
|
SCM_MISC_ERROR ("start and end indices must not be equal", SCM_EOL);
|
||||||
SCM_ASSERT_RANGE (1, tstart,
|
SCM_ASSERT_RANGE (1, tstart,
|
||||||
ctstart + (csto - csfrom) <= scm_i_string_length (target));
|
ctstart + (csto - csfrom) <= scm_i_string_length (target));
|
||||||
|
@ -2886,6 +2905,7 @@ SCM_DEFINE (scm_string_xcopy_x, "string-xcopy!", 4, 3, 0,
|
||||||
scm_i_string_stop_writing ();
|
scm_i_string_stop_writing ();
|
||||||
|
|
||||||
scm_remember_upto_here_2 (target, s);
|
scm_remember_upto_here_2 (target, s);
|
||||||
|
}
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
|
@ -70,7 +70,7 @@ SCM_DEFINE (scm_srfi60_log2_binary_factors, "log2-binary-factors", 1, 0, 0,
|
||||||
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0,
|
SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0,
|
||||||
(SCM index, SCM n, SCM bit),
|
(SCM index, SCM n, SCM newbit),
|
||||||
"Return @var{n} with the bit at @var{index} set according to\n"
|
"Return @var{n} with the bit at @var{index} set according to\n"
|
||||||
"@var{newbit}. @var{newbit} should be @code{#t} to set the bit\n"
|
"@var{newbit}. @var{newbit} should be @code{#t} to set the bit\n"
|
||||||
"to 1, or @code{#f} to set it to 0. Bits other than at\n"
|
"to 1, or @code{#f} to set it to 0. Bits other than at\n"
|
||||||
|
@ -86,7 +86,7 @@ SCM_DEFINE (scm_srfi60_copy_bit, "copy-bit", 3, 0, 0,
|
||||||
int bb;
|
int bb;
|
||||||
|
|
||||||
ii = scm_to_ulong (index);
|
ii = scm_to_ulong (index);
|
||||||
bb = scm_to_bool (bit);
|
bb = scm_to_bool (newbit);
|
||||||
|
|
||||||
if (SCM_I_INUMP (n))
|
if (SCM_I_INUMP (n))
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1998,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -436,6 +436,9 @@ scm_i_string_length (SCM str)
|
||||||
int
|
int
|
||||||
scm_i_is_narrow_string (SCM str)
|
scm_i_is_narrow_string (SCM str)
|
||||||
{
|
{
|
||||||
|
if (IS_SH_STRING (str))
|
||||||
|
str = SH_STRING_STRING (str);
|
||||||
|
|
||||||
return !STRINGBUF_WIDE (STRING_STRINGBUF (str));
|
return !STRINGBUF_WIDE (STRING_STRINGBUF (str));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -446,6 +449,9 @@ scm_i_is_narrow_string (SCM str)
|
||||||
int
|
int
|
||||||
scm_i_try_narrow_string (SCM str)
|
scm_i_try_narrow_string (SCM str)
|
||||||
{
|
{
|
||||||
|
if (IS_SH_STRING (str))
|
||||||
|
str = SH_STRING_STRING (str);
|
||||||
|
|
||||||
SET_STRING_STRINGBUF (str, narrow_stringbuf (STRING_STRINGBUF (str)));
|
SET_STRING_STRINGBUF (str, narrow_stringbuf (STRING_STRINGBUF (str)));
|
||||||
|
|
||||||
return scm_i_is_narrow_string (str);
|
return scm_i_is_narrow_string (str);
|
||||||
|
@ -664,6 +670,12 @@ scm_i_string_strcmp (SCM sstr, size_t start_x, const char *cstr)
|
||||||
void
|
void
|
||||||
scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
|
scm_i_string_set_x (SCM str, size_t p, scm_t_wchar chr)
|
||||||
{
|
{
|
||||||
|
if (IS_SH_STRING (str))
|
||||||
|
{
|
||||||
|
p += STRING_START (str);
|
||||||
|
str = SH_STRING_STRING (str);
|
||||||
|
}
|
||||||
|
|
||||||
if (chr > 0xFF && scm_i_is_narrow_string (str))
|
if (chr > 0xFF && scm_i_is_narrow_string (str))
|
||||||
SET_STRING_STRINGBUF (str, wide_stringbuf (STRING_STRINGBUF (str)));
|
SET_STRING_STRINGBUF (str, wide_stringbuf (STRING_STRINGBUF (str)));
|
||||||
|
|
||||||
|
@ -2243,7 +2255,7 @@ SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_CHAR, scm_make_string)
|
||||||
void
|
void
|
||||||
scm_init_strings ()
|
scm_init_strings ()
|
||||||
{
|
{
|
||||||
scm_nullstr = scm_i_make_string (0, NULL, 1);
|
scm_nullstr = scm_i_make_string (0, NULL, 0);
|
||||||
|
|
||||||
#include "libguile/strings.x"
|
#include "libguile/strings.x"
|
||||||
}
|
}
|
||||||
|
|
|
@ -85,7 +85,7 @@
|
||||||
- SCM_STRING_CHARS uses scm_i_string_writable_chars and immediately
|
- SCM_STRING_CHARS uses scm_i_string_writable_chars and immediately
|
||||||
calls scm_i_stop_writing, hoping for the best. SCM_STRING_LENGTH
|
calls scm_i_stop_writing, hoping for the best. SCM_STRING_LENGTH
|
||||||
is the same as scm_i_string_length. SCM_STRING_CHARS will throw
|
is the same as scm_i_string_length. SCM_STRING_CHARS will throw
|
||||||
an error for for strings that are not null-terminated. There is
|
an error for strings that are not null-terminated. There is
|
||||||
no wide version of this interface.
|
no wide version of this interface.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
#ifndef SCM_TAGS_H
|
#ifndef SCM_TAGS_H
|
||||||
#define SCM_TAGS_H
|
#define SCM_TAGS_H
|
||||||
|
|
||||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011
|
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
|
||||||
* Free Software Foundation, Inc.
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
|
@ -440,8 +440,8 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
|
||||||
#define scm_tc7_program 79
|
#define scm_tc7_program 79
|
||||||
#define scm_tc7_weak_set 85
|
#define scm_tc7_weak_set 85
|
||||||
#define scm_tc7_weak_table 87
|
#define scm_tc7_weak_table 87
|
||||||
#define scm_tc7_unused_20 93
|
#define scm_tc7_array 93
|
||||||
#define scm_tc7_unused_11 95
|
#define scm_tc7_bitvector 95
|
||||||
#define scm_tc7_unused_12 101
|
#define scm_tc7_unused_12 101
|
||||||
#define scm_tc7_unused_18 103
|
#define scm_tc7_unused_18 103
|
||||||
#define scm_tc7_unused_13 109
|
#define scm_tc7_unused_13 109
|
||||||
|
|
|
@ -1,4 +1,6 @@
|
||||||
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
|
||||||
|
* 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
|
||||||
|
* Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -25,6 +27,7 @@
|
||||||
#include "libguile/bdw-gc.h"
|
#include "libguile/bdw-gc.h"
|
||||||
#include "libguile/_scm.h"
|
#include "libguile/_scm.h"
|
||||||
|
|
||||||
|
#include <stdlib.h>
|
||||||
#if HAVE_UNISTD_H
|
#if HAVE_UNISTD_H
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
;;; -*- mode: scheme; coding: utf-8; -*-
|
;;; -*- mode: scheme; coding: utf-8; -*-
|
||||||
|
|
||||||
;;;; Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
|
;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
||||||
|
;;;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
|
||||||
;;;; Free Software Foundation, Inc.
|
;;;; Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
|
@ -2979,7 +2980,7 @@ module '(ice-9 q) '(make-q q-length))}."
|
||||||
;; 0 by printing a newline, but we then advance it by printing
|
;; 0 by printing a newline, but we then advance it by printing
|
||||||
;; the prompt. However the port-column of the output port
|
;; the prompt. However the port-column of the output port
|
||||||
;; does not typically correspond with the actual column on the
|
;; does not typically correspond with the actual column on the
|
||||||
;; screen, because the input is is echoed back! Since the
|
;; screen, because the input is echoed back! Since the
|
||||||
;; input is line-buffered and thus ends with a newline, the
|
;; input is line-buffered and thus ends with a newline, the
|
||||||
;; output will really start on column zero. So, here we zero
|
;; output will really start on column zero. So, here we zero
|
||||||
;; it out. See bug 9664.
|
;; it out. See bug 9664.
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;;; ftw.scm --- file system tree walk
|
;;;; ftw.scm --- file system tree walk
|
||||||
|
|
||||||
;;;; Copyright (C) 2002, 2003, 2006, 2011 Free Software Foundation, Inc.
|
;;;; Copyright (C) 2002, 2003, 2006, 2011, 2012 Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -389,7 +389,14 @@
|
||||||
;;; `file-system-fold' & co.
|
;;; `file-system-fold' & co.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define* (file-system-fold enter? leaf down up skip init file-name
|
(define-syntax-rule (errno-if-exception expr)
|
||||||
|
(catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
expr)
|
||||||
|
(lambda args
|
||||||
|
(system-error-errno args))))
|
||||||
|
|
||||||
|
(define* (file-system-fold enter? leaf down up skip error init file-name
|
||||||
#:optional (stat lstat))
|
#:optional (stat lstat))
|
||||||
"Traverse the directory at FILE-NAME, recursively. Enter
|
"Traverse the directory at FILE-NAME, recursively. Enter
|
||||||
sub-directories only when (ENTER? PATH STAT RESULT) returns true. When
|
sub-directories only when (ENTER? PATH STAT RESULT) returns true. When
|
||||||
|
@ -397,7 +404,11 @@ a sub-directory is entered, call (DOWN PATH STAT RESULT), where PATH is
|
||||||
the path of the sub-directory and STAT the result of (stat PATH); when
|
the path of the sub-directory and STAT the result of (stat PATH); when
|
||||||
it is left, call (UP PATH STAT RESULT). For each file in a directory,
|
it is left, call (UP PATH STAT RESULT). For each file in a directory,
|
||||||
call (LEAF PATH STAT RESULT). When ENTER? returns false, call (SKIP
|
call (LEAF PATH STAT RESULT). When ENTER? returns false, call (SKIP
|
||||||
PATH STAT RESULT). Return the result of these successive applications.
|
PATH STAT RESULT). When an `opendir' or STAT call raises an exception,
|
||||||
|
call (ERROR PATH STAT ERRNO RESULT), with ERRNO being the operating
|
||||||
|
system error number that was raised.
|
||||||
|
|
||||||
|
Return the result of these successive applications.
|
||||||
When FILE-NAME names a flat file, (LEAF PATH STAT INIT) is returned.
|
When FILE-NAME names a flat file, (LEAF PATH STAT INIT) is returned.
|
||||||
The optional STAT parameter defaults to `lstat'."
|
The optional STAT parameter defaults to `lstat'."
|
||||||
|
|
||||||
|
@ -409,7 +420,7 @@ The optional STAT parameter defaults to `lstat'."
|
||||||
|
|
||||||
(let loop ((name file-name)
|
(let loop ((name file-name)
|
||||||
(path "")
|
(path "")
|
||||||
(dir-stat (false-if-exception (stat file-name)))
|
(dir-stat (errno-if-exception (stat file-name)))
|
||||||
(result init)
|
(result init)
|
||||||
(visited vlist-null))
|
(visited vlist-null))
|
||||||
|
|
||||||
|
@ -419,16 +430,17 @@ The optional STAT parameter defaults to `lstat'."
|
||||||
(string-append path "/" name)))
|
(string-append path "/" name)))
|
||||||
|
|
||||||
(cond
|
(cond
|
||||||
((not dir-stat)
|
((integer? dir-stat)
|
||||||
;; FILE-NAME is not readable.
|
;; FILE-NAME is not readable.
|
||||||
(leaf full-name dir-stat result))
|
(error full-name #f dir-stat result))
|
||||||
((visited? visited dir-stat)
|
((visited? visited dir-stat)
|
||||||
(values result visited))
|
(values result visited))
|
||||||
((eq? 'directory (stat:type dir-stat)) ; true except perhaps the 1st time
|
((eq? 'directory (stat:type dir-stat)) ; true except perhaps the 1st time
|
||||||
(if (enter? full-name dir-stat result)
|
(if (enter? full-name dir-stat result)
|
||||||
(let ((dir (false-if-exception (opendir full-name)))
|
(let ((dir (errno-if-exception (opendir full-name)))
|
||||||
(visited (mark visited dir-stat)))
|
(visited (mark visited dir-stat)))
|
||||||
(if dir
|
(cond
|
||||||
|
((directory-stream? dir)
|
||||||
(let liip ((entry (readdir dir))
|
(let liip ((entry (readdir dir))
|
||||||
(result (down full-name dir-stat result))
|
(result (down full-name dir-stat result))
|
||||||
(subdirs '()))
|
(subdirs '()))
|
||||||
|
@ -456,20 +468,22 @@ The optional STAT parameter defaults to `lstat'."
|
||||||
subdirs))
|
subdirs))
|
||||||
(else
|
(else
|
||||||
(let* ((child (string-append full-name "/" entry))
|
(let* ((child (string-append full-name "/" entry))
|
||||||
(st (false-if-exception (stat child))))
|
(st (errno-if-exception (stat child))))
|
||||||
(if (and st (eq? (stat:type st) 'directory))
|
(if (integer? st) ; CHILD is a dangling symlink?
|
||||||
|
(liip (readdir dir)
|
||||||
|
(error child #f st result)
|
||||||
|
subdirs)
|
||||||
|
(if (eq? (stat:type st) 'directory)
|
||||||
(liip (readdir dir)
|
(liip (readdir dir)
|
||||||
result
|
result
|
||||||
(alist-cons entry st subdirs))
|
(alist-cons entry st subdirs))
|
||||||
(liip (readdir dir)
|
(liip (readdir dir)
|
||||||
(leaf child st result)
|
(leaf child st result)
|
||||||
subdirs))))))
|
subdirs))))))))
|
||||||
|
(else
|
||||||
;; Directory FULL-NAME not readable.
|
;; Directory FULL-NAME not readable, but it is stat'able.
|
||||||
;; XXX: It's up to the user to distinguish between not
|
(values (error full-name dir-stat dir result)
|
||||||
;; readable and not ENTER?.
|
visited))))
|
||||||
(values (skip full-name dir-stat result)
|
|
||||||
visited)))
|
|
||||||
(values (skip full-name dir-stat result)
|
(values (skip full-name dir-stat result)
|
||||||
(mark visited dir-stat))))
|
(mark visited dir-stat))))
|
||||||
(else
|
(else
|
||||||
|
@ -480,13 +494,14 @@ The optional STAT parameter defaults to `lstat'."
|
||||||
#:optional (enter? (lambda (n s) #t))
|
#:optional (enter? (lambda (n s) #t))
|
||||||
(stat lstat))
|
(stat lstat))
|
||||||
"Return a tree of the form (FILE-NAME STAT CHILDREN ...) where STAT is
|
"Return a tree of the form (FILE-NAME STAT CHILDREN ...) where STAT is
|
||||||
the result of (stat FILE-NAME) and CHILDREN are similar structures for
|
the result of (STAT FILE-NAME) and CHILDREN are similar structures for
|
||||||
each file contained in FILE-NAME when it designates a directory. The
|
each file contained in FILE-NAME when it designates a directory. The
|
||||||
optional ENTER? predicate is invoked as (ENTER? NAME STAT) and should
|
optional ENTER? predicate is invoked as (ENTER? NAME STAT) and should
|
||||||
return true to allow recursion into directory NAME; the default value is
|
return true to allow recursion into directory NAME; the default value is
|
||||||
a procedure that always returns #t. When a directory does not match
|
a procedure that always returns #t. When a directory does not match
|
||||||
ENTER?, it nonetheless appears in the resulting tree, only with zero
|
ENTER?, it nonetheless appears in the resulting tree, only with zero
|
||||||
children. The optional STAT parameter defaults to `lstat'."
|
children. The optional STAT parameter defaults to `lstat'. Return #f
|
||||||
|
when FILE-NAME is not readable."
|
||||||
(define (enter?* name stat result)
|
(define (enter?* name stat result)
|
||||||
(enter? name stat))
|
(enter? name stat))
|
||||||
(define (leaf name stat result)
|
(define (leaf name stat result)
|
||||||
|
@ -504,8 +519,15 @@ children. The optional STAT parameter defaults to `lstat'."
|
||||||
rest))))
|
rest))))
|
||||||
(define skip ; keep an entry for skipped directories
|
(define skip ; keep an entry for skipped directories
|
||||||
leaf)
|
leaf)
|
||||||
|
(define (error name stat errno result)
|
||||||
|
(if (string=? name file-name)
|
||||||
|
result
|
||||||
|
(leaf name stat result)))
|
||||||
|
|
||||||
(caar (file-system-fold enter?* leaf down up skip '(()) file-name stat)))
|
(match (file-system-fold enter?* leaf down up skip error '(())
|
||||||
|
file-name stat)
|
||||||
|
(((tree)) tree)
|
||||||
|
((()) #f))) ; FILE-NAME is unreadable
|
||||||
|
|
||||||
(define* (scandir name #:optional (select? (const #t))
|
(define* (scandir name #:optional (select? (const #t))
|
||||||
(entry<? string-locale<?))
|
(entry<? string-locale<?))
|
||||||
|
@ -532,7 +554,12 @@ of file names is sorted according to ENTRY<?, which defaults to
|
||||||
;; All the sub-directories are skipped.
|
;; All the sub-directories are skipped.
|
||||||
(cons (basename name) result))
|
(cons (basename name) result))
|
||||||
|
|
||||||
(and=> (file-system-fold enter? leaf down up skip #f name stat)
|
(define (error name* stat errno result)
|
||||||
|
(if (string=? name name*) ; top-level NAME is unreadable
|
||||||
|
result
|
||||||
|
(cons (basename name*) result)))
|
||||||
|
|
||||||
|
(and=> (file-system-fold enter? leaf down up skip error #f name stat)
|
||||||
(lambda (files)
|
(lambda (files)
|
||||||
(sort files entry<?))))
|
(sort files entry<?))))
|
||||||
|
|
||||||
|
|
|
@ -17,7 +17,7 @@
|
||||||
;;;; "test.scm" Test correctness of scheme implementations.
|
;;;; "test.scm" Test correctness of scheme implementations.
|
||||||
;;; Author: Aubrey Jaffer
|
;;; Author: Aubrey Jaffer
|
||||||
;;; Modified: Mikael Djurfeldt (Removed tests which Guile deliberately
|
;;; Modified: Mikael Djurfeldt (Removed tests which Guile deliberately
|
||||||
;;; won't pass. Made the the tests (test-cont), (test-sc4), and
|
;;; won't pass. Made the tests (test-cont), (test-sc4), and
|
||||||
;;; (test-delay) start to run automatically.
|
;;; (test-delay) start to run automatically.
|
||||||
|
|
||||||
;;; This includes examples from
|
;;; This includes examples from
|
||||||
|
|
|
@ -81,7 +81,7 @@
|
||||||
(progn ,@(cdr cur))
|
(progn ,@(cdr cur))
|
||||||
,rest))))))))
|
,rest))))))))
|
||||||
|
|
||||||
;;; The and and or forms can also be easily defined with macros.
|
;;; The `and' and `or' forms can also be easily defined with macros.
|
||||||
|
|
||||||
(built-in-macro and
|
(built-in-macro and
|
||||||
(case-lambda
|
(case-lambda
|
||||||
|
|
|
@ -238,7 +238,7 @@
|
||||||
c)
|
c)
|
||||||
(list body)))
|
(list body)))
|
||||||
(else
|
(else
|
||||||
;; Otherwise for plain letrec, evaluate the the "complex"
|
;; Otherwise for plain letrec, evaluate the "complex"
|
||||||
;; bindings, in a `let' to indicate that order doesn't
|
;; bindings, in a `let' to indicate that order doesn't
|
||||||
;; matter, and bind to their variables.
|
;; matter, and bind to their variables.
|
||||||
(list
|
(list
|
||||||
|
|
|
@ -652,7 +652,7 @@ has just one element then that's the return value."
|
||||||
(define map! map)
|
(define map! map)
|
||||||
|
|
||||||
(define (filter-map proc list1 . rest)
|
(define (filter-map proc list1 . rest)
|
||||||
"Apply PROC to to the elements of LIST1... and return a list of the
|
"Apply PROC to the elements of LIST1... and return a list of the
|
||||||
results as per SRFI-1 `map', except that any #f results are omitted from
|
results as per SRFI-1 `map', except that any #f results are omitted from
|
||||||
the list returned."
|
the list returned."
|
||||||
(check-arg procedure? proc filter-map)
|
(check-arg procedure? proc filter-map)
|
||||||
|
|
|
@ -93,7 +93,7 @@
|
||||||
;;; This function is among the trickiest I've ever written. I tried many
|
;;; This function is among the trickiest I've ever written. I tried many
|
||||||
;;; variants. In the end, simple is best, of course.
|
;;; variants. In the end, simple is best, of course.
|
||||||
;;;
|
;;;
|
||||||
;;; After turning this around a number of times, it seems that the the
|
;;; After turning this around a number of times, it seems that the
|
||||||
;;; desired behavior is that .go files should exist in a path, for
|
;;; desired behavior is that .go files should exist in a path, for
|
||||||
;;; searching. That is orthogonal to this function. For writing .go
|
;;; searching. That is orthogonal to this function. For writing .go
|
||||||
;;; files, either you know where they should go, in which case you tell
|
;;; files, either you know where they should go, in which case you tell
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Compilation targets
|
;;; Compilation targets
|
||||||
|
|
||||||
;; Copyright (C) 2011 Free Software Foundation, Inc.
|
;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
|
||||||
|
|
||||||
;; This library is free software; you can redistribute it and/or
|
;; This library is free software; you can redistribute it and/or
|
||||||
;; modify it under the terms of the GNU Lesser General Public
|
;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -82,9 +82,9 @@
|
||||||
(cond ((string-match "^i[0-9]86$" cpu) 4)
|
(cond ((string-match "^i[0-9]86$" cpu) 4)
|
||||||
((string-match "64$" cpu) 8)
|
((string-match "64$" cpu) 8)
|
||||||
((string-match "64[lbe][lbe]$" cpu) 8)
|
((string-match "64[lbe][lbe]$" cpu) 8)
|
||||||
((member cpu '("sparc" "powerpc" "mips")) 4)
|
((member cpu '("sparc" "powerpc" "mips" "mipsel")) 4)
|
||||||
((string-match "^arm.*" cpu) 4)
|
((string-match "^arm.*" cpu) 4)
|
||||||
(else "unknown CPU word size" cpu))))
|
(else (error "unknown CPU word size" cpu)))))
|
||||||
|
|
||||||
(define (triplet-cpu t)
|
(define (triplet-cpu t)
|
||||||
(substring t 0 (string-index t #\-)))
|
(substring t 0 (string-index t #\-)))
|
||||||
|
|
|
@ -805,9 +805,6 @@ ordered alist."
|
||||||
(display-digits (date-second date) 2 port)
|
(display-digits (date-second date) 2 port)
|
||||||
(display " GMT" port)))
|
(display " GMT" port)))
|
||||||
|
|
||||||
(define (write-uri uri port)
|
|
||||||
(display (uri->string uri) port))
|
|
||||||
|
|
||||||
(define (parse-entity-tag val)
|
(define (parse-entity-tag val)
|
||||||
(if (string-prefix? "W/" val)
|
(if (string-prefix? "W/" val)
|
||||||
(cons (parse-qstring val 2) #f)
|
(cons (parse-qstring val 2) #f)
|
||||||
|
@ -1082,7 +1079,18 @@ three values: the method, the URI, and the version."
|
||||||
"Write the first line of an HTTP request to @var{port}."
|
"Write the first line of an HTTP request to @var{port}."
|
||||||
(display method port)
|
(display method port)
|
||||||
(display #\space port)
|
(display #\space port)
|
||||||
(write-uri uri port)
|
(let ((path (uri-path uri))
|
||||||
|
(query (uri-query uri)))
|
||||||
|
(if (not (string-null? path))
|
||||||
|
(display path port))
|
||||||
|
(if query
|
||||||
|
(begin
|
||||||
|
(display "?" port)
|
||||||
|
(display query port)))
|
||||||
|
(if (and (string-null? path)
|
||||||
|
(not query))
|
||||||
|
;; Make sure we display something.
|
||||||
|
(display "/" port)))
|
||||||
(display #\space port)
|
(display #\space port)
|
||||||
(write-http-version version port)
|
(write-http-version version port)
|
||||||
(display "\r\n" port))
|
(display "\r\n" port))
|
||||||
|
@ -1506,7 +1514,15 @@ phrase\"."
|
||||||
|
|
||||||
;; Expires = HTTP-date
|
;; Expires = HTTP-date
|
||||||
;;
|
;;
|
||||||
(declare-date-header! "Expires")
|
(define *date-in-the-past* (parse-date "Thu, 01 Jan 1970 00:00:00 GMT"))
|
||||||
|
|
||||||
|
(declare-header! "Expires"
|
||||||
|
(lambda (str)
|
||||||
|
(if (member str '("0" "-1"))
|
||||||
|
*date-in-the-past*
|
||||||
|
(parse-date str)))
|
||||||
|
date?
|
||||||
|
write-date)
|
||||||
|
|
||||||
;; Last-Modified = HTTP-date
|
;; Last-Modified = HTTP-date
|
||||||
;;
|
;;
|
||||||
|
|
|
@ -119,7 +119,7 @@
|
||||||
;;;;
|
;;;;
|
||||||
;;;; * (pass-if-exception name exception body) will pass if the execution of
|
;;;; * (pass-if-exception name exception body) will pass if the execution of
|
||||||
;;;; body causes the given exception to be thrown. If no exception is
|
;;;; body causes the given exception to be thrown. If no exception is
|
||||||
;;;; thrown, the test fails. If some other exception is thrown, is is an
|
;;;; thrown, the test fails. If some other exception is thrown, it is an
|
||||||
;;;; error.
|
;;;; error.
|
||||||
;;;; * (expect-fail-exception name exception body) will pass unexpectedly if
|
;;;; * (expect-fail-exception name exception body) will pass unexpectedly if
|
||||||
;;;; the execution of body causes the given exception to be thrown. If no
|
;;;; the execution of body causes the given exception to be thrown. If no
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2008, 2010, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 1999, 2000, 2001, 2003, 2004, 2006, 2008, 2010, 2011
|
||||||
|
* 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -34,8 +35,7 @@ SCM call_num2ulong_long_body (void *data);
|
||||||
SCM
|
SCM
|
||||||
out_of_range_handler (void *data, SCM key, SCM args)
|
out_of_range_handler (void *data, SCM key, SCM args)
|
||||||
{
|
{
|
||||||
assert (scm_is_true
|
assert (scm_is_eq (key, scm_from_locale_symbol ("out-of-range")));
|
||||||
(scm_equal_p (key, scm_from_locale_symbol ("out-of-range"))));
|
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -27,7 +27,7 @@
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <libguile.h>
|
#include <libguile.h>
|
||||||
|
|
||||||
#include <gc/gc_version.h>
|
#include <gc/gc.h>
|
||||||
|
|
||||||
|
|
||||||
/* Up to GC 7.2alpha5, calling `GC_INIT' from a secondary thread would
|
/* Up to GC 7.2alpha5, calling `GC_INIT' from a secondary thread would
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 2011, 2012 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;;; ftw.test --- exercise ice-9/ftw.scm -*- scheme -*-
|
;;;; ftw.test --- exercise ice-9/ftw.scm -*- scheme -*-
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright 2006, 2011 Free Software Foundation, Inc.
|
;;;; Copyright 2006, 2011, 2012 Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -81,12 +81,71 @@
|
||||||
;;; `file-system-fold' & co.
|
;;; `file-system-fold' & co.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
(define %top-builddir
|
||||||
|
(canonicalize-path (getcwd)))
|
||||||
|
|
||||||
(define %top-srcdir
|
(define %top-srcdir
|
||||||
(assq-ref %guile-build-info 'top_srcdir))
|
(assq-ref %guile-build-info 'top_srcdir))
|
||||||
|
|
||||||
(define %test-dir
|
(define %test-dir
|
||||||
(string-append %top-srcdir "/test-suite"))
|
(string-append %top-srcdir "/test-suite"))
|
||||||
|
|
||||||
|
(define (make-file-tree dir tree)
|
||||||
|
"Make file system TREE at DIR."
|
||||||
|
(define (touch file)
|
||||||
|
(call-with-output-file file
|
||||||
|
(cut display "" <>)))
|
||||||
|
|
||||||
|
(let loop ((dir dir)
|
||||||
|
(tree tree))
|
||||||
|
(define (scope file)
|
||||||
|
(string-append dir "/" file))
|
||||||
|
|
||||||
|
(match tree
|
||||||
|
(('directory name (body ...))
|
||||||
|
(mkdir (scope name))
|
||||||
|
(for-each (cute loop (scope name) <>) body))
|
||||||
|
(('directory name (? integer? mode) (body ...))
|
||||||
|
(mkdir (scope name))
|
||||||
|
(for-each (cute loop (scope name) <>) body)
|
||||||
|
(chmod (scope name) mode))
|
||||||
|
((file)
|
||||||
|
(touch (scope file)))
|
||||||
|
((file (? integer? mode))
|
||||||
|
(touch (scope file))
|
||||||
|
(chmod (scope file) mode))
|
||||||
|
((from '-> to)
|
||||||
|
(symlink to (scope from))))))
|
||||||
|
|
||||||
|
(define (delete-file-tree dir tree)
|
||||||
|
"Delete file TREE from DIR."
|
||||||
|
(let loop ((dir dir)
|
||||||
|
(tree tree))
|
||||||
|
(define (scope file)
|
||||||
|
(string-append dir "/" file))
|
||||||
|
|
||||||
|
(match tree
|
||||||
|
(('directory name (body ...))
|
||||||
|
(for-each (cute loop (scope name) <>) body)
|
||||||
|
(rmdir (scope name)))
|
||||||
|
(('directory name (? integer? mode) (body ...))
|
||||||
|
(chmod (scope name) #o755) ; make sure it can be entered
|
||||||
|
(for-each (cute loop (scope name) <>) body)
|
||||||
|
(rmdir (scope name)))
|
||||||
|
((from '-> _)
|
||||||
|
(delete-file (scope from)))
|
||||||
|
((file _ ...)
|
||||||
|
(delete-file (scope file))))))
|
||||||
|
|
||||||
|
(define-syntax-rule (with-file-tree dir tree body ...)
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda ()
|
||||||
|
(make-file-tree dir tree))
|
||||||
|
(lambda ()
|
||||||
|
body ...)
|
||||||
|
(lambda ()
|
||||||
|
(delete-file-tree dir tree))))
|
||||||
|
|
||||||
(with-test-prefix "file-system-fold"
|
(with-test-prefix "file-system-fold"
|
||||||
|
|
||||||
(pass-if "test-suite"
|
(pass-if "test-suite"
|
||||||
|
@ -98,10 +157,11 @@
|
||||||
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
||||||
(down (lambda (n s r) (cons `(down ,n) r)))
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
(up (lambda (n s r) (cons `(up ,n) r)))
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
(skip (lambda (n s r) (cons `(skip ,n) r))))
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
|
(error (lambda (n s e r) (cons `(error ,n) r))))
|
||||||
(define seq
|
(define seq
|
||||||
(reverse
|
(reverse
|
||||||
(file-system-fold enter? leaf down up skip '() %test-dir)))
|
(file-system-fold enter? leaf down up skip error '() %test-dir)))
|
||||||
|
|
||||||
(match seq
|
(match seq
|
||||||
((('down (? (cut string=? <> %test-dir)))
|
((('down (? (cut string=? <> %test-dir)))
|
||||||
|
@ -123,8 +183,9 @@
|
||||||
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
||||||
(down (lambda (n s r) (cons `(down ,n) r)))
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
(up (lambda (n s r) (cons `(up ,n) r)))
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
(skip (lambda (n s r) (cons `(skip ,n) r))))
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
(equal? (file-system-fold enter? leaf down up skip '() %test-dir)
|
(error (lambda (n s e r) (cons `(error ,n) r))))
|
||||||
|
(equal? (file-system-fold enter? leaf down up skip error '() %test-dir)
|
||||||
`((skip , %test-dir)))))
|
`((skip , %test-dir)))))
|
||||||
|
|
||||||
(pass-if "test-suite/lib.scm (flat file)"
|
(pass-if "test-suite/lib.scm (flat file)"
|
||||||
|
@ -133,9 +194,67 @@
|
||||||
(down (lambda (n s r) (cons `(down ,n) r)))
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
(up (lambda (n s r) (cons `(up ,n) r)))
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
|
(error (lambda (n s e r) (cons `(error ,n) r)))
|
||||||
(name (string-append %test-dir "/lib.scm")))
|
(name (string-append %test-dir "/lib.scm")))
|
||||||
(equal? (file-system-fold enter? leaf down up skip '() name)
|
(equal? (file-system-fold enter? leaf down up skip error '() name)
|
||||||
`((leaf ,name))))))
|
`((leaf ,name)))))
|
||||||
|
|
||||||
|
(pass-if "ENOENT"
|
||||||
|
(let ((enter? (lambda (n s r) #t))
|
||||||
|
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
||||||
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
|
(error (lambda (n s e r) (cons `(error ,n ,e) r)))
|
||||||
|
(name "/.does-not-exist."))
|
||||||
|
(equal? (file-system-fold enter? leaf down up skip error '() name)
|
||||||
|
`((error ,name ,ENOENT)))))
|
||||||
|
|
||||||
|
(pass-if "EACCES"
|
||||||
|
(with-file-tree %top-builddir '(directory "test-EACCES" #o000
|
||||||
|
(("a") ("b")))
|
||||||
|
(let ((enter? (lambda (n s r) #t))
|
||||||
|
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
||||||
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
|
(error (lambda (n s e r) (cons `(error ,n ,e) r)))
|
||||||
|
(name (string-append %top-builddir "/test-EACCES")))
|
||||||
|
(equal? (file-system-fold enter? leaf down up skip error '() name)
|
||||||
|
`((error ,name ,EACCES))))))
|
||||||
|
|
||||||
|
(pass-if "dangling symlink and lstat"
|
||||||
|
(with-file-tree %top-builddir '(directory "test-dangling"
|
||||||
|
(("dangling" -> "xxx")))
|
||||||
|
(let ((enter? (lambda (n s r) #t))
|
||||||
|
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
||||||
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
|
(error (lambda (n s e r) (cons `(error ,n ,e) r)))
|
||||||
|
(name (string-append %top-builddir "/test-dangling")))
|
||||||
|
(equal? (file-system-fold enter? leaf down up skip error '()
|
||||||
|
name)
|
||||||
|
`((up ,name)
|
||||||
|
(leaf ,(string-append name "/dangling"))
|
||||||
|
(down ,name))))))
|
||||||
|
|
||||||
|
(pass-if "dangling symlink and stat"
|
||||||
|
;; Same as above, but using `stat' instead of `lstat'.
|
||||||
|
(with-file-tree %top-builddir '(directory "test-dangling"
|
||||||
|
(("dangling" -> "xxx")))
|
||||||
|
(let ((enter? (lambda (n s r) #t))
|
||||||
|
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
|
||||||
|
(down (lambda (n s r) (cons `(down ,n) r)))
|
||||||
|
(up (lambda (n s r) (cons `(up ,n) r)))
|
||||||
|
(skip (lambda (n s r) (cons `(skip ,n) r)))
|
||||||
|
(error (lambda (n s e r) (cons `(error ,n ,e) r)))
|
||||||
|
(name (string-append %top-builddir "/test-dangling")))
|
||||||
|
(equal? (file-system-fold enter? leaf down up skip error '()
|
||||||
|
name stat)
|
||||||
|
`((up ,name)
|
||||||
|
(error ,(string-append name "/dangling") ,ENOENT)
|
||||||
|
(down ,name)))))))
|
||||||
|
|
||||||
(with-test-prefix "file-system-tree"
|
(with-test-prefix "file-system-tree"
|
||||||
|
|
||||||
|
@ -165,7 +284,10 @@
|
||||||
(lset-intersection string=? files expected)
|
(lset-intersection string=? files expected)
|
||||||
expected)))
|
expected)))
|
||||||
(_ #f))
|
(_ #f))
|
||||||
children)))))
|
children))))
|
||||||
|
|
||||||
|
(pass-if "ENOENT"
|
||||||
|
(not (file-system-tree "/.does-not-exist."))))
|
||||||
|
|
||||||
(with-test-prefix "scandir"
|
(with-test-prefix "scandir"
|
||||||
|
|
||||||
|
@ -188,4 +310,11 @@
|
||||||
#t))))
|
#t))))
|
||||||
|
|
||||||
(pass-if "flat file"
|
(pass-if "flat file"
|
||||||
(not (scandir (string-append %test-dir "/Makefile.am")))))
|
(not (scandir (string-append %test-dir "/Makefile.am"))))
|
||||||
|
|
||||||
|
(pass-if "EACCES"
|
||||||
|
(not (scandir "/.does-not-exist."))))
|
||||||
|
|
||||||
|
;;; Local Variables:
|
||||||
|
;;; eval: (put 'with-file-tree 'scheme-indent-function 2)
|
||||||
|
;;; End:
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*-
|
;;;; i18n.test --- Exercise the i18n API. -*- coding: utf-8; mode: scheme; -*-
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011 Free Software Foundation, Inc.
|
;;;; Copyright (C) 2006, 2007, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
;;;; Ludovic Courtès
|
;;;; Ludovic Courtès
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
|
@ -138,7 +138,11 @@
|
||||||
(under-locale-or-unresolved %french-utf8-locale thunk))
|
(under-locale-or-unresolved %french-utf8-locale thunk))
|
||||||
|
|
||||||
(define (under-turkish-utf8-locale-or-unresolved thunk)
|
(define (under-turkish-utf8-locale-or-unresolved thunk)
|
||||||
(under-locale-or-unresolved %turkish-utf8-locale thunk))
|
;; FreeBSD 8.2 has a broken tr_TR locale where `i' is mapped to
|
||||||
|
;; uppercase `I' instead of `İ', so disable tests on that platform.
|
||||||
|
(if (string-contains %host-type "freebsd8")
|
||||||
|
(throw 'unresolved)
|
||||||
|
(under-locale-or-unresolved %turkish-utf8-locale thunk)))
|
||||||
|
|
||||||
(define (under-german-utf8-locale-or-unresolved thunk)
|
(define (under-german-utf8-locale-or-unresolved thunk)
|
||||||
(under-locale-or-unresolved %german-utf8-locale thunk))
|
(under-locale-or-unresolved %german-utf8-locale thunk))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
;;;; load.test --- test LOAD and path searching functions -*- scheme -*-
|
;;;; load.test --- test LOAD and path searching functions -*- scheme -*-
|
||||||
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
|
;;;; Jim Blandy <jimb@red-bean.com> --- September 1999
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 1999, 2001, 2006, 2010 Free Software Foundation, Inc.
|
;;;; Copyright (C) 1999, 2001, 2006, 2010, 2012 Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -18,8 +18,9 @@
|
||||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
(define-module (test-suite test-load)
|
(define-module (test-suite test-load)
|
||||||
:use-module (test-suite lib)
|
#:use-module (test-suite lib)
|
||||||
:use-module (test-suite guile-test))
|
#:use-module (test-suite guile-test)
|
||||||
|
#:use-module (system base compile))
|
||||||
|
|
||||||
(define temp-dir (data-file-name "load-test.dir"))
|
(define temp-dir (data-file-name "load-test.dir"))
|
||||||
|
|
||||||
|
@ -124,4 +125,17 @@
|
||||||
(try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm")
|
(try-search-with-extensions path "ugly.scm" extensions "dir3/ugly.scm")
|
||||||
(try-search-with-extensions path "ugly.ss" extensions #f))
|
(try-search-with-extensions path "ugly.ss" extensions #f))
|
||||||
|
|
||||||
|
(with-test-prefix "return value of `load'"
|
||||||
|
(let ((temp-file (in-vicinity temp-dir "foo.scm")))
|
||||||
|
(call-with-output-file temp-file
|
||||||
|
(lambda (port)
|
||||||
|
(write '(+ 2 3) port)
|
||||||
|
(newline port)))
|
||||||
|
(pass-if "primitive-load"
|
||||||
|
(equal? 5 (primitive-load temp-file)))
|
||||||
|
(let ((temp-compiled-file (in-vicinity temp-dir "foo.go")))
|
||||||
|
(compile-file temp-file #:output-file temp-compiled-file)
|
||||||
|
(pass-if "load-compiled"
|
||||||
|
(equal? 5 (load-compiled temp-compiled-file))))))
|
||||||
|
|
||||||
(delete-tree temp-dir)
|
(delete-tree temp-dir)
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
;;;; procprop.test --- Procedure properties -*- mode: scheme; coding: utf-8; -*-
|
;;;; procprop.test --- Procedure properties -*- mode: scheme; coding: utf-8; -*-
|
||||||
;;;; Ludovic Courtès <ludo@gnu.org>
|
;;;; Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
|
;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
@ -72,4 +72,10 @@
|
||||||
(pass-if "opt, eval"
|
(pass-if "opt, eval"
|
||||||
(equal? (procedure-minimum-arity (eval '(lambda* (a b #:optional c) #t)
|
(equal? (procedure-minimum-arity (eval '(lambda* (a b #:optional c) #t)
|
||||||
(current-module)))
|
(current-module)))
|
||||||
'(2 1 #f))))
|
'(2 1 #f)))
|
||||||
|
|
||||||
|
(if (include-deprecated-features)
|
||||||
|
(pass-if-exception "set-procedure-properties! arity"
|
||||||
|
'(misc-error . "arity is a read-only property")
|
||||||
|
(set-procedure-properties! (lambda x x) '((arity . 3))))
|
||||||
|
#t))
|
||||||
|
|
|
@ -35,7 +35,7 @@
|
||||||
;;;; Author: Aubrey Jaffer
|
;;;; Author: Aubrey Jaffer
|
||||||
;;;; Modified: Mikael Djurfeldt
|
;;;; Modified: Mikael Djurfeldt
|
||||||
;;;; Removed tests which Guile deliberately
|
;;;; Removed tests which Guile deliberately
|
||||||
;;;; won't pass. Made the the tests (test-cont), (test-sc4), and
|
;;;; won't pass. Made the tests (test-cont), (test-sc4), and
|
||||||
;;;; (test-delay) start to run automatically.
|
;;;; (test-delay) start to run automatically.
|
||||||
;;;; Modified: Jim Blandy
|
;;;; Modified: Jim Blandy
|
||||||
;;;; adapted to new Guile test suite framework
|
;;;; adapted to new Guile test suite framework
|
||||||
|
|
|
@ -147,6 +147,14 @@
|
||||||
|
|
||||||
(define char-code-limit 256)
|
(define char-code-limit 256)
|
||||||
|
|
||||||
|
;; Since `regexp-quote' uses string ports, and since it is used below
|
||||||
|
;; with non-ASCII characters, these ports must be Unicode-capable.
|
||||||
|
(define-syntax with-unicode
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ exp)
|
||||||
|
(with-fluids ((%default-port-encoding "UTF-8"))
|
||||||
|
exp))))
|
||||||
|
|
||||||
(with-test-prefix "regexp-quote"
|
(with-test-prefix "regexp-quote"
|
||||||
|
|
||||||
(pass-if-exception "no args" exception:wrong-num-args
|
(pass-if-exception "no args" exception:wrong-num-args
|
||||||
|
@ -175,7 +183,7 @@
|
||||||
(s (string c)))
|
(s (string c)))
|
||||||
(pass-if (list "char" i (format #f "~s ~s" c s))
|
(pass-if (list "char" i (format #f "~s ~s" c s))
|
||||||
(with-ascii-or-latin1-locale i
|
(with-ascii-or-latin1-locale i
|
||||||
(let* ((q (regexp-quote s))
|
(let* ((q (with-unicode (regexp-quote s)))
|
||||||
(m (regexp-exec (make-regexp q flag) s)))
|
(m (regexp-exec (make-regexp q flag) s)))
|
||||||
(and (= 0 (match:start m))
|
(and (= 0 (match:start m))
|
||||||
(= 1 (match:end m))))))))
|
(= 1 (match:end m))))))))
|
||||||
|
@ -187,7 +195,7 @@
|
||||||
((>= i char-code-limit))
|
((>= i char-code-limit))
|
||||||
(let* ((c (integer->char i))
|
(let* ((c (integer->char i))
|
||||||
(s (string #\a c))
|
(s (string #\a c))
|
||||||
(q (regexp-quote s)))
|
(q (with-unicode (regexp-quote s))))
|
||||||
(pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
|
(pass-if (list "string \"aX\"" i (format #f "~s ~s ~s" c s q))
|
||||||
(with-ascii-or-latin1-locale i
|
(with-ascii-or-latin1-locale i
|
||||||
(let* ((m (regexp-exec (make-regexp q flag) s)))
|
(let* ((m (regexp-exec (make-regexp q flag) s)))
|
||||||
|
@ -196,7 +204,8 @@
|
||||||
|
|
||||||
(pass-if "string of all chars"
|
(pass-if "string of all chars"
|
||||||
(with-latin1-locale
|
(with-latin1-locale
|
||||||
(let ((m (regexp-exec (make-regexp (regexp-quote allchars)
|
(let ((m (regexp-exec (make-regexp (with-unicode
|
||||||
|
(regexp-quote allchars))
|
||||||
flag) allchars)))
|
flag) allchars)))
|
||||||
(and (= 0 (match:start m))
|
(and (= 0 (match:start m))
|
||||||
(= (string-length allchars) (match:end m)))))))))
|
(= (string-length allchars) (match:end m)))))))))
|
||||||
|
|
|
@ -36,7 +36,7 @@
|
||||||
; Test engine
|
; Test engine
|
||||||
; ===========
|
; ===========
|
||||||
;
|
;
|
||||||
; We use an extended version of the the checker of SRFI-42 (with
|
; We use an extended version of the checker of SRFI-42 (with
|
||||||
; Felix' reduction on codesize) for running a batch of tests for
|
; Felix' reduction on codesize) for running a batch of tests for
|
||||||
; the various procedures of 'compare.scm'. Moreover, we use the
|
; the various procedures of 'compare.scm'. Moreover, we use the
|
||||||
; comprehensions of SRFI-42 to generate examples systematically.
|
; comprehensions of SRFI-42 to generate examples systematically.
|
||||||
|
|
|
@ -75,7 +75,7 @@
|
||||||
|
|
||||||
(let ((drift-fraction (/ max-diff average)))
|
(let ((drift-fraction (/ max-diff average)))
|
||||||
(or (< drift-fraction max-allowed-drift)
|
(or (< drift-fraction max-allowed-drift)
|
||||||
;; don't stop the the test suite for what statistically is
|
;; don't stop the test suite for what statistically is
|
||||||
;; bound to happen.
|
;; bound to happen.
|
||||||
(throw 'unresolved (pk average drift-fraction))))))))
|
(throw 'unresolved (pk average drift-fraction))))))))
|
||||||
|
|
||||||
|
|
|
@ -81,6 +81,8 @@
|
||||||
|
|
||||||
(define exception:too-many-args
|
(define exception:too-many-args
|
||||||
"too many arguments")
|
"too many arguments")
|
||||||
|
(define exception:zero-expression-sequence
|
||||||
|
"sequence of zero expressions")
|
||||||
|
|
||||||
|
|
||||||
;; (put 'pass-if-syntax-error 'scheme-indent-function 1)
|
;; (put 'pass-if-syntax-error 'scheme-indent-function 1)
|
||||||
|
@ -148,12 +150,12 @@
|
||||||
|
|
||||||
(with-test-prefix "begin"
|
(with-test-prefix "begin"
|
||||||
|
|
||||||
(pass-if "legal (begin)"
|
(pass-if "valid (begin)"
|
||||||
(eval '(begin (begin) #t) (interaction-environment)))
|
(eval '(begin (begin) #t) (interaction-environment)))
|
||||||
|
|
||||||
(if (not (include-deprecated-features))
|
(if (not (include-deprecated-features))
|
||||||
(pass-if-syntax-error "illegal (begin)"
|
(pass-if-syntax-error "invalid (begin)"
|
||||||
exception:generic-syncase-error
|
exception:zero-expression-sequence
|
||||||
(eval '(begin (if #t (begin)) #t) (interaction-environment)))))
|
(eval '(begin (if #t (begin)) #t) (interaction-environment)))))
|
||||||
|
|
||||||
(define-syntax matches?
|
(define-syntax matches?
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue