diff options
52 files changed, 3063 insertions, 562 deletions
diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 54b43cd12..53cc7ce9a 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -1,7 +1,7 @@ ## Process this file with Automake to create Makefile.in ## ## Copyright (C) 1998, 2004, 2006, 2008, 2009, 2010, -## 2011 Free Software Foundation, Inc. +## 2011, 2013 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -22,8 +22,6 @@ AUTOMAKE_OPTIONS = gnu -BUILT_SOURCES = standard-library.texi - info_TEXINFOS = guile.texi guile_TEXINFOS = preface.texi \ @@ -91,6 +89,9 @@ guile_TEXINFOS = preface.texi \ libguile-extensions.texi \ api-init.texi \ mod-getopt-long.texi \ + statprof.texi \ + sxml.texi \ + texinfo.texi \ goops.texi \ goops-tutorial.texi \ guile-invoke.texi \ @@ -124,35 +125,6 @@ autoconf-macros.texi: $(top_srcdir)/meta/guile.m4 MAINTAINERCLEANFILES = autoconf-macros.texi -# Support for snarfing docs out of Scheme modules. -snarf_doc = standard-library - -$(snarf_doc).am: $(snarf_doc).scm - GUILE_AUTO_COMPILE=0 ; \ - variable="`echo $(snarf_doc) | tr - _`_scm_files" ; \ - "$(top_builddir_absolute)/meta/guile" -l "$(srcdir)/$(snarf_doc).scm" \ - -c " \ - (format #t \"# Automatically generated, do not edit.~%\") \ - (format #t \"$$variable = \") \ - (for-each (lambda (m) \ - (format #t \"$$""(top_srcdir)/module/~a.scm \" \ - (string-join (map symbol->string m) \"/\"))) \ - (map car *modules*))" > "$@.tmp" - mv "$@.tmp" "$@" - -# The following line leads to the definition of $(standard_library_scm_files). -include standard-library.am - -$(snarf_doc).texi: $(standard_library_scm_files) - GUILE_AUTO_COMPILE=0 \ - "$(top_builddir_absolute)/meta/guile" "$(srcdir)/make-texinfo.scm" \ - "$(abs_srcdir)/$(snarf_doc).scm" > "$@.tmp" - mv "$@.tmp" "$@" - -DISTCLEANFILES = $(snarf_doc).texi -EXTRA_DIST += $(snarf_doc).scm make-texinfo.scm $(snarf_doc).texi $(snarf_doc).am - - www-commit: html cd guile.html; \ cvs -d :ext:cvs.sv.gnu.org:/web/guile \ diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi index 2e5a3d251..0ffb5014e 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2012 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2009, 2010, 2011, 2012, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -878,15 +878,20 @@ of modifying the path both at compile-time and at run-time. Search @code{%load-path} for the file named @var{filename} and load it into the top-level environment. If @var{filename} is a relative pathname and is not found in the list of search paths, -an error is signalled. Preferentially loads a compiled version of the +an error is signalled. Preferentially loads a compiled version of the file, if it is available and up-to-date. -By default or if @var{exception-on-not-found} is true, an exception is -raised if @var{filename} is not found. If @var{exception-on-not-found} -is @code{#f} and @var{filename} is not found, no exception is raised and -@code{#f} is returned. For compatibility with Guile 1.8 and earlier, -the C function takes only one argument, which can be either a string -(the file name) or an argument list. +If @var{filename} is a relative pathname and is not found in the list of +search paths, one of three things may happen, depending on the optional +second argument, @var{exception-on-not-found}. If it is @code{#f}, +@code{#f} will be returned. If it is a procedure, it will be called +with no arguments. (This allows a distinction to be made between +exceptions raised by loading a file, and exceptions related to the +loader itself.) Otherwise an error is signalled. + +For compatibility with Guile 1.8 and earlier, the C function takes only +one argument, which can be either a string (the file name) or an +argument list. @end deffn @deffn {Scheme Procedure} %search-load-path filename @@ -1156,6 +1161,9 @@ parts of programs together at expansion-time instead of at run-time. Open @var{file-name}, at expansion-time, and read the Scheme forms that it contains, splicing them into the location of the @code{include}, within a @code{begin}. + +If @var{file-name} is a relative path, it is searched for relative to +the path that contains the file that the @code{include} for appears in. @end deffn If you are a C programmer, if @code{load} in Scheme is like diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi index 57cf8846d..f8ed4ccd7 100644 --- a/doc/ref/api-foreign.texi +++ b/doc/ref/api-foreign.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, -@c 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +@c 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Foreign Function Interface @@ -156,9 +156,6 @@ is equivalent to @smallexample (dynamic-call (dynamic-func @var{func} @var{dobj}) #f) @end smallexample - -Interrupts are deferred while the C function is executing (with -@code{SCM_DEFER_INTS}/@code{SCM_ALLOW_INTS}). @end deffn @code{dynamic-call} is not very powerful. It is mostly intended to be diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index de3684c31..11ae5803a 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -577,6 +577,33 @@ used. This function is equivalent to: @end lisp @end deffn +In the past, Guile did not have a procedure that would just read out all +of the characters from a port. As a workaround, many people just called +@code{read-delimited} with no delimiters, knowing that would produce the +behavior they wanted. This prompted Guile developers to add some +routines that would read all characters from a port. So it is that +@code{(ice-9 rdelim)} is also the home for procedures that can reading +undelimited text: + +@deffn {Scheme Procedure} read-string [port] [count] +Read all of the characters out of @var{port} and return them as a +string. If the @var{count} is present, treat it as a limit to the +number of characters to read. + +By default, read from the current input port, with no size limit on the +result. This procedure always returns a string, even if no characters +were read. +@end deffn + +@deffn {Scheme Procedure} read-string! buf [port] [start] [end] +Fill @var{buf} with characters read from @var{port}, defaulting to the +current input port. Return the number of characters read. + +If @var{start} or @var{end} are specified, store data only into the +substring of @var{str} bounded by @var{start} and @var{end} (which +default to the beginning and end of the string, respectively). +@end deffn + Some of the aforementioned I/O functions rely on the following C primitives. These will mainly be of interest to people hacking Guile internals. diff --git a/doc/ref/api-procedures.texi b/doc/ref/api-procedures.texi index e749fdc98..bef3386e8 100644 --- a/doc/ref/api-procedures.texi +++ b/doc/ref/api-procedures.texi @@ -599,12 +599,61 @@ A @code{case-lambda*} clause matches if the arguments fill the required arguments, but are not too many for the optional and/or rest arguments. -Keyword arguments are possible with @code{case-lambda*}, but they do -not contribute to the ``matching'' behavior. That is to say, -@code{case-lambda*} matches only on required, optional, and rest -arguments, and on the predicate; keyword arguments may be present but -do not contribute to the ``success'' of a match. In fact a bad keyword -argument list may cause an error to be raised. +Keyword arguments are possible with @code{case-lambda*} as well, but +they do not contribute to the ``matching'' behavior, and their +interactions with required, optional, and rest arguments can be +surprising. + +For the purposes of @code{case-lambda*} (and of @code{case-lambda}, as a +special case), a clause @dfn{matches} if it has enough required +arguments, and not too many positional arguments. The required +arguments are any arguments before the @code{#:optional}, @code{#:key}, +and @code{#:rest} arguments. @dfn{Positional} arguments are the +required arguments, together with the optional arguments. + +In the absence of @code{#:key} or @code{#:rest} arguments, it's easy to +see how there could be too many positional arguments: you pass 5 +arguments to a function that only takes 4 arguments, including optional +arguments. If there is a @code{#:rest} argument, there can never be too +many positional arguments: any application with enough required +arguments for a clause will match that clause, even if there are also +@code{#:key} arguments. + +Otherwise, for applications to a clause with @code{#:key} arguments (and +without a @code{#:rest} argument), a clause will match there only if +there are enough required arguments and if the next argument after +binding required and optional arguments, if any, is a keyword. For +efficiency reasons, Guile is currently unable to include keyword +arguments in the matching algorithm. Clauses match on positional +arguments only, not by comparing a given keyword to the available set of +keyword arguments that a function has. + +Some examples follow. + +@example +(define f + (case-lambda* + ((a #:optional b) 'clause-1) + ((a #:optional b #:key c) 'clause-2) + ((a #:key d) 'clause-3) + ((#:key e #:rest f) 'clause-4))) + +(f) @result{} clause-4 +(f 1) @result{} clause-1 +(f) @result{} clause-4 +(f #:e 10) clause-1 +(f 1 #:foo) clause-1 +(f 1 #:c 2) clause-2 +(f #:a #:b #:c #:d #:e) clause-4 + +;; clause-2 will match anything that clause-3 would match. +(f 1 #:d 2) @result{} error: bad keyword args in clause 2 +@end example + +Don't forget that the clauses are matched in order, and the first +matching clause will be taken. This can result in a keyword being bound +to a required argument, as in the case of @code{f #:e 10}. + @node Higher-Order Functions @subsection Higher-Order Functions diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index 9c2b4132a..749583a1b 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010, 2012 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2009, 2010, 2012, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -869,7 +869,7 @@ through several layers of calls before reaching the point they should affect. And introducing a new setting to existing code is often easier with a parameter object than adding arguments. -@defun make-parameter init [converter] +@deffn {Scheme Procedure} make-parameter init [converter] Return a new parameter object, with initial value @var{init}. If a @var{converter} is given, then a call @code{(@var{converter} @@ -888,7 +888,7 @@ canonical form. For example, (my-param 0.75) (my-param) @result{} 3/4 @end example -@end defun +@end deffn @deffn {library syntax} parameterize ((param value) @dots{}) body1 body2 @dots{} Establish a new dynamic scope with the given @var{param}s bound to new @@ -926,6 +926,21 @@ locations. That includes the separate locations when outside any separate initial location in each dynamic state, all initialized to the given @var{init} value. +New code should probably just use parameters instead of fluids, because +the interface is better. But for migrating old code or otherwise +providing interoperability, Guile provides the @code{fluid->parameter} +procedure: + +@deffn {Scheme Procedure} fluid->parameter fluid [conv] +Make a parameter that wraps a fluid. + +The value of the parameter will be the same as the value of the fluid. +If the parameter is rebound in some dynamic extent, perhaps via +@code{parameterize}, the new value will be run through the optional +@var{conv} procedure, as with any parameter. Note that unlike +@code{make-parameter}, @var{conv} is not applied to the initial value. +@end deffn + As alluded to above, because each thread usually has a separate dynamic state, each thread has its own locations behind parameter objects, and changes in one thread are not visible to any other. When a new dynamic diff --git a/doc/ref/api-smobs.texi b/doc/ref/api-smobs.texi index 6b042367e..cb2034ce1 100644 --- a/doc/ref/api-smobs.texi +++ b/doc/ref/api-smobs.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2009, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -129,12 +129,10 @@ Return true iff @var{exp} is a smob instance of the type indicated by so it shouldn't contain any side effects. @end deftypefn -@deftypefn {C Macro} void SCM_NEWSMOB (SCM value, scm_t_bits tag, void *data) -@deftypefnx {C Macro} void SCM_NEWSMOB2 (SCM value, scm_t_bits tag, void *data, void *data2) -@deftypefnx {C Macro} void SCM_NEWSMOB3 (SCM value, scm_t_bits tag, void *data, void *data2, void *data3) -Make @var{value} contain a smob instance of the type with tag -@var{tag} and smob data @var{data}, @var{data2}, and @var{data3}, as -appropriate. +@deftypefn {C Function} SCM scm_new_smob (scm_t_bits tag, void *data) +@deftypefnx {C Function} SCM scm_new_double_smob (scm_t_bits tag, void *data, void *data2, void *data3) +Make a new smob of the type with tag @var{tag} and smob data @var{data}, +@var{data2}, and @var{data3}, as appropriate. The @var{tag} is what has been returned by @code{scm_make_smob_type}. The initial values @var{data}, @var{data2}, and @var{data3} are of @@ -145,20 +143,6 @@ by using @code{SCM_UNPACK}. The flags of the smob instance start out as zero. @end deftypefn -Since it is often the case (e.g., in smob constructors) that you will -create a smob instance and return it, there is also a slightly specialized -macro for this situation: - -@deftypefn {C Macro} {} SCM_RETURN_NEWSMOB (scm_t_bits tag, void *data) -@deftypefnx {C Macro} {} SCM_RETURN_NEWSMOB2 (scm_t_bits tag, void *data1, void *data2) -@deftypefnx {C Macro} {} SCM_RETURN_NEWSMOB3 (scm_t_bits tag, void *data1, void *data2, void *data3) -This macro expands to a block of code that creates a smob instance of -the type with tag @var{tag} and smob data @var{data}, @var{data2}, and -@var{data3}, as with @code{SCM_NEWSMOB}, etc., and causes the -surrounding function to return that @code{SCM} value. It should be -the last piece of code in a block. -@end deftypefn - @deftypefn {C Macro} scm_t_bits SCM_SMOB_FLAGS (SCM obj) Return the 16 extra bits of the smob @var{obj}. No meaning is predefined for these bits, you can use them freely. diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index d95cd02aa..fcb4a0ecd 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2008, 2009, 2010, 2011, 2012 +@c Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -112,9 +112,10 @@ subsequent calls to @code{define-language}, so it should be quite fast. @end deffn -There is a notion of a ``current language'', which is maintained in -the @code{*current-language*} fluid. This language is normally Scheme, -and may be rebound by the user. The run-time compilation interfaces +There is a notion of a ``current language'', which is maintained in the +@code{current-language} parameter, defined in the core @code{(guile)} +module. This language is normally Scheme, and may be rebound by the +user. The run-time compilation interfaces (@pxref{Read/Load/Eval/Compile}) also allow you to choose other source and target languages. diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index ed820af29..262cd645f 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -14,7 +14,7 @@ This manual documents Guile version @value{VERSION}. Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009, -2010, 2011, 2012 Free Software Foundation. +2010, 2011, 2012, 2013 Free Software Foundation. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -177,7 +177,6 @@ x * API Reference:: * Guile Modules:: -* Standard Library:: * GOOPS:: @@ -373,6 +372,9 @@ available through both Scheme and C interfaces. * sxml-match:: Pattern matching of SXML. * The Scheme shell (scsh):: Using scsh interfaces in Guile. * Curried Definitions:: Extended @code{define} syntax. +* Statprof:: An easy-to-use statistical profiler. +* SXML:: Parsing, transforming, and serializing XML. +* Texinfo:: Munging documents written in Texinfo. @end menu @include slib.texi @@ -392,12 +394,9 @@ available through both Scheme and C interfaces. @include scsh.texi @include curried.texi -@node Standard Library -@chapter Standard Library - -@lowersections -@include standard-library.texi -@raisesections +@include statprof.texi +@include sxml.texi +@include texinfo.texi @include goops.texi diff --git a/doc/ref/hierarchy.dot b/doc/ref/hierarchy.dot new file mode 100644 index 000000000..f0d9daf8e --- /dev/null +++ b/doc/ref/hierarchy.dot @@ -0,0 +1,21 @@ +/* + * Process this file with graphviz to produce hierarchy.[png,eps] + * e.g. dot hierarchy.dot -Tpng > hierarchy.png + */ +digraph hierarchy { + graph [rankdir="BT"]; + node [shape="none"]; + F -> D + F -> E + D -> A + E -> A + D -> B + E -> C + A -> "<object>" + B -> "<object>" + C -> "<object>" + "<object>" -> "<top>" + "<pair>" -> "<top>" + "<procedure>" -> "<top>" + "<integer>" -> "<real>" -> "<complex>" -> "<number>" -> "<top>" +} diff --git a/doc/ref/hierarchy.eps b/doc/ref/hierarchy.eps index 7b1a98605..d9e896ccf 100644 --- a/doc/ref/hierarchy.eps +++ b/doc/ref/hierarchy.eps @@ -1,127 +1,601 @@ -%!PS-Adobe-2.0 EPSF -%%Title: /tmp/xfig-fig016295 -%%Creator: fig2dev -%%CreationDate: Fri Jun 10 23:18:16 1994 -%%For: eg@kaolin (Erick Gallesio) -%%BoundingBox: 0 0 361 217 -%%Pages: 0 +%!PS-Adobe-3.0 +%%Creator: graphviz version 2.26.3 (20100126.1600) +%%Title: hierarchy +%%Pages: (atend) +%%BoundingBox: (atend) %%EndComments -/$F2psDict 200 dict def -$F2psDict begin -$F2psDict /mtrx matrix put -/l {lineto} bind def -/m {moveto} bind def -/s {stroke} bind def -/n {newpath} bind def -/gs {gsave} bind def -/gr {grestore} bind def -/clp {closepath} bind def -/graycol {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul -4 -2 roll mul setrgbcolor} bind def -/col-1 {} def -/col0 {0 0 0 setrgbcolor} bind def -/col1 {0 0 1 setrgbcolor} bind def -/col2 {0 1 0 setrgbcolor} bind def -/col3 {0 1 1 setrgbcolor} bind def -/col4 {1 0 0 setrgbcolor} bind def -/col5 {1 0 1 setrgbcolor} bind def -/col6 {1 1 0 setrgbcolor} bind def -/col7 {1 1 1 setrgbcolor} bind def - end -/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def -/$F2psEnd {$F2psEnteredState restore end} def +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw text fitted to its expected width +/alignedtext { % width text + /text exch def + /width exch def + gsave + width 0 gt { + [] 0 setdash + text stringwidth pop width exch sub text length div 0 text ashow + } if + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource %%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if -$F2psBegin -0 setlinecap 0 setlinejoin --216.0 288.0 translate 0.900 -0.900 scale -0.500 setlinewidth -n 309 159 m 309 159 l gs col-1 s gr -n 246.401 216.889 m 244.000 209.000 l 249.831 214.831 l gs 2 setlinejoin col-1 s gr -% Polyline -n 244 209 m 274 259 l gs col-1 s gr -n 298.169 214.831 m 304.000 209.000 l 301.599 216.889 l gs 2 setlinejoin col-1 s gr -% Polyline -n 304 209 m 274 259 l gs col-1 s gr -n 255.721 213.778 m 249.000 209.000 l 257.179 210.053 l gs 2 setlinejoin col-1 s gr -% Polyline -n 249 209 m 364 254 l gs col-1 s gr -n 370.312 216.376 m 374.000 209.000 l 374.217 217.243 l gs 2 setlinejoin col-1 s gr -% Polyline -n 374 209 m 364 254 l gs col-1 s gr -n 283.772 280.725 m 279.000 274.000 l 286.376 277.688 l gs 2 setlinejoin col-1 s gr -% Polyline -n 279 274 m 314 304 l gs col-1 s gr -n 351.457 272.333 m 359.000 269.000 l 353.913 275.490 l gs 2 setlinejoin col-1 s gr -% Polyline -n 359 269 m 314 304 l gs col-1 s gr -n 300.950 165.789 m 309.000 164.000 l 302.739 169.367 l gs 2 setlinejoin col-1 s gr -% Polyline -n 309 164 m 249 194 l gs col-1 s gr -n 307.000 172.000 m 309.000 164.000 l 311.000 172.000 l gs 2 setlinejoin col-1 s gr -% Polyline -n 309 164 m 309 199 l gs col-1 s gr -n 315.261 169.367 m 309.000 164.000 l 317.050 165.789 l gs 2 setlinejoin col-1 s gr -% Polyline -n 309 164 m 379 199 l gs col-1 s gr -n 406.949 101.701 m 404.000 94.000 l 410.226 99.407 l gs 2 setlinejoin col-1 s gr -% Polyline -n 404 94 m 439 144 l gs col-1 s gr -n 410.363 99.245 m 404.000 94.000 l 412.083 95.634 l gs 2 setlinejoin col-1 s gr -% Polyline -n 404 94 m 509 144 l gs col-1 s gr -n 411.173 98.068 m 404.000 94.000 l 412.243 94.214 l gs 2 setlinejoin col-1 s gr -% Polyline -n 404 94 m 584 144 l gs col-1 s gr -n 396.075 96.277 m 404.000 94.000 l 398.079 99.739 l gs 2 setlinejoin col-1 s gr -% Polyline -n 404 94 m 309 149 l gs col-1 s gr -% Polyline -n 584 229 m 584 204 l gs col-1 s gr -n 582.000 212.000 m 584.000 204.000 l 586.000 212.000 l gs 2 setlinejoin col-1 s gr -% Polyline -n 584 189 m 584 159 l gs col-1 s gr -n 582.000 167.000 m 584.000 159.000 l 586.000 167.000 l gs 2 setlinejoin col-1 s gr -/Times-Bold findfont 12.00 scalefont setfont -239 209 m -gs 1 -1 scale (A) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -274 274 m -gs 1 -1 scale (D) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -359 269 m -gs 1 -1 scale (E) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -304 209 m -gs 1 -1 scale (B) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -374 209 m -gs 1 -1 scale (C) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -314 319 m -gs 1 -1 scale (F) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -289 159 m -gs 1 -1 scale (<object>) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -389 89 m -gs 1 -1 scale (<top>) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -424 154 m -gs 1 -1 scale (<pair>) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -474 154 m -gs 1 -1 scale (<procedure>) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -559 154 m -gs 1 -1 scale (<number>) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -629 154 m -gs 1 -1 scale (...) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -569 199 m -gs 1 -1 scale (<real>) col-1 show gr -/Times-Bold findfont 12.00 scalefont setfont -559 239 m -gs 1 -1 scale (<integer>) col-1 show gr -$F2psEnd +%%EndSetup +setupLatin1 +%%Page: 1 1 +%%PageBoundingBox: 36 36 452 368 +%%PageOrientation: Portrait +0 0 1 beginpage +gsave +36 36 416 332 boxprim clip newpath +1 1 set_scale 0 rotate 40 41 translate +% F +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +94.5 13.4 moveto 9 (F) alignedtext +grestore +% D +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +57.5 85.4 moveto 11 (D) alignedtext +grestore +% F->D +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 89.92 36.17 moveto +85.94 44.12 81.18 53.63 76.79 62.43 curveto +stroke +0 0 0 edgecolor +newpath 73.55 61.08 moveto +72.21 71.59 lineto +79.81 64.21 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 73.55 61.08 moveto +72.21 71.59 lineto +79.81 64.21 lineto +closepath stroke +grestore +% E +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +130 85.4 moveto 10 (E) alignedtext +grestore +% F->E +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 108.08 36.17 moveto +112.06 44.12 116.82 53.63 121.21 62.43 curveto +stroke +0 0 0 edgecolor +newpath 118.19 64.21 moveto +125.79 71.59 lineto +124.45 61.08 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 118.19 64.21 moveto +125.79 71.59 lineto +124.45 61.08 lineto +closepath stroke +grestore +% A +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +93.5 157.4 moveto 11 (A) alignedtext +grestore +% D->A +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 72.08 108.17 moveto +76.06 116.12 80.82 125.63 85.21 134.43 curveto +stroke +0 0 0 edgecolor +newpath 82.19 136.21 moveto +89.79 143.59 lineto +88.45 133.08 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 82.19 136.21 moveto +89.79 143.59 lineto +88.45 133.08 lineto +closepath stroke +grestore +% B +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +22 157.4 moveto 10 (B) alignedtext +grestore +% D->B +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 53.92 108.17 moveto +49.94 116.12 45.18 125.63 40.79 134.43 curveto +stroke +0 0 0 edgecolor +newpath 37.55 133.08 moveto +36.21 143.59 lineto +43.81 136.21 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 37.55 133.08 moveto +36.21 143.59 lineto +43.81 136.21 lineto +closepath stroke +grestore +% E->A +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 125.92 108.17 moveto +121.94 116.12 117.18 125.63 112.79 134.43 curveto +stroke +0 0 0 edgecolor +newpath 109.55 133.08 moveto +108.21 143.59 lineto +115.81 136.21 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 109.55 133.08 moveto +108.21 143.59 lineto +115.81 136.21 lineto +closepath stroke +grestore +% C +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +166 157.4 moveto 10 (C) alignedtext +grestore +% E->C +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 144.08 108.17 moveto +148.06 116.12 152.82 125.63 157.21 134.43 curveto +stroke +0 0 0 edgecolor +newpath 154.19 136.21 moveto +161.79 143.59 lineto +160.45 133.08 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 154.19 136.21 moveto +161.79 143.59 lineto +160.45 133.08 lineto +closepath stroke +grestore +% <object> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +73.5 229.4 moveto 51 (<object>) alignedtext +grestore +% A-><object> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 99 180.17 moveto +99 187.87 99 197.03 99 205.58 curveto +stroke +0 0 0 edgecolor +newpath 95.5 205.59 moveto +99 215.59 lineto +102.5 205.59 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 95.5 205.59 moveto +99 215.59 lineto +102.5 205.59 lineto +closepath stroke +grestore +% B-><object> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 45.17 180.17 moveto +53.72 188.72 64.06 199.06 73.38 208.38 curveto +stroke +0 0 0 edgecolor +newpath 71.04 210.99 moveto +80.59 215.59 lineto +75.99 206.04 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 71.04 210.99 moveto +80.59 215.59 lineto +75.99 206.04 lineto +closepath stroke +grestore +% C-><object> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 152.83 180.17 moveto +144.28 188.72 133.94 199.06 124.62 208.38 curveto +stroke +0 0 0 edgecolor +newpath 122.01 206.04 moveto +117.41 215.59 lineto +126.96 210.99 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 122.01 206.04 moveto +117.41 215.59 lineto +126.96 210.99 lineto +closepath stroke +grestore +% <top> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +205.5 301.4 moveto 35 (<top>) alignedtext +grestore +% <object>-><top> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 130.29 252.17 moveto +147.52 262.17 168.98 274.63 186.92 285.05 curveto +stroke +0 0 0 edgecolor +newpath 185.53 288.29 moveto +195.93 290.28 lineto +189.04 282.23 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 185.53 288.29 moveto +195.93 290.28 lineto +189.04 282.23 lineto +closepath stroke +grestore +% <pair> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +158 229.4 moveto 40 (<pair>) alignedtext +grestore +% <pair>-><top> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 189.36 252.17 moveto +194.43 260.29 200.52 270.04 206.12 278.99 curveto +stroke +0 0 0 edgecolor +newpath 203.22 280.96 moveto +211.49 287.59 lineto +209.16 277.25 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 203.22 280.96 moveto +211.49 287.59 lineto +209.16 277.25 lineto +closepath stroke +grestore +% <procedure> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +231.5 229.4 moveto 73 (<procedure>) alignedtext +grestore +% <procedure>-><top> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 256.64 252.17 moveto +251.57 260.29 245.48 270.04 239.88 278.99 curveto +stroke +0 0 0 edgecolor +newpath 236.84 277.25 moveto +234.51 287.59 lineto +242.78 280.96 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 236.84 277.25 moveto +234.51 287.59 lineto +242.78 280.96 lineto +closepath stroke +grestore +% <integer> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +339.5 13.4 moveto 57 (<integer>) alignedtext +grestore +% <real> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +348.5 85.4 moveto 39 (<real>) alignedtext +grestore +% <integer>-><real> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 368 36.17 moveto +368 43.87 368 53.03 368 61.58 curveto +stroke +0 0 0 edgecolor +newpath 364.5 61.59 moveto +368 71.59 lineto +371.5 61.59 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 364.5 61.59 moveto +368 71.59 lineto +371.5 61.59 lineto +closepath stroke +grestore +% <complex> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +336 157.4 moveto 64 (<complex>) alignedtext +grestore +% <real>-><complex> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 368 108.17 moveto +368 115.87 368 125.03 368 133.58 curveto +stroke +0 0 0 edgecolor +newpath 364.5 133.59 moveto +368 143.59 lineto +371.5 133.59 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 364.5 133.59 moveto +368 143.59 lineto +371.5 133.59 lineto +closepath stroke +grestore +% <number> +gsave +0 0 0 nodecolor +14 /Times-Roman set_font +337.5 229.4 moveto 61 (<number>) alignedtext +grestore +% <complex>-><number> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 368 180.17 moveto +368 187.87 368 197.03 368 205.58 curveto +stroke +0 0 0 edgecolor +newpath 364.5 205.59 moveto +368 215.59 lineto +371.5 205.59 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 364.5 205.59 moveto +368 215.59 lineto +371.5 205.59 lineto +closepath stroke +grestore +% <number>-><top> +gsave +1 setlinewidth +0 0 0 edgecolor +newpath 331.41 252.17 moveto +309.39 263.1 281.45 276.98 259.45 287.9 curveto +stroke +0 0 0 edgecolor +newpath 257.82 284.8 moveto +250.42 292.38 lineto +260.94 291.07 lineto +closepath fill +1 setlinewidth +solid +0 0 0 edgecolor +newpath 257.82 284.8 moveto +250.42 292.38 lineto +260.94 291.07 lineto +closepath stroke +grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +%%BoundingBox: 36 36 452 368 +end +restore +%%EOF diff --git a/doc/ref/hierarchy.pdf b/doc/ref/hierarchy.pdf Binary files differindex 3a19ba4eb..8c02d7a56 100644 --- a/doc/ref/hierarchy.pdf +++ b/doc/ref/hierarchy.pdf diff --git a/doc/ref/hierarchy.png b/doc/ref/hierarchy.png Binary files differindex 46f58b051..e3a516164 100644 --- a/doc/ref/hierarchy.png +++ b/doc/ref/hierarchy.png diff --git a/doc/ref/libguile-concepts.texi b/doc/ref/libguile-concepts.texi index 915054c53..0103ad173 100644 --- a/doc/ref/libguile-concepts.texi +++ b/doc/ref/libguile-concepts.texi @@ -1,7 +1,7 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011 -@c Free Software Foundation, Inc. +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, +@c 2011, 2013 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node General Libguile Concepts @@ -494,12 +494,12 @@ my_list_to_vector (SCM list) SCM vector = scm_make_vector (scm_length (list), SCM_UNDEFINED); size_t len, i; - len = SCM_SIMPLE_VECTOR_LENGTH (vector); + len = scm_c_vector_length (vector); i = 0; while (i < len && scm_is_pair (list)) @{ - SCM_SIMPLE_VECTOR_SET (vector, i, SCM_CAR (list)); - list = SCM_CDR (list); + scm_c_vector_set_x (vector, i, scm_car (list)); + list = scm_cdr (list); i++; @} @@ -516,22 +516,23 @@ But there is no guarantee that the list referenced by @var{list} is not modified in another thread while the loop iterates over it. Thus, while copying its elements into the vector, the list might get longer or shorter. For this reason, the loop must check both that it doesn't -overrun the vector (@code{SCM_SIMPLE_VECTOR_SET} does no range-checking) -and that it doesn't overrun the list (@code{SCM_CAR} and @code{SCM_CDR} -likewise do no type checking). +overrun the vector and that it doesn't overrun the list. Otherwise, +@code{scm_c_vector_set_x} would raise an error if the index is out of +range, and @code{scm_car} and @code{scm_cdr} would raise an error if the +value is not a pair. -It is safe to use @code{SCM_CAR} and @code{SCM_CDR} on the local +It is safe to use @code{scm_car} and @code{scm_cdr} on the local variable @var{list} once it is known that the variable contains a pair. The contents of the pair might change spontaneously, but it will always stay a valid pair (and a local variable will of course not spontaneously point to a different Scheme object). -Likewise, a simple vector such as the one returned by -@code{scm_make_vector} is guaranteed to always stay the same length so -that it is safe to only use SCM_SIMPLE_VECTOR_LENGTH once and store the -result. (In the example, @var{vector} is safe anyway since it is a -fresh object that no other thread can possibly know about until it is -returned from @code{my_list_to_vector}.) +Likewise, a vector such as the one returned by @code{scm_make_vector} is +guaranteed to always stay the same length so that it is safe to only use +scm_c_vector_length once and store the result. (In the example, +@var{vector} is safe anyway since it is a fresh object that no other +thread can possibly know about until it is returned from +@code{my_list_to_vector}.) Of course the behavior of @code{my_list_to_vector} is suboptimal when @var{list} does indeed get asynchronously lengthened or shortened in @@ -549,11 +550,11 @@ my_pedantic_list_to_vector (SCM list) SCM vector = scm_make_vector (scm_length (list), SCM_UNDEFINED); size_t len, i; - len = SCM_SIMPLE_VECTOR_LENGTH (vector); + len = scm_c_vector_length (vector); i = 0; while (i < len) @{ - SCM_SIMPLE_VECTOR_SET (vector, i, scm_car (list)); + scm_c_vector_set_x (vector, i, scm_car (list)); list = scm_cdr (list); i++; @} @@ -562,12 +563,10 @@ my_pedantic_list_to_vector (SCM list) @} @end example -This version uses the type-checking and thread-robust functions -@code{scm_car} and @code{scm_cdr} instead of the faster, but less robust -macros @code{SCM_CAR} and @code{SCM_CDR}. When the list is shortened -(that is, when @var{list} holds a non-pair), @code{scm_car} will throw -an error. This might be preferable to just returning a half-initialized -vector. +This version relies on the error-checking behavior of @code{scm_car} and +@code{scm_cdr}. When the list is shortened (that is, when @var{list} +holds a non-pair), @code{scm_car} will throw an error. This might be +preferable to just returning a half-initialized vector. The API for accessing vectors and arrays of various kinds from C takes a slightly different approach to thread-robustness. In order to get at @@ -583,13 +582,13 @@ see, Guile itself is again only concerned about robustness, not about correctness: without proper synchronization, your program will likely not be correct, but the worst consequence is an error message. -Real thread-safeness often requires that a critical section of code is +Real thread-safety often requires that a critical section of code is executed in a certain restricted manner. A common requirement is that the code section is not entered a second time when it is already being executed. Locking a mutex while in that section ensures that no other thread will start executing it, blocking asyncs ensures that no -asynchronous code enters the section again from the current thread, -and the error checking of Guile mutexes guarantees that an error is +asynchronous code enters the section again from the current thread, and +the error checking of Guile mutexes guarantees that an error is signalled when the current thread accidentally reenters the critical section via recursive function calls. diff --git a/doc/ref/libguile-smobs.texi b/doc/ref/libguile-smobs.texi index eb938f099..6f7c0f45f 100644 --- a/doc/ref/libguile-smobs.texi +++ b/doc/ref/libguile-smobs.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2010, 2011, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -180,7 +180,7 @@ Initialize these fields with @code{SCM_BOOL_F}. A valid state is one that can be safely acted upon by the @emph{mark} and @emph{free} functions of your smob type. @item -Create the smob using @code{SCM_NEWSMOB}, passing it the initialized +Create the smob using @code{scm_new_smob}, passing it the initialized memory block. (This step will always succeed.) @item Complete the initialization of the memory block by, for example, @@ -223,7 +223,7 @@ make_image (SCM name, SCM s_width, SCM s_height) /* Step 3: Create the smob. */ - SCM_NEWSMOB (smob, image_tag, image); + smob = scm_new_smob (image_tag, image); /* Step 4: Finish the initialization. */ @@ -254,7 +254,7 @@ After it, @var{smob} contains a valid smob that is properly initialized and protected, and in turn can properly protect the Scheme values in its @var{image} struct. -But before the smob is completely created, @code{SCM_NEWSMOB} might +But before the smob is completely created, @code{scm_new_smob} might cause the garbage collector to run. During this garbage collection, the @code{SCM} values in the @var{image} struct would be invisible to Guile. It only gets to know about them via the @code{mark_image} function, but @@ -530,13 +530,11 @@ four-word cells, which are appropriately called @dfn{double cells}. You can use them for @dfn{double smobs} and get two more immediate words of type @code{scm_t_bits}. -A double smob is created with @code{SCM_NEWSMOB2} or -@code{SCM_NEWSMOB3} instead of @code{SCM_NEWSMOB}. Its immediate -words can be retrieved as @code{scm_t_bits} with -@code{SCM_SMOB_DATA_2} and @code{SCM_SMOB_DATA_3} in addition to -@code{SCM_SMOB_DATA}. Unsurprisingly, the words can be set to -@code{scm_t_bits} values with @code{SCM_SET_SMOB_DATA_2} and -@code{SCM_SET_SMOB_DATA_3}. +A double smob is created with @code{scm_new_double_smob}. Its immediate +words can be retrieved as @code{scm_t_bits} with @code{SCM_SMOB_DATA_2} +and @code{SCM_SMOB_DATA_3} in addition to @code{SCM_SMOB_DATA}. +Unsurprisingly, the words can be set to @code{scm_t_bits} values with +@code{SCM_SET_SMOB_DATA_2} and @code{SCM_SET_SMOB_DATA_3}. Of course there are also @code{SCM_SMOB_OBJECT_2}, @code{SCM_SMOB_OBJECT_3}, @code{SCM_SET_SMOB_OBJECT_2}, and @@ -599,7 +597,7 @@ make_image (SCM name, SCM s_width, SCM s_height) /* Step 3: Create the smob. */ - SCM_NEWSMOB (smob, image_tag, image); + smob = scm_new_smob (image_tag, image); /* Step 4: Finish the initialization. */ diff --git a/doc/ref/make-texinfo.scm b/doc/ref/make-texinfo.scm deleted file mode 100644 index c967bc163..000000000 --- a/doc/ref/make-texinfo.scm +++ /dev/null @@ -1,28 +0,0 @@ -;; make-texinfo.scm -- document a set of scheme modules as texinfo -;; Copyright (C) 2006,2007,2009 Andy Wingo <wingo at pobox dot com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -(use-modules (texinfo reflection) - (texinfo serialize)) - -(define (main config-scm) - (load config-scm) - (display - (stexi->texi - (package-stexi-documentation-for-include - (map car *modules*) - (map cdr *modules*))))) - -(apply main (cdr (command-line))) diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index 4f9e6db82..e0f91af02 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2006, 2010, 2011, 2012 +@c Copyright (C) 2006, 2010, 2011, 2012, 2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -298,8 +298,13 @@ Time execution. Profile execution. @end deffn -@deffn {REPL Command} trace exp +@deffn {REPL Command} trace exp [#:width w] [#:max-indent i] Trace execution. + +By default, the trace will limit its width to the width of your +terminal, or @var{width} if specified. Nested procedure invocations +will be printed farther to the right, though if the width of the +indentation passes the @var{max-indent}, the indentation is abbreviated. @end deffn @node Debug Commands diff --git a/doc/ref/standard-library.am b/doc/ref/standard-library.am deleted file mode 100644 index 27246f4ff..000000000 --- a/doc/ref/standard-library.am +++ /dev/null @@ -1,2 +0,0 @@ -# Automatically generated, do not edit. -standard_library_scm_files = $(top_srcdir)/module/statprof.scm $(top_srcdir)/module/sxml/apply-templates.scm $(top_srcdir)/module/sxml/fold.scm $(top_srcdir)/module/sxml/simple.scm $(top_srcdir)/module/sxml/ssax.scm $(top_srcdir)/module/sxml/ssax/input-parse.scm $(top_srcdir)/module/sxml/transform.scm $(top_srcdir)/module/sxml/xpath.scm $(top_srcdir)/module/texinfo.scm $(top_srcdir)/module/texinfo/docbook.scm $(top_srcdir)/module/texinfo/html.scm $(top_srcdir)/module/texinfo/indexing.scm $(top_srcdir)/module/texinfo/string-utils.scm $(top_srcdir)/module/texinfo/plain-text.scm $(top_srcdir)/module/texinfo/serialize.scm $(top_srcdir)/module/texinfo/reflection.scm
\ No newline at end of file diff --git a/doc/ref/standard-library.scm b/doc/ref/standard-library.scm deleted file mode 100644 index 7fd17b51f..000000000 --- a/doc/ref/standard-library.scm +++ /dev/null @@ -1,48 +0,0 @@ -;; The modules to document -(define *modules* - '(((statprof) - "Statistical profiler") - ((sxml apply-templates) - "A more XSLT-like approach to SXML transformations") - ((sxml fold) - "Fold-based SXML transformation operators") - ((sxml simple) - "Convenient XML parsing and serializing") - ((sxml ssax) - "Functional-style XML parsing for Scheme") - ((sxml ssax input-parse) - "The SSAX tokenizer, optimized for Guile") - ((sxml transform) - "A higher-order SXML transformation operator, " - (code "pre-post-order")) - ((sxml xpath) - "XPath for SXML") - ((texinfo) - "Parse texinfo files or fragments into " (code "stexi") ", a " - "scheme representation") - ((texinfo docbook) - "Transform a subset of docbook into " (code "stexi")) - ((texinfo html) - "Transform " (code "stexi") " into HTML") - ((texinfo indexing) - "Extract an index from a piece of " (code "stexi")) - ((texinfo string-utils) - "String utility functions used by the texinfo processor") - ((texinfo plain-text) - "Render " (code "stexi") " as plain text") - ((texinfo serialize) - "Render " (code "stexi") " as texinfo") - ((texinfo reflection) - "Enable texinfo across Guile's help system"))) - -(define *module-sources* - '(((sxml ssax) . "http://ssax.sourceforge.net/") - ((sxml xpath) . "http://ssax.sourceforge.net/") - ((sxml transform) . "http://ssax.sourceforge.net/") - ((sxml apply-templates) . "http://ssax.sourceforge.net/") - ((sxml ssax input-parse) . "http://ssax.sourceforge.net/") - ((htmlprag) . "http://neilvandyke.org/htmlprag/"))) - -(define *scripts* '()) - -;; arch-tag: e493ad42-ad58-451c-a2d6-b17ba6c1d1d0 diff --git a/doc/ref/statprof.texi b/doc/ref/statprof.texi new file mode 100644 index 000000000..c481ac72e --- /dev/null +++ b/doc/ref/statprof.texi @@ -0,0 +1,283 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 2013 Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + +@node Statprof +@section Statprof + +@code{(statprof)} is a fairly simple statistical profiler for Guile. + +A simple use of statprof would look like this: + +@example +(statprof-reset 0 50000 #t) +(statprof-start) +(do-something) +(statprof-stop) +(statprof-display) +@end example + +This would reset statprof, clearing all accumulated statistics, then +start profiling, run some code, stop profiling, and finally display a +gprof flat-style table of statistics which will look something like +this: + +@example + % cumulative self self total + time seconds seconds calls ms/call ms/call name + 35.29 0.23 0.23 2002 0.11 0.11 - + 23.53 0.15 0.15 2001 0.08 0.08 positive? + 23.53 0.15 0.15 2000 0.08 0.08 + + 11.76 0.23 0.08 2000 0.04 0.11 do-nothing + 5.88 0.64 0.04 2001 0.02 0.32 loop + 0.00 0.15 0.00 1 0.00 150.59 do-something + ... +@end example + +All of the numerical data with the exception of the calls column is +statistically approximate. In the following column descriptions, and in +all of statprof, "time" refers to execution time (both user and system), +not wall clock time. + +@table @asis +@item % time +The percent of the time spent inside the procedure itself (not counting +children). + +@item cumulative seconds +The total number of seconds spent in the procedure, including children. + +@item self seconds +The total number of seconds spent in the procedure itself (not counting +children). + +@item calls +The total number of times the procedure was called. + +@item self ms/call +The average time taken by the procedure itself on each call, in ms. + +@item total ms/call +The average time taken by each call to the procedure, including time +spent in child functions. + +@item name +The name of the procedure. + +@end table + +The profiler uses @code{eq?} and the procedure object itself to identify +the procedures, so it won't confuse different procedures with the same +name. They will show up as two different rows in the output. + +Right now the profiler is quite simplistic. I cannot provide call-graphs +or other higher level information. What you see in the table is pretty +much all there is. Patches are welcome :-) + +@section Implementation notes +The profiler works by setting the unix profiling signal +@code{ITIMER_PROF} to go off after the interval you define in the call +to @code{statprof-reset}. When the signal fires, a sampling routine is +run which looks at the current procedure that's executing, and then +crawls up the stack, and for each procedure encountered, increments that +procedure's sample count. Note that if a procedure is encountered +multiple times on a given stack, it is only counted once. After the +sampling is complete, the profiler resets profiling timer to fire again +after the appropriate interval. + +Meanwhile, the profiler keeps track, via @code{get-internal-run-time}, +how much CPU time (system and user -- which is also what +@code{ITIMER_PROF} tracks), has elapsed while code has been executing +within a statprof-start/stop block. + +The profiler also tries to avoid counting or timing its own code as much +as possible. + +@section Usage +@anchor{statprof statprof-active?}@defun statprof-active? +Returns @code{#t} if @code{statprof-start} has been called more times +than @code{statprof-stop}, @code{#f} otherwise. + +@end defun + +@anchor{statprof statprof-start}@defun statprof-start +Start the profiler.@code{} + +@end defun + +@anchor{statprof statprof-stop}@defun statprof-stop +Stop the profiler.@code{} + +@end defun + +@anchor{statprof statprof-reset}@defun statprof-reset sample-seconds sample-microseconds count-calls? [full-stacks?] +Reset the statprof sampler interval to @var{sample-seconds} and +@var{sample-microseconds}. If @var{count-calls?} is true, arrange to +instrument procedure calls as well as collecting statistical profiling +data. If @var{full-stacks?} is true, collect all sampled stacks into a +list for later analysis. + +Enables traps and debugging as necessary. + +@end defun + +@anchor{statprof statprof-accumulated-time}@defun statprof-accumulated-time +Returns the time accumulated during the last statprof run.@code{} + +@end defun + +@anchor{statprof statprof-sample-count}@defun statprof-sample-count +Returns the number of samples taken during the last statprof run.@code{} + +@end defun + +@anchor{statprof statprof-fold-call-data}@defun statprof-fold-call-data proc init +Fold @var{proc} over the call-data accumulated by statprof. Cannot be +called while statprof is active. @var{proc} should take two arguments, +@code{(@var{call-data} @var{prior-result})}. + +Note that a given proc-name may appear multiple times, but if it does, +it represents different functions with the same name. + +@end defun + +@anchor{statprof statprof-proc-call-data}@defun statprof-proc-call-data proc +Returns the call-data associated with @var{proc}, or @code{#f} if none +is available. + +@end defun + +@anchor{statprof statprof-call-data-name}@defun statprof-call-data-name cd +@end defun + +@anchor{statprof statprof-call-data-calls}@defun statprof-call-data-calls cd +@end defun + +@anchor{statprof statprof-call-data-cum-samples}@defun statprof-call-data-cum-samples cd +@end defun + +@anchor{statprof statprof-call-data-self-samples}@defun statprof-call-data-self-samples cd +@end defun + +@anchor{statprof statprof-call-data->stats}@defun statprof-call-data->stats call-data +Returns an object of type @code{statprof-stats}. + +@end defun + +@anchor{statprof statprof-stats-proc-name}@defun statprof-stats-proc-name stats +@end defun + +@anchor{statprof statprof-stats-%-time-in-proc}@defun statprof-stats-%-time-in-proc stats +@end defun + +@anchor{statprof statprof-stats-cum-secs-in-proc}@defun statprof-stats-cum-secs-in-proc stats +@end defun + +@anchor{statprof statprof-stats-self-secs-in-proc}@defun statprof-stats-self-secs-in-proc stats +@end defun + +@anchor{statprof statprof-stats-calls}@defun statprof-stats-calls stats +@end defun + +@anchor{statprof statprof-stats-self-secs-per-call}@defun statprof-stats-self-secs-per-call stats +@end defun + +@anchor{statprof statprof-stats-cum-secs-per-call}@defun statprof-stats-cum-secs-per-call stats +@end defun + +@anchor{statprof statprof-display}@defun statprof-display . _ +Displays a gprof-like summary of the statistics collected. Unless an +optional @var{port} argument is passed, uses the current output port. + +@end defun + +@anchor{statprof statprof-display-anomolies}@defun statprof-display-anomolies +A sanity check that attempts to detect anomolies in statprof's +statistics.@code{} + +@end defun + +@anchor{statprof statprof-fetch-stacks}@defun statprof-fetch-stacks +Returns a list of stacks, as they were captured since the last call to +@code{statprof-reset}. + +Note that stacks are only collected if the @var{full-stacks?} argument +to @code{statprof-reset} is true. + +@end defun + +@anchor{statprof statprof-fetch-call-tree}@defun statprof-fetch-call-tree +@verbatim +Return a call tree for the previous statprof run. + +The return value is a list of nodes, each of which is of the type: +@@code + node ::= (@@var@{proc@} @@var@{count@} . @@var@{nodes@}) +@@end code +@end verbatim + +@end defun + +@anchor{statprof statprof}@defun statprof thunk [#:loop] [#:hz] [#:count-calls?] [#:full-stacks?] +Profiles the execution of @var{thunk}. + +The stack will be sampled @var{hz} times per second, and the thunk +itself will be called @var{loop} times. + +If @var{count-calls?} is true, all procedure calls will be recorded. +This operation is somewhat expensive. + +If @var{full-stacks?} is true, at each sample, statprof will store away +the whole call tree, for later analysis. Use +@code{statprof-fetch-stacks} or @code{statprof-fetch-call-tree} to +retrieve the last-stored stacks. + +@end defun + +@anchor{statprof with-statprof}@defspec with-statprof args +Profiles the expressions in its body. + +Keyword arguments: + +@table @code +@item #:loop +Execute the body @var{loop} number of times, or @code{#f} for no looping + +default: @code{#f} + +@item #:hz +Sampling rate + +default: @code{20} + +@item #:count-calls? +Whether to instrument each function call (expensive) + +default: @code{#f} + +@item #:full-stacks? +Whether to collect away all sampled stacks into a list + +default: @code{#f} + +@end table + +@end defspec + +@anchor{statprof gcprof}@defun gcprof thunk [#:loop] [#:full-stacks?] +Do an allocation profile of the execution of @var{thunk}. + +The stack will be sampled soon after every garbage collection, yielding +an approximate idea of what is causing allocation in your program. + +Since GC does not occur very frequently, you may need to use the +@var{loop} parameter, to cause @var{thunk} to be called @var{loop} +times. + +If @var{full-stacks?} is true, at each sample, statprof will store away +the whole call tree, for later analysis. Use +@code{statprof-fetch-stacks} or @code{statprof-fetch-call-tree} to +retrieve the last-stored stacks. + +@end defun diff --git a/doc/ref/sxml.texi b/doc/ref/sxml.texi new file mode 100644 index 000000000..3ce6062f4 --- /dev/null +++ b/doc/ref/sxml.texi @@ -0,0 +1,733 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 2013 Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + +@node SXML +@section SXML + +@menu +* sxml apply-templates:: A more XSLT-like approach to SXML transformations +* sxml fold:: Fold-based SXML transformation operators +* sxml simple:: Convenient XML parsing and serializing +* sxml ssax:: Functional-style XML parsing for Scheme +* sxml ssax input-parse:: The SSAX tokenizer, optimized for Guile +* sxml transform:: A higher-order SXML transformation operator, @code{pre-post-order} +* sxml xpath:: XPath for SXML +@end menu + +@node sxml apply-templates +@subsection (sxml apply-templates) +@subsubsection Overview +Pre-order traversal of a tree and creation of a new tree: + +@smallexample + apply-templates:: tree x <templates> -> <new-tree> +@end smallexample + +where + +@smallexample + <templates> ::= (<template> ...) + <template> ::= (<node-test> <node-test> ... <node-test> . <handler>) + <node-test> ::= an argument to node-typeof? above + <handler> ::= <tree> -> <new-tree> +@end smallexample + +This procedure does a @emph{normal}, pre-order traversal of an SXML +tree. It walks the tree, checking at each node against the list of +matching templates. + +If the match is found (which must be unique, i.e., unambiguous), the +corresponding handler is invoked and given the current node as an +argument. The result from the handler, which must be a @code{<tree>}, +takes place of the current node in the resulting tree. The name of the +function is not accidental: it resembles rather closely an +@code{apply-templates} function of XSLT. + +@subsubsection Usage +@anchor{sxml apply-templates apply-templates}@defun apply-templates tree templates +@end defun + +@node sxml fold +@subsection (sxml fold) +@subsubsection Overview +@code{(sxml fold)} defines a number of variants of the @dfn{fold} +algorithm for use in transforming SXML trees. Additionally it defines +the layout operator, @code{fold-layout}, which might be described as a +context-passing variant of SSAX's @code{pre-post-order}. + +@subsubsection Usage +@anchor{sxml fold foldt}@defun foldt fup fhere tree +The standard multithreaded tree fold. + +@var{fup} is of type [a] -> a. @var{fhere} is of type object -> a. + +@end defun + +@anchor{sxml fold foldts}@defun foldts fdown fup fhere seed tree +The single-threaded tree fold originally defined in SSAX. @xref{sxml +ssax,,(sxml ssax)}, for more information. + +@end defun + +@anchor{sxml fold foldts*}@defun foldts* fdown fup fhere seed tree +A variant of @ref{sxml fold foldts,,foldts} that allows pre-order tree +rewrites. Originally defined in Andy Wingo's 2007 paper, +@emph{Applications of fold to XML transformation}. + +@end defun + +@anchor{sxml fold fold-values}@defun fold-values proc list . seeds +A variant of @ref{SRFI-1 Fold and Map,fold} that allows multi-valued +seeds. Note that the order of the arguments differs from that of +@code{fold}. + +@end defun + +@anchor{sxml fold foldts*-values}@defun foldts*-values fdown fup fhere tree . seeds +A variant of @ref{sxml fold foldts*,,foldts*} that allows multi-valued +seeds. Originally defined in Andy Wingo's 2007 paper, @emph{Applications +of fold to XML transformation}. + +@end defun + +@anchor{sxml fold fold-layout}@defun fold-layout tree bindings params layout stylesheet +A traversal combinator in the spirit of SSAX's @ref{sxml transform +pre-post-order,,pre-post-order}. + +@code{fold-layout} was originally presented in Andy Wingo's 2007 paper, +@emph{Applications of fold to XML transformation}. + +@example +bindings := (<binding>...) +binding := (<tag> <bandler-pair>...) + | (*default* . <post-handler>) + | (*text* . <text-handler>) +tag := <symbol> +handler-pair := (pre-layout . <pre-layout-handler>) + | (post . <post-handler>) + | (bindings . <bindings>) + | (pre . <pre-handler>) + | (macro . <macro-handler>) +@end example + +@table @var +@item pre-layout-handler +A function of three arguments: + +@table @var +@item kids +the kids of the current node, before traversal + +@item params +the params of the current node + +@item layout +the layout coming into this node + +@end table + +@var{pre-layout-handler} is expected to use this information to return a +layout to pass to the kids. The default implementation returns the +layout given in the arguments. + +@item post-handler +A function of five arguments: + +@table @var +@item tag +the current tag being processed + +@item params +the params of the current node + +@item layout +the layout coming into the current node, before any kids were processed + +@item klayout +the layout after processing all of the children + +@item kids +the already-processed child nodes + +@end table + +@var{post-handler} should return two values, the layout to pass to the +next node and the final tree. + +@item text-handler +@var{text-handler} is a function of three arguments: + +@table @var +@item text +the string + +@item params +the current params + +@item layout +the current layout + +@end table + +@var{text-handler} should return two values, the layout to pass to the +next node and the value to which the string should transform. + +@end table + +@end defun + +@node sxml simple +@subsection (sxml simple) +@subsubsection Overview +A simple interface to XML parsing and serialization. + +@subsubsection Usage +@anchor{sxml simple xml->sxml}@defun xml->sxml [port] +Use SSAX to parse an XML document into SXML. Takes one optional +argument, @var{port}, which defaults to the current input port. + +@end defun + +@anchor{sxml simple sxml->xml}@defun sxml->xml tree [port] +Serialize the sxml tree @var{tree} as XML. The output will be written to +the current output port, unless the optional argument @var{port} is +present. + +@end defun + +@anchor{sxml simple sxml->string}@defun sxml->string sxml +Detag an sxml tree @var{sxml} into a string. Does not perform any +formatting. + +@end defun + +@node sxml ssax +@subsection (sxml ssax) +@subsubsection Overview +@subheading Functional XML parsing framework +@subsubheading SAX/DOM and SXML parsers with support for XML Namespaces and validation +This is a package of low-to-high level lexing and parsing procedures +that can be combined to yield a SAX, a DOM, a validating parser, or a +parser intended for a particular document type. The procedures in the +package can be used separately to tokenize or parse various pieces of +XML documents. The package supports XML Namespaces, internal and +external parsed entities, user-controlled handling of whitespace, and +validation. This module therefore is intended to be a framework, a set +of "Lego blocks" you can use to build a parser following any discipline +and performing validation to any degree. As an example of the parser +construction, this file includes a semi-validating SXML parser. + +The present XML framework has a "sequential" feel of SAX yet a +"functional style" of DOM. Like a SAX parser, the framework scans the +document only once and permits incremental processing. An application +that handles document elements in order can run as efficiently as +possible. @emph{Unlike} a SAX parser, the framework does not require an +application register stateful callbacks and surrender control to the +parser. Rather, it is the application that can drive the framework -- +calling its functions to get the current lexical or syntax element. +These functions do not maintain or mutate any state save the input port. +Therefore, the framework permits parsing of XML in a pure functional +style, with the input port being a monad (or a linear, read-once +parameter). + +Besides the @var{port}, there is another monad -- @var{seed}. Most of +the middle- and high-level parsers are single-threaded through the +@var{seed}. The functions of this framework do not process or affect the +@var{seed} in any way: they simply pass it around as an instance of an +opaque datatype. User functions, on the other hand, can use the seed to +maintain user's state, to accumulate parsing results, etc. A user can +freely mix his own functions with those of the framework. On the other +hand, the user may wish to instantiate a high-level parser: +@code{SSAX:make-elem-parser} or @code{SSAX:make-parser}. In the latter +case, the user must provide functions of specific signatures, which are +called at predictable moments during the parsing: to handle character +data, element data, or processing instructions (PI). The functions are +always given the @var{seed}, among other parameters, and must return the +new @var{seed}. + +From a functional point of view, XML parsing is a combined +pre-post-order traversal of a "tree" that is the XML document itself. +This down-and-up traversal tells the user about an element when its +start tag is encountered. The user is notified about the element once +more, after all element's children have been handled. The process of XML +parsing therefore is a fold over the raw XML document. Unlike a fold +over trees defined in [1], the parser is necessarily single-threaded -- +obviously as elements in a text XML document are laid down sequentially. +The parser therefore is a tree fold that has been transformed to accept +an accumulating parameter [1,2]. + +Formally, the denotational semantics of the parser can be expressed as + +@smallexample + parser:: (Start-tag -> Seed -> Seed) -> + (Start-tag -> Seed -> Seed -> Seed) -> + (Char-Data -> Seed -> Seed) -> + XML-text-fragment -> Seed -> Seed + parser fdown fup fchar "<elem attrs> content </elem>" seed + = fup "<elem attrs>" seed + (parser fdown fup fchar "content" (fdown "<elem attrs>" seed)) + + parser fdown fup fchar "char-data content" seed + = parser fdown fup fchar "content" (fchar "char-data" seed) + + parser fdown fup fchar "elem-content content" seed + = parser fdown fup fchar "content" ( + parser fdown fup fchar "elem-content" seed) +@end smallexample + +Compare the last two equations with the left fold + +@smallexample + fold-left kons elem:list seed = fold-left kons list (kons elem seed) +@end smallexample + +The real parser created by @code{SSAX:make-parser} is slightly more +complicated, to account for processing instructions, entity references, +namespaces, processing of document type declaration, etc. + +The XML standard document referred to in this module +is@uref{http://www.w3.org/TR/1998/REC-xml-19980210.html} + +The present file also defines a procedure that parses the text of an XML +document or of a separate element into SXML, an S-expression-based model +of an XML Information Set. SXML is also an Abstract Syntax Tree of an +XML document. SXML is similar but not identical to DOM; SXML is +particularly suitable for Scheme-based XML/HTML authoring, SXPath +queries, and tree transformations. See SXML.html for more details. SXML +is a term implementation of evaluation of the XML document [3]. The +other implementation is context-passing. + +The present frameworks fully supports the XML Namespaces +Recommendation:@uref{http://www.w3.org/TR/REC-xml-names/} Other links: + +@table @asis +@item [1] +Jeremy Gibbons, Geraint Jones, "The Under-appreciated Unfold," Proc. +ICFP'98, 1998, pp. 273-279. + +@item [2] +Richard S. Bird, The promotion and accumulation strategies in +transformational programming, ACM Trans. Progr. Lang. Systems, +6(4):487-504, October 1984. + +@item [3] +Ralf Hinze, "Deriving Backtracking Monad Transformers," Functional +Pearl. Proc ICFP'00, pp. 186-197. + +@end table + +@subsubsection Usage +@anchor{sxml ssax current-ssax-error-port}@defun current-ssax-error-port +@end defun + +@anchor{sxml ssax with-ssax-error-to-port}@defun with-ssax-error-to-port port thunk +@end defun + +@anchor{sxml ssax xml-token?}@defun xml-token? _ +@verbatim + -- Scheme Procedure: pair? x + Return `#t' if X is a pair; otherwise return `#f'. + + +@end verbatim + +@end defun + +@anchor{sxml ssax xml-token-kind}@defspec xml-token-kind token +@end defspec + +@anchor{sxml ssax xml-token-head}@defspec xml-token-head token +@end defspec + +@anchor{sxml ssax make-empty-attlist}@defun make-empty-attlist +@end defun + +@anchor{sxml ssax attlist-add}@defun attlist-add attlist name-value +@end defun + +@anchor{sxml ssax attlist-null?}@defun attlist-null? _ +@verbatim + -- Scheme Procedure: null? x + Return `#t' iff X is the empty list, else `#f'. + + +@end verbatim + +@end defun + +@anchor{sxml ssax attlist-remove-top}@defun attlist-remove-top attlist +@end defun + +@anchor{sxml ssax attlist->alist}@defun attlist->alist attlist +@end defun + +@anchor{sxml ssax attlist-fold}@defun attlist-fold kons knil lis1 +@end defun + +@anchor{sxml ssax define-parsed-entity!}@defun define-parsed-entity! entity str +Define a new parsed entity. @var{entity} should be a symbol. + +Instances of &@var{entity}; in XML text will be replaced with the string +@var{str}, which will then be parsed. + +@end defun + +@anchor{sxml ssax reset-parsed-entity-definitions!}@defun reset-parsed-entity-definitions! +Restore the set of parsed entity definitions to its initial state. + +@end defun + +@anchor{sxml ssax ssax:uri-string->symbol}@defun ssax:uri-string->symbol uri-str +@end defun + +@anchor{sxml ssax ssax:skip-internal-dtd}@defun ssax:skip-internal-dtd port +@end defun + +@anchor{sxml ssax ssax:read-pi-body-as-string}@defun ssax:read-pi-body-as-string port +@end defun + +@anchor{sxml ssax ssax:reverse-collect-str-drop-ws}@defun ssax:reverse-collect-str-drop-ws fragments +@end defun + +@anchor{sxml ssax ssax:read-markup-token}@defun ssax:read-markup-token port +@end defun + +@anchor{sxml ssax ssax:read-cdata-body}@defun ssax:read-cdata-body port str-handler seed +@end defun + +@anchor{sxml ssax ssax:read-char-ref}@defun ssax:read-char-ref port +@end defun + +@anchor{sxml ssax ssax:read-attributes}@defun ssax:read-attributes port entities +@end defun + +@anchor{sxml ssax ssax:complete-start-tag}@defun ssax:complete-start-tag tag-head port elems entities namespaces +@end defun + +@anchor{sxml ssax ssax:read-external-id}@defun ssax:read-external-id port +@end defun + +@anchor{sxml ssax ssax:read-char-data}@defun ssax:read-char-data port expect-eof? str-handler seed +@end defun + +@anchor{sxml ssax ssax:xml->sxml}@defun ssax:xml->sxml port namespace-prefix-assig +@end defun + +@anchor{sxml ssax ssax:make-parser}@defspec ssax:make-parser . kw-val-pairs +@end defspec + +@anchor{sxml ssax ssax:make-pi-parser}@defspec ssax:make-pi-parser orig-handlers +@end defspec + +@anchor{sxml ssax ssax:make-elem-parser}@defspec ssax:make-elem-parser my-new-level-seed my-finish-element my-char-data-handler my-pi-handlers +@end defspec + +@node sxml ssax input-parse +@subsection (sxml ssax input-parse) +@subsubsection Overview +A simple lexer. + +The procedures in this module surprisingly often suffice to parse an +input stream. They either skip, or build and return tokens, according to +inclusion or delimiting semantics. The list of characters to expect, +include, or to break at may vary from one invocation of a function to +another. This allows the functions to easily parse even +context-sensitive languages. + +EOF is generally frowned on, and thrown up upon if encountered. +Exceptions are mentioned specifically. The list of expected characters +(characters to skip until, or break-characters) may include an EOF +"character", which is to be coded as the symbol, @code{*eof*}. + +The input stream to parse is specified as a @dfn{port}, which is usually +the last (and optional) argument. It defaults to the current input port +if omitted. + +If the parser encounters an error, it will throw an exception to the key +@code{parser-error}. The arguments will be of the form @code{(@var{port} +@var{message} @var{specialising-msg}*)}. + +The first argument is a port, which typically points to the offending +character or its neighborhood. You can then use @code{port-column} and +@code{port-line} to query the current position. @var{message} is the +description of the error. Other arguments supply more details about the +problem. + +@subsubsection Usage +@anchor{sxml ssax input-parse peek-next-char}@defun peek-next-char [port] +@end defun + +@anchor{sxml ssax input-parse assert-curr-char}@defun assert-curr-char expected-chars comment [port] +@end defun + +@anchor{sxml ssax input-parse skip-until}@defun skip-until arg [port] +@end defun + +@anchor{sxml ssax input-parse skip-while}@defun skip-while skip-chars [port] +@end defun + +@anchor{sxml ssax input-parse next-token}@defun next-token prefix-skipped-chars break-chars [comment] [port] +@end defun + +@anchor{sxml ssax input-parse next-token-of}@defun next-token-of incl-list/pred [port] +@end defun + +@anchor{sxml ssax input-parse read-text-line}@defun read-text-line [port] +@end defun + +@anchor{sxml ssax input-parse read-string}@defun read-string n [port] +@end defun + +@anchor{sxml ssax input-parse find-string-from-port?}@defun find-string-from-port? _ _ . _ +Looks for @var{str} in @var{<input-port>}, optionally within the first +@var{max-no-char} characters. + +@end defun + +@node sxml transform +@subsection (sxml transform) +@subsubsection Overview +@heading SXML expression tree transformers +@subheading Pre-Post-order traversal of a tree and creation of a new tree +@smallexample +pre-post-order:: <tree> x <bindings> -> <new-tree> +@end smallexample + +where + +@smallexample + <bindings> ::= (<binding> ...) + <binding> ::= (<trigger-symbol> *preorder* . <handler>) | + (<trigger-symbol> *macro* . <handler>) | + (<trigger-symbol> <new-bindings> . <handler>) | + (<trigger-symbol> . <handler>) + <trigger-symbol> ::= XMLname | *text* | *default* + <handler> :: <trigger-symbol> x [<tree>] -> <new-tree> +@end smallexample + +The pre-post-order function visits the nodes and nodelists +pre-post-order (depth-first). For each @code{<Node>} of the form +@code{(@var{name} <Node> ...)}, it looks up an association with the +given @var{name} among its @var{<bindings>}. If failed, +@code{pre-post-order} tries to locate a @code{*default*} binding. It's +an error if the latter attempt fails as well. Having found a binding, +the @code{pre-post-order} function first checks to see if the binding is +of the form + +@smallexample + (<trigger-symbol> *preorder* . <handler>) +@end smallexample + +If it is, the handler is 'applied' to the current node. Otherwise, the +pre-post-order function first calls itself recursively for each child of +the current node, with @var{<new-bindings>} prepended to the +@var{<bindings>} in effect. The result of these calls is passed to the +@var{<handler>} (along with the head of the current @var{<Node>}). To be +more precise, the handler is _applied_ to the head of the current node +and its processed children. The result of the handler, which should also +be a @code{<tree>}, replaces the current @var{<Node>}. If the current +@var{<Node>} is a text string or other atom, a special binding with a +symbol @code{*text*} is looked up. + +A binding can also be of a form + +@smallexample + (<trigger-symbol> *macro* . <handler>) +@end smallexample + +This is equivalent to @code{*preorder*} described above. However, the +result is re-processed again, with the current stylesheet. + +@subsubsection Usage +@anchor{sxml transform SRV:send-reply}@defun SRV:send-reply . fragments +Output the @var{fragments} to the current output port. + +The fragments are a list of strings, characters, numbers, thunks, +@code{#f}, @code{#t} -- and other fragments. The function traverses the +tree depth-first, writes out strings and characters, executes thunks, +and ignores @code{#f} and @code{'()}. The function returns @code{#t} if +anything was written at all; otherwise the result is @code{#f} If +@code{#t} occurs among the fragments, it is not written out but causes +the result of @code{SRV:send-reply} to be @code{#t}. + +@end defun + +@anchor{sxml transform foldts}@defun foldts fdown fup fhere seed tree +@end defun + +@anchor{sxml transform post-order}@defun post-order tree bindings +@end defun + +@anchor{sxml transform pre-post-order}@defun pre-post-order tree bindings +@end defun + +@anchor{sxml transform replace-range}@defun replace-range beg-pred end-pred forest +@end defun + +@node sxml xpath +@subsection (sxml xpath) +@subsubsection Overview +@heading SXPath: SXML Query Language +SXPath is a query language for SXML, an instance of XML Information set +(Infoset) in the form of s-expressions. See @code{(sxml ssax)} for the +definition of SXML and more details. SXPath is also a translation into +Scheme of an XML Path Language, @uref{http://www.w3.org/TR/xpath,XPath}. +XPath and SXPath describe means of selecting a set of Infoset's items or +their properties. + +To facilitate queries, XPath maps the XML Infoset into an explicit tree, +and introduces important notions of a location path and a current, +context node. A location path denotes a selection of a set of nodes +relative to a context node. Any XPath tree has a distinguished, root +node -- which serves as the context node for absolute location paths. +Location path is recursively defined as a location step joined with a +location path. A location step is a simple query of the database +relative to a context node. A step may include expressions that further +filter the selected set. Each node in the resulting set is used as a +context node for the adjoining location path. The result of the step is +a union of the sets returned by the latter location paths. + +The SXML representation of the XML Infoset (see SSAX.scm) is rather +suitable for querying as it is. Bowing to the XPath specification, we +will refer to SXML information items as 'Nodes': + +@example + <Node> ::= <Element> | <attributes-coll> | <attrib> + | "text string" | <PI> +@end example + +This production can also be described as + +@example + <Node> ::= (name . <Nodeset>) | "text string" +@end example + +An (ordered) set of nodes is just a list of the constituent nodes: + +@example + <Nodeset> ::= (<Node> ...) +@end example + +Nodesets, and Nodes other than text strings are both lists. A <Nodeset> +however is either an empty list, or a list whose head is not a symbol. A +symbol at the head of a node is either an XML name (in which case it's a +tag of an XML element), or an administrative name such as '@@'. This +uniform list representation makes processing rather simple and elegant, +while avoiding confusion. The multi-branch tree structure formed by the +mutually-recursive datatypes <Node> and <Nodeset> lends itself well to +processing by functional languages. + +A location path is in fact a composite query over an XPath tree or its +branch. A singe step is a combination of a projection, selection or a +transitive closure. Multiple steps are combined via join and union +operations. This insight allows us to @emph{elegantly} implement XPath +as a sequence of projection and filtering primitives -- converters -- +joined by @dfn{combinators}. Each converter takes a node and returns a +nodeset which is the result of the corresponding query relative to that +node. A converter can also be called on a set of nodes. In that case it +returns a union of the corresponding queries over each node in the set. +The union is easily implemented as a list append operation as all nodes +in a SXML tree are considered distinct, by XPath conventions. We also +preserve the order of the members in the union. Query combinators are +high-order functions: they take converter(s) (which is a Node|Nodeset -> +Nodeset function) and compose or otherwise combine them. We will be +concerned with only relative location paths [XPath]: an absolute +location path is a relative path applied to the root node. + +Similarly to XPath, SXPath defines full and abbreviated notations for +location paths. In both cases, the abbreviated notation can be +mechanically expanded into the full form by simple rewriting rules. In +case of SXPath the corresponding rules are given as comments to a sxpath +function, below. The regression test suite at the end of this file shows +a representative sample of SXPaths in both notations, juxtaposed with +the corresponding XPath expressions. Most of the samples are borrowed +literally from the XPath specification, while the others are adjusted +for our running example, tree1. + +@subsubsection Usage +@anchor{sxml xpath nodeset?}@defun nodeset? x +@end defun + +@anchor{sxml xpath node-typeof?}@defun node-typeof? crit +@end defun + +@anchor{sxml xpath node-eq?}@defun node-eq? other +@end defun + +@anchor{sxml xpath node-equal?}@defun node-equal? other +@end defun + +@anchor{sxml xpath node-pos}@defun node-pos n +@end defun + +@anchor{sxml xpath filter}@defun filter pred? +@verbatim + -- Scheme Procedure: filter pred list + Return all the elements of 2nd arg LIST that satisfy predicate + PRED. The list is not disordered - elements that appear in the + result list occur in the same order as they occur in the argument + list. The returned list may share a common tail with the argument + list. The dynamic order in which the various applications of pred + are made is not specified. + + (filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4) + + +@end verbatim + +@end defun + +@anchor{sxml xpath take-until}@defun take-until pred? +@end defun + +@anchor{sxml xpath take-after}@defun take-after pred? +@end defun + +@anchor{sxml xpath map-union}@defun map-union proc lst +@end defun + +@anchor{sxml xpath node-reverse}@defun node-reverse node-or-nodeset +@end defun + +@anchor{sxml xpath node-trace}@defun node-trace title +@end defun + +@anchor{sxml xpath select-kids}@defun select-kids test-pred? +@end defun + +@anchor{sxml xpath node-self}@defun node-self pred? +@verbatim + -- Scheme Procedure: filter pred list + Return all the elements of 2nd arg LIST that satisfy predicate + PRED. The list is not disordered - elements that appear in the + result list occur in the same order as they occur in the argument + list. The returned list may share a common tail with the argument + list. The dynamic order in which the various applications of pred + are made is not specified. + + (filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4) + + +@end verbatim + +@end defun + +@anchor{sxml xpath node-join}@defun node-join . selectors +@end defun + +@anchor{sxml xpath node-reduce}@defun node-reduce . converters +@end defun + +@anchor{sxml xpath node-or}@defun node-or . converters +@end defun + +@anchor{sxml xpath node-closure}@defun node-closure test-pred? +@end defun + +@anchor{sxml xpath node-parent}@defun node-parent rootnode +@end defun + +@anchor{sxml xpath sxpath}@defun sxpath path +@end defun diff --git a/doc/ref/texinfo.texi b/doc/ref/texinfo.texi new file mode 100644 index 000000000..b2947fc30 --- /dev/null +++ b/doc/ref/texinfo.texi @@ -0,0 +1,588 @@ +@c -*-texinfo-*- +@c This is part of the GNU Guile Reference Manual. +@c Copyright (C) 2013 Free Software Foundation, Inc. +@c See the file guile.texi for copying conditions. + +@node Texinfo +@section Texinfo + +@menu +* texinfo:: Parse texinfo files or fragments into @code{stexi}, a scheme representation +* texinfo docbook:: Transform a subset of docbook into @code{stexi} +* texinfo html:: Transform @code{stexi} into HTML +* texinfo indexing:: Extract an index from a piece of @code{stexi} +* texinfo string-utils:: String utility functions used by the texinfo processor +* texinfo plain-text:: Render @code{stexi} as plain text +* texinfo serialize:: Render @code{stexi} as texinfo +* texinfo reflection:: Enable texinfo across Guile's help system +@end menu + +@node texinfo +@subsection (texinfo) +@subsubsection Overview +@subheading Texinfo processing in scheme +This module parses texinfo into SXML. TeX will always be the processor +of choice for print output, of course. However, although @code{makeinfo} +works well for info, its output in other formats is not very +customizable, and the program is not extensible as a whole. This module +aims to provide an extensible framework for texinfo processing that +integrates texinfo into the constellation of SXML processing tools. + +@subheading Notes on the SXML vocabulary +Consider the following texinfo fragment: + +@example + @@deffn Primitive set-car! pair value + This function... + @@end deffn +@end example + +Logically, the category (Primitive), name (set-car!), and arguments +(pair value) are ``attributes'' of the deffn, with the description as +the content. However, texinfo allows for @@-commands within the +arguments to an environment, like @code{@@deffn}, which means that +texinfo ``attributes'' are PCDATA. XML attributes, on the other hand, +are CDATA. For this reason, ``attributes'' of texinfo @@-commands are +called ``arguments'', and are grouped under the special element, `%'. + +Because `%' is not a valid NCName, stexinfo is a superset of SXML. In +the interests of interoperability, this module provides a conversion +function to replace the `%' with `texinfo-arguments'. + +@subsubsection Usage +@anchor{texinfo call-with-file-and-dir}@defun call-with-file-and-dir filename proc +Call the one-argument procedure @var{proc} with an input port that reads +from @var{filename}. During the dynamic extent of @var{proc}'s +execution, the current directory will be @code{(dirname +@var{filename})}. This is useful for parsing documents that can include +files by relative path name. + +@end defun + +@anchor{texinfo texi-command-specs}@defvar texi-command-specs +@end defvar + +@anchor{texinfo texi-command-depth}@defun texi-command-depth command max-depth +Given the texinfo command @var{command}, return its nesting level, or +@code{#f} if it nests too deep for @var{max-depth}. + +Examples: + +@example + (texi-command-depth 'chapter 4) @result{} 1 + (texi-command-depth 'top 4) @result{} 0 + (texi-command-depth 'subsection 4) @result{} 3 + (texi-command-depth 'appendixsubsec 4) @result{} 3 + (texi-command-depth 'subsection 2) @result{} #f +@end example + +@end defun + +@anchor{texinfo texi-fragment->stexi}@defun texi-fragment->stexi string-or-port +Parse the texinfo commands in @var{string-or-port}, and return the +resultant stexi tree. The head of the tree will be the special command, +@code{*fragment*}. + +@end defun + +@anchor{texinfo texi->stexi}@defun texi->stexi port +Read a full texinfo document from @var{port} and return the parsed stexi +tree. The parsing will start at the @code{@@settitle} and end at +@code{@@bye} or EOF. + +@end defun + +@anchor{texinfo stexi->sxml}@defun stexi->sxml tree +Transform the stexi tree @var{tree} into sxml. This involves replacing +the @code{%} element that keeps the texinfo arguments with an element +for each argument. + +FIXME: right now it just changes % to @code{texinfo-arguments} -- that +doesn't hang with the idea of making a dtd at some point + +@end defun + +@node texinfo docbook +@subsection (texinfo docbook) +@subsubsection Overview +@c +This module exports procedures for transforming a limited subset of the +SXML representation of docbook into stexi. It is not complete by any +means. The intention is to gather a number of routines and stylesheets +so that external modules can parse specific subsets of docbook, for +example that set generated by certain tools. + +@subsubsection Usage +@anchor{texinfo docbook *sdocbook->stexi-rules*}@defvar *sdocbook->stexi-rules* +@end defvar + +@anchor{texinfo docbook *sdocbook-block-commands*}@defvar *sdocbook-block-commands* +@end defvar + +@anchor{texinfo docbook sdocbook-flatten}@defun sdocbook-flatten sdocbook +"Flatten" a fragment of sdocbook so that block elements do not nest +inside each other. + +Docbook is a nested format, where e.g. a @code{refsect2} normally +appears inside a @code{refsect1}. Logical divisions in the document are +represented via the tree topology; a @code{refsect2} element +@emph{contains} all of the elements in its section. + +On the contrary, texinfo is a flat format, in which sections are marked +off by standalone section headers like @code{@@subsection}, and block +elements do not nest inside each other. + +This function takes a nested sdocbook fragment @var{sdocbook} and +flattens all of the sections, such that e.g. + +@example + (refsect1 (refsect2 (para "Hello"))) +@end example + +becomes + +@example + ((refsect1) (refsect2) (para "Hello")) +@end example + +Oftentimes (always?) sectioning elements have @code{<title>} as their +first element child; users interested in processing the @code{refsect*} +elements into proper sectioning elements like @code{chapter} might be +interested in @code{replace-titles} and @code{filter-empty-elements}. +@xref{texinfo docbook replace-titles,,replace-titles}, and @ref{texinfo +docbook filter-empty-elements,,filter-empty-elements}. + +Returns a nodeset, as described in @ref{sxml xpath}. That is to say, +this function returns an untagged list of stexi elements. + +@end defun + +@anchor{texinfo docbook filter-empty-elements}@defun filter-empty-elements sdocbook +Filters out empty elements in an sdocbook nodeset. Mostly useful after +running @code{sdocbook-flatten}. + +@end defun + +@anchor{texinfo docbook replace-titles}@defun replace-titles sdocbook-fragment +Iterate over the sdocbook nodeset @var{sdocbook-fragment}, transforming +contiguous @code{refsect} and @code{title} elements into the appropriate +texinfo sectioning command. Most useful after having run +@code{sdocbook-flatten}. + +For example: + +@example + (replace-titles '((refsect1) (title "Foo") (para "Bar."))) + @result{} '((chapter "Foo") (para "Bar.")) +@end example + +@end defun + +@node texinfo html +@subsection (texinfo html) +@subsubsection Overview +This module implements transformation from @code{stexi} to HTML. Note +that the output of @code{stexi->shtml} is actually SXML with the HTML +vocabulary. This means that the output can be further processed, and +that it must eventually be serialized by @ref{sxml simple +sxml->xml,sxml->xml}. References (i.e., the @code{@@ref} family of +commands) are resolved by a @dfn{ref-resolver}. @xref{texinfo html +add-ref-resolver!,add-ref-resolver!}, for more information. + +@subsubsection Usage +@anchor{texinfo html add-ref-resolver!}@defun add-ref-resolver! proc +Add @var{proc} to the head of the list of ref-resolvers. @var{proc} will +be expected to take the name of a node and the name of a manual and +return the URL of the referent, or @code{#f} to pass control to the next +ref-resolver in the list. + +The default ref-resolver will return the concatenation of the manual +name, @code{#}, and the node name. + +@end defun + +@anchor{texinfo html stexi->shtml}@defun stexi->shtml tree +Transform the stexi @var{tree} into shtml, resolving references via +ref-resolvers. See the module commentary for more details. + +@end defun + +@anchor{texinfo html urlify}@defun urlify str +@end defun + +@node texinfo indexing +@subsection (texinfo indexing) +@subsubsection Overview +@c texinfo formatting +Given a piece of stexi, return an index of a specified variety. + +Note that currently, @code{stexi-extract-index} doesn't differentiate +between different kinds of index entries. That's a bug ;) + +@subsubsection Usage +@anchor{texinfo indexing stexi-extract-index}@defun stexi-extract-index tree manual-name kind +Given an stexi tree @var{tree}, index all of the entries of type +@var{kind}. @var{kind} can be one of the predefined texinfo indices +(@code{concept}, @code{variable}, @code{function}, @code{key}, +@code{program}, @code{type}) or one of the special symbols @code{auto} +or @code{all}. @code{auto} will scan the stext for a @code{(printindex)} +statement, and @code{all} will generate an index from all entries, +regardless of type. + +The returned index is a list of pairs, the @sc{car} of which is the +entry (a string) and the @sc{cdr} of which is a node name (a string). + +@end defun + +@node texinfo string-utils +@subsection (texinfo string-utils) +@subsubsection Overview +Module @samp{(texinfo string-utils)} provides various string-related +functions useful to Guile's texinfo support. + +@subsubsection Usage +@anchor{texinfo string-utils escape-special-chars}@defun escape-special-chars str special-chars escape-char +Returns a copy of @var{str} with all given special characters preceded +by the given @var{escape-char}. + +@var{special-chars} can either be a single character, or a string +consisting of all the special characters. + +@lisp +;; make a string regexp-safe... + (escape-special-chars "***(Example String)***" + "[]()/*." + #\\) +=> "\\*\\*\\*\\(Example String\\)\\*\\*\\*" + +;; also can escape a singe char... + (escape-special-chars "richardt@@vzavenue.net" + #\@@ + #\@@) +=> "richardt@@@@vzavenue.net" +@end lisp + +@end defun + +@anchor{texinfo string-utils transform-string}@defun transform-string str match? replace [start] [end] +Uses @var{match?} against each character in @var{str}, and performs a +replacement on each character for which matches are found. + +@var{match?} may either be a function, a character, a string, or +@code{#t}. If @var{match?} is a function, then it takes a single +character as input, and should return @samp{#t} for matches. +@var{match?} is a character, it is compared to each string character +using @code{char=?}. If @var{match?} is a string, then any character in +that string will be considered a match. @code{#t} will cause every +character to be a match. + +If @var{replace} is a function, it is called with the matched character +as an argument, and the returned value is sent to the output string via +@samp{display}. If @var{replace} is anything else, it is sent through +the output string via @samp{display}. + +Note that te replacement for the matched characters does not need to be +a single character. That is what differentiates this function from +@samp{string-map}, and what makes it useful for applications such as +converting @samp{#\&} to @samp{"&"} in web page text. Some other +functions in this module are just wrappers around common uses of +@samp{transform-string}. Transformations not possible with this function +should probably be done with regular expressions. + +If @var{start} and @var{end} are given, they control which portion of +the string undergoes transformation. The entire input string is still +output, though. So, if @var{start} is @samp{5}, then the first five +characters of @var{str} will still appear in the returned string. + +@lisp +; these two are equivalent... + (transform-string str #\space #\-) ; change all spaces to -'s + (transform-string str (lambda (c) (char=? #\space c)) #\-) +@end lisp + +@end defun + +@anchor{texinfo string-utils expand-tabs}@defun expand-tabs str [tab-size] +Returns a copy of @var{str} with all tabs expanded to spaces. +@var{tab-size} defaults to 8. + +Assuming tab size of 8, this is equivalent to: + +@lisp + (transform-string str #\tab " ") +@end lisp + +@end defun + +@anchor{texinfo string-utils center-string}@defun center-string str [width] [chr] [rchr] +Returns a copy of @var{str} centered in a field of @var{width} +characters. Any needed padding is done by character @var{chr}, which +defaults to @samp{#\space}. If @var{rchr} is provided, then the padding +to the right will use it instead. See the examples below. left and +@var{rchr} on the right. The default @var{width} is 80. The default +@var{chr} and @var{rchr} is @samp{#\space}. The string is never +truncated. + +@lisp + (center-string "Richard Todd" 24) +=> " Richard Todd " + + (center-string " Richard Todd " 24 #\=) +=> "===== Richard Todd =====" + + (center-string " Richard Todd " 24 #\< #\>) +=> "<<<<< Richard Todd >>>>>" +@end lisp + +@end defun + +@anchor{texinfo string-utils left-justify-string}@defun left-justify-string str [width] [chr] +@code{left-justify-string str [width chr]}. Returns a copy of @var{str} +padded with @var{chr} such that it is left justified in a field of +@var{width} characters. The default @var{width} is 80. Unlike +@samp{string-pad} from srfi-13, the string is never truncated. + +@end defun + +@anchor{texinfo string-utils right-justify-string}@defun right-justify-string str [width] [chr] +Returns a copy of @var{str} padded with @var{chr} such that it is right +justified in a field of @var{width} characters. The default @var{width} +is 80. The default @var{chr} is @samp{#\space}. Unlike @samp{string-pad} +from srfi-13, the string is never truncated. + +@end defun + +@anchor{texinfo string-utils collapse-repeated-chars}@defun collapse-repeated-chars str [chr] [num] +Returns a copy of @var{str} with all repeated instances of @var{chr} +collapsed down to at most @var{num} instances. The default value for +@var{chr} is @samp{#\space}, and the default value for @var{num} is 1. + +@lisp + (collapse-repeated-chars "H e l l o") +=> "H e l l o" + (collapse-repeated-chars "H--e--l--l--o" #\-) +=> "H-e-l-l-o" + (collapse-repeated-chars "H-e--l---l----o" #\- 2) +=> "H-e--l--l--o" +@end lisp + +@end defun + +@anchor{texinfo string-utils make-text-wrapper}@defun make-text-wrapper [#:line-width] [#:expand-tabs?] [#:tab-width] [#:collapse-whitespace?] [#:subsequent-indent] [#:initial-indent] [#:break-long-words?] +Returns a procedure that will split a string into lines according to the +given parameters. + +@table @code +@item #:line-width +This is the target length used when deciding where to wrap lines. +Default is 80. + +@item #:expand-tabs? +Boolean describing whether tabs in the input should be expanded. Default +is #t. + +@item #:tab-width +If tabs are expanded, this will be the number of spaces to which they +expand. Default is 8. + +@item #:collapse-whitespace? +Boolean describing whether the whitespace inside the existing text +should be removed or not. Default is #t. + +If text is already well-formatted, and is just being wrapped to fit in a +different width, then set this to @samp{#f}. This way, many common text +conventions (such as two spaces between sentences) can be preserved if +in the original text. If the input text spacing cannot be trusted, then +leave this setting at the default, and all repeated whitespace will be +collapsed down to a single space. + +@item #:initial-indent +Defines a string that will be put in front of the first line of wrapped +text. Default is the empty string, ``''. + +@item #:subsequent-indent +Defines a string that will be put in front of all lines of wrapped text, +except the first one. Default is the empty string, ``''. + +@item #:break-long-words? +If a single word is too big to fit on a line, this setting tells the +wrapper what to do. Defaults to #t, which will break up long words. When +set to #f, the line will be allowed, even though it is longer than the +defined @code{#:line-width}. + +@end table + +The return value is a procedure of one argument, the input string, which +returns a list of strings, where each element of the list is one line. + +@end defun + +@anchor{texinfo string-utils fill-string}@defun fill-string str . kwargs +Wraps the text given in string @var{str} according to the parameters +provided in @var{kwargs}, or the default setting if they are not given. +Returns a single string with the wrapped text. Valid keyword arguments +are discussed in @code{make-text-wrapper}. + +@end defun + +@anchor{texinfo string-utils string->wrapped-lines}@defun string->wrapped-lines str . kwargs +@code{string->wrapped-lines str keywds ...}. Wraps the text given in +string @var{str} according to the parameters provided in @var{keywds}, +or the default setting if they are not given. Returns a list of strings +representing the formatted lines. Valid keyword arguments are discussed +in @code{make-text-wrapper}. + +@end defun + +@node texinfo plain-text +@subsection (texinfo plain-text) +@subsubsection Overview +Transformation from stexi to plain-text. Strives to re-create the output +from @code{info}; comes pretty damn close. + +@subsubsection Usage +@anchor{texinfo plain-text stexi->plain-text}@defun stexi->plain-text tree +Transform @var{tree} into plain text. Returns a string. + +@end defun + +@node texinfo serialize +@subsection (texinfo serialize) +@subsubsection Overview +Serialization of @code{stexi} to plain texinfo. + +@subsubsection Usage +@anchor{texinfo serialize stexi->texi}@defun stexi->texi tree +Serialize the stexi @var{tree} into plain texinfo. + +@end defun + +@node texinfo reflection +@subsection (texinfo reflection) +@subsubsection Overview +Routines to generare @code{stexi} documentation for objects and modules. + +Note that in this context, an @dfn{object} is just a value associated +with a location. It has nothing to do with GOOPS. + +@subsubsection Usage +@anchor{texinfo reflection module-stexi-documentation}@defun module-stexi-documentation sym-name [%docs-resolver] [#:docs-resolver] +Return documentation for the module named @var{sym-name}. The +documentation will be formatted as @code{stexi} +(@pxref{texinfo,texinfo}). + +@end defun + +@anchor{texinfo reflection script-stexi-documentation}@defun script-stexi-documentation scriptpath +Return documentation for given script. The documentation will be taken +from the script's commentary, and will be returned in the @code{stexi} +format (@pxref{texinfo,texinfo}). + +@end defun + +@anchor{texinfo reflection object-stexi-documentation}@defun object-stexi-documentation _ [_] [#:force] +@end defun + +@anchor{texinfo reflection package-stexi-standard-copying}@defun package-stexi-standard-copying name version updated years copyright-holder permissions +Create a standard texinfo @code{copying} section. + +@var{years} is a list of years (as integers) in which the modules being +documented were released. All other arguments are strings. + +@end defun + +@anchor{texinfo reflection package-stexi-standard-titlepage}@defun package-stexi-standard-titlepage name version updated authors +Create a standard GNU title page. + +@var{authors} is a list of @code{(@var{name} . @var{email})} pairs. All +other arguments are strings. + +Here is an example of the usage of this procedure: + +@smallexample + (package-stexi-standard-titlepage + "Foolib" + "3.2" + "26 September 2006" + '(("Alyssa P Hacker" . "alyssa@@example.com")) + '(2004 2005 2006) + "Free Software Foundation, Inc." + "Standard GPL permissions blurb goes here") +@end smallexample + +@end defun + +@anchor{texinfo reflection package-stexi-generic-menu}@defun package-stexi-generic-menu name entries +Create a menu from a generic alist of entries, the car of which should +be the node name, and the cdr the description. As an exception, an entry +of @code{#f} will produce a separator. + +@end defun + +@anchor{texinfo reflection package-stexi-standard-menu}@defun package-stexi-standard-menu name modules module-descriptions extra-entries +Create a standard top node and menu, suitable for processing by +makeinfo. + +@end defun + +@anchor{texinfo reflection package-stexi-extended-menu}@defun package-stexi-extended-menu name module-pairs script-pairs extra-entries +Create an "extended" menu, like the standard menu but with a section for +scripts. + +@end defun + +@anchor{texinfo reflection package-stexi-standard-prologue}@defun package-stexi-standard-prologue name filename category description copying titlepage menu +Create a standard prologue, suitable for later serialization to texinfo +and .info creation with makeinfo. + +Returns a list of stexinfo forms suitable for passing to +@code{package-stexi-documentation} as the prologue. @xref{texinfo +reflection package-stexi-documentation}, @ref{texinfo reflection +package-stexi-standard-titlepage,package-stexi-standard-titlepage}, +@ref{texinfo reflection +package-stexi-standard-copying,package-stexi-standard-copying}, and +@ref{texinfo reflection +package-stexi-standard-menu,package-stexi-standard-menu}. + +@end defun + +@anchor{texinfo reflection package-stexi-documentation}@defun package-stexi-documentation modules name filename prologue epilogue [#:module-stexi-documentation-args] [#:scripts] +Create stexi documentation for a @dfn{package}, where a package is a set +of modules that is released together. + +@var{modules} is expected to be a list of module names, where a module +name is a list of symbols. The stexi that is returned will be titled +@var{name} and a texinfo filename of @var{filename}. + +@var{prologue} and @var{epilogue} are lists of stexi forms that will be +spliced into the output document before and after the generated modules +documentation, respectively. @xref{texinfo reflection +package-stexi-standard-prologue}, to create a conventional GNU texinfo +prologue. + +@var{module-stexi-documentation-args} is an optional argument that, if +given, will be added to the argument list when +@code{module-texi-documentation} is called. For example, it might be +useful to define a @code{#:docs-resolver} argument. + +@end defun + +@anchor{texinfo reflection package-stexi-documentation-for-include}@defun package-stexi-documentation-for-include modules module-descriptions [#:module-stexi-documentation-args] +Create stexi documentation for a @dfn{package}, where a package is a set +of modules that is released together. + +@var{modules} is expected to be a list of module names, where a module +name is a list of symbols. Returns an stexinfo fragment. + +Unlike @code{package-stexi-documentation}, this function simply produces +a menu and the module documentations instead of producing a full texinfo +document. This can be useful if you write part of your manual by hand, +and just use @code{@@include} to pull in the automatically generated +parts. + +@var{module-stexi-documentation-args} is an optional argument that, if +given, will be added to the argument list when +@code{module-texi-documentation} is called. For example, it might be +useful to define a @code{#:docs-resolver} argument. + +@end defun diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi index 851e2b2eb..76e3ab9ff 100644 --- a/doc/ref/vm.texi +++ b/doc/ref/vm.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2008,2009,2010,2011 +@c Copyright (C) 2008,2009,2010,2011,2013 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -772,6 +772,7 @@ list. The list is then assigned to the @var{idx}th local variable. @end deffn @deffn Instruction bind-optionals/shuffle nreq nreq-and-opt ntotal +@deffnx Instruction bind-optionals/shuffle-or-br nreq nreq-and-opt ntotal offset Shuffle keyword arguments to the top of the stack, filling in the holes with @code{SCM_UNDEFINED}. Each argument is encoded over two bytes. @@ -783,6 +784,11 @@ the @var{nreq}th argument up to the @var{nreq-and-opt}th, and start shuffling when it sees the first keyword argument or runs out of positional arguments. +@code{bind-optionals/shuffle-or-br} does the same, except that it checks +if there are too many positional arguments before shuffling. If this is +the case, it jumps to @var{offset}, encoded using the normal three-byte +encoding. + Shuffling simply moves the keyword arguments past the total number of arguments, @var{ntotal}, which includes keyword and rest arguments. The free slots created by the shuffle are filled in with diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 36f15491a..d42c650ae 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -711,6 +711,7 @@ $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES): scmconfig.h snarf.h guile-snarf-docs.in error.x: cpp-E.c posix.x: cpp-SIG.c load.x: libpath.h +dynl.x: libpath.h alldotdocfiles = $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) snarf2checkedtexi = GUILE_AUTO_COMPILE=0 $(top_builddir)/meta/uninstalled-env guild snarf-check-and-output-texi diff --git a/libguile/eval.c b/libguile/eval.c index 4076d16b7..f743ed78e 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1,4 +1,5 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004, + * 2005,2006,2007,2008,2009,2010,2011,2012,2013 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -851,6 +852,14 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args, env = scm_cons (args, env); i++; } + else if (scm_is_true (alt) + && scm_is_pair (args) && !scm_is_keyword (CAR (args))) + { + /* Too many positional args, no rest arg, and we have an + alternate clause. */ + mx = alt; + goto loop; + } /* Now fill in env with unbound values, limn the rest of the args for keywords, and fill in unbound values with their inits. */ diff --git a/libguile/load.c b/libguile/load.c index 3b11a7c98..081c364e6 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008, - * 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -846,11 +846,13 @@ canonical_suffix (SCM fname) SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, (SCM args), "Search @var{%load-path} for the file named @var{filename} and\n" - "load it into the top-level environment. If @var{filename} is a\n" - "relative pathname and is not found in the list of search paths,\n" - "an error is signalled, unless the optional argument\n" - "@var{exception_on_not_found} is @code{#f}, in which case\n" - "@code{#f} is returned instead.") + "load it into the top-level environment.\n\n" + "If @var{filename} is a relative pathname and is not found in\n" + "the list of search paths, one of three things may happen,\n" + "depending on the optional second argument,\n" + "@var{exception_on_not_found}. If it is @code{#f}, @code{#f}\n" + "will be returned. If it is a procedure, it will be called\n" + "with no arguments. Otherwise an error is signalled.") #define FUNC_NAME s_scm_primitive_load_path { SCM filename, exception_on_not_found; @@ -924,11 +926,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, if (scm_is_false (full_filename) && scm_is_false (compiled_filename)) { - if (scm_is_true (exception_on_not_found)) + if (scm_is_true (scm_procedure_p (exception_on_not_found))) + return scm_call_0 (exception_on_not_found); + else if (scm_is_false (exception_on_not_found)) + return SCM_BOOL_F; + else SCM_MISC_ERROR ("Unable to find file ~S in load path", scm_list_1 (filename)); - else - return SCM_BOOL_F; } if (!scm_is_false (hook)) diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c index 0e3956363..dce90e326 100644 --- a/libguile/vm-i-scheme.c +++ b/libguile/vm-i-scheme.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -558,7 +558,7 @@ VM_DEFINE_INSTRUCTION (170, make_array, "make-array", 3, -1, 1) * Structs */ #define VM_VALIDATE_STRUCT(obj, proc) \ - VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj)) + VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_struct (proc, obj)) VM_DEFINE_FUNCTION (171, struct_p, "struct?", 1) { diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index a05326868..ac1d4a61a 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2001,2008,2009,2010,2011,2012 Free Software Foundation, Inc. +/* Copyright (C) 2001,2008,2009,2010,2011,2012,2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -647,6 +647,8 @@ VM_DEFINE_INSTRUCTION (49, bind_optionals_shuffle, "bind-optionals/shuffle", 6, NEXT; } +/* See also bind-optionals/shuffle-or-br below. */ + /* Flags that determine whether other keywords are allowed, and whether a rest argument is expected. These values must match those used by the glil->assembly compiler. */ @@ -1571,6 +1573,61 @@ VM_DEFINE_INSTRUCTION (95, assert_nargs_ee_locals, "assert-nargs-ee/locals", 1, NEXT; } +/* Like bind-optionals/shuffle, but if there are too many positional + arguments, jumps to the next case-lambda clause. */ +VM_DEFINE_INSTRUCTION (96, bind_optionals_shuffle_or_br, "bind-optionals/shuffle-or-br", 9, -1, -1) +{ + SCM *walk; + scm_t_ptrdiff nreq, nreq_and_opt, ntotal; + scm_t_int32 offset; + nreq = FETCH () << 8; + nreq += FETCH (); + nreq_and_opt = FETCH () << 8; + nreq_and_opt += FETCH (); + ntotal = FETCH () << 8; + ntotal += FETCH (); + FETCH_OFFSET (offset); + + /* look in optionals for first keyword or last positional */ + /* starting after the last required positional arg */ + walk = fp + nreq; + while (/* while we have args */ + walk <= sp + /* and we still have positionals to fill */ + && walk - fp < nreq_and_opt + /* and we haven't reached a keyword yet */ + && !scm_is_keyword (*walk)) + /* bind this optional arg (by leaving it in place) */ + walk++; + if (/* If we have filled all the positionals */ + walk - fp == nreq_and_opt + /* and there are still more arguments */ + && walk <= sp + /* and the next argument is not a keyword, */ + && !scm_is_keyword (*walk)) + { + /* Jump to the next case-lambda* clause. */ + ip += offset; + } + else + { + /* Otherwise, finish as in bind-optionals/shuffle: shuffle up, + from walk to ntotal */ + scm_t_ptrdiff nshuf = sp - walk + 1, i; + sp = (fp - 1) + ntotal + nshuf; + CHECK_OVERFLOW (); + for (i = 0; i < nshuf; i++) + sp[-i] = walk[nshuf-i-1]; + + /* and fill optionals & keyword args with SCM_UNDEFINED */ + while (walk <= (fp - 1) + ntotal) + *walk++ = SCM_UNDEFINED; + } + + NEXT; +} + + /* (defun renumber-ops () "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index a846c5f64..735ffcfcc 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1,7 +1,7 @@ ;;; -*- mode: scheme; coding: utf-8; -*- ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;;;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 +;;;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 ;;;; Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -1289,6 +1289,34 @@ VALUE." (set-struct-vtable-name! <parameter> '<parameter>) (define* (make-parameter init #:optional (conv (lambda (x) x))) + "Make a new parameter. + +A parameter is a dynamically bound value, accessed through a procedure. +To access the current value, apply the procedure with no arguments: + + (define p (make-parameter 10)) + (p) => 10 + +To provide a new value for the parameter in a dynamic extent, use +`parameterize': + + (parameterize ((p 20)) + (p)) => 20 + (p) => 10 + +The value outside of the dynamic extent of the body is unaffected. To +update the current value, apply it to one argument: + + (p 20) => 10 + (p) => 20 + +As you can see, the call that updates a parameter returns its previous +value. + +All values for the parameter are first run through the CONV procedure, +including INIT, the initial value. The default CONV procedure is the +identity procedure. CONV is commonly used to ensure some set of +invariants on the values that a parameter may have." (let ((fluid (make-fluid (conv init)))) (make-struct <parameter> 0 (case-lambda @@ -1327,6 +1355,22 @@ VALUE." ...) body body* ...))))))) +(define* (fluid->parameter fluid #:optional (conv (lambda (x) x))) + "Make a parameter that wraps a fluid. + +The value of the parameter will be the same as the value of the fluid. +If the parameter is rebound in some dynamic extent, perhaps via +`parameterize', the new value will be run through the optional CONV +procedure, as with any parameter. Note that unlike `make-parameter', +CONV is not applied to the initial value." + (make-struct <parameter> 0 + (case-lambda + (() (fluid-ref fluid)) + ((x) (let ((prev (fluid-ref fluid))) + (fluid-set! fluid (conv x)) + prev))) + fluid conv)) + ;;; Once parameters have booted, define the default prompt tag as being @@ -1340,15 +1384,7 @@ VALUE." ;;; Current ports as parameters. ;;; -(let ((fluid->parameter - (lambda (fluid conv) - (make-struct <parameter> 0 - (case-lambda - (() (fluid-ref fluid)) - ((x) (let ((prev (fluid-ref fluid))) - (fluid-set! fluid (conv x)) - prev))) - fluid conv)))) +(let () (define-syntax-rule (port-parameterize! binding fluid predicate msg) (begin (set! binding (fluid->parameter (module-ref (current-module) 'fluid) @@ -1376,6 +1412,18 @@ VALUE." x (error "expected an output port" x))))) + + + +;;; {Languages} +;;; + +;; The language can be a symbolic name or a <language> object from +;; (system base language). +;; +(define current-language (make-parameter 'scheme)) + + ;;; {High-Level Port Routines} @@ -2880,8 +2928,8 @@ written into the port is returned." version) (let* ((module (resolve-module name #t version #:ensure #f)) (public-i (and module (module-public-interface module)))) - (and (or (not module) (not public-i)) - (error "no code for module" name)) + (unless public-i + (error "no code for module" name)) (if (and (not select) (null? hide) (eq? renamer identity)) public-i (let ((selection (or select (module-map (lambda (sym var) sym) @@ -3052,10 +3100,13 @@ module '(ice-9 q) '(make-q q-length))}." (define autoloads-in-progress '()) -;; This function is called from "modules.c". If you change it, be -;; sure to update "modules.c" as well. - +;; This function is called from scm_load_scheme_module in +;; "deprecated.c". Please do not change its interface. +;; (define* (try-module-autoload module-name #:optional version) + "Try to load a module of the given name. If it is not found, return +#f. Otherwise return #t. May raise an exception if a file is found, +but it fails to load." (let* ((reverse-name (reverse module-name)) (name (symbol->string (car reverse-name))) (dir-hint-module-name (reverse (cdr reverse-name))) @@ -3072,6 +3123,13 @@ module '(ice-9 q) '(make-q q-length))}." (with-fluids ((current-reader #f)) (save-module-excursion (lambda () + (define (call/ec proc) + (let ((tag (make-prompt-tag))) + (call-with-prompt + tag + (lambda () + (proc (lambda () (abort-to-prompt tag)))) + (lambda (k) (values))))) ;; The initial environment when loading a module is a fresh ;; user module. (set-current-module (make-fresh-user-module)) @@ -3081,8 +3139,11 @@ module '(ice-9 q) '(make-q q-length))}." ;; out how to locate the compiled file, do auto-compilation, ;; etc. Punt for now, and don't use versions when locating ;; the file. - (primitive-load-path (in-vicinity dir-hint name) #f) - (set! didit #t))))) + (call/ec + (lambda (abort) + (primitive-load-path (in-vicinity dir-hint name) + abort) + (set! didit #t))))))) (lambda () (set-autoloaded! dir-hint name didit))) didit)))) diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm index d60a6e36a..13274126b 100644 --- a/module/ice-9/command-line.scm +++ b/module/ice-9/command-line.scm @@ -1,6 +1,6 @@ ;;; Parsing Guile's command-line -;;; Copyright (C) 1994-1998, 2000-2011, 2012 Free Software Foundation, Inc. +;;; Copyright (C) 1994-1998, 2000-2011, 2012, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -106,10 +106,10 @@ There is NO WARRANTY, to the extent permitted by law.")) (_ "General help using GNU software: <http://www.gnu.org/gethelp/>\n"))) (define *usage* - (_ "Evaluate Scheme code, interactively or from a script. + (_ "Evaluate code with Guile, interactively or from a script. - [-s] FILE load Scheme source code from FILE, and exit - -c EXPR evalute Scheme expression EXPR, and exit + [-s] FILE load source code from FILE, and exit + -c EXPR evalute expression EXPR, and exit -- stop scanning arguments; run interactively The above switches stop argument processing, and pass all @@ -118,21 +118,22 @@ If FILE begins with `-' the -s switch is mandatory. -L DIRECTORY add DIRECTORY to the front of the module load path -x EXTENSION add EXTENSION to the front of the load extensions - -l FILE load Scheme source code from FILE + -l FILE load source code from FILE -e FUNCTION after reading script, apply FUNCTION to command line arguments + --language=LANG change language; default: scheme -ds do -s script at this point --debug start with the \"debugging\" VM engine - --no-debug start with the normal VM engine, which also supports debugging - Default is to enable debugging for interactive + --no-debug start with the normal VM engine (backtraces but + no breakpoints); default is --debug for interactive use, but not for `-s' and `-c'. --auto-compile compile source files automatically --fresh-auto-compile invalidate auto-compilation cache - --no-auto-compile disable automatic source file compilation - Default is to enable auto-compilation of source + --no-auto-compile disable automatic source file compilation; + default is to enable auto-compilation of source files. - --listen[=P] Listen on a local port or a path for REPL clients. - If P is not given, the default is local port 37146. + --listen[=P] listen on a local port or a path for REPL clients; + if P is not given, the default is local port 37146 -q inhibit loading of user init file --use-srfi=LS load SRFI modules for the SRFIs in LS, which is a list of numbers like \"2,13,14\" @@ -163,20 +164,34 @@ If FILE begins with `-' the -s switch is mandatory. (if fatal? (exit 1)))) -(define (eval-string str) - (call-with-input-string - str - (lambda (port) - (let lp () - (let ((exp (read port))) - (if (not (eof-object? exp)) - (begin - (eval exp (current-module)) - (lp)))))))) +;; Try to avoid loading (ice-9 eval-string) and (system base compile) if +;; possible. +(define (eval-string/lang str) + (case (current-language) + ((scheme) + (call-with-input-string + str + (lambda (port) + (let lp () + (let ((exp (read port))) + (if (not (eof-object? exp)) + (begin + (eval exp (current-module)) + (lp)))))))) + (else + ((module-ref (resolve-module '(ice-9 eval-string)) 'eval-string) str)))) + +(define (load/lang f) + (case (current-language) + ((scheme) + (load f)) + (else + ((module-ref (resolve-module '(system base compile)) 'compile-file) + f #:to 'value)))) (define* (compile-shell-switches args #:optional (usage-name "guile")) (let ((arg0 "guile") - (do-script '()) + (script-cell #f) (entry-point #f) (user-load-path '()) (user-extensions '()) @@ -197,36 +212,39 @@ If FILE begins with `-' the -s switch is mandatory. (args (cdr args))) (cond ((not (string-prefix? "-" arg)) ; foo - ;; If we specified the -ds option, do-script is the cdr of + ;; If we specified the -ds option, script-cell is the cdr of ;; an expression like (load #f). We replace the car (i.e., ;; the #f) with the script name. (set! arg0 arg) (set! interactive? #f) - (if (pair? do-script) + (if script-cell (begin - (set-car! do-script arg0) + (set-car! script-cell arg0) (finish args out)) - (finish args (cons `(load ,arg0) out)))) + (finish args + (cons `((@@ (ice-9 command-line) load/lang) ,arg0) + out)))) ((string=? arg "-s") ; foo (if (null? args) (error "missing argument to `-s' switch")) (set! arg0 (car args)) (set! interactive? #f) - (if (pair? do-script) + (if script-cell (begin - (set-car! do-script arg0) + (set-car! script-cell arg0) (finish (cdr args) out)) - (finish (cdr args) (cons `(load ,arg0) out)))) + (finish (cdr args) + (cons `((@@ (ice-9 command-line) load/lang) ,arg0) + out)))) ((string=? arg "-c") ; evaluate expr (if (null? args) (error "missing argument to `-c' switch")) (set! interactive? #f) (finish (cdr args) - ;; Use our own eval-string to avoid loading (ice-9 - ;; eval-string), which loads the compiler. - (cons `((@@ (ice-9 command-line) eval-string) ,(car args)) + (cons `((@@ (ice-9 command-line) eval-string/lang) + ,(car args)) out))) ((string=? arg "--") ; end args go interactive @@ -236,7 +254,8 @@ If FILE begins with `-' the -s switch is mandatory. (if (null? args) (error "missing argument to `-l' switch")) (parse (cdr args) - (cons `(load ,(car args)) out))) + (cons `((@@ (ice-9 command-line) load/lang) ,arg0) + out))) ((string=? arg "-L") ; add to %load-path (if (null? args) @@ -273,14 +292,30 @@ If FILE begins with `-' the -s switch is mandatory. (parse (cdr args) out)) + ((string-prefix? "--language=" arg) ; language + (parse args + (cons `(current-language + ',(string->symbol + (substring arg (string-length "--language=")))) + out))) + + ((string=? "--language" arg) ; language + (when (null? args) + (error "missing argument to `--language' option")) + (parse (cdr args) + (cons `(current-language ',(string->symbol (car args))) + out))) + ((string=? arg "-ds") ; do script here ;; We put a dummy "load" expression, and let the -s put the ;; filename in. - (if (pair? do-script) - (error "the -ds switch may only be specified once") - (set! do-script (list #f))) + (when script-cell + (error "the -ds switch may only be specified once")) + (set! script-cell (list #f)) (parse args - (cons `(load . ,do-script) out))) + (acons '(@@ (ice-9 command-line) load/lang) + script-cell + out))) ((string=? arg "--debug") (set! turn-on-debugging? #t) @@ -364,8 +399,8 @@ If FILE begins with `-' the -s switch is mandatory. (define (finish args out) ;; Check to make sure the -ds got a -s. - (if (and (pair? do-script) (not (car do-script))) - (error "the `-ds' switch requires the use of `-s' as well")) + (when (and script-cell (not (car script-cell))) + (error "the `-ds' switch requires the use of `-s' as well")) ;; Make any remaining arguments available to the ;; script/command/whatever. diff --git a/module/ice-9/eval-string.scm b/module/ice-9/eval-string.scm index 27448d73f..649551d9f 100644 --- a/module/ice-9/eval-string.scm +++ b/module/ice-9/eval-string.scm @@ -1,6 +1,6 @@ ;;; Evaluating code from users -;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;; Copyright (C) 2011, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -30,7 +30,7 @@ (lookup-language x))) (define* (read-and-eval port #:key (lang (current-language))) - (with-fluids ((*current-language* (ensure-language lang))) + (parameterize ((current-language (ensure-language lang))) (define (read) ((language-reader (current-language)) port (current-module))) (define (eval exp) diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index d9a4d594d..90bc25457 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -1,6 +1,6 @@ ;;; -*- mode: scheme; coding: utf-8; -*- -;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -298,72 +298,83 @@ (1- nopt) args (cdr inits)) (lp (cons (car args) env) (1- nopt) (cdr args) (cdr inits))))) - ;; With keywords, we stop binding optionals at the first - ;; keyword. (let lp ((env env) (nopt* nopt) (args args) (inits inits)) - (if (> nopt* 0) - (if (or (null? args) (keyword? (car args))) - (lp (cons (eval (car inits) env) env) - (1- nopt*) args (cdr inits)) - (lp (cons (car args) env) - (1- nopt*) (cdr args) (cdr inits))) - ;; Finished with optionals. - (let* ((aok (car kw)) - (kw (cdr kw)) - (kw-base (+ nopt nreq (if rest? 1 0))) - (imax (let lp ((imax (1- kw-base)) (kw kw)) - (if (null? kw) - imax - (lp (max (cdar kw) imax) - (cdr kw))))) - ;; Fill in kwargs with "undefined" vals. - (env (let lp ((i kw-base) - ;; Also, here we bind the rest - ;; arg, if any. - (env (if rest? (cons args env) env))) - (if (<= i imax) - (lp (1+ i) (cons unbound-arg env)) - env)))) - ;; Now scan args for keywords. - (let lp ((args args)) - (if (and (pair? args) (pair? (cdr args)) - (keyword? (car args))) - (let ((kw-pair (assq (car args) kw)) - (v (cadr args))) - (if kw-pair - ;; Found a known keyword; set its value. - (list-set! env (- imax (cdr kw-pair)) v) - ;; Unknown keyword. - (if (not aok) - (scm-error 'keyword-argument-error - "eval" "Unrecognized keyword" - '() #f))) - (lp (cddr args))) - (if (pair? args) - (if rest? - ;; Be lenient parsing rest args. - (lp (cdr args)) - (scm-error 'keyword-argument-error - "eval" "Invalid keyword" - '() #f)) - ;; Finished parsing keywords. Fill in - ;; uninitialized kwargs by evalling init - ;; expressions in their appropriate - ;; environment. - (let lp ((i (- imax kw-base)) - (inits inits)) - (if (pair? inits) - (let ((tail (list-tail env i))) - (if (eq? (car tail) unbound-arg) - (set-car! tail - (eval (car inits) - (cdr tail)))) - (lp (1- i) (cdr inits))) - ;; Finally, eval the body. - (eval body env))))))))))))))) + (cond + ;; With keywords, we stop binding optionals at the + ;; first keyword. + ((> nopt* 0) + (if (or (null? args) (keyword? (car args))) + (lp (cons (eval (car inits) env) env) + (1- nopt*) args (cdr inits)) + (lp (cons (car args) env) + (1- nopt*) (cdr args) (cdr inits)))) + ;; Finished with optionals. + ((and alt (pair? args) (not (keyword? (car args))) + (not rest?)) + ;; Too many positional args, no #:rest arg, + ;; and we have an alternate. + (apply alt-proc %args)) + (else + (let* ((aok (car kw)) + (kw (cdr kw)) + (kw-base (+ nopt nreq (if rest? 1 0))) + (imax (let lp ((imax (1- kw-base)) (kw kw)) + (if (null? kw) + imax + (lp (max (cdar kw) imax) + (cdr kw))))) + ;; Fill in kwargs with "undefined" vals. + (env (let lp ((i kw-base) + ;; Also, here we bind the rest + ;; arg, if any. + (env (if rest? + (cons args env) + env))) + (if (<= i imax) + (lp (1+ i) (cons unbound-arg env)) + env)))) + ;; Now scan args for keywords. + (let lp ((args args)) + (if (and (pair? args) (pair? (cdr args)) + (keyword? (car args))) + (let ((kw-pair (assq (car args) kw)) + (v (cadr args))) + (if kw-pair + ;; Found a known keyword; set its value. + (list-set! env + (- imax (cdr kw-pair)) v) + ;; Unknown keyword. + (if (not aok) + (scm-error + 'keyword-argument-error + "eval" "Unrecognized keyword" + '() #f))) + (lp (cddr args))) + (if (pair? args) + (if rest? + ;; Be lenient parsing rest args. + (lp (cdr args)) + (scm-error 'keyword-argument-error + "eval" "Invalid keyword" + '() #f)) + ;; Finished parsing keywords. Fill in + ;; uninitialized kwargs by evalling init + ;; expressions in their appropriate + ;; environment. + (let lp ((i (- imax kw-base)) + (inits inits)) + (if (pair? inits) + (let ((tail (list-tail env i))) + (if (eq? (car tail) unbound-arg) + (set-car! tail + (eval (car inits) + (cdr tail)))) + (lp (1- i) (cdr inits))) + ;; Finally, eval the body. + (eval body env)))))))))))))))) ;; The "engine". EXP is a memoized expression. (define (eval exp env) diff --git a/module/ice-9/iconv.scm b/module/ice-9/iconv.scm index 88af90d5a..125dad8b8 100644 --- a/module/ice-9/iconv.scm +++ b/module/ice-9/iconv.scm @@ -21,7 +21,7 @@ (define-module (ice-9 iconv) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) - #:use-module ((ice-9 rdelim) #:select (read-delimited)) + #:use-module ((ice-9 rdelim) #:select (read-string)) #:export (string->bytevector bytevector->string call-with-encoded-output-string)) @@ -88,7 +88,7 @@ naming a character encoding, like \"utf-8\"." (set-port-encoding! p encoding) (if conversion-strategy (set-port-conversion-strategy! p conversion-strategy)) - (let ((res (read-delimited "" p))) + (let ((res (read-string p))) (close-port p) (if (eof-object? res) "" diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index af5e18081..1698a024b 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -1,7 +1,7 @@ ;;;; -*-scheme-*- ;;;; ;;;; Copyright (C) 2001, 2003, 2006, 2009, 2010, 2011, -;;;; 2012 Free Software Foundation, Inc. +;;;; 2012, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -3016,9 +3016,15 @@ (define-syntax include (lambda (x) + (define (absolute-path? path) + (string-prefix? "/" path)) + (define read-file - (lambda (fn k) - (let ((p (open-input-file fn))) + (lambda (fn dir k) + (let ((p (open-input-file + (if (absolute-path? fn) + fn + (in-vicinity dir fn))))) (let f ((x (read p)) (result '())) (if (eof-object? x) @@ -3027,11 +3033,14 @@ (reverse result)) (f (read p) (cons (datum->syntax k x) result))))))) - (syntax-case x () - ((k filename) - (let ((fn (syntax->datum #'filename))) - (with-syntax (((exp ...) (read-file fn #'filename))) - #'(begin exp ...))))))) + (let* ((src (syntax-source x)) + (file (and src (assq-ref src 'filename))) + (dir (and (string? file) (dirname file)))) + (syntax-case x () + ((k filename) + (let ((fn (syntax->datum #'filename))) + (with-syntax (((exp ...) (read-file fn dir #'filename))) + #'(begin exp ...)))))))) (define-syntax include-from-path (lambda (x) diff --git a/module/ice-9/rdelim.scm b/module/ice-9/rdelim.scm index c6ab2ba9c..32908cc4a 100644 --- a/module/ice-9/rdelim.scm +++ b/module/ice-9/rdelim.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006, 2010, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -26,6 +26,8 @@ read-line! read-delimited read-delimited! + read-string + read-string! %read-delimited! %read-line write-line)) @@ -114,6 +116,59 @@ (else (error "unexpected handle-delim value: " handle-delim))))))))) +(define-syntax-rule (check-arg exp message arg ...) + (unless exp + (error message arg ...))) + +(define (index? n) + (and (integer? n) (exact? n) (>= n 0))) + +(define* (read-string! buf #:optional + (port (current-input-port)) + (start 0) (end (string-length buf))) + "Read all of the characters out of PORT and write them to BUF. +Returns the number of characters read. + +This function only reads out characters from PORT if it will be able to +write them to BUF. That is to say, if BUF is smaller than the number of +available characters, then BUF will be filled, and characters will be +left in the port." + (check-arg (string? buf) "not a string" buf) + (check-arg (index? start) "bad index" start) + (check-arg (index? end) "bad index" end) + (check-arg (<= start end) "start beyond end" start end) + (check-arg (<= end (string-length buf)) "end beyond string length" end) + (let lp ((n start)) + (if (< n end) + (let ((c (read-char port))) + (if (eof-object? c) + (- n start) + (begin + (string-set! buf n c) + (lp (1+ n))))) + (- n start)))) + +(define* (read-string #:optional (port (current-input-port)) (count #f)) + "Read all of the characters out of PORT and return them as a string. +If the COUNT argument is present, treat it as a limit to the number of +characters to read. By default, there is no limit." + (check-arg (or (not count) (index? count)) "bad count" count) + (let loop ((substrings '()) + (total-chars 0) + (buf-size 100)) ; doubled each time through. + (let* ((buf (make-string (if count + (min buf-size (- count total-chars)) + buf-size))) + (nchars (read-string! buf port)) + (new-total (+ total-chars nchars))) + (cond + ((= nchars buf-size) + ;; buffer filled. + (loop (cons buf substrings) new-total (* buf-size 2))) + (else + (string-concatenate-reverse + (cons (substring buf 0 nchars) substrings))))))) + ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string ;;; from PORT. The return value depends on the value of HANDLE-DELIM, ;;; which may be one of the symbols `trim', `concat', `peek' and diff --git a/module/ice-9/top-repl.scm b/module/ice-9/top-repl.scm index d43436c4a..302729792 100644 --- a/module/ice-9/top-repl.scm +++ b/module/ice-9/top-repl.scm @@ -1,7 +1,7 @@ ;;; -*- mode: scheme; coding: utf-8; -*- ;;;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;;;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -73,6 +73,6 @@ "warning: failed to install locale: ~a~%" (strerror (car errno)))))) - (let ((status (start-repl 'scheme))) + (let ((status (start-repl (current-language)))) (run-hook exit-hook) status))))) diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index bd31930fb..d54186e16 100644 --- a/module/language/assembly/compile-bytecode.scm +++ b/module/language/assembly/compile-bytecode.scm @@ -1,6 +1,6 @@ ;;; Guile VM assembler -;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -138,6 +138,17 @@ ((br-if-nargs-ne ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l)) ((br-if-nargs-lt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l)) ((br-if-nargs-gt ,hi ,lo ,l) (write-byte hi) (write-byte lo) (write-break l)) + ((bind-optionals/shuffle-or-br ,nreq-hi ,nreq-lo + ,nreq-and-nopt-hi ,nreq-and-nopt-lo + ,ntotal-hi ,ntotal-lo + ,l) + (write-byte nreq-hi) + (write-byte nreq-lo) + (write-byte nreq-and-nopt-hi) + (write-byte nreq-and-nopt-lo) + (write-byte ntotal-hi) + (write-byte ntotal-lo) + (write-break l)) ((mv-call ,n ,l) (write-byte n) (write-break l)) ((prompt ,escape-only? ,l) (write-byte escape-only?) (write-break l)) (else diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm index 605e3dfdf..c3469bde8 100644 --- a/module/language/assembly/decompile-bytecode.scm +++ b/module/language/assembly/decompile-bytecode.scm @@ -1,6 +1,6 @@ ;;; Guile VM code converters -;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -43,7 +43,7 @@ (define (br-instruction? x) (memq x '(br br-if br-if-not br-if-eq br-if-not-eq br-if-null br-if-not-null))) (define (br-nargs-instruction? x) - (memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt))) + (memq x '(br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt br-if-nargs-lt/non-kw))) (define (bytes->s24 a b c) (let ((x (+ (ash a 16) (ash b 8) c))) @@ -88,6 +88,16 @@ (lp (cons `(,br ,(ensure-label rel1 rel2 rel3)) out))) ((,br ,hi ,lo ,rel1 ,rel2 ,rel3) (guard (br-nargs-instruction? br)) (lp (cons `(,br ,hi ,lo ,(ensure-label rel1 rel2 rel3)) out))) + ((bind-optionals/shuffle-or-br ,nreq-hi ,nreq-lo + ,nreq-and-nopt-hi ,nreq-and-nopt-lo + ,ntotal-hi ,ntotal-lo + ,rel1 ,rel2 ,rel3) + (lp (cons `(bind-optionals/shuffle-or-br + ,nreq-hi ,nreq-lo + ,nreq-and-nopt-hi ,nreq-and-nopt-lo + ,ntotal-hi ,ntotal-lo + ,(ensure-label rel1 rel2 rel3)) + out))) ((mv-call ,n ,rel1 ,rel2 ,rel3) (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out))) ((prompt ,n0 ,rel1 ,rel2 ,rel3) diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm index 6ad5f7df9..dcdd78073 100644 --- a/module/language/assembly/disassemble.scm +++ b/module/language/assembly/disassemble.scm @@ -1,6 +1,6 @@ ;;; Guile VM code converters -;; Copyright (C) 2001, 2009, 2010, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2012, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -131,6 +131,8 @@ (list "-> ~A" (assq-ref labels (car args)))) ((br-if-nargs-ne br-if-nargs-lt br-if-nargs-gt) (list "-> ~A" (assq-ref labels (caddr args)))) + ((bind-optionals/shuffle-or-br) + (list "-> ~A" (assq-ref labels (car (last-pair args))))) ((object-ref) (and objs (list "~s" (vector-ref objs (car args))))) ((local-ref local-boxed-ref local-set local-boxed-set) diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm index 83a5007d8..767fda347 100644 --- a/module/language/glil/compile-assembly.scm +++ b/module/language/glil/compile-assembly.scm @@ -1,6 +1,6 @@ ;;; Guile VM assembler -;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -486,13 +486,18 @@ ,(modulo nreq 256))))) (ntotal (apply max (+ nreq nopt) (map 1+ (map cdr kw)))) (bind-optionals-and-shuffle - `((bind-optionals/shuffle + `((,(if (and else-label (not rest)) + 'bind-optionals/shuffle-or-br + 'bind-optionals/shuffle) ,(quotient nreq 256) ,(modulo nreq 256) ,(quotient (+ nreq nopt) 256) ,(modulo (+ nreq nopt) 256) ,(quotient ntotal 256) - ,(modulo ntotal 256)))) + ,(modulo ntotal 256) + ,@(if (and else-label (not rest)) + `(,else-label) + '())))) (bind-kw ;; when this code gets called, all optionals are filled ;; in, space has been made for kwargs, and the kwargs diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 041d99d7c..5ae691ddd 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -1,6 +1,6 @@ ;;; Tree-IL partial evaluator -;; Copyright (C) 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -426,7 +426,7 @@ top-level bindings from ENV and return the resulting expression." (define (fresh-gensyms vars) (map (lambda (var) (let ((new (gensym (string-append (symbol->string (var-name var)) - "-")))) + " ")))) (set! store (vhash-consq new var store)) new)) vars)) diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm index 70d8a131c..05362e077 100644 --- a/module/oop/goops/save.scm +++ b/module/oop/goops/save.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2000,2001,2002, 2006, 2009, 2010, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -122,8 +122,10 @@ (define (readable-expression obj) `(readable ,(hashq-ref readables obj))) +;; FIXME: if obj is nil or false, this can return a false value. OTOH +;; usually this is only for non-immediates. (define (readable? obj) - (hashq-get-handle readables obj)) + (hashq-ref readables obj)) ;;; ;;; Strings diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index 8e04f5dea..069574a49 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -1,6 +1,6 @@ ;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*- -;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -459,7 +459,7 @@ return the characters accumulated in that port." (with-textual-input-conditions port (read-line port 'trim))) (define (get-string-all port) - (with-textual-input-conditions port (read-delimited "" port 'concat))) + (with-textual-input-conditions port (read-string port))) (define (get-string-n port count) "Read up to @var{count} characters from @var{port}. diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index afcb55a72..f3e464182 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -1,6 +1,6 @@ ;;; High-level compiler interface -;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -152,7 +152,7 @@ file) comp))) -(define* (compile-and-load file #:key (from 'scheme) (to 'value) +(define* (compile-and-load file #:key (from (current-language)) (to 'value) (env (current-module)) (opts '()) (canonicalization 'relative)) (with-fluids ((%file-port-name-canonicalization canonicalization)) @@ -181,12 +181,26 @@ (let lp ((in (reverse (or (lookup-compilation-order from to) (error "no way to compile" from "to" to)))) (lang to)) - (cond ((null? in) - (error "don't know how to join expressions" from to)) + (cond ((null? in) to) ((language-joiner lang) lang) (else (lp (cdr in) (caar in)))))) +(define (default-language-joiner lang) + (lambda (exps env) + (if (and (pair? exps) (null? (cdr exps))) + (car exps) + (error + "Multiple expressions read and compiled, but language has no joiner" + lang)))) + +(define (read-and-parse lang port cenv) + (let ((exp ((language-reader lang) port cenv))) + (cond + ((eof-object? exp) exp) + ((language-parser lang) => (lambda (parse) (parse exp))) + (else exp)))) + (define* (read-and-compile port #:key (from (current-language)) (to 'objcode) @@ -195,12 +209,16 @@ (let ((from (ensure-language from)) (to (ensure-language to))) (let ((joint (find-language-joint from to))) - (with-fluids ((*current-language* from)) + (parameterize ((current-language from)) (let lp ((exps '()) (env #f) (cenv env)) - (let ((x ((language-reader (current-language)) port cenv))) + (let ((x (read-and-parse (current-language) port cenv))) (cond ((eof-object? x) - (compile ((language-joiner joint) (reverse exps) env) + (close-port port) + (compile ((or (language-joiner joint) + (default-language-joiner joint)) + (reverse exps) + env) #:from joint #:to to ;; env can be false if no expressions were read. #:env (or env (default-environment joint)) diff --git a/module/system/base/language.scm b/module/system/base/language.scm index 5b27bc98d..81b43b70d 100644 --- a/module/system/base/language.scm +++ b/module/system/base/language.scm @@ -1,6 +1,6 @@ ;;; Multi-language support -;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -30,7 +30,9 @@ lookup-compilation-order lookup-decompilation-order invalidate-compilation-cache! default-environment - *current-language* current-language)) + *current-language*) + + #:re-export (current-language)) ;;; @@ -111,7 +113,5 @@ ;;; Current language ;;; -(define *current-language* (make-fluid 'scheme)) - -(define (current-language) - (fluid-ref *current-language*)) +;; Deprecated; use current-language instead. +(define *current-language* (parameter-fluid current-language)) diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index 58d324176..aa16f5d8d 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -1,6 +1,6 @@ ;;; Repl commands -;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -446,7 +446,7 @@ Change languages." (cur (repl-language repl))) (format #t "Happy hacking with ~a! To switch back, type `,L ~a'.\n" (language-title lang) (language-name cur)) - (fluid-set! *current-language* lang) + (current-language lang) (set! (repl-language repl) lang))) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index f7b022999..7d2b7c836 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -1,6 +1,6 @@ ;;; Read-Eval-Print Loop -;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -132,9 +132,9 @@ ;;; (define* (start-repl #:optional (lang (current-language)) #:key debug) - ;; ,language at the REPL will fluid-set! the *current-language*. Make - ;; sure that it does so in a new scope. - (with-fluids ((*current-language* lang)) + ;; ,language at the REPL will update the current-language. Make + ;; sure that it does so in a new dynamic scope. + (parameterize ((current-language lang)) (run-repl (make-repl lang debug)))) ;; (put 'abort-on-error 'scheme-indent-function 1) diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm index 2dad37686..e27dc3784 100644 --- a/module/system/vm/trace.scm +++ b/module/system/vm/trace.scm @@ -1,6 +1,6 @@ ;;; Guile VM tracer -;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2013 Free Software Foundation, Inc. ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -36,61 +36,66 @@ ;; FIXME: this constant needs to go in system vm objcode (define *objcode-header-len* 8) -(define (print-application frame depth width prefix) - (format (current-error-port) "~a~a~v:@y\n" - prefix - (let lp ((depth depth) (s "")) - (if (zero? depth) - s - (lp (1- depth) (string-append "| " s)))) - (max (- width (* 3 depth)) 1) - (frame-call-representation frame))) - -(define (print-return frame depth width prefix) - (let* ((len (frame-num-locals frame)) - (nvalues (frame-local-ref frame (1- len)))) +(define (build-prefix prefix depth infix numeric-format max-indent) + (let lp ((indent "") (n 0)) (cond - ((= nvalues 1) - (format (current-error-port) "~a~a~v:@y\n" - prefix - (let lp ((depth depth) (s "")) - (if (zero? depth) - s - (lp (1- depth) (string-append "| " s)))) - width (frame-local-ref frame (- len 2)))) + ((= n depth) + (string-append prefix indent)) + ((< (+ (string-length indent) (string-length infix)) max-indent) + (lp (string-append indent infix) (1+ n))) (else - ;; this should work, but there appears to be a bug - ;; "~a~d values:~:{ ~v:@y~}\n" - (format (current-error-port) "~a~a~d values:~{ ~a~}\n" - prefix - (let lp ((depth depth) (s "")) - (if (zero? depth) - s - (lp (1- depth) (string-append "| " s)))) - nvalues - (map (lambda (val) - (format #f "~v:@y" width val)) - (frame-return-values frame))))))) + (string-append prefix indent (format #f numeric-format depth)))))) + +(define (print-application frame depth width prefix max-indent) + (let ((prefix (build-prefix prefix depth "| " "~d> " max-indent))) + (format (current-error-port) "~a~v:@y\n" + prefix + width + (frame-call-representation frame)))) + +(define* (print-return frame depth width prefix max-indent) + (let* ((len (frame-num-locals frame)) + (nvalues (frame-local-ref frame (1- len))) + (prefix (build-prefix prefix depth "| " "~d< "max-indent))) + (case nvalues + ((0) + (format (current-error-port) "~ano values\n" prefix)) + ((1) + (format (current-error-port) "~a~v:@y\n" + prefix + width + (frame-local-ref frame (- len 2)))) + (else + ;; this should work, but there appears to be a bug + ;; "~a~d values:~:{ ~v:@y~}\n" + (format (current-error-port) "~a~d values:~{ ~a~}\n" + prefix nvalues + (map (lambda (val) + (format #f "~v:@y" width val)) + (frame-return-values frame))))))) (define* (trace-calls-to-procedure proc #:key (width 80) (vm (the-vm)) - (prefix "trace: ")) + (prefix "trace: ") + (max-indent (- width 40))) (define (apply-handler frame depth) - (print-application frame depth width prefix)) + (print-application frame depth width prefix max-indent)) (define (return-handler frame depth) - (print-return frame depth width prefix)) + (print-return frame depth width prefix max-indent)) (trap-calls-to-procedure proc apply-handler return-handler #:vm vm)) (define* (trace-calls-in-procedure proc #:key (width 80) (vm (the-vm)) - (prefix "trace: ")) + (prefix "trace: ") + (max-indent (- width 40))) (define (apply-handler frame depth) - (print-application frame depth width prefix)) + (print-application frame depth width prefix max-indent)) (define (return-handler frame depth) - (print-return frame depth width prefix)) + (print-return frame depth width prefix max-indent)) (trap-calls-in-dynamic-extent proc apply-handler return-handler #:vm vm)) -(define* (trace-instructions-in-procedure proc #:key (width 80) (vm (the-vm))) +(define* (trace-instructions-in-procedure proc #:key (width 80) (vm (the-vm)) + (max-indent (- width 40))) (define (trace-next frame) (let* ((ip (frame-instruction-pointer frame)) (objcode (program-objcode (frame-procedure frame))) @@ -104,17 +109,20 @@ ;; Note that because this procedure manipulates the VM trace level ;; directly, it doesn't compose well with traps at the REPL. ;; -(define* (call-with-trace thunk #:key (calls? #t) (instructions? #f) (width 80) (vm (the-vm))) +(define* (call-with-trace thunk #:key (calls? #t) (instructions? #f) + (width 80) (vm (the-vm)) (max-indent (- width 40))) (let ((call-trap #f) (inst-trap #f)) (dynamic-wind (lambda () (if calls? (set! call-trap - (trace-calls-in-procedure thunk #:vm vm #:width width))) + (trace-calls-in-procedure thunk #:vm vm #:width width + #:max-indent max-indent))) (if instructions? (set! inst-trap - (trace-instructions-in-procedure thunk #:vm vm #:width width))) + (trace-instructions-in-procedure thunk #:vm vm #:width width + #:max-indent max-indent))) (set-vm-trace-level! vm (1+ (vm-trace-level vm)))) thunk (lambda () diff --git a/module/web/client.scm b/module/web/client.scm index ce93cd841..9fbb25bba 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -285,10 +285,9 @@ true)." (extra-headers #f) (headers (or extra-headers '())) (decode-body? #t)) "Deprecated in favor of (http-get #:streaming? #t)." - (when extra-headers - (issue-deprecation-warning - "`http-get*' has been deprecated. " - "Instead, use `http-get' with the #:streaming? #t keyword argument.")) + (issue-deprecation-warning + "`http-get*' has been deprecated. " + "Instead, use `http-get' with the #:streaming? #t keyword argument.") (http-get uri #:body body #:port port #:version version #:keep-alive? keep-alive? #:headers headers #:decode-body? #t #:streaming? #t)) diff --git a/module/web/uri.scm b/module/web/uri.scm index b688ea8cb..25406b368 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -1,6 +1,6 @@ ;;;; (web uri) --- URI manipulation tools ;;;; -;;;; Copyright (C) 1997,2001,2002,2010,2011,2012 Free Software Foundation, Inc. +;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -286,7 +286,7 @@ serialization." (utf8->string bv) (let ((p (open-bytevector-input-port bv))) (set-port-encoding! p encoding) - (let ((res (read-delimited "" p))) + (let ((res (read-string p))) (close-port p) res)))) diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test index a1e62bd37..396fdeca8 100644 --- a/test-suite/tests/optargs.test +++ b/test-suite/tests/optargs.test @@ -1,7 +1,7 @@ ;;;; optargs.test --- test suite for optional arg processing -*- scheme -*- ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; -;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2009, 2010, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -22,6 +22,9 @@ #:use-module (system base compile) #:use-module (ice-9 optargs)) +(define exception:invalid-keyword + '(keyword-argument-error . "Invalid keyword")) + (define exception:unrecognized-keyword '(keyword-argument-error . "Unrecognized keyword")) @@ -217,3 +220,70 @@ (pass-if "default arg" (equal? (transmogrify quote) 10))) + +(with-test-prefix/c&e "case-lambda*" + (pass-if "unambiguous" + ((case-lambda* + ((a b) #t) + ((a) #f)) + 1 2)) + + (pass-if "unambiguous (reversed)" + ((case-lambda* + ((a) #f) + ((a b) #t)) + 1 2)) + + (pass-if "optionals (order disambiguates)" + ((case-lambda* + ((a #:optional b) #t) + ((a b) #f)) + 1 2)) + + (pass-if "optionals (order disambiguates (2))" + ((case-lambda* + ((a b) #t) + ((a #:optional b) #f)) + 1 2)) + + (pass-if "optionals (one arg)" + ((case-lambda* + ((a b) #f) + ((a #:optional b) #t)) + 1)) + + (pass-if "optionals (one arg (2))" + ((case-lambda* + ((a #:optional b) #t) + ((a b) #f)) + 1)) + + (pass-if "keywords without keyword" + ((case-lambda* + ((a #:key c) #t) + ((a b) #f)) + 1)) + + (pass-if "keywords with keyword" + ((case-lambda* + ((a #:key c) #t) + ((a b) #f)) + 1 #:c 2)) + + (pass-if "keywords (too many positionals)" + ((case-lambda* + ((a #:key c) #f) + ((a b) #t)) + 1 2)) + + (pass-if "keywords (order disambiguates)" + ((case-lambda* + ((a #:key c) #t) + ((a b c) #f)) + 1 #:c 2)) + + (pass-if "keywords (order disambiguates (2))" + ((case-lambda* + ((a b c) #t) + ((a #:key c) #f)) + 1 #:c 2))) diff --git a/test-suite/tests/rdelim.test b/test-suite/tests/rdelim.test index e61fc9246..5cfe6460d 100644 --- a/test-suite/tests/rdelim.test +++ b/test-suite/tests/rdelim.test @@ -1,7 +1,7 @@ ;;;; rdelim.test --- Delimited I/O. -*- mode: scheme; coding: utf-8; -*- ;;;; Ludovic Courtès <ludo@gnu.org> ;;;; -;;;; Copyright (C) 2011 Free Software Foundation, Inc. +;;;; Copyright (C) 2011, 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -189,7 +189,60 @@ (pass-if "eof, split" (eof-object? (read-delimited! ":" (make-string 7) - (open-input-string "")))))) + (open-input-string ""))))) + + (with-test-prefix "read-string" + + (pass-if "short string" + (let* ((s "hello, world!") + (p (open-input-string s))) + (and (string=? (read-string p) s) + (string=? (read-string p) "")))) + + (pass-if "100 chars" + (let* ((s (make-string 100 #\space)) + (p (open-input-string s))) + (and (string=? (read-string p) s) + (string=? (read-string p) "")))) + + (pass-if "longer than 100 chars" + (let* ((s (string-concatenate (make-list 20 "hello, world!"))) + (p (open-input-string s))) + (and (string=? (read-string p) s) + (string=? (read-string p) ""))))) + + (with-test-prefix "read-string!" + + (pass-if "buf smaller" + (let* ((s "hello, world!") + (len (1- (string-length s))) + (buf (make-string len #\.)) + (p (open-input-string s))) + (and (= (read-string! buf p) len) + (string=? buf (substring s 0 len)) + (= (read-string! buf p) 1) + (string=? (substring buf 0 1) (substring s len))))) + + (pass-if "buf right size" + (let* ((s "hello, world!") + (len (string-length s)) + (buf (make-string len #\.)) + (p (open-input-string s))) + (and (= (read-string! buf p) len) + (string=? buf (substring s 0 len)) + (= (read-string! buf p) 0) + (string=? buf (substring s 0 len))))) + + (pass-if "buf bigger" + (let* ((s "hello, world!") + (len (string-length s)) + (buf (make-string (1+ len) #\.)) + (p (open-input-string s))) + (and (= (read-string! buf p) len) + (string=? (substring buf 0 len) s) + (= (read-string! buf p) 0) + (string=? (substring buf 0 len) s) + (string=? (substring buf len) ".")))))) ;;; Local Variables: ;;; eval: (put 'with-test-prefix 'scheme-indent-function 1) |