summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore2
-rw-r--r--configure.ac9
-rw-r--r--doc/ref/compiler.texi3
-rw-r--r--doc/ref/sxml-match.texi10
-rw-r--r--doc/ref/sxml.texi1068
-rw-r--r--doc/ref/texinfo.texi14
-rw-r--r--doc/ref/web.texi6
-rw-r--r--libguile/memoize.c3
-rw-r--r--module/ice-9/psyntax-pp.scm101
-rw-r--r--module/ice-9/psyntax.scm63
-rw-r--r--module/language/assembly/spec.scm3
-rw-r--r--module/language/bytecode/spec.scm3
-rw-r--r--module/language/ecmascript/base.scm5
-rw-r--r--module/language/glil/spec.scm6
-rw-r--r--module/language/objcode/spec.scm3
-rw-r--r--module/language/tree-il/analyze.scm13
-rw-r--r--module/language/tree-il/spec.scm3
-rw-r--r--module/language/value/spec.scm3
-rw-r--r--module/oop/goops.scm15
-rw-r--r--module/oop/goops/active-slot.scm19
-rw-r--r--module/oop/goops/composite-slot.scm17
-rw-r--r--module/oop/goops/describe.scm17
-rw-r--r--module/oop/goops/save.scm41
-rw-r--r--module/sxml/simple.scm188
-rw-r--r--module/sxml/ssax.scm21
-rw-r--r--module/sxml/upstream/SSAX.scm31
-rw-r--r--module/system/base/language.scm4
-rw-r--r--module/system/repl/common.scm5
-rw-r--r--test-suite/standalone/Makefile.am7
-rwxr-xr-xtest-suite/standalone/test-language25
-rw-r--r--test-suite/standalone/test-language.el11
-rw-r--r--test-suite/standalone/test-language.js12
-rw-r--r--test-suite/tests/ecmascript.test1
-rw-r--r--test-suite/tests/sxml.simple.test85
-rw-r--r--test-suite/tests/tree-il.test29
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{&lt;}, @code{&gt;}, @code{&amp;},
+@code{&apos;} and @code{&quot;} 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>&amp;</foo>")
+@result{} (*TOP* (foo "&"))
+(xml->sxml "<foo>&nbsp;</foo>")
+@result{} error: undefined entity: nbsp
+(xml->sxml "<foo>&#xA0;</foo>")
+@result{} (*TOP* (foo "\xa0"))
+(xml->sxml "<foo>&nbsp;</foo>"
+ #:entities '((nbsp . "\xa0")))
+@result{} (*TOP* (foo "\xa0"))
+(xml->sxml "<foo>&nbsp; &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 . "&lt;&ent1;T;&gt;") (ent1 . "&amp;"))
`((,(string->symbol "Abc") . ,(unesc-string "<&>%n"))
(,(string->symbol "Next") . "12<&T;>34")))
+ (test "%tAbc='&lt;&amp;&gt;&#x0A;'%nNext='12&ent;34' />"
+ `((*DEFAULT* . ,(lambda (port name)
+ (case name
+ ((ent) "&lt;&ent1;T;&gt;")
+ ((ent1) "&amp;")
+ (else (error "unrecognized" name))))))
+ `((,(string->symbol "Abc") . ,(unesc-string "<&>%n"))
+ (,(string->symbol "Next") . "12<&T;>34")))
(assert (failed?
(test "%tAbc='&lt;&amp;&gt;&#x0A;'%nNext='12&ent;34' />"
'((ent . "<&ent1;T;&gt;") (ent1 . "&amp;")) '())))
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>&amp;</foo>"))
+
+ (pass-if-exception "nbsp undefined" parser-error
+ (xml->sxml "<foo>&nbsp;</foo>"))
+
+ (pass-if-equal
+ '(*TOP* (foo "\xA0"))
+ (xml->sxml "<foo>&nbsp;</foo>"
+ #:entities '((nbsp . "\xA0"))))
+
+ (pass-if-equal
+ '(*TOP* (foo "\xA0"))
+ (xml->sxml "<foo>&#xA0;</foo>"))
+
+ (let ((ents '()))
+ (pass-if-equal
+ (xml->sxml "<foo>&nbsp; &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 ()