diff options
35 files changed, 1216 insertions, 630 deletions
diff --git a/.gitignore b/.gitignore index d67839a02..07601b9ec 100644 --- a/.gitignore +++ b/.gitignore @@ -150,3 +150,5 @@ INSTALL /lib/dirent.h /lib/langinfo.h /lib/wctype.h +/build-aux/ar-lib +/build-aux/test-driver diff --git a/configure.ac b/configure.ac index d41026df4..3b532a07b 100644 --- a/configure.ac +++ b/configure.ac @@ -5,7 +5,7 @@ dnl define(GUILE_CONFIGURE_COPYRIGHT,[[ Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, - 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. + 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. This file is part of GUILE @@ -35,8 +35,11 @@ AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) AC_CONFIG_SRCDIR(GUILE-VERSION) -dnl `AM_PROG_AR' was introduced in Automake 1.11.2. -AM_INIT_AUTOMAKE([1.11.2 gnu no-define -Wall -Wno-override color-tests dist-xz]) +dnl Use `serial-tests' so the output `check-guile' is not hidden +dnl (`parallel-tests' is the default in Automake 1.13.) +dnl `serial-tests' was introduced in Automake 1.12. +AM_INIT_AUTOMAKE([1.12 gnu no-define -Wall -Wno-override \ + serial-tests color-tests dist-xz]) m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])], [AC_SUBST([AM_DEFAULT_VERBOSITY],1)]) AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT) diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi index fcb4a0ecd..1d730b79c 100644 --- a/doc/ref/compiler.texi +++ b/doc/ref/compiler.texi @@ -55,7 +55,8 @@ They are registered with the @code{define-language} form. @deffn {Scheme Syntax} define-language @ name title reader printer @ [parser=#f] [compilers='()] [decompilers='()] [evaluator=#f] @ -[joiner=#f] [make-default-environment=make-fresh-user-module] +[joiner=#f] [for-humans?=#t] @ +[make-default-environment=make-fresh-user-module] Define a language. This syntax defines a @code{#<language>} object, bound to @var{name} diff --git a/doc/ref/sxml-match.texi b/doc/ref/sxml-match.texi index 7a1a9ac7c..d2795a5f7 100644 --- a/doc/ref/sxml-match.texi +++ b/doc/ref/sxml-match.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2010 Free Software Foundation, Inc. +@c Copyright (C) 2010, 2013 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @c @c Based on the documentation at @@ -16,10 +16,10 @@ @cindex pattern matching (SXML) @cindex SXML pattern matching -The @code{(sxml match)} module provides syntactic forms for pattern matching of -SXML trees, in a ``by example'' style reminiscent of the pattern matching of the -@code{syntax-rules} and @code{syntax-case} macro systems. @xref{sxml simple, -the @code{(sxml simple)} module}, for more information on SXML. +The @code{(sxml match)} module provides syntactic forms for pattern +matching of SXML trees, in a ``by example'' style reminiscent of the +pattern matching of the @code{syntax-rules} and @code{syntax-case} macro +systems. @xref{SXML}, for more information on SXML. The following example@footnote{This example is taken from a paper by Krishnamurthi et al. Their paper was the first to show the usefulness of the diff --git a/doc/ref/sxml.texi b/doc/ref/sxml.texi index 3ce6062f4..6dc261f31 100644 --- a/doc/ref/sxml.texi +++ b/doc/ref/sxml.texi @@ -6,257 +6,290 @@ @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. +SXML is a native representation of XML in terms of standard Scheme data +types: lists, symbols, and strings. For example, the simple XML +fragment: -@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>) +@example +<parrot type="African Grey"><name>Alfie</name></parrot> @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 +may be represented with the following SXML: -@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. +@example +(parrot (@@ (type "African Grey)) (name "Alfie")) +@end example -@item post-handler -A function of five arguments: +SXML is very general, and is capable of representing all of XML. +Formally, this means that SXML is a conforming implementation of the +@uref{XML Information Set,http://www.w3.org/TR/xml-infoset/} standard. -@table @var -@item tag -the current tag being processed +Guile includes several facilities for working with XML and SXML: +parsers, serializers, and transformers. -@item params -the params of the current node +@menu +* SXML Overview:: XML, as it was meant to be +* Reading and Writing XML:: Convenient XML parsing and serializing +* SSAX:: Custom functional-style XML parsers +* Transforming SXML:: Munging SXML with @code{pre-post-order} +* SXML Tree Fold:: Fold-based SXML transformations +* SXPath:: XPath for SXML +* sxml apply-templates:: A more XSLT-like approach to SXML transformations +* sxml ssax input-parse:: The SSAX tokenizer, optimized for Guile +@end menu -@item layout -the layout coming into the current node, before any kids were processed +@node SXML Overview +@subsection SXML Overview -@item klayout -the layout after processing all of the children +(This section needs to be written; volunteers welcome.) -@item kids -the already-processed child nodes -@end table +@node Reading and Writing XML +@subsection Reading and Writing XML -@var{post-handler} should return two values, the layout to pass to the -next node and the final tree. +The @code{(sxml simple)} module presents a basic interface for parsing +XML from a port into the Scheme SXML format, and for serializing it back +to text. -@item text-handler -@var{text-handler} is a function of three arguments: - -@table @var -@item text -the string - -@item params -the current params +@example +(use-modules (sxml simple)) +@end example -@item layout -the current layout +@deffn {Scheme Procedure} xml->sxml [string-or-port] [#:namespaces='()] @ + [#:declare-namespaces?=#t] [#:trim-whitespace?=#f] @ + [#:entities='()] [#:default-entity-handler=#f] @ + [#:doctype-handler=#f] +Use SSAX to parse an XML document into SXML. Takes one optional +argument, @var{string-or-port}, which defaults to the current input +port. Returns the resulting SXML document. If @var{string-or-port} is +a port, it will be left pointing at the next available character in the +port. +@end deffn + +As is normal in SXML, XML elements parse as tagged lists. Attributes, +if any, are placed after the tag, within an @code{@@} element. The root +of the resulting XML will be contained in a special tag, @code{*TOP*}. +This tag will contain the root element of the XML, but also any prior +processing instructions. + +@example +(xml->sxml "<foo/>") +@result{} (*TOP* (foo)) +(xml->sxml "<foo>text</foo>") +@result{} (*TOP* (foo "text")) +(xml->sxml "<foo kind=\"bar\">text</foo>") +@result{} (*TOP* (foo (@@ (kind "bar")) "text")) +(xml->sxml "<?xml version=\"1.0\"?><foo/>") +@result{} (*TOP* (*PI* xml "version=\"1.0\"") (foo)) +@end example -@end table +All namespaces in the XML document must be declared, via @code{xmlns} +attributes. SXML elements built from non-default namespaces will have +their tags prefixed with their URI. Users can specify custom prefixes +for certain namespaces with the @code{#:namespaces} keyword argument to +@code{xml->sxml}. + +@example +(xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>") +@result{} (*TOP* (http://example.org/ns1:foo "text")) +(xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>" + #:namespaces '((ns1 . "http://example.org/ns1"))) +@result{} (*TOP* (ns1:foo "text")) +(xml->sxml "<foo xmlns:bar=\"http://example.org/ns2\"><bar:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2"))) +@result{} (*TOP* (foo (ns2:baz))) +@end example -@var{text-handler} should return two values, the layout to pass to the -next node and the value to which the string should transform. +By default, namespaces passed to @code{xml->sxml} are treated as if they +were declared on the root element. Passing a false +@code{#:declare-namespaces?} argument will disable this behavior, +requiring in-document declarations of namespaces before use.. + +@example +(xml->sxml "<foo><ns2:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2"))) +@result{} (*TOP* (foo (ns2:baz))) +(xml->sxml "<foo><ns2:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2")) + #:declare-namespaces? #f) +@result{} error: undeclared namespace: `bar' +@end example -@end table +By default, all whitespace in XML is significant. Passing the +@code{#:trim-whitespace?} keyword argument to @code{xml->sxml} will trim +whitespace in front, behind and between elements, treating it as +``unsignificant''. Whitespace in text fragments is left alone. + +@example +(xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>") +@result{} (*TOP* (foo "\n" (bar " Alfie the parrot! ") "\n")) +(xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>" + #:trim-whitespace? #t) +@result{} (*TOP* (foo (bar " Alfie the parrot! "))) +@end example -@end defun +Parsed entities may be declared with the @code{#:entities} keyword +argument, or handled with the @code{#:default-entity-handler}. By +default, only the standard @code{<}, @code{>}, @code{&}, +@code{'} and @code{"} entities are defined, as well as the +@code{&#@var{N};} and @code{&#x@var{N};} (decimal and hexadecimal) +numeric character entities. + +@example +(xml->sxml "<foo>&</foo>") +@result{} (*TOP* (foo "&")) +(xml->sxml "<foo> </foo>") +@result{} error: undefined entity: nbsp +(xml->sxml "<foo> </foo>") +@result{} (*TOP* (foo "\xa0")) +(xml->sxml "<foo> </foo>" + #:entities '((nbsp . "\xa0"))) +@result{} (*TOP* (foo "\xa0")) +(xml->sxml "<foo> &foo;</foo>" + #:default-entity-handler + (lambda (port name) + (case name + ((nbsp) "\xa0") + (else + (format (current-warning-port) + "~a:~a:~a: undefined entitity: ~a\n" + (or (port-filename port) "<unknown file>") + (port-line port) (port-column port) + name) + (symbol->string name))))) +@print{} <unknown file>:0:17: undefined entitity: foo +@result{} (*TOP* (foo "\xa0 foo")) +@end example -@node sxml simple -@subsection (sxml simple) -@subsubsection Overview -A simple interface to XML parsing and serialization. +By default, @code{xml->sxml} skips over the @code{<!DOCTYPE>} +declaration, if any. This behavior can be overridden with the +@code{#:doctype-handler} argument, which should be a procedure of three +arguments: the @dfn{docname} (a symbol), @dfn{systemid} (a string), and +the internal doctype subset (as a string or @code{#f} if not present). + +The handler should return keyword arguments as multiple values, as if it +were calling its continuation with keyword arguments. The continuation +accepts the @code{#:entities} and @code{#:namespaces} keyword arguments, +in the same format that @code{xml->sxml} itself takes. These entities +and namespaces will be prepended to those given to the @code{xml->sxml} +invocation. + +@example +(define (handle-foo docname systemid internal-subset) + (case docname + ((foo) + (values #:entities '((greets . "<i>Hello, world!</i>")))) + (else + (values)))) + +(xml->sxml "<!DOCTYPE foo><p>&greets;</p>" + #:doctype-handler handle-foo) +@result{} (*TOP* (p (i "Hello, world!"))) +@end example -@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. +If the document has no doctype declaration, the @var{doctype-handler} is +invoked with @code{#f} for the three arguments. -@end defun +In the future, the continuation may accept other keyword arguments, for +example to validate the parsed SXML against the doctype. -@anchor{sxml simple sxml->xml}@defun sxml->xml tree [port] -Serialize the sxml tree @var{tree} as XML. The output will be written to +@deffn {Scheme Procedure} 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 deffn -@end defun - -@anchor{sxml simple sxml->string}@defun sxml->string sxml +@deffn {Scheme Procedure} 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 +@end deffn + +@node SSAX +@subsection SSAX: A Functional XML Parsing Toolkit + +Guile's XML parser is based on Oleg Kiselyov's powerful XML parsing +toolkit, SSAX. + +@subsubsection History + +Back in the 1990s, when the world was young again and XML was the +solution to all of its problems, there were basically two kinds of XML +parsers out there: DOM parsers and SAX parsers. + +A DOM parser reads through an entire XML document, building up a tree of +``DOM objects'' representing the document structure. They are very easy +to use, but sometimes you don't actually want all of the information in +a document; building an object tree is not necessary if all you want to +do is to count word frequencies in a document, for example. + +SAX parsers were created to give the programmer more control on the +parsing process. A programmer gives the SAX parser a number of +``callbacks'': functions that will be called on various features of the +XML stream as they are encountered. SAX parsers are more efficient, but +much harder to user, as users typically have to manually maintain a +stack of open elements. + +Kiselyov realized that the SAX programming model could be made much +simpler if the callbacks were formulated not as a linear fold across the +features of the XML stream, but as a @emph{tree fold} over the structure +implicit in the XML. In this way, the user has a very convenient, +functional-style interface that can still generate optimal parsers. + +The @code{xml->sxml} interface from the @code{(sxml simple)} module is a +DOM-style parser built using SSAX, though it returns SXML instead of DOM +objects. + +@subsubsection Implementation + +@code{(sxml ssax)} 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. + +SSAX 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 +@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 +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. +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]. +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 @@ -287,20 +320,22 @@ 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 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 +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. +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/}. -The present frameworks fully supports the XML Namespaces -Recommendation:@uref{http://www.w3.org/TR/REC-xml-names/} Other links: +Other links: @table @asis @item [1] @@ -319,175 +354,109 @@ 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 +@deffn {Scheme Procedure} current-ssax-error-port +@end deffn -@anchor{sxml ssax with-ssax-error-to-port}@defun with-ssax-error-to-port port thunk -@end defun +@deffn {Scheme Procedure} with-ssax-error-to-port port thunk +@end deffn -@anchor{sxml ssax xml-token?}@defun xml-token? _ +@deffn {Scheme Procedure} xml-token? _ @verbatim -- Scheme Procedure: pair? x Return `#t' if X is a pair; otherwise return `#f'. @end verbatim +@end deffn -@end defun +@deffn {Scheme Syntax} xml-token-kind token +@end deffn -@anchor{sxml ssax xml-token-kind}@defspec xml-token-kind token -@end defspec +@deffn {Scheme Syntax} xml-token-head token +@end deffn -@anchor{sxml ssax xml-token-head}@defspec xml-token-head token -@end defspec +@deffn {Scheme Procedure} make-empty-attlist +@end deffn -@anchor{sxml ssax make-empty-attlist}@defun make-empty-attlist -@end defun +@deffn {Scheme Procedure} attlist-add attlist name-value +@end deffn -@anchor{sxml ssax attlist-add}@defun attlist-add attlist name-value -@end defun - -@anchor{sxml ssax attlist-null?}@defun attlist-null? _ +@deffn {Scheme Procedure} attlist-null? _ @verbatim -- Scheme Procedure: null? x Return `#t' iff X is the empty list, else `#f'. @end verbatim +@end deffn -@end defun - -@anchor{sxml ssax attlist-remove-top}@defun attlist-remove-top attlist -@end defun +@deffn {Scheme Procedure} attlist-remove-top attlist +@end deffn -@anchor{sxml ssax attlist->alist}@defun attlist->alist attlist -@end defun +@deffn {Scheme Procedure} attlist->alist attlist +@end deffn -@anchor{sxml ssax attlist-fold}@defun attlist-fold kons knil lis1 -@end defun +@deffn {Scheme Procedure} attlist-fold kons knil lis1 +@end deffn -@anchor{sxml ssax define-parsed-entity!}@defun define-parsed-entity! entity str -Define a new parsed entity. @var{entity} should be a symbol. +@deffn {Scheme Procedure} 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 deffn -@end defun - -@anchor{sxml ssax reset-parsed-entity-definitions!}@defun reset-parsed-entity-definitions! +@deffn {Scheme Procedure} reset-parsed-entity-definitions! Restore the set of parsed entity definitions to its initial state. +@end deffn -@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 +@deffn {Scheme Procedure} ssax:uri-string->symbol uri-str +@end deffn -@anchor{sxml ssax ssax:read-external-id}@defun ssax:read-external-id port -@end defun +@deffn {Scheme Procedure} ssax:skip-internal-dtd port +@end deffn -@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. +@deffn {Scheme Procedure} ssax:read-pi-body-as-string port +@end deffn -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}*)}. +@deffn {Scheme Procedure} ssax:reverse-collect-str-drop-ws fragments +@end deffn -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. +@deffn {Scheme Procedure} ssax:read-markup-token port +@end deffn -@subsubsection Usage -@anchor{sxml ssax input-parse peek-next-char}@defun peek-next-char [port] -@end defun +@deffn {Scheme Procedure} ssax:read-cdata-body port str-handler seed +@end deffn -@anchor{sxml ssax input-parse assert-curr-char}@defun assert-curr-char expected-chars comment [port] -@end defun +@deffn {Scheme Procedure} ssax:read-char-ref port +@end deffn -@anchor{sxml ssax input-parse skip-until}@defun skip-until arg [port] -@end defun +@deffn {Scheme Procedure} ssax:read-attributes port entities +@end deffn -@anchor{sxml ssax input-parse skip-while}@defun skip-while skip-chars [port] -@end defun +@deffn {Scheme Procedure} ssax:complete-start-tag tag-head port elems entities namespaces +@end deffn -@anchor{sxml ssax input-parse next-token}@defun next-token prefix-skipped-chars break-chars [comment] [port] -@end defun +@deffn {Scheme Procedure} ssax:read-external-id port +@end deffn -@anchor{sxml ssax input-parse next-token-of}@defun next-token-of incl-list/pred [port] -@end defun +@deffn {Scheme Procedure} ssax:read-char-data port expect-eof? str-handler seed +@end deffn -@anchor{sxml ssax input-parse read-text-line}@defun read-text-line [port] -@end defun +@deffn {Scheme Procedure} ssax:xml->sxml port namespace-prefix-assig +@end deffn -@anchor{sxml ssax input-parse read-string}@defun read-string n [port] -@end defun +@deffn {Scheme Syntax} ssax:make-parser . kw-val-pairs +@end deffn -@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. +@deffn {Scheme Syntax} ssax:make-pi-parser orig-handlers +@end deffn -@end defun +@deffn {Scheme Syntax} ssax:make-elem-parser my-new-level-seed my-finish-element my-char-data-handler my-pi-handlers +@end deffn -@node sxml transform -@subsection (sxml transform) +@node Transforming SXML +@subsection Transforming SXML @subsubsection Overview @heading SXML expression tree transformers @subheading Pre-Post-order traversal of a tree and creation of a new tree @@ -508,11 +477,11 @@ where @end smallexample The pre-post-order function visits the nodes and nodelists -pre-post-order (depth-first). For each @code{<Node>} of the form +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, +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 @@ -520,14 +489,14 @@ of the form (<trigger-symbol> *preorder* . <handler>) @end smallexample -If it is, the handler is 'applied' to the current node. Otherwise, the +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 +@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 +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. @@ -537,60 +506,182 @@ A binding can also be of a form (<trigger-symbol> *macro* . <handler>) @end smallexample -This is equivalent to @code{*preorder*} described above. However, the +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 +@deffn {Scheme Procedure} 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 +@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 +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 deffn + +@deffn {Scheme Procedure} foldts fdown fup fhere seed tree +@end deffn + +@deffn {Scheme Procedure} post-order tree bindings +@end deffn + +@deffn {Scheme Procedure} pre-post-order tree bindings +@end deffn + +@deffn {Scheme Procedure} replace-range beg-pred end-pred forest +@end deffn + +@node SXML Tree Fold +@subsection SXML Tree 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 +@deffn {Scheme Procedure} foldt fup fhere tree +The standard multithreaded tree fold. + +@var{fup} is of type [a] -> a. @var{fhere} is of type object -> a. +@end deffn -@end defun +@deffn {Scheme Procedure} foldts fdown fup fhere seed tree +The single-threaded tree fold originally defined in SSAX. @xref{SSAX}, +for more information. +@end deffn -@anchor{sxml transform foldts}@defun foldts fdown fup fhere seed tree -@end defun +@deffn {Scheme Procedure} foldts* fdown fup fhere seed tree +A variant of @code{foldts} that allows pre-order tree +rewrites. Originally defined in Andy Wingo's 2007 paper, +@emph{Applications of fold to XML transformation}. +@end deffn + +@deffn {Scheme Procedure} fold-values proc list . seeds +A variant of @code{fold} that allows multi-valued seeds. Note that the +order of the arguments differs from that of @code{fold}. @xref{SRFI-1 +Fold and Map}. +@end deffn -@anchor{sxml transform post-order}@defun post-order tree bindings -@end defun +@deffn {Scheme Procedure} foldts*-values fdown fup fhere tree . seeds +A variant of @code{foldts*} that allows multi-valued +seeds. Originally defined in Andy Wingo's 2007 paper, @emph{Applications +of fold to XML transformation}. +@end deffn -@anchor{sxml transform pre-post-order}@defun pre-post-order tree bindings -@end defun +@deffn {Scheme Procedure} fold-layout tree bindings params layout stylesheet +A traversal combinator in the spirit of @code{pre-post-order}. +@xref{Transforming SXML}. -@anchor{sxml transform replace-range}@defun replace-range beg-pred end-pred forest -@end defun +@code{fold-layout} was originally presented in Andy Wingo's 2007 paper, +@emph{Applications of fold to XML transformation}. -@node sxml xpath -@subsection (sxml xpath) +@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 deffn + +@node SXPath +@subsection SXPath @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 +(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 +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 +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 +suitable for querying as it is. Bowing to the XPath specification, we will refer to SXML information items as 'Nodes': @example @@ -610,124 +701,217 @@ An (ordered) set of nodes is just a list of the constituent nodes: <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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +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 +@deffn {Scheme Procedure} nodeset? x +@end deffn -@anchor{sxml xpath node-typeof?}@defun node-typeof? crit -@end defun +@deffn {Scheme Procedure} node-typeof? crit +@end deffn -@anchor{sxml xpath node-eq?}@defun node-eq? other -@end defun +@deffn {Scheme Procedure} node-eq? other +@end deffn -@anchor{sxml xpath node-equal?}@defun node-equal? other -@end defun +@deffn {Scheme Procedure} node-equal? other +@end deffn -@anchor{sxml xpath node-pos}@defun node-pos n -@end defun +@deffn {Scheme Procedure} node-pos n +@end deffn -@anchor{sxml xpath filter}@defun filter pred? +@deffn {Scheme Procedure} 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 + 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 deffn -@end defun +@deffn {Scheme Procedure} take-until pred? +@end deffn -@anchor{sxml xpath take-until}@defun take-until pred? -@end defun +@deffn {Scheme Procedure} take-after pred? +@end deffn -@anchor{sxml xpath take-after}@defun take-after pred? -@end defun +@deffn {Scheme Procedure} map-union proc lst +@end deffn -@anchor{sxml xpath map-union}@defun map-union proc lst -@end defun +@deffn {Scheme Procedure} node-reverse node-or-nodeset +@end deffn -@anchor{sxml xpath node-reverse}@defun node-reverse node-or-nodeset -@end defun +@deffn {Scheme Procedure} node-trace title +@end deffn -@anchor{sxml xpath node-trace}@defun node-trace title -@end defun +@deffn {Scheme Procedure} select-kids test-pred? +@end deffn -@anchor{sxml xpath select-kids}@defun select-kids test-pred? -@end defun - -@anchor{sxml xpath node-self}@defun node-self pred? +@deffn {Scheme Procedure} 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 + 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 deffn + +@deffn {Scheme Procedure} node-join . selectors +@end deffn + +@deffn {Scheme Procedure} node-reduce . converters +@end deffn + +@deffn {Scheme Procedure} node-or . converters +@end deffn + +@deffn {Scheme Procedure} node-closure test-pred? +@end deffn + +@deffn {Scheme Procedure} node-parent rootnode +@end deffn + +@deffn {Scheme Procedure} sxpath path +@end deffn + +@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 +@deffn {Scheme Procedure} peek-next-char [port] +@end deffn + +@deffn {Scheme Procedure} assert-curr-char expected-chars comment [port] +@end deffn + +@deffn {Scheme Procedure} skip-until arg [port] +@end deffn -@end defun +@deffn {Scheme Procedure} skip-while skip-chars [port] +@end deffn -@anchor{sxml xpath node-join}@defun node-join . selectors -@end defun +@deffn {Scheme Procedure} next-token prefix-skipped-chars break-chars [comment] [port] +@end deffn -@anchor{sxml xpath node-reduce}@defun node-reduce . converters -@end defun +@deffn {Scheme Procedure} next-token-of incl-list/pred [port] +@end deffn -@anchor{sxml xpath node-or}@defun node-or . converters -@end defun +@deffn {Scheme Procedure} read-text-line [port] +@end deffn -@anchor{sxml xpath node-closure}@defun node-closure test-pred? -@end defun +@deffn {Scheme Procedure} read-string n [port] +@end deffn -@anchor{sxml xpath node-parent}@defun node-parent rootnode -@end defun +@deffn {Scheme Procedure} find-string-from-port? _ _ . _ +Looks for @var{str} in @var{<input-port>}, optionally within the first +@var{max-no-char} characters. +@end deffn + +@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 +@deffn {Scheme Procedure} apply-templates tree templates +@end deffn -@anchor{sxml xpath sxpath}@defun sxpath path -@end defun diff --git a/doc/ref/texinfo.texi b/doc/ref/texinfo.texi index b2947fc30..b5ef393c1 100644 --- a/doc/ref/texinfo.texi +++ b/doc/ref/texinfo.texi @@ -152,8 +152,8 @@ 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. +Returns a nodeset; that is to say, an untagged list of stexi elements. +@xref{SXPath}, for the definition of a nodeset. @end defun @@ -184,10 +184,12 @@ For example: 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. +that it must eventually be serialized by @code{sxml->xml}. +@xref{Reading and Writing 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!}. @subsubsection Usage @anchor{texinfo html add-ref-resolver!}@defun add-ref-resolver! proc diff --git a/doc/ref/web.texi b/doc/ref/web.texi index 0f69089d0..6c33f3225 100644 --- a/doc/ref/web.texi +++ b/doc/ref/web.texi @@ -127,8 +127,8 @@ basic idea is that HTML is either text, represented by a string, or an element, represented as a tagged list. So @samp{foo} becomes @samp{"foo"}, and @samp{<b>foo</b>} becomes @samp{(b "foo")}. Attributes, if present, go in a tagged list headed by @samp{@@}, like -@samp{(img (@@ (src "http://example.com/foo.png")))}. @xref{sxml -simple}, for more information. +@samp{(img (@@ (src "http://example.com/foo.png")))}. @xref{SXML}, for +more information. The good thing about SXML is that HTML elements cannot be confused with text. Let's make a new definition of @code{para}: @@ -1769,7 +1769,7 @@ message body is long enough.) The web handler interface is a common baseline that all kinds of Guile web applications can use. You will usually want to build something on top of it, however, especially when producing HTML. Here is a simple -example that builds up HTML output using SXML (@pxref{sxml simple}). +example that builds up HTML output using SXML (@pxref{SXML}). First, load up the modules: diff --git a/libguile/memoize.c b/libguile/memoize.c index af6861001..7431d3c0e 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -1,5 +1,5 @@ /* 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 @@ -910,7 +910,6 @@ void scm_init_memoize () { scm_tc16_memoized = scm_make_smob_type ("%memoized", 0); - scm_set_smob_mark (scm_tc16_memoized, scm_markcdr); scm_set_smob_print (scm_tc16_memoized, scm_print_memoized); scm_tc16_memoizer = scm_make_smob_type ("memoizer", 0); diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm index 5c393402b..e330423b5 100644 --- a/module/ice-9/psyntax-pp.scm +++ b/module/ice-9/psyntax-pp.scm @@ -990,7 +990,7 @@ (let ((e (cdar body)) (er (caar body))) (call-with-values (lambda () - (syntax-type e er '(()) (source-annotation er) ribcage mod #f)) + (syntax-type e er '(()) (source-annotation e) ribcage mod #f)) (lambda (type value form e w s mod) (let ((key type)) (cond ((memv key '(define-form)) @@ -1004,20 +1004,31 @@ (cons var vars) (cons (cons er (wrap e w mod)) vals) (cons (cons 'lexical var) bindings))))) - ((memv key '(define-syntax-form define-syntax-parameter-form)) - (let ((id (wrap value w mod)) (label (gen-label))) + ((memv key '(define-syntax-form)) + (let ((id (wrap value w mod)) + (label (gen-label)) + (trans-r (macros-only-env er))) (extend-ribcage! ribcage id label) - (parse (cdr body) - (cons id ids) - (cons label labels) - var-ids - vars - vals - (cons (cons (if (eq? type 'define-syntax-parameter-form) - 'syntax-parameter - 'macro) - (cons er (wrap e w mod))) - bindings)))) + (set-cdr! + r + (extend-env + (list label) + (list (cons 'macro (eval-local-transformer (expand e trans-r w mod) mod))) + (cdr r))) + (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) + ((memv key '(define-syntax-parameter-form)) + (let ((id (wrap value w mod)) + (label (gen-label)) + (trans-r (macros-only-env er))) + (extend-ribcage! ribcage id label) + (set-cdr! + r + (extend-env + (list label) + (list (cons 'syntax-parameter + (list (eval-local-transformer (expand e trans-r w mod) mod)))) + (cdr r))) + (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) ((memv key '(begin-form)) (let* ((tmp-1 e) (tmp ($sc-dispatch tmp-1 '(_ . each-any)))) (if tmp @@ -1067,18 +1078,6 @@ #f "invalid or duplicate identifier in definition" outer-form)) - (let loop ((bs bindings) (er-cache #f) (r-cache #f)) - (if (not (null? bs)) - (let ((b (car bs))) - (if (memq (car b) '(macro syntax-parameter)) - (let* ((er (cadr b)) - (r-cache (if (eq? er er-cache) r-cache (macros-only-env er)))) - (set-cdr! - b - (eval-local-transformer (expand (cddr b) r-cache '(()) mod) mod)) - (if (eq? (car b) 'syntax-parameter) (set-cdr! b (list (cdr b)))) - (loop (cdr bs) er r-cache)) - (loop (cdr bs) er-cache r-cache))))) (set-cdr! r (extend-env labels bindings (cdr r))) (build-letrec #f @@ -3026,33 +3025,37 @@ 'macro (lambda (x) (letrec* - ((read-file - (lambda (fn k) - (let ((p (open-input-file fn))) + ((absolute-path? (lambda (path) (string-prefix? "/" path))) + (read-file + (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) (begin (close-input-port p) (reverse result)) (f (read p) (cons (datum->syntax k x) result)))))))) - (let ((tmp-1 x)) - (let ((tmp ($sc-dispatch tmp-1 '(any any)))) - (if tmp - (apply (lambda (k filename) - (let ((fn (syntax->datum filename))) - (let ((tmp-1 (read-file fn filename))) - (let ((tmp ($sc-dispatch tmp-1 'each-any))) - (if tmp - (apply (lambda (exp) - (cons '#(syntax-object begin ((top)) (hygiene guile)) exp)) - tmp) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-1)))))) - tmp) - (syntax-violation - #f - "source expression failed to match any pattern" - tmp-1)))))))) + (let ((src (syntax-source x))) + (let ((file (if src (assq-ref src 'filename) #f))) + (let ((dir (if (string? file) (dirname file) #f))) + (let ((tmp-1 x)) + (let ((tmp ($sc-dispatch tmp-1 '(any any)))) + (if tmp + (apply (lambda (k filename) + (let ((fn (syntax->datum filename))) + (let ((tmp-1 (read-file fn dir filename))) + (let ((tmp ($sc-dispatch tmp-1 'each-any))) + (if tmp + (apply (lambda (exp) + (cons '#(syntax-object begin ((top)) (hygiene guile)) exp)) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1)))))) + tmp) + (syntax-violation + #f + "source expression failed to match any pattern" + tmp-1))))))))))) (define include-from-path (make-syntax-transformer diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm index 1698a024b..79f2fd41f 100644 --- a/module/ice-9/psyntax.scm +++ b/module/ice-9/psyntax.scm @@ -1531,7 +1531,7 @@ (syntax-violation #f "no expressions in body" outer-form) (let ((e (cdar body)) (er (caar body))) (call-with-values - (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f)) + (lambda () (syntax-type e er empty-wrap (source-annotation e) ribcage mod #f)) (lambda (type value form e w s mod) (case type ((define-form) @@ -1543,18 +1543,40 @@ (cons id var-ids) (cons var vars) (cons (cons er (wrap e w mod)) vals) (cons (make-binding 'lexical var) bindings))))) - ((define-syntax-form define-syntax-parameter-form) - (let ((id (wrap value w mod)) (label (gen-label))) + ((define-syntax-form) + (let ((id (wrap value w mod)) + (label (gen-label)) + (trans-r (macros-only-env er))) + (extend-ribcage! ribcage id label) + ;; As required by R6RS, evaluate the right-hand-sides of internal + ;; syntax definition forms and add their transformers to the + ;; compile-time environment immediately, so that the newly-defined + ;; keywords may be used in definition context within the same + ;; lexical contour. + (set-cdr! r (extend-env + (list label) + (list (make-binding + 'macro + (eval-local-transformer + (expand e trans-r w mod) + mod))) + (cdr r))) + (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) + ((define-syntax-parameter-form) + ;; Same as define-syntax-form, but different format of the binding. + (let ((id (wrap value w mod)) + (label (gen-label)) + (trans-r (macros-only-env er))) (extend-ribcage! ribcage id label) - (parse (cdr body) - (cons id ids) (cons label labels) - var-ids vars vals - (cons (make-binding - (if (eq? type 'define-syntax-parameter-form) - 'syntax-parameter - 'macro) - (cons er (wrap e w mod))) - bindings)))) + (set-cdr! r (extend-env + (list label) + (list (make-binding + 'syntax-parameter + (list (eval-local-transformer + (expand e trans-r w mod) + mod)))) + (cdr r))) + (parse (cdr body) (cons id ids) labels var-ids vars vals bindings))) ((begin-form) (syntax-case e () ((_ e1 ...) @@ -1585,23 +1607,6 @@ (syntax-violation #f "invalid or duplicate identifier in definition" outer-form)) - (let loop ((bs bindings) (er-cache #f) (r-cache #f)) - (if (not (null? bs)) - (let* ((b (car bs))) - (if (memq (car b) '(macro syntax-parameter)) - (let* ((er (cadr b)) - (r-cache - (if (eq? er er-cache) - r-cache - (macros-only-env er)))) - (set-cdr! b - (eval-local-transformer - (expand (cddr b) r-cache empty-wrap mod) - mod)) - (if (eq? (car b) 'syntax-parameter) - (set-cdr! b (list (cdr b)))) - (loop (cdr bs) er r-cache)) - (loop (cdr bs) er-cache r-cache))))) (set-cdr! r (extend-env labels bindings (cdr r))) (build-letrec no-source #t (reverse (map syntax->datum var-ids)) diff --git a/module/language/assembly/spec.scm b/module/language/assembly/spec.scm index 01a55c4e1..0a497e4cf 100644 --- a/module/language/assembly/spec.scm +++ b/module/language/assembly/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Virtual Machine Assembly -;; 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 @@ -31,4 +31,5 @@ #:parser read ;; fixme: make a verifier? #:compilers `((bytecode . ,compile-bytecode)) #:decompilers `((bytecode . ,decompile-bytecode)) + #:for-humans? #f ) diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm index c2a6d46ab..ca703c33c 100644 --- a/module/language/bytecode/spec.scm +++ b/module/language/bytecode/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Lowlevel Intermediate Language -;; 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 @@ -36,4 +36,5 @@ #:printer write #:compilers `((objcode . ,compile-objcode)) #:decompilers `((objcode . ,decompile-objcode)) + #:for-humans? #f ) diff --git a/module/language/ecmascript/base.scm b/module/language/ecmascript/base.scm index 6f5c65ba5..ac8493dd0 100644 --- a/module/language/ecmascript/base.scm +++ b/module/language/ecmascript/base.scm @@ -1,6 +1,6 @@ ;;; ECMAScript for Guile -;; Copyright (C) 2009 Free Software Foundation, Inc. +;; Copyright (C) 2009, 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 @@ -168,7 +168,8 @@ x)) (define (->boolean x) - (not (or (not x) (null? x) (eq? x *undefined*) (zero? x) (nan? x) + (not (or (not x) (null? x) (eq? x *undefined*) + (and (number? x) (or (zero? x) (nan? x))) (and (string? x) (= (string-length x) 0))))) (define (->number x) diff --git a/module/language/glil/spec.scm b/module/language/glil/spec.scm index a8164e5e4..3679e2166 100644 --- a/module/language/glil/spec.scm +++ b/module/language/glil/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Lowlevel Intermediate Language -;; 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 @@ -37,4 +37,6 @@ #:printer write-glil #:parser parse-glil #:compilers `((assembly . ,compile-asm)) - #:decompilers `((assembly . ,decompile-assembly))) + #:decompilers `((assembly . ,decompile-assembly)) + #:for-humans? #f + ) diff --git a/module/language/objcode/spec.scm b/module/language/objcode/spec.scm index 022419e9d..16f52410a 100644 --- a/module/language/objcode/spec.scm +++ b/module/language/objcode/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Lowlevel Intermediate Language -;; 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 @@ -80,4 +80,5 @@ #:printer write-objcode #:compilers `((value . ,objcode->value)) #:decompilers `((value . ,decompile-value)) + #:for-humans? #f ) diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm index 4af7998ab..f5890b25a 100644 --- a/module/language/tree-il/analyze.scm +++ b/module/language/tree-il/analyze.scm @@ -1265,11 +1265,11 @@ accurate information is missing from a given `tree-il' element." (case state ((tilde) (case (car chars) - ((#\~ #\% #\& #\t #\_ #\newline #\( #\)) + ((#\~ #\% #\& #\t #\T #\_ #\newline #\( #\) #\! #\| #\/ #\q #\Q) (loop (cdr chars) 'literal '() conditions end-group min-count max-count)) - ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\, #\: #\@) + ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\, #\: #\@ #\+ #\- #\#) (loop (cdr chars) 'tilde (cons (car chars) params) conditions end-group @@ -1336,16 +1336,23 @@ accurate information is missing from a given `tree-il' element." min-count) (+ (or (previous-number params) 1) max-count)))) - ((#\? #\k) + ((#\? #\k #\K) ;; We don't have enough info to determine the exact number ;; of args, but we could determine a lower bound (TODO). (values 'any 'any)) + ((#\^) + (values min-count 'any)) ((#\h #\H) (let ((argc (if (memq #\: params) 2 1))) (loop (cdr chars) 'literal '() conditions end-group (+ argc min-count) (+ argc max-count)))) + ((#\') + (if (null? (cdr chars)) + (throw &syntax-error 'unexpected-termination) + (loop (cddr chars) 'tilde (cons (cadr chars) params) + conditions end-group min-count max-count))) (else (loop (cdr chars) 'literal '() conditions end-group (+ 1 min-count) (+ 1 max-count))))) diff --git a/module/language/tree-il/spec.scm b/module/language/tree-il/spec.scm index 3ad372709..80c32fe29 100644 --- a/module/language/tree-il/spec.scm +++ b/module/language/tree-il/spec.scm @@ -1,6 +1,6 @@ ;;; Tree Intermediate Language -;; 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 @@ -44,4 +44,5 @@ #:parser parse-tree-il #:joiner join #:compilers `((glil . ,compile-glil)) + #:for-humans? #f ) diff --git a/module/language/value/spec.scm b/module/language/value/spec.scm index 6c6cff93f..506b07333 100644 --- a/module/language/value/spec.scm +++ b/module/language/value/spec.scm @@ -1,6 +1,6 @@ ;;; Guile Lowlevel Intermediate Language -;; Copyright (C) 2001, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 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,4 +26,5 @@ #:title "Values" #:reader #f #:printer write + #:for-humans? #f ) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index cd811b3bb..2e875fa4b 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -1,28 +1,27 @@ ;;; installed-scm-file ;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; +;;;; -;;;; This software is a derivative work of other copyrighted softwares; the -;;;; copyright notices of these softwares are placed in the file COPYRIGHTS ;;;; -;;;; This file is based upon stklos.stk from the STk distribution by -;;;; Erick Gallesio <eg@unice.fr>. +;;;; This file was based upon stklos.stk from the STk distribution +;;;; version 4.0.1 by Erick Gallesio <eg@unice.fr>. ;;;; (define-module (oop goops) diff --git a/module/oop/goops/active-slot.scm b/module/oop/goops/active-slot.scm index 79aa1b3f2..4d3bbf72f 100644 --- a/module/oop/goops/active-slot.scm +++ b/module/oop/goops/active-slot.scm @@ -1,28 +1,27 @@ ;;; installed-scm-file -;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 1999, 2001, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; - +;;;; -;;;; This software is a derivative work of other copyrighted softwares; the -;;;; copyright notices of these softwares are placed in the file COPYRIGHTS + ;;;; -;;;; This file is based upon active-slot.stklos from the STk -;;;; distribution by Erick Gallesio <eg@unice.fr>. +;;;; This file was based upon active-slot.stklos from the STk distribution +;;;; version 4.0.1 by Erick Gallesio <eg@unice.fr>. ;;;; (define-module (oop goops active-slot) diff --git a/module/oop/goops/composite-slot.scm b/module/oop/goops/composite-slot.scm index b3f8cc038..bd3eb941e 100644 --- a/module/oop/goops/composite-slot.scm +++ b/module/oop/goops/composite-slot.scm @@ -1,28 +1,27 @@ ;;; installed-scm-file -;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 1999, 2000, 2001, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; +;;;; -;;;; This software is a derivative work of other copyrighted softwares; the -;;;; copyright notices of these softwares are placed in the file COPYRIGHTS ;;;; -;;;; This file is based upon composite-slot.stklos from the STk -;;;; distribution by Erick Gallesio <eg@unice.fr>. +;;;; This file was based upon composite-slot.stklos from the STk distribution +;;;; version 4.0.1 by Erick Gallesio <eg@unice.fr>. ;;;; (define-module (oop goops composite-slot) diff --git a/module/oop/goops/describe.scm b/module/oop/goops/describe.scm index 86b2d2ce4..52eb29954 100644 --- a/module/oop/goops/describe.scm +++ b/module/oop/goops/describe.scm @@ -1,28 +1,27 @@ ;;; installed-scm-file -;;;; Copyright (C) 1998, 1999, 2001, 2006, 2008, 2009 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 1998, 1999, 2001, 2006, 2008, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; +;;;; -;;;; This software is a derivative work of other copyrighted softwares; the -;;;; copyright notices of these softwares are placed in the file COPYRIGHTS ;;;; -;;;; This file is based upon describe.stklos from the STk distribution by -;;;; Erick Gallesio <eg@unice.fr>. +;;;; This file was based upon describe.stklos from the STk distribution +;;;; version 4.0.1 by Erick Gallesio <eg@unice.fr>. ;;;; (define-module (oop goops describe) diff --git a/module/oop/goops/save.scm b/module/oop/goops/save.scm index 05362e077..dda2aea4e 100644 --- a/module/oop/goops/save.scm +++ b/module/oop/goops/save.scm @@ -128,6 +128,29 @@ (hashq-ref readables obj)) ;;; +;;; Writer helpers +;;; + +(define (write-component-procedure o file env) + "Return #f if circular reference" + (cond ((immediate? o) (write o file) #t) + ((readable? o) (write (readable-expression o) file) #t) + ((excluded? o env) (display #f file) #t) + (else + (let ((info (object-info o env))) + (cond ((not (binding? info)) (write-readably o file env) #t) + ((not (eq? (visiting info) #:defined)) #f) ;forward reference + (else (display (binding info) file) #t)))))) + +;;; write-component OBJECT PATCHER FILE ENV +;;; +(define-macro (write-component object patcher file env) + `(or (write-component-procedure ,object ,file ,env) + (begin + (display #f ,file) + (add-patcher! ,patcher ,env)))) + +;;; ;;; Strings ;;; @@ -603,24 +626,6 @@ (pop-ref! env) (set! (objects env) (cons o (objects env))))))) -(define (write-component-procedure o file env) - "Return #f if circular reference" - (cond ((immediate? o) (write o file) #t) - ((readable? o) (write (readable-expression o) file) #t) - ((excluded? o env) (display #f file) #t) - (else - (let ((info (object-info o env))) - (cond ((not (binding? info)) (write-readably o file env) #t) - ((not (eq? (visiting info) #:defined)) #f) ;forward reference - (else (display (binding info) file) #t)))))) - -;;; write-component OBJECT PATCHER FILE ENV -;;; -(define-macro (write-component object patcher file env) - `(or (write-component-procedure ,object ,file ,env) - (begin - (display #f ,file) - (add-patcher! ,patcher ,env)))) ;;; ;;; Main engine diff --git a/module/sxml/simple.scm b/module/sxml/simple.scm index dcef3b2cb..703ad9137 100644 --- a/module/sxml/simple.scm +++ b/module/sxml/simple.scm @@ -1,6 +1,6 @@ ;;;; (sxml simple) -- a simple interface to the SSAX parser ;;;; -;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2013 Free Software Foundation, Inc. ;;;; Modified 2004 by Andy Wingo <wingo at pobox dot com>. ;;;; Originally written by Oleg Kiselyov <oleg at pobox dot com> as SXML-to-HTML.scm. ;;;; @@ -26,16 +26,194 @@ ;;; Code: (define-module (sxml simple) + #:use-module (sxml ssax input-parse) #:use-module (sxml ssax) #:use-module (sxml transform) - #:use-module (ice-9 optargs) + #:use-module (ice-9 match) #:use-module (srfi srfi-13) #:export (xml->sxml sxml->xml sxml->string)) -(define* (xml->sxml #:optional (port (current-input-port))) +;; Helpers from upstream/SSAX.scm. +;; + +; ssax:reverse-collect-str LIST-OF-FRAGS -> LIST-OF-FRAGS +; given the list of fragments (some of which are text strings) +; reverse the list and concatenate adjacent text strings. +; We can prove from the general case below that if LIST-OF-FRAGS +; has zero or one element, the result of the procedure is equal? +; to its argument. This fact justifies the shortcut evaluation below. +(define (ssax:reverse-collect-str fragments) + (cond + ((null? fragments) '()) ; a shortcut + ((null? (cdr fragments)) fragments) ; see the comment above + (else + (let loop ((fragments fragments) (result '()) (strs '())) + (cond + ((null? fragments) + (if (null? strs) result + (cons (string-concatenate/shared strs) result))) + ((string? (car fragments)) + (loop (cdr fragments) result (cons (car fragments) strs))) + (else + (loop (cdr fragments) + (cons + (car fragments) + (if (null? strs) result + (cons (string-concatenate/shared strs) result))) + '()))))))) + +(define (read-internal-doctype-as-string port) + (string-concatenate/shared + (let loop () + (let ((fragment + (next-token '() '(#\]) "reading internal DOCTYPE" port))) + (if (eqv? #\> (peek-next-char port)) + (begin + (read-char port) + (cons fragment '())) + (cons* fragment "]" (loop))))))) + +;; Ideas for the future for this interface: +;; +;; * Allow doctypes to provide parsed entities +;; +;; * Allow validation (the ELEMENTS value from the DOCTYPE handler +;; below) +;; +;; * Parse internal DTDs +;; +;; * Parse external DTDs +;; +(define* (xml->sxml #:optional (string-or-port (current-input-port)) #:key + (namespaces '()) + (declare-namespaces? #t) + (trim-whitespace? #f) + (entities '()) + (default-entity-handler #f) + (doctype-handler #f)) "Use SSAX to parse an XML document into SXML. Takes one optional -argument, @var{port}, which defaults to the current input port." - (ssax:xml->sxml port '())) +argument, @var{string-or-port}, which defaults to the current input +port." + ;; NAMESPACES: alist of PREFIX -> URI. Specifies the symbol prefix + ;; that the user wants on elements of a given namespace in the + ;; resulting SXML, regardless of the abbreviated namespaces defined in + ;; the document by xmlns attributes. If DECLARE-NAMESPACES? is true, + ;; these namespaces are treated as if they were declared in the DTD. + + ;; ENTITIES: alist of SYMBOL -> STRING. + + ;; NAMESPACES: list of (DOC-PREFIX . (USER-PREFIX . URI)). + ;; A DOC-PREFIX of #f indicates that it comes from the user. + ;; Otherwise, prefixes are symbols. + (define (munge-namespaces namespaces) + (map (lambda (el) + (match el + ((prefix . uri-string) + (cons* (and declare-namespaces? prefix) + prefix + (ssax:uri-string->symbol uri-string))))) + namespaces)) + + (define (user-namespaces) + (munge-namespaces namespaces)) + + (define (user-entities) + (if (and default-entity-handler + (not (assq '*DEFAULT* entities))) + (acons '*DEFAULT* default-entity-handler entities) + entities)) + + (define (name->sxml name) + (match name + ((prefix . local-part) + (symbol-append prefix (string->symbol ":") local-part)) + (_ name))) + + (define (doctype-continuation seed) + (lambda* (#:key (entities '()) (namespaces '())) + (values #f + (append entities (user-entities)) + (append (munge-namespaces namespaces) (user-namespaces)) + seed))) + + ;; The SEED in this parser is the SXML: initialized to '() at each new + ;; level by the fdown handlers; built in reverse by the fhere parsers; + ;; and reverse-collected by the fup handlers. + (define parser + (ssax:make-parser + NEW-LEVEL-SEED ; fdown + (lambda (elem-gi attributes namespaces expected-content seed) + '()) + + FINISH-ELEMENT ; fup + (lambda (elem-gi attributes namespaces parent-seed seed) + (let ((seed (if trim-whitespace? + (ssax:reverse-collect-str-drop-ws seed) + (ssax:reverse-collect-str seed))) + (attrs (attlist-fold + (lambda (attr accum) + (cons (list (name->sxml (car attr)) (cdr attr)) + accum)) + '() attributes))) + (acons (name->sxml elem-gi) + (if (null? attrs) + seed + (cons (cons '@ attrs) seed)) + parent-seed))) + + CHAR-DATA-HANDLER ; fhere + (lambda (string1 string2 seed) + (if (string-null? string2) + (cons string1 seed) + (cons* string2 string1 seed))) + + DOCTYPE + ;; -> ELEMS ENTITIES NAMESPACES SEED + ;; + ;; ELEMS is for validation and currently unused. + ;; + ;; ENTITIES is an alist of parsed entities (symbol -> string). + ;; + ;; NAMESPACES is as above. + ;; + ;; SEED builds up the content. + (lambda (port docname systemid internal-subset? seed) + (call-with-values + (lambda () + (cond + (doctype-handler + (doctype-handler docname systemid + (and internal-subset? + (read-internal-doctype-as-string port)))) + (else + (when internal-subset? + (ssax:skip-internal-dtd port)) + (values)))) + (doctype-continuation seed))) + + UNDECL-ROOT + ;; This is like the DOCTYPE handler, but for documents that do not + ;; have a <!DOCTYPE!> entry. + (lambda (elem-gi seed) + (call-with-values + (lambda () + (if doctype-handler + (doctype-handler #f #f #f) + (values))) + (doctype-continuation seed))) + + PI + ((*DEFAULT* + . (lambda (port pi-tag seed) + (cons + (list '*PI* pi-tag (ssax:read-pi-body-as-string port)) + seed)))))) + + (let* ((port (if (string? string-or-port) + (open-input-string string-or-port) + string-or-port)) + (elements (reverse (parser port '())))) + `(*TOP* ,@elements))) (define check-name (let ((*good-cache* (make-hash-table))) diff --git a/module/sxml/ssax.scm b/module/sxml/ssax.scm index a4de0e3e1..f750c934a 100644 --- a/module/sxml/ssax.scm +++ b/module/sxml/ssax.scm @@ -1,6 +1,6 @@ ;;;; (sxml ssax) -- the SSAX parser ;;;; -;;;; Copyright (C) 2009, 2010,2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010,2012,2013 Free Software Foundation, Inc. ;;;; Modified 2004 by Andy Wingo <wingo at pobox dot com>. ;;;; Written 2001,2002,2003,2004 by Oleg Kiselyov <oleg at pobox dot com> as SSAX.scm. ;;;; @@ -170,17 +170,22 @@ (define ascii->char integer->char) (define char->ascii char->integer) -(define *current-ssax-error-port* (make-fluid)) -(define (current-ssax-error-port) - (fluid-ref *current-ssax-error-port*)) +(define current-ssax-error-port + (make-parameter (current-error-port))) + +(define *current-ssax-error-port* + (parameter-fluid current-ssax-error-port)) (define (with-ssax-error-to-port port thunk) - (with-fluids ((*current-ssax-error-port* port)) + (parameterize ((current-ssax-error-port port)) (thunk))) -(define (ssax:warn port msg . args) - (format (current-ssax-error-port) - ";;; SSAX warning: ~a ~a\n" msg args)) +(define (ssax:warn port . args) + (with-output-to-port (current-ssax-error-port) + (lambda () + (display ";;; SSAX warning: ") + (for-each display args) + (newline)))) (define (ucscode->string codepoint) (string (integer->char codepoint))) diff --git a/module/sxml/upstream/SSAX.scm b/module/sxml/upstream/SSAX.scm index 776e3119e..d2b8fd925 100644 --- a/module/sxml/upstream/SSAX.scm +++ b/module/sxml/upstream/SSAX.scm @@ -442,6 +442,11 @@ ; named-entity-name is currently being expanded. A reference to ; this named-entity-name will be an error: violation of the ; WFC nonrecursion. +; +; As an extension to the original SSAX, Guile allows a +; named-entity-name of *DEFAULT* to indicate a fallback procedure, +; called as (FALLBACK PORT NAME). The procedure should return a +; string. ; XML-TOKEN -- a record @@ -1095,10 +1100,20 @@ (close-input-port port)))) (else (parser-error port "[norecursion] broken for " name)))))) - ((assq name ssax:predefined-parsed-entities) - => (lambda (decl-entity) - (str-handler (cdr decl-entity) "" seed))) - (else (parser-error port "[wf-entdeclared] broken for " name)))) + ((assq name ssax:predefined-parsed-entities) + => (lambda (decl-entity) + (str-handler (cdr decl-entity) "" seed))) + ((assq '*DEFAULT* entities) => + (lambda (decl-entity) + (let ((fallback (cdr decl-entity)) + (new-entities (cons (cons name #f) entities))) + (cond + ((procedure? fallback) + (call-with-input-string (fallback port name) + (lambda (port) (content-handler port new-entities seed)))) + (else + (parser-error port "[norecursion] broken for " name)))))) + (else (parser-error port "[wf-entdeclared] broken for " name)))) @@ -1267,6 +1282,14 @@ '((ent . "<&ent1;T;>") (ent1 . "&")) `((,(string->symbol "Abc") . ,(unesc-string "<&>%n")) (,(string->symbol "Next") . "12<&T;>34"))) + (test "%tAbc='<&>
'%nNext='12&ent;34' />" + `((*DEFAULT* . ,(lambda (port name) + (case name + ((ent) "<&ent1;T;>") + ((ent1) "&") + (else (error "unrecognized" name)))))) + `((,(string->symbol "Abc") . ,(unesc-string "<&>%n")) + (,(string->symbol "Next") . "12<&T;>34"))) (assert (failed? (test "%tAbc='<&>
'%nNext='12&ent;34' />" '((ent . "<&ent1;T;>") (ent1 . "&")) '()))) diff --git a/module/system/base/language.scm b/module/system/base/language.scm index 81b43b70d..5d927e061 100644 --- a/module/system/base/language.scm +++ b/module/system/base/language.scm @@ -25,7 +25,8 @@ language-name language-title language-reader language-printer language-parser language-compilers language-decompilers language-evaluator - language-joiner language-make-default-environment + language-joiner language-for-humans? + language-make-default-environment lookup-compilation-order lookup-decompilation-order invalidate-compilation-cache! default-environment @@ -49,6 +50,7 @@ (decompilers '()) (evaluator #f) (joiner #f) + (for-humans? #t) (make-default-environment make-fresh-user-module)) (define-macro (define-language name . spec) diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm index 3f3e7854a..5da7c48f0 100644 --- a/module/system/repl/common.scm +++ b/module/system/repl/common.scm @@ -1,6 +1,7 @@ ;;; Repl common routines -;; Copyright (C) 2001, 2008, 2009, 2010, 2011 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 @@ -39,7 +40,7 @@ (define *version* (format #f "GNU Guile ~A -Copyright (C) 1995-2012 Free Software Foundation, Inc. +Copyright (C) 1995-2013 Free Software Foundation, Inc. Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'. This program is free software, and you are welcome to redistribute it diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index daa3d0744..be5d91380 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -1,7 +1,7 @@ ## Process this file with automake to produce Makefile.in. ## ## Copyright 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, -## 2011, 2012 Free Software Foundation, Inc. +## 2011, 2012, 2013 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -31,6 +31,7 @@ BUILT_SOURCES = EXTRA_DIST = TESTS_ENVIRONMENT = \ + top_srcdir="$(top_srcdir)" \ srcdir="$(srcdir)" \ builddir="$(builddir)" \ @LOCALCHARSET_TESTS_ENVIRONMENT@ \ @@ -88,6 +89,10 @@ TESTS += test-command-line-encoding check_SCRIPTS += test-command-line-encoding2 TESTS += test-command-line-encoding2 +check_SCRIPTS += test-language +TESTS += test-language +EXTRA_DIST += test-language.el test-language.js + # test-num2integral test_num2integral_SOURCES = test-num2integral.c test_num2integral_CFLAGS = ${test_cflags} diff --git a/test-suite/standalone/test-language b/test-suite/standalone/test-language new file mode 100755 index 000000000..59ed82b62 --- /dev/null +++ b/test-suite/standalone/test-language @@ -0,0 +1,25 @@ +#!/bin/sh + +set -e + +# Make sure that code passed as `-c' or `-l' is evaluted using the +# right language. + +# The default language in effect until `--language' is encountered is +# Scheme. +guile -c "(exit (= 3 (apply + '(1 2))))" --language=elisp +! guile -c "(= (funcall (symbol-function '+) 1 2) 3)" 2> /dev/null + +guile --language=elisp -c "(= (funcall (symbol-function '+) 1 2) 3)" +guile --language=ecmascript -c '(function (x) { return x * x; })(2);' + +# Same with `-l'. +guile --no-auto-compile -l "$top_srcdir/module/ice-9/q.scm" -c 1 +guile --no-auto-compile \ + -l "$top_srcdir/module/ice-9/q.scm" \ + --language=elisp \ + -l "$srcdir/test-language.el" \ + --language=ecmascript \ + -l "$srcdir/test-language.js" \ + --language=scheme \ + -c 1 diff --git a/test-suite/standalone/test-language.el b/test-suite/standalone/test-language.el new file mode 100644 index 000000000..c1f09cc3f --- /dev/null +++ b/test-suite/standalone/test-language.el @@ -0,0 +1,11 @@ +;; Sample Elisp code for `test-language'. + +(defun fib (n) + "Anything but a fib." + (if (<= n 1) + n + (+ (fib (- n 1)) + (fib (- n 2))))) + +(or (= 13 (fib 7)) + (error "Something's wrong!")) diff --git a/test-suite/standalone/test-language.js b/test-suite/standalone/test-language.js new file mode 100644 index 000000000..c8de366cc --- /dev/null +++ b/test-suite/standalone/test-language.js @@ -0,0 +1,12 @@ +/* Sample ECMAscript code for `test-language'. */ + +function fib (n) +{ + if (n <= 1) + return n; + else + return fib (n - 1) + fib (n - 2); +} + +if (fib (7) != 13) + error ("Something's wrong!"); diff --git a/test-suite/tests/ecmascript.test b/test-suite/tests/ecmascript.test index f15499c37..17036f93d 100644 --- a/test-suite/tests/ecmascript.test +++ b/test-suite/tests/ecmascript.test @@ -80,6 +80,7 @@ (with-test-prefix "compiler" (ecompile "true;" #t) + (ecompile "if (3 > 2) true; else false;" #t) (ecompile "2 + 2;" 4) (ecompile "\"hello\";" "hello") (ecompile "var test = { bar: 1 };") diff --git a/test-suite/tests/sxml.simple.test b/test-suite/tests/sxml.simple.test index 623f13e51..e52ba319d 100644 --- a/test-suite/tests/sxml.simple.test +++ b/test-suite/tests/sxml.simple.test @@ -1,6 +1,6 @@ ;;;; sxml.simple.test --- (sxml simple) -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2010 Free Software Foundation, Inc. +;;;; Copyright (C) 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 @@ -20,6 +20,8 @@ #:use-module (test-suite lib) #:use-module (sxml simple)) +(define parser-error '(parser-error . "")) + (define %xml-sample ;; An XML sample without any space in between tags, to make it easier. (string-append "<?xml version='1.0' encoding='utf-8'?>" @@ -50,3 +52,84 @@ (lambda () (sxml->xml (xml->sxml (open-input-string %xml-sample)))))))))) + +(with-test-prefix "namespaces" + (pass-if-equal + (xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>") + '(*TOP* (http://example.org/ns1:foo "text"))) + + (pass-if-equal + (xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>" + #:namespaces '((ns1 . "http://example.org/ns1"))) + '(*TOP* (ns1:foo "text"))) + + (pass-if-equal + (xml->sxml "<foo xmlns:bar=\"http://example.org/ns2\"><bar:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2"))) + '(*TOP* (foo (ns2:baz)))) + + (pass-if-equal + (xml->sxml "<foo><ns2:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2"))) + '(*TOP* (foo (ns2:baz)))) + + (pass-if-exception "namespace undeclared" parser-error + (xml->sxml "<foo><ns2:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2")) + #:declare-namespaces? #f))) + +(with-test-prefix "whitespace" + (pass-if-equal + (xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>") + '(*TOP* (foo "\n" (bar " Alfie the parrot! ") "\n"))) + + (pass-if-equal + (xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>" + #:trim-whitespace? #t) + '(*TOP* (foo (bar " Alfie the parrot! "))))) + +(with-test-prefix "parsed entities" + (pass-if-equal + '(*TOP* (foo "&")) + (xml->sxml "<foo>&</foo>")) + + (pass-if-exception "nbsp undefined" parser-error + (xml->sxml "<foo> </foo>")) + + (pass-if-equal + '(*TOP* (foo "\xA0")) + (xml->sxml "<foo> </foo>" + #:entities '((nbsp . "\xA0")))) + + (pass-if-equal + '(*TOP* (foo "\xA0")) + (xml->sxml "<foo> </foo>")) + + (let ((ents '())) + (pass-if-equal + (xml->sxml "<foo> &foo;</foo>" + #:default-entity-handler + (lambda (port name) + (case name + ((nbsp) "\xa0") + (else + (set! ents (cons name ents)) + "qux")))) + '(*TOP* (foo "\xa0 qux"))) + + (pass-if-equal + ents + '(foo)))) + +(with-test-prefix "doctype handlers" + (define (handle-foo docname systemid internal-subset) + (case docname + ((foo) + (values #:entities '((greets . "<i>Hello, world!</i>")))) + (else + (values)))) + + (pass-if-equal + (xml->sxml "<!DOCTYPE foo><p>&greets;</p>" + #:doctype-handler handle-foo) + '(*TOP* (p (i "Hello, world!"))))) diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index c344795ca..6d501ec1c 100644 --- a/test-suite/tests/tree-il.test +++ b/test-suite/tests/tree-il.test @@ -1415,11 +1415,11 @@ (number? (string-contains (car w) "wrong number of arguments"))))) - (pass-if "~%, ~~, ~&, ~t, ~_, and ~\\n" + (pass-if "~%, ~~, ~&, ~t, ~_, ~!, ~|, ~/, ~q and ~\\n" (null? (call-with-warnings (lambda () (compile '((@ (ice-9 format) format) some-port - "~&~3_~~ ~\n~12they~%") + "~&~3_~~ ~\n~12they~% ~!~|~/~q") #:opts %opts-w-format #:to 'assembly))))) @@ -1687,6 +1687,31 @@ #:opts %opts-w-format #:to 'assembly))))) + (pass-if "~^" + (null? (call-with-warnings + (lambda () + (compile '((@ (ice-9 format) format) #f "~a ~^ ~a" 0 1) + #:opts %opts-w-format + #:to 'assembly))))) + + (pass-if "~^, too few args" + (let ((w (call-with-warnings + (lambda () + (compile '((@ (ice-9 format) format) #f "~a ~^ ~a") + #:opts %opts-w-format + #:to 'assembly))))) + (and (= (length w) 1) + (number? (string-contains (car w) + "expected at least 1, got 0"))))) + + (pass-if "parameters: +,-,#, and '" + (null? (call-with-warnings + (lambda () + (compile '((@ (ice-9 format) format) some-port + "~#~ ~,,-2f ~,,+2f ~'A~" 1234 1234) + #:opts %opts-w-format + #:to 'assembly))))) + (pass-if "complex 1" (let ((w (call-with-warnings (lambda () |