[m-rev.] For review: Allow custom functor to element mappings in term_to_xml
Ian MacLarty
maclarty at cs.mu.OZ.AU
Thu Dec 9 12:33:27 AEDT 2004
Note: this is a part of a previous diff entitled "use XML browser to browse
terms in mdb" that has now been split into seperate changes.
Ian.
For review by anyone.
Estimated hours taken: 11
Branches: main
Allow custom functor to element mappings in term_to_xml library.
Disable setting of the `field' attribute in generated XML until a bug in the
runtime system has been fixed. The bug causes a seg fault when
construct.get_functor is called on a functor with an existentially quantified
argument type.
Add a check to see if a DTD can be generated for a type under a custom mapping
scheme. This involves checking that the mapping scheme does not generate the
same element for any two distinct functors that could appear in ground terms of
the type.
Also do not generate DTDs for types other that discriminated unions, arrays,
strings, ints, characters and floats since we cannot predict what the children
will be for other types (e.g. curried preds). Note that XML can still
be generated for any type deconstruct.deconstruct/5 can handle.
extras/xml_stylesheets/xul_tree.xsl
Hide the field name by default (since we don't populate this attribute
at the moment).
Fix a bug where quotes were not being printed around strings.
The `typename' attribute has now become simply `type'.
library/term_to_xml.m
Allow custom functor to element mappings and include two predefined
mappings.
Do not call construct.get_functor when writing out an XML document so
that the previously mentioned runtime bug doesn't bite. This is one
line of code that just needs to be uncommented when the bug is fixed -
the line is responsible for getting the field names of the arguments of
a functor.
Check that a mapping scheme cannot assign the same element to
two different functors when a DTD is requested.
tests/hard_coded/write_xml.m
tests/hard_coded/write_xml.exp
Test custom and predefined mapping schemes.
Index: extras/xml_stylesheets/xul_tree.xsl
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/xml_stylesheets/xul_tree.xsl,v
retrieving revision 1.1
diff -u -r1.1 xul_tree.xsl
--- extras/xml_stylesheets/xul_tree.xsl 7 Dec 2004 04:55:49 -0000 1.1
+++ extras/xml_stylesheets/xul_tree.xsl 8 Dec 2004 14:37:06 -0000
@@ -32,6 +32,7 @@
<xsl:attribute name="id">field</xsl:attribute>
<xsl:attribute name="label">Field Name</xsl:attribute>
<xsl:attribute name="flex">1</xsl:attribute>
+ <xsl:attribute name="hidden">true</xsl:attribute>
</xsl:element>
<xsl:element name="splitter">
<xsl:attribute name="class">tree-splitter</xsl:attribute>
@@ -82,7 +83,7 @@
<xsl:element name="treerow">
<xsl:element name="treecell">
<xsl:choose>
- <xsl:when test="@name='String'">
+ <xsl:when test="name()='String'">
<xsl:attribute name="label">"<xsl:value-of select="." />"</xsl:attribute>
</xsl:when>
<xsl:otherwise>
@@ -96,7 +97,7 @@
</xsl:attribute>
</xsl:element>
<xsl:element name="treecell">
- <xsl:attribute name="label">string</xsl:attribute>
+ <xsl:attribute name="label"><xsl:value-of select="@type" /></xsl:attribute>
</xsl:element>
<xsl:element name="treecell">
<xsl:attribute name="label">
@@ -162,7 +163,7 @@
</xsl:element>
<xsl:element name="treecell">
<xsl:attribute name="label">
- <xsl:value-of select="@typename" />
+ <xsl:value-of select="@type" />
</xsl:attribute>
</xsl:element>
<xsl:element name="treecell">
Index: library/term_to_xml.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term_to_xml.m,v
retrieving revision 1.1
diff -u -r1.1 term_to_xml.m
--- library/term_to_xml.m 7 Dec 2004 04:55:49 -0000 1.1
+++ library/term_to_xml.m 9 Dec 2004 01:14:30 -0000
@@ -14,31 +14,25 @@
% an output stream as XML.
%
% Each functor in a term is given a corresponding well-formed element name
-% in the XML document.
+% in the XML document according to a mapping. Some predefined mappings are
+% prodice, but user defined mappings may also be used.
%
-% The element names `String', `Int', `Char' and `Float' are reserved for the
-% corresponding Mercury builtin types. The values for these elements are
-% stored as parsed characater data inside the element.
-%
-% Elements for discriminated unions get their name from the functor name and
-% the type name. Array element names consist of the string "Array--" followed
-% by the type name of the elements of the array. All other types are assigned
-% the reserved `Unrecognised' element name.
-%
-% Each element (including `Unrecognised') may also have certain attributes set:
+% The following attributes can be set for each XML element:
%
% functor - the original functor name as returned by
-% deconstruct.deconstruct/5. This attribute will be present for
-% every element except elements for builtin types.
-%
-% typename - the type name of the Mercury type the element represents.
-% This attribute will also always be present for all elements except
-% elements for builtin types.
+% deconstruct.deconstruct/5.
+%
+% arity - the arity of the functor as returned by deconstruct.deconstruct/5.
+%
+% type - the type name of the Mercury type the element represents.
+%
+% field - the field name of a discriminated union functor argument if it has
+% one. XXX Currently field attribute values are not set because of a bug
+% in the runtime system.
%
-% field - discriminated union functor arguments (including those with a
-% builtin type) that have a field name will have this attribute set.
+% The names of the above attributes can also be customized.
%
-% The XML document can also be annotated with a stylesheet reference. Once a
+% The XML document can be annotated with a stylesheet reference. Once a
% Mercury term is in XML it can be converted to many different formats using
% the appropriate stylesheet. For example in the extras/xml_stylesheets
% distribution there are stylesheets to convert XML documents generated with
@@ -47,6 +41,21 @@
%
% To support third parties generating XML which is compatible with the XML
% generated by this library, a DTD for a Mercury type can also be generated.
+% A DTD for a given type and functo-to-element mapping may be generated
+% provided the following conditions hold:
+%
+% 1. If the type is a discriminated union then there must be only
+% one top-level functor for the type. This is because the top
+% level functor will be used to generate the document type name.
+%
+% 2. The provided functor to element mapping must map each functor
+% to a unique element name for every functor that could appear in
+% terms of the type.
+%
+% 3. Only types whose terms consist of discriminated unions, arrays
+% and the builtin types `int', `string', `character' and `float' can be
+% used to automatically generate DTDs. This list may be extended in the
+% future.
%
% The generated DTD is also a good reference when creating a stylesheet as
% it contains comments describing the mapping from functors to elements.
@@ -57,17 +66,10 @@
:- module term_to_xml.
:- interface.
-:- import_module io, int, deconstruct, std_util.
+:- import_module io, int, deconstruct, std_util, list.
%-----------------------------------------------------------------------------%
-:- type maybe_stylesheet
- ---> with_stylesheet(
- stylesheet_type :: string,
- stylesheet_href :: string
- )
- ; no_stylesheet.
-
% Values of this type specify the DOCTYPE of an XML document when
% the DOCTYPE is defined by an external DTD.
%
@@ -80,177 +82,349 @@
% a generated XML document and if so how.
%
:- type maybe_dtd
- % Embed the entire DTD in the document.
+ % Generate and embed the entire DTD in the document.
---> embed
% Included a reference to an external DTD.
; external(doctype)
% Do not include any DOCTYPE information.
; no_dtd.
+ % Values of this type indicate whether a stylesheet reference should be
+ % included in a generated XML document.
+:- type maybe_stylesheet
+ ---> with_stylesheet(
+ stylesheet_type :: string, % For example "text/xsl"
+ stylesheet_href :: string
+ )
+ ; no_stylesheet.
+
% Values of this type indicate whether a DTD was successfully
% generated or not. A DTD cannot be generated for a type with more
% than one top-level functor since only one root element can be
- % specified by a DTD.
+ % specified by a DTD. A DTD also cannot be generated for a
+ % type where the mapping from functors of the type to
+ % elements is not unique (since then the legal children DTD rules
+ % cannot be expressed properly).
%
:- type dtd_generation_result
---> ok
- ; multiple_functors_for_root.
-
- % write_xml_doc(Term, MaybeStyleSheet, MaybeDTD, DTDResult, !IO).
- % Write Term to the current output stream as an XML document.
+ % The root type is a discriminated union with
+ % multiple functors.
+ %
+ ; multiple_functors_for_root
+
+ % The functor-to-element mapping maps different
+ % functors to the same element. The duplicate element
+ % and a list of types whose functors map to that
+ % element is given.
+ %
+ ; duplicate_elements(
+ duplicate_element :: string,
+ duplicate_types :: list(type_desc)
+ )
+ ;
+ % At the moment we only support generation of DTDs for
+ % types made up of discriminated unions, arrays,
+ % strings, ints, characters and floats.
+ %
+ unsupported_dtd_type(type_desc).
+
+ % Values of this type specify what mapping from functors to elements
+ % to use when generating XML. The role of a mapping is two fold:
+ % 1. To map functors to elements, and
+ % 2. To map functors to a set of attributes that should be
+ % set for the corresponding element.
+ %
+ % We provide two predefined mappings:
+ %
+ % 1. simple: The functors `[]', `[|]' and `{}' are mapped to the
+ % elements `List', `Nil' and `Tuple' respectively. Arrays are
+ % assigned the `Array' element. The builtin types are assigned
+ % the elements `Int', `String', `Float' and `Char'. All other
+ % functors are assigned elements with the same name as the
+ % functor provided the funtor name is well formed and does
+ % not start with a capital letter. Otherwise a mangled
+ % version of the functor name is used.
+ %
+ % All elements except `Int', `String', `Float' and `Char'
+ % will have their `functor', `arity', `type' and `field' (if
+ % there is a field name) attrinutes set. `Int', `String',
+ % `Float' and `Char' elements will just have their `type' and
+ % possibly their `field' attributes set.
+ %
+ % The `simple' mapping is designed to be easy to read and use,
+ % but may result in the same element being assigned to different
+ % functors.
+ %
+ % 2. unique: Here we use the same mapping as `simple' except
+ % we append the fuctor arity for discriminated unions and
+ % a mangled version of the type name for every element. The same
+ % attributes as the `simple' scheme are provided. The advantage
+ % of this scheme is that it maps each functor to a unique
+ % element. This means that it will always be possible to
+ % generate a DTD using this mapping so long as there is only
+ % one top level functor and no unsupported types can appear in
+ % terms of the type.
+ %
+ % A custom mapping can be provided using the `custom' functor. See the
+ % documentation for the element_pred type below for more information.
+ %
+:- type element_mapping
+ ---> simple
+ ; unique
+ ; custom(element_pred).
+
+:- inst element_mapping
+ ---> simple
+ ; unique
+ ; custom(element_pred).
+
+ % write_xml_doc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ % DTDResult, !IO).
+ % Write Term to the current output stream as an XML document using
+ % ElementMapping as the scheme to map functors to elements.
% MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
% reference and/or a DTD should be included. Any non-canonical terms
- % will be canonicalized. If an embedded DTD was requested and the type
- % has more than one top level functor then multiple_functors_for_root
- % will be returned in DTDResult and nothing will be written.
+ % will be canonicalized. If an embedded DTD is requested, but it is
+ % not possible to generated a DTD for Term using ElementMapping, then a
+ % value other than `ok' is returned in DTDResult and nothing is written
+ % out. See the documentatin of the dtd_generation_result type for more
+ % information of DTDResult when it is not `ok'.
%
-:- pred write_xml_doc(T::in, maybe_stylesheet::in, maybe_dtd::in,
+:- pred write_xml_doc(T::in, element_mapping::in(element_mapping),
+ maybe_stylesheet::in, maybe_dtd::in,
dtd_generation_result::out, io::di, io::uo) is det.
- % write_xml_doc(Stream, Term, MaybeStyleSheet, MaybeDTD, DTDResult,
- % !IO).
- % Same as write_xml_doc/5 except write the XML doc to the given
+ % write_xml_doc(Stream, Term, ElementMapping, MaybeStyleSheet,
+ % MaybeDTD, DTDResult, !IO).
+ % Same as write_xml_doc/7 except write the XML doc to the given
% output stream.
%
-:- pred write_xml_doc(io.output_stream::in, T::in, maybe_stylesheet::in,
+:- pred write_xml_doc(io.output_stream::in, T::in,
+ element_mapping::in(element_mapping), maybe_stylesheet::in,
maybe_dtd::in, dtd_generation_result::out, io::di, io::uo) is det.
- % write_xml_doc_cc(Term, MaybeStyleSheet, MaybeDTD, DTDResult, !IO).
- % Write Term to the current output stream as an XML document.
+ % write_xml_doc_cc(Term, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ % DTDResult, !IO).
+ % Write Term to the current output stream as an XML document using
+ % ElementMapping as the scheme to map functors to elements.
% MaybeStyleSheet and MaybeDTD specify whether or not a stylesheet
% reference and/or a DTD should be included. Any non-canonical terms
- % will be be written out in full. If an embedded DTD was requested and
- % the type has more than one top level functor then
- % multiple_functors_for_root will be returned in DTDResult and nothing
- % will be written.
- %
-:- pred write_xml_doc_cc(T::in, maybe_stylesheet::in, maybe_dtd::in,
- dtd_generation_result::out, io::di, io::uo) is cc_multi.
-
- % write_xml_doc_cc(Stream, Term, MaybeStyleSheet, MaybeDTD, DTDResult,
- % !IO).
- % Same as write_xml_doc/5 except write the XML doc to the given
+ % will be be written out in full. If an embedded DTD is requested, but
+ % it is not possible to generated a DTD for Term using ElementMapping,
+ % then a value other than `ok' is returned in DTDResult and nothing is
+ % written out. See the documentatin of the dtd_generation_result type
+ % for more information on the meaning of DTDResult when it is not `ok'.
+ %
+:- pred write_xml_doc_cc(T::in, element_mapping::in(element_mapping),
+ maybe_stylesheet::in, maybe_dtd::in, dtd_generation_result::out,
+ io::di, io::uo) is cc_multi.
+
+ % write_xml_doc_cc(Stream, Term, ElementMapping, MaybeStyleSheet,
+ % MaybeDTD, DTDResult, !IO).
+ % Same as write_xml_doc/7 except write the XML doc to the given
% output stream.
%
-:- pred write_xml_doc_cc(io.output_stream::in, T::in, maybe_stylesheet::in,
+:- pred write_xml_doc_cc(io.output_stream::in, T::in,
+ element_mapping::in(element_mapping), maybe_stylesheet::in,
maybe_dtd::in, dtd_generation_result::out, io::di, io::uo) is cc_multi.
- % True if the given type doesn not have multiple top level functors.
- %
-:- pred ok_to_generate_dtd(type_desc::in) is semidet.
-
- % write_dtd(Term, DTDResult, !IO).
- % Write a DTD for the given term to the current output stream. If the
- % type of Term has more than one top level functor then
- % multiple_functors_for_root will be returned in DTDResult and
- % nothing will be written, otherwise ok is returned in DTDResult.
+ % check_ok_to_generate_dtd(ElementMapping, Type, Result).
+ % Check if a DTD can be generated for the given Type using the
+ % functor-to-element mapping scheme ElementMapping. Result will be
+ % `ok' if it is possible to generate a DTD and will be another value
+ % otherwise. See the documentation of the dtd_generation_result type
+ % for the meaning of Result when it is not `ok'.
+ %
+:- pred check_ok_to_generate_dtd(element_mapping::in(element_mapping),
+ type_desc::in, dtd_generation_result::out) is det.
+
+ % write_dtd(Term, ElementMapping, DTDResult, !IO).
+ % Write a DTD for the given term to the current output stream using
+ % ElementMapping to map functors to elements. If a DTD
+ % cannot be generated for Term using ElementMapping then a value
+ % other than `ok' is returned in DTDResult and nothing is written.
+ % See the documentation of the dtd_generation_result type for the
+ % meaning of Result when it is not `ok'.
%
-:- pred write_dtd(T::unused, dtd_generation_result::out, io::di, io::uo)
- is det.
+:- pred write_dtd(T::unused, element_mapping::in(element_mapping),
+ dtd_generation_result::out, io::di, io::uo) is det.
- % write_dtd(Stream, Term, DTDResult, !IO).
- % Write a DTD for the given term to the specified output stream. If the
- % type of Term has more than one top level functor then
- % multiple_functors_for_root will be returned in DTDResult and
- % nothing will be written, otherwise ok is returned in DTDResult.
+ % write_dtd(Stream, Term, ElementMapping, DTDResult, !IO).
+ % Same as write_dtd/5 except the DTD will be written to the given
+ % output stream.
%
-:- pred write_dtd(io.output_stream::in, T::unused, dtd_generation_result::out,
+:- pred write_dtd(io.output_stream::in, T::unused,
+ element_mapping::in(element_mapping), dtd_generation_result::out,
io::di, io::uo) is det.
- % write_dtd_for_type(Type, DTDResult, !IO).
- % Write a DTD for the given type to the current output stream. If the
- % type has more than one top level functor then
- % multiple_functors_for_root will be returned in DTDResult and nothing
- % will be written, otherwise ok is returned in DTDResult.
+ % write_dtd_for_type(Type, ElementMapping, DTDResult, !IO).
+ % Write a DTD for the given type to the current output stream. If a DTD
+ % cannot be generated for Type using ElementMapping then a value
+ % other than `ok' is returned in DTDResult and nothing is written.
+ % See the documentation of the dtd_generation_result type for the
+ % meaning of Result when it is not `ok'.
%
-:- pred write_dtd_from_type(type_desc::in, dtd_generation_result::out,
+:- pred write_dtd_from_type(type_desc::in,
+ element_mapping::in(element_mapping), dtd_generation_result::out,
io::di, io::uo) is det.
- % write_dtd_for_type(Stream, Type, DTDResult, !IO).
- % Write a DTD for the given type to the given output stream. If the
- % type has more than one top level functor then
- % multiple_functors_for_root will be returned in DTDResult and nothing
- % will be written, otherwise ok is returned in DTDResult.
+ % write_dtd_for_type(Stream, Type, ElementMapping, DTDResult, !IO).
+ % Same as write_dtd_for_type/5 except the DTD will be written to the
+ % given output stream.
%
:- pred write_dtd_from_type(io.output_stream::in, type_desc::in,
+ element_mapping::in(element_mapping),
dtd_generation_result::out, io::di, io::uo) is det.
- % write_xml_element(NonCanon, IndentLevel, Term, !IO).
+ % write_xml_element(NonCanon, MakeElement, IndentLevel, Term, !IO).
% Write XML elements for the given term and all its descendents,
% using IndentLevel as the initial indentation level (each
- % indentation level is one space character). No <?xml ... ?>
+ % indentation level is one tab character) and using the MakeElement
+ % predicate to map functors to elements. No <?xml ... ?>
% header will be written. Non-canonical terms will be handled
% according to the value of NonCanon. See the deconstruct
% module in the standard library for more information on this argument.
%
-:- pred write_xml_element(deconstruct.noncanon_handling, int, T, io, io).
-:- mode write_xml_element(in(do_not_allow), in, in, di, uo) is det.
-:- mode write_xml_element(in(canonicalize), in, in, di, uo) is det.
-:- mode write_xml_element(in(include_details_cc), in, in, di, uo) is cc_multi.
-:- mode write_xml_element(in, in, in, di, uo) is cc_multi.
+:- pred write_xml_element(deconstruct.noncanon_handling,
+ element_pred, int, T, io, io).
+:- mode write_xml_element(in(do_not_allow), in(element_pred), in, in, di, uo)
+ is det.
+:- mode write_xml_element(in(canonicalize), in(element_pred), in, in, di, uo)
+ is det.
+:- mode write_xml_element(in(include_details_cc), in(element_pred), in, in,
+ di, uo) is cc_multi.
+:- mode write_xml_element(in, in(element_pred), in, in, di, uo) is cc_multi.
+
+ % Deterministic procedures with the following signature can be used as
+ % custom functor to element mappings. The inputs to the procedure are
+ % a type and some information about the required functor for that type
+ % if the type is a discriminated union. The output should be a well
+ % formed XML element name and a list of attributes that should be set
+ % for that element. See the types `maybe_functor_info' and
+ % `attribute' below.
+ %
+:- type element_pred == (pred(type_desc, maybe_functor_info, string,
+ list(attribute))).
+
+:- inst element_pred == (pred(in, in, out, out) is det).
+
+ % Values of this type are passed to custom functor-to-element
+ % mapping predicates to tell the predicate which functor to generate
+ % an element name for if the type is a discriminated union. If the
+ % type is not a discriminated union, then not_a_du is passed to
+ % the predicate when requesting an element for the type.
+ %
+:- type maybe_functor_info
+ % The functor's name and arity.
+ ---> du_functor(
+ functor_name :: string,
+ functor_arity :: int
+ )
+ % The type is not a discriminated union.
+ ; not_a_du.
+
+ % Values of this type specify attributes that should be set by
+ % particular element. The attribute_name field specifys the name
+ % of the attribute in the generated XML and the attribute_source
+ % field indicates where the attributes value should come from.
+ %
+:- type attribute
+ ---> attribute(
+ attribute_name :: string,
+ attribute_source :: attribute_source
+ ).
+
+ % Possible attribute sources.
+ %
+:- type attribute_source
+ % The original functor name as returned by
+ % deconstruct.deconstruct/5.
+ ---> functor
+ % The field name if the functor appears in a
+ % named field (If the field is not named then this
+ % attribute is omitted.
+ ; field_name
+ % The fully qualified type name the functor is for.
+ ; type_name
+ % The arity of the functor as returned by
+ % deconstruct.deconstruct/5.
+ ; arity.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module string, list, char, bool, array.
-:- import_module exception, map.
+:- import_module string, char, bool, array.
+:- import_module exception, map, require.
%-----------------------------------------------------------------------------%
-write_xml_doc(X, MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
+write_xml_doc(X, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
+ check_ok_to_generate_dtd(MaybeDTD, ElementMapping, type_of(X),
+ DTDResult),
(
- ( MaybeDTD \= embed ; ok_to_generate_dtd(type_of(X)) )
+ DTDResult = ok
->
- DTDResult = ok,
+ get_element_pred(ElementMapping, MakeElement),
write_xml_header(no, !IO),
write_stylesheet_ref(MaybeStyleSheet, !IO),
- write_doctype(canonicalize, X, MaybeDTD, _, !IO),
- write_xml_element(canonicalize, 0, X, !IO)
+ write_doctype(canonicalize, X, ElementMapping, MaybeDTD, _,
+ !IO),
+ write_xml_element(canonicalize, MakeElement, 0, X, !IO)
;
- DTDResult = multiple_functors_for_root
+ true
).
-write_xml_doc(Stream, X, MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
+write_xml_doc(Stream, X, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_xml_doc(X, MaybeStyleSheet, MaybeDTD, DTDResult, !IO),
+ write_xml_doc(X, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult,
+ !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_xml_doc_cc(X, MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
+write_xml_doc_cc(X, ElementMapping, MaybeStyleSheet, MaybeDTD, DTDResult,
+ !IO) :-
+ check_ok_to_generate_dtd(MaybeDTD, ElementMapping, type_of(X),
+ DTDResult),
(
- ( MaybeDTD = embed ; ok_to_generate_dtd(type_of(X)) )
+ DTDResult = ok
->
- DTDResult = ok,
+ get_element_pred(ElementMapping, MakeElement),
write_xml_header(no, !IO),
write_stylesheet_ref(MaybeStyleSheet, !IO),
- write_doctype(include_details_cc, X, MaybeDTD, _, !IO),
- write_xml_element(include_details_cc, 0, X, !IO)
+ write_doctype(include_details_cc, X, ElementMapping, MaybeDTD,
+ _, !IO),
+ write_xml_element(include_details_cc, MakeElement, 0, X, !IO)
;
- DTDResult = multiple_functors_for_root
+ true
).
-write_xml_doc_cc(Stream, X, MaybeStyleSheet, MaybeDTD, DTDResult, !IO) :-
+write_xml_doc_cc(Stream, X, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_xml_doc_cc(X, MaybeStyleSheet, MaybeDTD, DTDResult, !IO),
+ write_xml_doc_cc(X, ElementMapping, MaybeStyleSheet, MaybeDTD,
+ DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_xml_element(NonCanon, IndentLevel, X, !IO) :-
+write_xml_element(NonCanon, MakeElement, IndentLevel, X, !IO) :-
type_to_univ(X, Univ),
- write_xml_element_univ(NonCanon, IndentLevel, Univ, [], _, !IO).
+ write_xml_element_univ(NonCanon, MakeElement, IndentLevel, Univ, [], _,
+ !IO).
-write_dtd(Term, DTDResult, !IO) :-
+write_dtd(Term, ElementMapping, DTDResult, !IO) :-
type_of(Term) = TypeDesc,
- write_dtd_from_type(TypeDesc, DTDResult, !IO).
+ write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO).
-write_dtd(Stream, Term, DTDResult, !IO) :-
+write_dtd(Stream, Term, ElementMapping, DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_dtd(Term, DTDResult, !IO),
+ write_dtd(Term, ElementMapping, DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
-write_dtd_from_type(Stream, TypeDesc, DTDResult, !IO) :-
+write_dtd_from_type(Stream, TypeDesc, ElementMapping, DTDResult, !IO) :-
io.set_output_stream(Stream, OrigStream, !IO),
- write_dtd_from_type(TypeDesc, DTDResult, !IO),
+ write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO),
io.set_output_stream(OrigStream, _, !IO).
:- pred write_xml_header(maybe(string)::in, io::di, io::uo) is det.
@@ -277,20 +451,32 @@
io.write_string(Href, !IO),
io.write_string("""?>\n", !IO).
-:- pred write_doctype(deconstruct.noncanon_handling, T, maybe_dtd,
- dtd_generation_result, io, io).
-:- mode write_doctype(in(canonicalize), in, in, out, di, uo) is det.
-:- mode write_doctype(in(do_not_allow), in, in, out, di, uo) is det.
-:- mode write_doctype(in(include_details_cc), in, in, out, di, uo) is cc_multi.
-:- mode write_doctype(in, in, in, out, di, uo) is cc_multi.
-
-write_doctype(_, _, no_dtd, ok, !IO).
-write_doctype(_, T, embed, DTDResult, !IO) :-
- write_dtd(T, DTDResult, !IO),
+:- pred write_doctype(deconstruct.noncanon_handling, T, element_mapping,
+ maybe_dtd, dtd_generation_result, io, io).
+:- mode write_doctype(in(canonicalize), in, in(element_mapping), in, out,
+ di, uo) is det.
+:- mode write_doctype(in(do_not_allow), in, in(element_mapping), in, out,
+ di, uo) is det.
+:- mode write_doctype(in(include_details_cc), in, in(element_mapping), in, out,
+ di, uo) is cc_multi.
+:- mode write_doctype(in, in, in(element_mapping), in, out,
+ di, uo) is cc_multi.
+
+write_doctype(_, _, _, no_dtd, ok, !IO).
+write_doctype(_, T, ElementMapping, embed, DTDResult, !IO) :-
+ write_dtd(T, ElementMapping, DTDResult, !IO),
io.nl(!IO).
-write_doctype(NonCanon, T, external(DocType), ok, !IO) :-
- deconstruct.deconstruct(T, NonCanon, Functor, _, _),
- Root = get_element(type_of(T), from_functor_name(Functor)),
+write_doctype(NonCanon, T, ElementMapping, external(DocType), ok, !IO) :-
+ get_element_pred(ElementMapping, MakeElement),
+ deconstruct.deconstruct(T, NonCanon, Functor, Arity, _),
+ (
+ is_discriminated_union(type_of(T), _)
+ ->
+ Request = du_functor(Functor, Arity)
+ ;
+ Request = not_a_du
+ ),
+ MakeElement(type_of(T), Request, Root, _),
io.write_string("<!DOCTYPE ", !IO),
io.write_string(Root, !IO),
(
@@ -310,10 +496,98 @@
),
io.write_string(""">\n", !IO).
+ % Implementation of the `unique' predefined mapping scheme.
+ %
+:- pred make_unique_element(type_desc::in, maybe_functor_info::in,
+ string::out, list(attribute)::out) is det.
+
+% XXX This should be uncommented once memoing can be switched off for grades
+% which don't support it.
+% :- pragma memo(make_unique_element/4).
+
+make_unique_element(TypeDesc, du_functor(Functor, Arity), Element,
+ all_attributes) :-
+ (
+ common_mercury_functor(Functor, ReservedElement)
+ ->
+ MangledElement = ReservedElement
+ ;
+ MangledElement = mangle(Functor)
+ ),
+ Element = MangledElement ++ "--" ++ string.int_to_string(Arity) ++
+ "--" ++ mangle(type_name(TypeDesc)).
+make_unique_element(TypeDesc, not_a_du, Element, Attributes) :-
+ (
+ is_primitive_type(TypeDesc, PrimitiveElement)
+ ->
+ Element = PrimitiveElement,
+ Attributes = [attribute("type", type_name),
+ attribute("field", field_name)]
+ ;
+ is_array(TypeDesc, _)
+ ->
+ Element = array_element ++ "--" ++ mangle(type_name(TypeDesc)),
+ Attributes = all_attributes
+ ;
+ Element = mangle(type_name(TypeDesc)),
+ Attributes = all_attributes
+ ).
+
+ % Implementation of the `simple' mapping scheme.
+ %
+:- pred make_simple_element(type_desc::in, maybe_functor_info::in,
+ string::out, list(attribute)::out) is det.
+
+% XXX This should be uncommented once memoing can be switched off for grades
+% which don't support it.
+% :- pragma memo(make_simple_element/4).
+
+make_simple_element(_, du_functor(Functor, _), Element, all_attributes) :-
+ (
+ common_mercury_functor(Functor, ReservedElement)
+ ->
+ Element = ReservedElement
+ ;
+ Element = mangle(Functor)
+ ).
+make_simple_element(TypeDesc, not_a_du, Element, Attributes) :-
+ (
+ is_primitive_type(TypeDesc, PrimitiveElement)
+ ->
+ Element = PrimitiveElement,
+ Attributes = [attribute("type", type_name),
+ attribute("field", field_name)]
+ ;
+ is_array(TypeDesc, _)
+ ->
+ Element = array_element,
+ Attributes = all_attributes
+ ;
+ Element = "Unknown",
+ Attributes = all_attributes
+ ).
+
+:- func all_attributes = list(attribute).
+
+all_attributes = [
+ attribute("functor", functor),
+ attribute("field", field_name),
+ attribute("type", type_name),
+ attribute("arity", arity)
+ ].
+
+:- pred get_element_pred(element_mapping::in(element_mapping),
+ element_pred::out(element_pred)) is det.
+
+get_element_pred(simple, make_simple_element).
+get_element_pred(unique, make_unique_element).
+get_element_pred(custom(P), P).
+
%-----------------------------------------------------------------------------%
%
-% Some reserved element names. Reserved element names all start with a
-% capital letter so as not to conflict with a mangled element name.
+% Some reserved element names for the predefined mapping schemes. Reserved
+% element names all start with a capital letter so as not to conflict with a
+% mangled element name.
%
% A prefix for functors that start with a capital letter or
@@ -334,13 +608,6 @@
common_mercury_functor("[]", "Nil").
common_mercury_functor("{}", "Tuple").
- % A general element for types whose structure we do not generate
- % DTD rules for.
- %
-:- func unrecognized_element = string.
-
-unrecognized_element = "Unrecognized".
-
:- func array_element = string.
array_element = "Array".
@@ -417,101 +684,66 @@
%-----------------------------------------------------------------------------%
-:- type element_request
- ---> from_functor_name(string)
- ; from_functor_num(int).
+ % Return a list of elements, functors and arities
+ % (if the type is a discriminated union), argument types and
+ % attributes for all the functors for the type. Only one element
+ % will be in each list if the type is not a discriminated union.
+ %
+:- pred get_elements_and_args(element_pred::in(element_pred),
+ type_desc::in, list(string)::out, list(maybe(string))::out,
+ list(maybe(int))::out, list(list(type_desc))::out,
+ list(list(attribute))::out) is det.
% XXX This should be uncommented once memoing can be switched off for grades
% which don't support it.
-% :- pragma memo(get_element/2).
-
- % Return an element for a functor for the type.
- %
-:- func get_element(type_desc, element_request) = string.
-
-get_element(TypeDesc, ElementRequest) = Element :-
- (
- (
- ElementRequest = from_functor_num(FunctorNum),
- get_functor(TypeDesc, FunctorNum, Functor, _, _)
- ;
- ElementRequest = from_functor_name(Functor),
- is_discriminated_union(TypeDesc, _)
- )
- ->
- (
- common_mercury_functor(Functor, ReservedElement)
- ->
- MangledElement = ReservedElement
- ;
- MangledElement = mangle(Functor)
- ),
- MangledType = "--" ++ mangle(type_name(TypeDesc))
- ;
- is_primitive_type(TypeDesc, PrimitiveElement)
- ->
- % primitive element names are reserved, so no mangling is
- % required.
- MangledElement = PrimitiveElement,
- MangledType = ""
- ;
- is_array(TypeDesc, _)
- ->
- % array element name is also reserved.
- MangledElement = array_element,
- MangledType = "--" ++ mangle(type_name(TypeDesc))
- ;
- MangledElement = unrecognized_element,
- MangledType = ""
- ),
- Element = MangledElement ++ MangledType.
-
- % Return a list of elements and argument types for all the
- % functors in a discriminated union or a list with just one
- % element for the type if it's not a du.
- %
-:- pred get_elements_and_args(type_desc::in, list(string)::out,
- list(string)::out, list(list(type_desc))::out) is det.
+% :- pragma memo(get_elements_and_args/7).
-get_elements_and_args(TypeDesc, Elements, Functors, MaybeArgTypeLists) :-
- NumFunctors = num_functors(TypeDesc),
+get_elements_and_args(MakeElement, TypeDesc, Elements, MaybeFunctors,
+ MaybeArities, ArgTypeLists, AttributeLists) :-
(
- NumFunctors > 0
+ is_discriminated_union(TypeDesc, NumFunctors)
->
FunctorNums = 0 `..` (NumFunctors - 1),
- Elements = list.map(func(X) = get_element(TypeDesc,
- from_functor_num(X)), FunctorNums),
(
list.map3(get_functor(TypeDesc), FunctorNums,
- Functors0, _, MaybeArgTypeLists0)
+ Functors, Arities, ArgTypeLists0)
->
- Functors = Functors0,
- MaybeArgTypeLists = MaybeArgTypeLists0
+ list.map(yessify, Functors, MaybeFunctors),
+ list.map(yessify, Arities, MaybeArities),
+ ArgTypeLists = ArgTypeLists0,
+ Requests = list.map_corresponding(make_du_functor,
+ Functors, Arities),
+ P = (pred(A::in, B::out, C::out) is det :-
+ MakeElement(TypeDesc, A, B, C)),
+ list.map2(P, Requests, Elements, AttributeLists)
;
- throw(term_to_xml_internal_error("get_elements_and_args",
+ throw(software_error(
+ "term_to_xml.get_elements_and_args: " ++
"get_functor failed for discriminated union"))
)
;
- Elements = [get_element(TypeDesc, from_functor_num(0))],
+ MakeElement(TypeDesc, not_a_du, Element, Attributes),
+ Elements = [Element],
+ AttributeLists = [Attributes],
+ MaybeFunctors = [no],
+ MaybeArities = [no],
(
is_array(TypeDesc, ArgType)
->
- MaybeArgTypeLists = [[ArgType]],
- array.from_list([1], Array),
- % We want the same functor name returned by
- % deconstruct so it matches the "functor" field in
- % the `Array--*' element.
- deconstruct.deconstruct(Array, canonicalize, Functor,
- _, _),
- Functors = [Functor]
+ ArgTypeLists = [[ArgType]]
;
- MaybeArgTypeLists = [[]],
- % We make these the same so the "functor" attribute
- % isn't fixed.
- Functors = Elements
+ ArgTypeLists = [[]]
)
).
+:- pred yessify(T::in, maybe(T)::out) is det.
+
+yessify(X, yes(X)).
+
+:- func make_du_functor(string, int) = maybe_functor_info.
+
+make_du_functor(Functor, Arity) = du_functor(Functor, Arity).
+
:- pred primitive_value(univ::in, string::out) is semidet.
primitive_value(Univ, PrimValue) :-
@@ -535,22 +767,23 @@
%-----------------------------------------------------------------------------%
:- pred write_xml_element_univ(deconstruct.noncanon_handling,
- int, univ, list(maybe(string)), list(maybe(string)), io, io).
-:- mode write_xml_element_univ(in(do_not_allow), in, in, in, out, di, uo)
- is det.
-:- mode write_xml_element_univ(in(canonicalize), in, in, in, out, di, uo)
- is det.
-:- mode write_xml_element_univ(in(include_details_cc), in, in, in, out,
- di, uo) is cc_multi.
-:- mode write_xml_element_univ(in, in, in, in, out, di, uo) is cc_multi.
+ element_pred, int, univ, list(maybe(string)),
+ list(maybe(string)), io, io).
+:- mode write_xml_element_univ(in(do_not_allow), in(element_pred), in, in,
+ in, out, di, uo) is det.
+:- mode write_xml_element_univ(in(canonicalize), in(element_pred), in, in,
+ in, out, di, uo) is det.
+:- mode write_xml_element_univ(in(include_details_cc), in(element_pred), in,
+ in, in, out, di, uo) is cc_multi.
+:- mode write_xml_element_univ(in, in(element_pred), in, in, in, out, di, uo)
+ is cc_multi.
% Write an element and all it's descendents to the current output
- % stream.
- % If MaybeFields isn't empty then its head is used for the "field"
- % attribute and the Tail is returned in RemainingMaybeFieldNames.
- % This is so it can be called using foldl2.
+ % stream. If MaybeFields isn't empty then its head is used for the
+ % `field' attribute and the Tail is returned in
+ % RemainingMaybeFieldNames. This is so it can be called using foldl2.
%
-write_xml_element_univ(NonCanon, IndentLevel, Univ,
+write_xml_element_univ(NonCanon, MakeElement, IndentLevel, Univ,
MaybeFieldNames, RemainingMaybeFieldNames, !IO) :-
(
MaybeFieldNames = [MaybeFieldName | RemainingMaybeFieldNames]
@@ -562,27 +795,42 @@
deconstruct.deconstruct(Term, NonCanon, Functor, Arity, Args),
Term = univ_value(Univ),
TypeDesc = type_of(Term),
- Element = get_element(TypeDesc, from_functor_name(Functor)),
+ (
+ is_discriminated_union(TypeDesc, _)
+ ->
+ Request = du_functor(Functor, Arity)
+ ;
+ Request = not_a_du
+ ),
+ MakeElement(TypeDesc, Request, Element, Attributes),
(
primitive_value(Univ, PrimValue)
->
indent(IndentLevel, !IO),
- write_primitive_element(Element, PrimValue, MaybeFieldName,
- !IO)
+ write_primitive_element(Element, Attributes, PrimValue,
+ MaybeFieldName, TypeDesc, !IO)
;
(
Args = [],
indent(IndentLevel, !IO),
- write_empty_element(Element, Functor, MaybeFieldName,
- TypeDesc, !IO)
+ write_empty_element(Element, Attributes, yes(Functor),
+ yes(Arity), MaybeFieldName, TypeDesc, !IO)
;
Args = [_ | _],
- ChildMaybeFieldNames = get_field_names(TypeDesc,
- Functor, Arity),
+ % XXX This has been commented out until a bug in
+ % the runtime system has been fixed that causes
+ % a seg fault when construct.get_functor is invoked on
+ % a functor with existentially quantified argument
+ % types.
+ % ChildMaybeFieldNames = get_field_names(TypeDesc,
+ % Functor, Arity),
+ ChildMaybeFieldNames = [],
indent(IndentLevel, !IO),
- write_element_start(Element, Functor, MaybeFieldName,
+ write_element_start(Element, Attributes, yes(Functor),
+ yes(Arity), MaybeFieldName,
TypeDesc, !IO),
- write_child_xml_elements(NonCanon, IndentLevel + 1,
+ write_child_xml_elements(NonCanon, MakeElement,
+ IndentLevel + 1,
Args, ChildMaybeFieldNames, !IO),
indent(IndentLevel, !IO),
write_element_end(Element, !IO)
@@ -603,16 +851,15 @@
type_ctor_name(TypeCtor) = "array",
type_ctor_module_name(TypeCtor) = "array".
+:- func get_field_names(type_desc, string, int) = list(maybe(string)).
+
% XXX This should be uncommented once memoing can be switched off for grades
% which don't support it.
% :- pragma memo(get_field_names/3).
-:- func get_field_names(type_desc, string, int) = list(maybe(string)).
-
get_field_names(TypeDesc, Functor, Arity) = MaybeFields :-
- NumFunctors = num_functors(TypeDesc),
(
- NumFunctors > 0
+ is_discriminated_union(TypeDesc, NumFunctors)
->
FunctorNums = 0`..`(NumFunctors - 1),
(
@@ -650,62 +897,64 @@
%
:- pred write_child_xml_elements(deconstruct.noncanon_handling,
- int, list(univ), list(maybe(string)), io, io).
-:- mode write_child_xml_elements(in(do_not_allow), in, in, in, di, uo)
- is det.
-:- mode write_child_xml_elements(in(canonicalize), in, in, in, di, uo)
- is det.
-:- mode write_child_xml_elements(in(include_details_cc), in, in, in,
- di, uo) is cc_multi.
-:- mode write_child_xml_elements(in, in, in, in, di, uo) is cc_multi.
+ element_pred, int, list(univ), list(maybe(string)), io, io).
+:- mode write_child_xml_elements(in(do_not_allow), in(element_pred), in, in,
+ in, di, uo) is det.
+:- mode write_child_xml_elements(in(canonicalize), in(element_pred), in, in,
+ in, di, uo) is det.
+:- mode write_child_xml_elements(in(include_details_cc), in(element_pred),
+ in, in, in, di, uo) is cc_multi.
+:- mode write_child_xml_elements(in, in(element_pred), in, in, in, di, uo)
+ is cc_multi.
-write_child_xml_elements(NonCanon, IndentLevel, Args,
+write_child_xml_elements(NonCanon, MakeElement, IndentLevel, Args,
MaybeFieldNames, !IO) :-
(
NonCanon = do_not_allow,
list.foldl2(
write_xml_element_univ_do_not_allow(
- IndentLevel), Args,
+ MakeElement, IndentLevel), Args,
MaybeFieldNames, _, !IO)
;
NonCanon = canonicalize,
list.foldl2(
write_xml_element_univ_canonicalize(
- IndentLevel), Args,
+ MakeElement, IndentLevel), Args,
MaybeFieldNames, _, !IO)
;
NonCanon = include_details_cc,
list.foldl2(
write_xml_element_univ_include_details_cc(
- IndentLevel), Args,
+ MakeElement, IndentLevel), Args,
MaybeFieldNames, _, !IO)
).
-:- pred write_xml_element_univ_do_not_allow(int::in, univ::in,
- list(maybe(string))::in, list(maybe(string))::out, io::di, io::uo)
- is det.
+:- pred write_xml_element_univ_do_not_allow(element_pred::in(element_pred),
+ int::in, univ::in, list(maybe(string))::in, list(maybe(string))::out,
+ io::di, io::uo) is det.
-write_xml_element_univ_do_not_allow(IndentLevel, Univ,
+write_xml_element_univ_do_not_allow(MakeElement, IndentLevel, Univ,
MaybeFieldNames0, MaybeFieldNames, !IO) :-
- write_xml_element_univ(do_not_allow, IndentLevel,
+ write_xml_element_univ(do_not_allow, MakeElement, IndentLevel,
Univ, MaybeFieldNames0, MaybeFieldNames, !IO).
-:- pred write_xml_element_univ_canonicalize(int::in, univ::in,
- list(maybe(string))::in, list(maybe(string))::out, io::di, io::uo)
- is det.
+:- pred write_xml_element_univ_canonicalize(element_pred::in(element_pred),
+ int::in, univ::in, list(maybe(string))::in, list(maybe(string))::out,
+ io::di, io::uo) is det.
-write_xml_element_univ_canonicalize(IndentLevel, Univ,
+write_xml_element_univ_canonicalize(MakeElement, IndentLevel, Univ,
MaybeFieldNames0, MaybeFieldNames, !IO) :-
- write_xml_element_univ(canonicalize, IndentLevel,
+ write_xml_element_univ(canonicalize, MakeElement, IndentLevel,
Univ, MaybeFieldNames0, MaybeFieldNames, !IO).
-:- pred write_xml_element_univ_include_details_cc(int::in, univ::in,
+:- pred write_xml_element_univ_include_details_cc(
+ element_pred::in(element_pred), int::in, univ::in,
list(maybe(string))::in, list(maybe(string))::out, io::di, io::uo)
is cc_multi.
-write_xml_element_univ_include_details_cc(IndentLevel, Univ,
+write_xml_element_univ_include_details_cc(MakeElement, IndentLevel, Univ,
MaybeFieldNames0, MaybeFieldNames, !IO) :-
- write_xml_element_univ(include_details_cc,
+ write_xml_element_univ(include_details_cc, MakeElement,
IndentLevel, Univ, MaybeFieldNames0, MaybeFieldNames, !IO).
%-----------------------------------------------------------------------------%
@@ -725,85 +974,104 @@
true
).
-:- pred write_primitive_element(string::in, string::in,
- maybe(string)::in, io::di, io::uo) is det.
+:- pred write_primitive_element(string::in, list(attribute)::in, string::in,
+ maybe(string)::in, type_desc::in, io::di, io::uo) is det.
-write_primitive_element(Element, Value, MaybeFieldName, !IO) :-
+write_primitive_element(Element, Attributes, Value, MaybeFieldName,
+ TypeDesc, !IO) :-
io.write_string("<", !IO),
io.write_string(Element, !IO),
- write_field_name_attribute(MaybeFieldName, !IO),
+ list.foldl(write_attribute(no, no, TypeDesc, MaybeFieldName),
+ Attributes, !IO),
io.write_string(">", !IO),
write_xml_escaped_string(Value, !IO),
io.write_string("</", !IO),
io.write_string(Element, !IO),
io.write_string(">\n", !IO).
-:- pred write_xml_escaped_string(string::in, io::di, io::uo) is det.
-
-write_xml_escaped_string(Str, !IO) :-
- string.foldl(write_xml_escaped_char, Str, !IO).
-
-:- pred write_xml_escaped_char(char::in, io::di, io::uo) is det.
-
-write_xml_escaped_char(Chr, !IO) :-
- (
- xml_predefined_entity(Chr, Str)
- ->
- io.write_string(Str, !IO)
- ;
- io.write_char(Chr, !IO)
- ).
-
-:- pred write_element_start(string::in, string::in,
- maybe(string)::in, type_desc::in, io::di, io::uo) is det.
+:- pred write_element_start(string::in, list(attribute)::in, maybe(string)::in,
+ maybe(int)::in, maybe(string)::in, type_desc::in, io::di, io::uo) is
+ det.
-write_element_start(Element, Functor, MaybeField, TypeDesc, !IO) :-
+write_element_start(Element, Attributes, MaybeFunctor, MaybeArity, MaybeField,
+ TypeDesc, !IO) :-
io.write_string("<", !IO),
io.write_string(Element, !IO),
- write_functor_attribute(Functor, !IO),
- write_field_name_attribute(MaybeField, !IO),
- write_type_name_attribute(TypeDesc, !IO),
+ list.foldl(write_attribute(MaybeFunctor, MaybeArity, TypeDesc,
+ MaybeField), Attributes, !IO),
io.write_string(">\n", !IO).
-:- pred write_empty_element(string::in, string::in, maybe(string)::in,
- type_desc::in, io::di, io::uo) is det.
+:- pred write_empty_element(string::in, list(attribute)::in,
+ maybe(string)::in, maybe(int)::in, maybe(string)::in, type_desc::in,
+ io::di, io::uo) is det.
-write_empty_element(Element, Functor, MaybeField, TypeDesc, !IO) :-
+write_empty_element(Element, Attributes, MaybeFunctor, MaybeArity, MaybeField,
+ TypeDesc, !IO) :-
io.write_string("<", !IO),
io.write_string(Element, !IO),
- write_functor_attribute(Functor, !IO),
- write_field_name_attribute(MaybeField, !IO),
- write_type_name_attribute(TypeDesc, !IO),
+ list.foldl(write_attribute(MaybeFunctor, MaybeArity, TypeDesc,
+ MaybeField), Attributes, !IO),
io.write_string(" />\n", !IO).
-:- pred write_field_name_attribute(maybe(string)::in, io::di, io::uo) is det.
+:- pred write_element_end(string::in, io::di, io::uo) is det.
-write_field_name_attribute(no, !IO).
-write_field_name_attribute(yes(Field), !IO) :-
- io.write_string(" field=""", !IO),
- write_xml_escaped_string(Field, !IO),
- io.write_string("""", !IO).
+write_element_end(Element, !IO) :-
+ io.write_string("</", !IO),
+ io.write_string(Element, !IO),
+ io.write_string(">\n", !IO).
-:- pred write_type_name_attribute(type_desc::in, io::di, io::uo) is det.
+:- pred write_attribute(maybe(string)::in, maybe(int)::in,
+ type_desc::in, maybe(string)::in, attribute::in, io::di, io::uo)
+ is det.
-write_type_name_attribute(TypeDesc, !IO) :-
- io.write_string(" typename=""", !IO),
- write_xml_escaped_string(type_name(TypeDesc), !IO),
- io.write_string("""", !IO).
+write_attribute(MaybeFunctor, MaybeArity, TypeDesc, MaybeFieldName,
+ attribute(Name, Source), !IO) :-
+ (
+ Source = functor,
+ MaybeValue = MaybeFunctor
+ ;
+ Source = arity,
+ (
+ MaybeArity = yes(Arity),
+ MaybeValue = yes(string.int_to_string(Arity))
+ ;
+ MaybeArity = no,
+ MaybeValue = no
+ )
+ ;
+ Source = type_name,
+ MaybeValue = yes(type_name(TypeDesc))
+ ;
+ Source = field_name,
+ MaybeValue = MaybeFieldName
+ ),
+ (
+ MaybeValue = yes(Value)
+ ->
+ io.write_string(" ", !IO),
+ io.write_string(Name, !IO),
+ io.write_string("=""", !IO),
+ write_xml_escaped_string(Value, !IO),
+ io.write_string("""", !IO)
+ ;
+ true
+ ).
-:- pred write_functor_attribute(string::in, io::di, io::uo) is det.
+:- pred write_xml_escaped_string(string::in, io::di, io::uo) is det.
-write_functor_attribute(Functor, !IO) :-
- io.write_string(" functor=""", !IO),
- write_xml_escaped_string(Functor, !IO),
- io.write_string("""", !IO).
+write_xml_escaped_string(Str, !IO) :-
+ string.foldl(write_xml_escaped_char, Str, !IO).
-:- pred write_element_end(string::in, io::di, io::uo) is det.
+:- pred write_xml_escaped_char(char::in, io::di, io::uo) is det.
-write_element_end(Element, !IO) :-
- io.write_string("</", !IO),
- io.write_string(Element, !IO),
- io.write_string(">\n", !IO).
+write_xml_escaped_char(Chr, !IO) :-
+ (
+ xml_predefined_entity(Chr, Str)
+ ->
+ io.write_string(Str, !IO)
+ ;
+ io.write_char(Chr, !IO)
+ ).
:- pred xml_predefined_entity(char::in, string::out) is semidet.
@@ -818,228 +1086,291 @@
% Predicates to write the DTD for a type.
%
-write_dtd_from_type(TypeDesc, DTDResult, !IO) :-
+write_dtd_from_type(TypeDesc, ElementMapping, DTDResult, !IO) :-
+ check_ok_to_generate_dtd(ElementMapping, TypeDesc, DTDResult),
(
- get_elements_and_args(TypeDesc, [RootElement], [_],
- [ArgTypes])
+ DTDResult = ok
->
- io.write_string("<!DOCTYPE ", !IO),
- io.write_string(RootElement, !IO),
- io.write_string(" [\n\n<!-- Builtin Mercury types -->\n\n",
- !IO),
- list.foldl(write_primitive_dtd_element,
- ["String", "Char", "Int", "Float"], !IO),
- io.nl(!IO),
- some [!AlreadyDone] (
- !:AlreadyDone = map.init,
- map.set(!.AlreadyDone, type_of(1), unit,
- !:AlreadyDone),
- map.set(!.AlreadyDone, type_of('c'), unit,
- !:AlreadyDone),
- map.set(!.AlreadyDone, type_of(""), unit,
- !:AlreadyDone),
- map.set(!.AlreadyDone, type_of(1.0), unit,
- !:AlreadyDone),
- AlreadyDone = !.AlreadyDone
- ),
- write_dtd_types([TypeDesc | ArgTypes], AlreadyDone, [],
- Unrecognised, !IO),
+ get_element_pred(ElementMapping, MakeElement),
(
- Unrecognised = []
+ get_elements_and_args(MakeElement, TypeDesc,
+ [RootElement], [_], [_], [ArgTypes], _)
+ ->
+ io.write_string("<!DOCTYPE ", !IO),
+ io.write_string(RootElement, !IO),
+ io.write_string(" [\n\n",
+ !IO),
+ write_dtd_types(MakeElement, [TypeDesc | ArgTypes],
+ map.init, !IO),
+ io.write_string("\n]>", !IO),
+ DTDResult = ok
;
- Unrecognised = [_ | _],
- io.write_string("<!-- The following types have ", !IO),
- io.write_string("been assigned to the ", !IO),
- io.write_string("`Unrecognised' element:\n\t", !IO),
- io.write_list(list.map(type_name, Unrecognised),
- "\n\t", io.write_string, !IO),
- io.write_string("\n-->\n\n", !IO),
- write_unrecognised_dtd_element(!IO)
- ),
- io.write_string("\n]>", !IO),
- DTDResult = ok
+ throw(software_error("term_to_xml.write_dtd_from_type"
+ ++ ": not ok to generate DTD"))
+ )
;
- DTDResult = multiple_functors_for_root
+ true
).
-ok_to_generate_dtd(TypeDesc) :-
- get_elements_and_args(TypeDesc, [_], [_], [_]).
-
-:- pred write_primitive_dtd_element(string::in, io::di, io::uo)
- is det.
+check_ok_to_generate_dtd(ElementMapping, TypeDesc, Result) :-
+ get_element_pred(ElementMapping, MakeElement),
+ (
+ get_elements_and_args(MakeElement, TypeDesc, [_], [_], [_],
+ [_], [_])
+ ->
+ check_types_ok(MakeElement, [TypeDesc],
+ map.init, map.init, Result)
+ ;
+ Result = multiple_functors_for_root
+ ).
-write_primitive_dtd_element(Element, !IO) :-
- io.write_string("<!ELEMENT ", !IO),
- io.write_string(Element, !IO),
- io.write_string(" (#PCDATA)>\n", !IO),
- write_dtd_field_attlist(Element, !IO).
+:- pred check_ok_to_generate_dtd(maybe_dtd::in,
+ element_mapping::in(element_mapping),
+ type_desc::in, dtd_generation_result::out) is det.
+
+check_ok_to_generate_dtd(no_dtd, _, _, ok).
+check_ok_to_generate_dtd(external(_), _, _, ok).
+check_ok_to_generate_dtd(embed, ElementMapping, TypeDesc, Result) :-
+ check_ok_to_generate_dtd(ElementMapping, TypeDesc, Result).
+
+:- pred check_types_ok(element_pred::in(element_pred),
+ list(type_desc)::in, map(type_desc, unit)::in,
+ map(string, type_desc)::in, dtd_generation_result::out) is det.
+
+check_types_ok(_, [], _, _, ok).
+check_types_ok(MakeElement, [TypeDesc | TypeDescs], DoneTypeDescs,
+ ElementsSoFar, Result) :-
+ (
+ (
+ is_discriminated_union(TypeDesc, _)
+ ;
+ is_array(TypeDesc, _)
+ ;
+ is_primitive_type(TypeDesc, _)
+ )
+ ->
+ (
+ map.search(DoneTypeDescs, TypeDesc, _)
+ ->
+ check_types_ok(MakeElement, TypeDescs, DoneTypeDescs,
+ ElementsSoFar, Result)
+ ;
+ get_elements_and_args(MakeElement, TypeDesc, Elements,
+ _, _, ArgLists, _),
+ list.filter(map.contains(ElementsSoFar), Elements,
+ DupElements),
+ (
+ DupElements = [DupElement | _],
+ map.lookup(ElementsSoFar, DupElement,
+ DupTypeDesc),
+ DupTypes = [TypeDesc, DupTypeDesc],
+ Result = duplicate_elements(DupElement,
+ DupTypes)
+ ;
+ DupElements = [],
+ list.merge_and_remove_dups(
+ list.condense(ArgLists),
+ TypeDescs, NewTypeDescs),
+ list.duplicate(length(Elements), TypeDesc,
+ TypeDescList),
+ map.det_insert_from_corresponding_lists(
+ ElementsSoFar, Elements, TypeDescList,
+ NewElementsSoFar),
+ map.det_insert(DoneTypeDescs, TypeDesc, unit,
+ NewDoneTypeDescs),
+ check_types_ok(MakeElement, NewTypeDescs,
+ NewDoneTypeDescs, NewElementsSoFar,
+ Result)
+ )
+ )
+ ;
+ Result = unsupported_dtd_type(TypeDesc)
+ ).
% Write out the DTD entries for all the given types and add the written
% types to AlreadyDone. Children types found along the way are added
% to the first argument. We stop when all the types have had their DTD
- % entry written. We also keep track of types assigned to the
- % `Unrecognised' element so we can print a comment about them in the
- % DTD.
- %
-:- pred write_dtd_types(list(type_desc)::in, map(type_desc, unit)::in,
- list(type_desc)::in, list(type_desc)::out, io::di, io::uo) is det.
-
-write_dtd_types([], _, Unrecognised, Unrecognised, !IO).
-write_dtd_types([TypeDesc | TypeDescs], AlreadyDone, Unrecognised0,
- Unrecognised, !IO) :-
+ % entry written.
+ %
+:- pred write_dtd_types(element_pred::in(element_pred),
+ list(type_desc)::in, map(type_desc, unit)::in,
+ io::di, io::uo) is det.
+
+write_dtd_types(_, [], _, !IO).
+write_dtd_types(MakeElement, [TypeDesc | TypeDescs], AlreadyDone, !IO) :-
(
map.search(AlreadyDone, TypeDesc, _)
->
- write_dtd_types(TypeDescs, AlreadyDone, Unrecognised0,
- Unrecognised, !IO)
+ write_dtd_types(MakeElement, TypeDescs, AlreadyDone, !IO)
;
- write_dtd_type_elements(TypeDesc, ChildArgTypes,
- IsUnrecognised, !IO),
- (
- IsUnrecognised = yes
- ->
- list.merge([TypeDesc], Unrecognised0, NewUnrecognised)
- ;
- NewUnrecognised = Unrecognised0
- ),
+ write_dtd_type_elements(MakeElement, TypeDesc, ChildArgTypes,
+ !IO),
map.set(AlreadyDone, TypeDesc, unit, NewAlreadyDone),
- write_dtd_types(append(ChildArgTypes, TypeDescs),
- NewAlreadyDone, NewUnrecognised, Unrecognised, !IO)
+ write_dtd_types(MakeElement, append(ChildArgTypes, TypeDescs),
+ NewAlreadyDone, !IO)
).
-:- pred write_unrecognised_dtd_element(io::di, io::uo) is det.
+:- pred write_attribute_source_kind(attribute_source::in, maybe(string)::in,
+ io::di, io::uo) is det.
-write_unrecognised_dtd_element(!IO) :-
- io.write_string("<!ELEMENT ", !IO),
- io.write_string(unrecognized_element, !IO),
- io.write_string(" ANY>\n", !IO),
- io.write_string("<!ATTLIST ", !IO),
- io.write_string(unrecognized_element, !IO),
- io.write_string(" functor CDATA #REQUIRED>\n", !IO),
- write_dtd_field_attlist(unrecognized_element, !IO),
- write_dtd_type_attlist(unrecognized_element, !IO).
+write_attribute_source_kind(functor, no, !IO) :-
+ io.write_string("#IMPLIED", !IO).
+write_attribute_source_kind(functor, yes(Value), !IO) :-
+ io.write_string("#FIXED """, !IO),
+ write_xml_escaped_string(Value, !IO),
+ io.write_string("""", !IO).
+write_attribute_source_kind(field_name, _, !IO) :-
+ io.write_string("#IMPLIED", !IO).
+write_attribute_source_kind(type_name, no, !IO) :-
+ io.write_string("#REQUIRED", !IO).
+write_attribute_source_kind(type_name, yes(Value), !IO) :-
+ io.write_string("#FIXED """, !IO),
+ write_xml_escaped_string(Value, !IO),
+ io.write_string("""", !IO).
+write_attribute_source_kind(arity, no, !IO) :-
+ io.write_string("#IMPLIED", !IO).
+write_attribute_source_kind(arity, yes(Value), !IO) :-
+ io.write_string("#FIXED """, !IO),
+ write_xml_escaped_string(Value, !IO),
+ io.write_string("""", !IO).
-:- pred write_dtd_field_attlist(string::in, io::di, io::uo) is det.
+:- pred write_dtd_attlist(string::in, maybe(string)::in, maybe(int)::in,
+ type_desc::in, attribute::in, io::di, io::uo) is det.
-write_dtd_field_attlist(Element, !IO) :-
+write_dtd_attlist(Element, MaybeFunctor, MaybeArity, TypeDesc,
+ attribute(Name, Source), !IO) :-
+ (
+ Source = functor,
+ MaybeValue = MaybeFunctor
+ ;
+ Source = arity,
+ (
+ MaybeArity = yes(Arity),
+ MaybeValue = yes(string.int_to_string(Arity))
+ ;
+ MaybeArity = no,
+ MaybeValue = no
+ )
+ ;
+ Source = type_name,
+ MaybeValue = yes(type_name(TypeDesc))
+ ;
+ Source = field_name,
+ MaybeValue = no
+ ),
io.write_string("<!ATTLIST ", !IO),
io.write_string(Element, !IO),
- io.write_string(" field CDATA #IMPLIED>\n", !IO).
+ io.write_string(" ", !IO),
+ io.write_string(Name, !IO),
+ io.write_string(" CDATA ", !IO),
+ write_attribute_source_kind(Source, MaybeValue, !IO),
+ io.write_string(">\n", !IO).
-:- pred write_dtd_type_attlist(string::in, io::di, io::uo) is det.
+:- pred write_dtd_attlists(string::in, list(attribute)::in, maybe(string)::in,
+ maybe(int)::in, type_desc::in, io::di, io::uo) is det.
-write_dtd_type_attlist(Element, !IO) :-
- io.write_string("<!ATTLIST ", !IO),
- io.write_string(Element, !IO),
- io.write_string(" typename CDATA #IMPLIED>\n", !IO).
+write_dtd_attlists(Element, Attributes, MaybeFunctor, MaybeArity, TypeDesc,
+ !IO) :-
+ list.foldl(write_dtd_attlist(Element, MaybeFunctor, MaybeArity,
+ TypeDesc), Attributes, !IO).
-:- pred write_dtd_type_elements(type_desc::in, list(type_desc)::out, bool::out,
- io::di, io::uo) is det.
+:- pred write_dtd_type_elements(element_pred::in(element_pred), type_desc::in,
+ list(type_desc)::out, io::di, io::uo) is det.
% Write DTD entries for all the functors for a type
%
-write_dtd_type_elements(TypeDesc, ChildArgTypes, IsUnrecognised, !IO) :-
- get_elements_and_args(TypeDesc, Elements, Functors, ArgTypeLists),
+write_dtd_type_elements(MakeElement, TypeDesc, ChildArgTypes, !IO) :-
+ get_elements_and_args(MakeElement, TypeDesc, Elements,
+ MaybeFunctors, MaybeArities, ArgTypeLists, AttributeLists),
list.condense(ArgTypeLists, ChildArgTypes),
- (
- % unrecognized elements don't have multiple functors.
- Elements \= [unrecognized_element]
- ->
- io.write_string("<!-- Elements for functors of type """, !IO),
- io.write_string(type_name(TypeDesc), !IO),
- io.write_string(""" -->\n\n", !IO),
- write_dtd_entries(TypeDesc, Elements, Functors,
- ArgTypeLists, !IO),
- IsUnrecognised = no
- ;
- IsUnrecognised = yes
- ).
-
-:- type term_to_xml_internal_error
- ---> term_to_xml_internal_error(string, string).
-
-:- pred write_dtd_entries(type_desc::in,
- list(string)::in, list(string)::in, list(list(type_desc))::in,
+ io.write_string("<!-- Elements for functors of type """, !IO),
+ write_xml_escaped_string(type_name(TypeDesc), !IO),
+ io.write_string(""" -->\n\n", !IO),
+ write_dtd_entries(MakeElement, TypeDesc, Elements, MaybeFunctors,
+ MaybeArities, ArgTypeLists, AttributeLists, !IO).
+
+:- pred write_dtd_entries(element_pred::in(element_pred), type_desc::in,
+ list(string)::in, list(maybe(string))::in, list(maybe(int))::in,
+ list(list(type_desc))::in, list(list(attribute))::in,
io::di, io::uo) is det.
% Write all the given DTD entries.
%
-write_dtd_entries(_, [], [], [], !IO).
-write_dtd_entries(TypeDesc, [Element | Elements], [Functor | Functors],
- [ArgTypeList | ArgTypeLists], !IO) :-
+write_dtd_entries(_, _, [], _, _, _, _, !IO).
+write_dtd_entries(MakeElement, TypeDesc, [Element | Elements],
+ MaybeFunctorList, MaybeArityList, ArgTypeListList,
+ AttributeListList, !IO) :-
+
+ MaybeFunctor = list.det_head(MaybeFunctorList),
+ MaybeFunctors = list.det_tail(MaybeFunctorList),
+ MaybeArity = list.det_head(MaybeArityList),
+ MaybeArities = list.det_tail(MaybeArityList),
+ ArgTypeList = list.det_head(ArgTypeListList),
+ ArgTypeLists = list.det_tail(ArgTypeListList),
+ AttributeList = list.det_head(AttributeListList),
+ AttributeLists = list.det_tail(AttributeListList),
+
io.write_string("<!ELEMENT ", !IO),
io.write_string(Element, !IO),
io.write_string(" ", !IO),
(
- ArgTypeList = [],
- io.write_string("EMPTY>\n", !IO)
+ is_primitive_type(TypeDesc, _)
+ ->
+ io.write_string("(#PCDATA)>\n", !IO)
;
- ArgTypeList = [Head | Tail],
(
- Tail = [_ | _],
- Braces = yes
+ ArgTypeList = [],
+ io.write_string("EMPTY>\n", !IO)
;
- Tail = [],
+ ArgTypeList = [Head | Tail],
(
- num_functors(Head) > 1
- ->
- Braces = no
- ;
+ Tail = [_ | _],
Braces = yes
- )
- ),
-
- % Put extra braces for arrays for the * at the end.
- ( is_array(TypeDesc, _) -> io.write_string("(", !IO) ; true ),
-
- ( Braces = yes, io.write_string("(", !IO) ; Braces = no ),
-
- io.write_list(ArgTypeList, ",",
- write_dtd_allowed_functors_regex, !IO),
-
- ( Braces = yes, io.write_string(")", !IO) ; Braces = no ),
-
- ( is_array(TypeDesc, _) -> io.write_string("*)", !IO) ; true ),
+ ;
+ Tail = [],
+ (
+ num_functors(Head) > 1
+ ->
+ Braces = no
+ ;
+ Braces = yes
+ )
+ ),
+
+ % Put extra braces for arrays for the * at the end.
+ ( is_array(TypeDesc, _) -> io.write_string("(", !IO)
+ ; true ),
+
+ ( Braces = yes, io.write_string("(", !IO)
+ ; Braces = no ),
+
+ io.write_list(ArgTypeList, ",",
+ write_dtd_allowed_functors_regex(MakeElement),
+ !IO),
+
+ ( Braces = yes, io.write_string(")", !IO)
+ ; Braces = no ),
+
+ ( is_array(TypeDesc, _) -> io.write_string("*)", !IO)
+ ; true ),
- io.write_string(">\n", !IO)
+ io.write_string(">\n", !IO)
+ )
),
- write_dtd_field_attlist(Element, !IO),
- write_dtd_type_attlist(Element, !IO),
- io.write_string("<!ATTLIST ", !IO),
- io.write_string(Element, !IO),
- io.write_string(" functor CDATA #FIXED """, !IO),
- write_xml_escaped_string(Functor, !IO),
- io.write_string(""">\n\n", !IO),
- write_dtd_entries(TypeDesc, Elements, Functors, ArgTypeLists,
- !IO).
-
-write_dtd_entries(_, [_ | _], [], [], !IO) :-
- throw(term_to_xml_internal_error("write_dtd_cons_elements",
- "lists not of equal length")).
-write_dtd_entries(_, [], [_ | _], [], !IO) :-
- throw(term_to_xml_internal_error("write_dtd_cons_elements",
- "lists not of equal length")).
-write_dtd_entries(_, [_ | _], [_ | _], [], !IO) :-
- throw(term_to_xml_internal_error("write_dtd_cons_elements",
- "lists not of equal length")).
-write_dtd_entries(_, [], [], [_ | _], !IO) :-
- throw(term_to_xml_internal_error("write_dtd_cons_elements",
- "lists not of equal length")).
-write_dtd_entries(_, [_ | _], [], [_ | _], !IO) :-
- throw(term_to_xml_internal_error("write_dtd_cons_elements",
- "lists not of equal length")).
-write_dtd_entries(_, [], [_ | _], [_ | _], !IO) :-
- throw(term_to_xml_internal_error("write_dtd_cons_elements",
- "lists not of equal length")).
+ write_dtd_attlists(Element, AttributeList, MaybeFunctor, MaybeArity,
+ TypeDesc, !IO),
+ io.nl(!IO),
+ write_dtd_entries(MakeElement, TypeDesc, Elements, MaybeFunctors,
+ MaybeArities, ArgTypeLists, AttributeLists, !IO).
% Write the allowed functors for the type as a DTD rule regular
% expression.
%
-:- pred write_dtd_allowed_functors_regex(type_desc::in, io::di, io::uo)
- is det.
+:- pred write_dtd_allowed_functors_regex(element_pred::in(element_pred),
+ type_desc::in, io::di, io::uo) is det.
-write_dtd_allowed_functors_regex(TypeDesc, !IO) :-
- get_elements_and_args(TypeDesc, Elements, _, _),
+write_dtd_allowed_functors_regex(MakeElement, TypeDesc, !IO) :-
+ get_elements_and_args(MakeElement, TypeDesc, Elements, _, _, _, _),
(
length(Elements) > 1
->
Index: tests/hard_coded/write_xml.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/write_xml.exp,v
retrieving revision 1.1
diff -u -r1.1 write_xml.exp
--- tests/hard_coded/write_xml.exp 7 Dec 2004 04:55:50 -0000 1.1
+++ tests/hard_coded/write_xml.exp 8 Dec 2004 10:25:16 -0000
@@ -1,470 +1,564 @@
+Result 1:
+unsupported_dtd_type(pred(int))
+
+<?xml version="1.0"?>
+<?xml-stylesheet type="text/css" href="http://www.cs.mu.oz.au/a_css.css"?>
+<Array--array-46array-40write_xml-46mytype-41 functor="<<array>>" type="array.array(write_xml.mytype)" arity="12">
+ <Tag_Tag-45--1--write_xml-46mytype functor="Tag-" type="write_xml.mytype" arity="1">
+ <Int type="int">44</Int>
+ </Tag_Tag-45--1--write_xml-46mytype>
+ <Tag_String--1--write_xml-46mytype functor="String" type="write_xml.mytype" arity="1">
+ <String type="string">a string</String>
+ </Tag_String--1--write_xml-46mytype>
+ <hello--5--write_xml-46mytype functor="hello" type="write_xml.mytype" arity="5">
+ <String type="string">this
+
+is a <string>&</String>
+ <Int type="int">-123</Int>
+ <Char type="character"><</Char>
+ <Float type="float">1.12300000000000</Float>
+ <yes--0--bool-46bool functor="yes" type="bool.bool" arity="0" />
+ </hello--5--write_xml-46mytype>
+ <a_tuple--1--write_xml-46mytype functor="a_tuple" type="write_xml.mytype" arity="1">
+ <Tuple--3--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 functor="{}" type="{string, int, {character, float}}" arity="3">
+ <String type="string">some more stuf</String>
+ <Int type="int">123456</Int>
+ <Tuple--2--Tag_-123character-44-32float-125 functor="{}" type="{character, float}" arity="2">
+ <Char type="character">a</Char>
+ <Float type="float">1.23553225220000e-97</Float>
+ </Tuple--2--Tag_-123character-44-32float-125>
+ </Tuple--3--Tag_-123string-44-32int-44-32-123character-44-32float-125-125>
+ </a_tuple--1--write_xml-46mytype>
+ <Tag_List--1--write_xml-46mytype functor="List" type="write_xml.mytype" arity="1">
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">1</Int>
+ </listPart--1--write_xml-46listPart>
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">2</Int>
+ </listPart--1--write_xml-46listPart>
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <nothing--0--write_xml-46listPart functor="nothing" type="write_xml.listPart" arity="0" />
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">4</Int>
+ </listPart--1--write_xml-46listPart>
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <nothing--0--write_xml-46listPart functor="nothing" type="write_xml.listPart" arity="0" />
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">6</Int>
+ </listPart--1--write_xml-46listPart>
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">7</Int>
+ </listPart--1--write_xml-46listPart>
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">8</Int>
+ </listPart--1--write_xml-46listPart>
+ <List--2--list-46list-40write_xml-46listPart-41 functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <nothing--0--write_xml-46listPart functor="nothing" type="write_xml.listPart" arity="0" />
+ <Nil--0--list-46list-40write_xml-46listPart-41 functor="[]" type="list.list(write_xml.listPart)" arity="0" />
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </List--2--list-46list-40write_xml-46listPart-41>
+ </Tag_List--1--write_xml-46mytype>
+ <a_map--1--write_xml-46mytype functor="a_map" type="write_xml.mytype" arity="1">
+ <four--10--tree234-46tree234-40int-44-32string-41 functor="four" type="tree234.tree234(int, string)" arity="10">
+ <Int type="int">2</Int>
+ <String type="string">hello1</String>
+ <Int type="int">4</Int>
+ <String type="string">hello3</String>
+ <Int type="int">6</Int>
+ <String type="string">hello5</String>
+ <two--4--tree234-46tree234-40int-44-32string-41 functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">1</Int>
+ <String type="string">hello</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two--4--tree234-46tree234-40int-44-32string-41>
+ <two--4--tree234-46tree234-40int-44-32string-41 functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">3</Int>
+ <String type="string">hello2</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two--4--tree234-46tree234-40int-44-32string-41>
+ <two--4--tree234-46tree234-40int-44-32string-41 functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">5</Int>
+ <String type="string">hello4</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two--4--tree234-46tree234-40int-44-32string-41>
+ <three--7--tree234-46tree234-40int-44-32string-41 functor="three" type="tree234.tree234(int, string)" arity="7">
+ <Int type="int">7</Int>
+ <String type="string">hello6</String>
+ <Int type="int">8</Int>
+ <String type="string">hello7</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </three--7--tree234-46tree234-40int-44-32string-41>
+ </four--10--tree234-46tree234-40int-44-32string-41>
+ </a_map--1--write_xml-46mytype>
+ <a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--1--write_xml-46mytype functor="a <!@#$%^&*()> functor name!!!" type="write_xml.mytype" arity="1">
+ <Int type="int">999</Int>
+ </a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--1--write_xml-46mytype>
+ <a_pred--1--write_xml-46mytype functor="a_pred" type="write_xml.mytype" arity="1">
+ <pred-40int-41 functor="p" type="pred(int)" arity="3">
+ <Int type="int">1</Int>
+ <Int type="int">2</Int>
+ <hello--5--write_xml-46mytype functor="hello" type="write_xml.mytype" arity="5">
+ <String type="string">a string</String>
+ <Int type="int">1</Int>
+ <Char type="character">c</Char>
+ <Float type="float">-1.00000000000000e-15</Float>
+ <yes--0--bool-46bool functor="yes" type="bool.bool" arity="0" />
+ </hello--5--write_xml-46mytype>
+ </pred-40int-41>
+ </a_pred--1--write_xml-46mytype>
+ <t--1--write_xml-46mytype functor="t" type="write_xml.mytype" arity="1">
+ <type_desc-46type_desc functor="tree234" type="type_desc.type_desc" arity="2">
+ <type_desc-46type_desc functor="int" type="type_desc.type_desc" arity="0" />
+ <type_desc-46type_desc functor="string" type="type_desc.type_desc" arity="0" />
+ </type_desc-46type_desc>
+ </t--1--write_xml-46mytype>
+ <ctor--1--write_xml-46mytype functor="ctor" type="write_xml.mytype" arity="1">
+ <type_desc-46type_ctor_desc functor="tree234.tree234/2" type="type_desc.type_ctor_desc" arity="0" />
+ </ctor--1--write_xml-46mytype>
+ <foreign--1--write_xml-46mytype functor="foreign" type="write_xml.mytype" arity="1">
+ <write_xml-46ftype functor="<<foreign>>" type="write_xml.ftype" arity="0" />
+ </foreign--1--write_xml-46mytype>
+ <pointer--1--write_xml-46mytype functor="pointer" type="write_xml.mytype" arity="1">
+ <c_pointer functor="<<c_pointer>>" type="c_pointer" arity="0" />
+ </pointer--1--write_xml-46mytype>
+</Array--array-46array-40write_xml-46mytype-41>
+Result 2:
+ok
+
<?xml version="1.0"?>
<?xml-stylesheet type="text/css" href="http://www.cs.mu.oz.au/a_css.css"?>
-<!DOCTYPE Array--array-46array-40write_xml-46mytype-41 [
+<!DOCTYPE wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 [
+
+<!-- Elements for functors of type "write_xml.wrap(tree234.tree234(int, string))" -->
-<!-- Builtin Mercury types -->
+<!ELEMENT wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 (empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41)>
+<!ATTLIST wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 functor CDATA #FIXED "wrap">
+<!ATTLIST wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 field CDATA #IMPLIED>
+<!ATTLIST wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 type CDATA #FIXED "write_xml.wrap(tree234.tree234(int, string))">
+<!ATTLIST wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 arity CDATA #FIXED "1">
+
+<!-- Elements for functors of type "tree234.tree234(int, string)" -->
+
+<!ELEMENT empty--0--tree234-46tree234-40int-44-32string-41 EMPTY>
+<!ATTLIST empty--0--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "empty">
+<!ATTLIST empty--0--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
+<!ATTLIST empty--0--tree234-46tree234-40int-44-32string-41 type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST empty--0--tree234-46tree234-40int-44-32string-41 arity CDATA #FIXED "0">
+
+<!ELEMENT four--10--tree234-46tree234-40int-44-32string-41 (Int,String,Int,String,Int,String,(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41),(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41),(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41),(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41))>
+<!ATTLIST four--10--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "four">
+<!ATTLIST four--10--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
+<!ATTLIST four--10--tree234-46tree234-40int-44-32string-41 type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST four--10--tree234-46tree234-40int-44-32string-41 arity CDATA #FIXED "10">
+
+<!ELEMENT three--7--tree234-46tree234-40int-44-32string-41 (Int,String,Int,String,(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41),(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41),(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41))>
+<!ATTLIST three--7--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "three">
+<!ATTLIST three--7--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
+<!ATTLIST three--7--tree234-46tree234-40int-44-32string-41 type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST three--7--tree234-46tree234-40int-44-32string-41 arity CDATA #FIXED "7">
+
+<!ELEMENT two--4--tree234-46tree234-40int-44-32string-41 (Int,String,(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41),(empty--0--tree234-46tree234-40int-44-32string-41|four--10--tree234-46tree234-40int-44-32string-41|three--7--tree234-46tree234-40int-44-32string-41|two--4--tree234-46tree234-40int-44-32string-41))>
+<!ATTLIST two--4--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "two">
+<!ATTLIST two--4--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
+<!ATTLIST two--4--tree234-46tree234-40int-44-32string-41 type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST two--4--tree234-46tree234-40int-44-32string-41 arity CDATA #FIXED "4">
+
+<!-- Elements for functors of type "int" -->
+
+<!ELEMENT Int (#PCDATA)>
+<!ATTLIST Int type CDATA #FIXED "int">
+<!ATTLIST Int field CDATA #IMPLIED>
+
+<!-- Elements for functors of type "string" -->
<!ELEMENT String (#PCDATA)>
+<!ATTLIST String type CDATA #FIXED "string">
<!ATTLIST String field CDATA #IMPLIED>
-<!ELEMENT Char (#PCDATA)>
-<!ATTLIST Char field CDATA #IMPLIED>
+
+
+]>
+<wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41 functor="wrap" type="write_xml.wrap(tree234.tree234(int, string))" arity="1">
+ <four--10--tree234-46tree234-40int-44-32string-41 functor="four" type="tree234.tree234(int, string)" arity="10">
+ <Int type="int">2</Int>
+ <String type="string">hello1</String>
+ <Int type="int">4</Int>
+ <String type="string">hello3</String>
+ <Int type="int">6</Int>
+ <String type="string">hello5</String>
+ <two--4--tree234-46tree234-40int-44-32string-41 functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">1</Int>
+ <String type="string">hello</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two--4--tree234-46tree234-40int-44-32string-41>
+ <two--4--tree234-46tree234-40int-44-32string-41 functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">3</Int>
+ <String type="string">hello2</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two--4--tree234-46tree234-40int-44-32string-41>
+ <two--4--tree234-46tree234-40int-44-32string-41 functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">5</Int>
+ <String type="string">hello4</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two--4--tree234-46tree234-40int-44-32string-41>
+ <three--7--tree234-46tree234-40int-44-32string-41 functor="three" type="tree234.tree234(int, string)" arity="7">
+ <Int type="int">7</Int>
+ <String type="string">hello6</String>
+ <Int type="int">8</Int>
+ <String type="string">hello7</String>
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty--0--tree234-46tree234-40int-44-32string-41 functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </three--7--tree234-46tree234-40int-44-32string-41>
+ </four--10--tree234-46tree234-40int-44-32string-41>
+</wrap--1--write_xml-46wrap-40tree234-46tree234-40int-44-32string-41-41>
+Result 3:
+ok
+
+<?xml version="1.0"?>
+<?xml-stylesheet type="text/css" href="http://www.cs.mu.oz.au/a_css.css"?>
+<!DOCTYPE wrap [
+
+<!-- Elements for functors of type "write_xml.wrap(tree234.tree234(int, string))" -->
+
+<!ELEMENT wrap (empty|four|three|two)>
+<!ATTLIST wrap functor CDATA #FIXED "wrap">
+<!ATTLIST wrap field CDATA #IMPLIED>
+<!ATTLIST wrap type CDATA #FIXED "write_xml.wrap(tree234.tree234(int, string))">
+<!ATTLIST wrap arity CDATA #FIXED "1">
+
+<!-- Elements for functors of type "tree234.tree234(int, string)" -->
+
+<!ELEMENT empty EMPTY>
+<!ATTLIST empty functor CDATA #FIXED "empty">
+<!ATTLIST empty field CDATA #IMPLIED>
+<!ATTLIST empty type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST empty arity CDATA #FIXED "0">
+
+<!ELEMENT four (Int,String,Int,String,Int,String,(empty|four|three|two),(empty|four|three|two),(empty|four|three|two),(empty|four|three|two))>
+<!ATTLIST four functor CDATA #FIXED "four">
+<!ATTLIST four field CDATA #IMPLIED>
+<!ATTLIST four type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST four arity CDATA #FIXED "10">
+
+<!ELEMENT three (Int,String,Int,String,(empty|four|three|two),(empty|four|three|two),(empty|four|three|two))>
+<!ATTLIST three functor CDATA #FIXED "three">
+<!ATTLIST three field CDATA #IMPLIED>
+<!ATTLIST three type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST three arity CDATA #FIXED "7">
+
+<!ELEMENT two (Int,String,(empty|four|three|two),(empty|four|three|two))>
+<!ATTLIST two functor CDATA #FIXED "two">
+<!ATTLIST two field CDATA #IMPLIED>
+<!ATTLIST two type CDATA #FIXED "tree234.tree234(int, string)">
+<!ATTLIST two arity CDATA #FIXED "4">
+
+<!-- Elements for functors of type "int" -->
+
<!ELEMENT Int (#PCDATA)>
+<!ATTLIST Int type CDATA #FIXED "int">
<!ATTLIST Int field CDATA #IMPLIED>
-<!ELEMENT Float (#PCDATA)>
-<!ATTLIST Float field CDATA #IMPLIED>
-<!-- Elements for functors of type "array.array(write_xml.mytype)" -->
+<!-- Elements for functors of type "string" -->
+
+<!ELEMENT String (#PCDATA)>
+<!ATTLIST String type CDATA #FIXED "string">
+<!ATTLIST String field CDATA #IMPLIED>
+
+
+]>
+<wrap functor="wrap" type="write_xml.wrap(tree234.tree234(int, string))" arity="1">
+ <four functor="four" type="tree234.tree234(int, string)" arity="10">
+ <Int type="int">2</Int>
+ <String type="string">hello1</String>
+ <Int type="int">4</Int>
+ <String type="string">hello3</String>
+ <Int type="int">6</Int>
+ <String type="string">hello5</String>
+ <two functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">1</Int>
+ <String type="string">hello</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two>
+ <two functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">3</Int>
+ <String type="string">hello2</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two>
+ <two functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">5</Int>
+ <String type="string">hello4</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two>
+ <three functor="three" type="tree234.tree234(int, string)" arity="7">
+ <Int type="int">7</Int>
+ <String type="string">hello6</String>
+ <Int type="int">8</Int>
+ <String type="string">hello7</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </three>
+ </four>
+</wrap>
+Result 3_1:
+ok
+
+<?xml version="1.0"?>
+<?xml-stylesheet type="text/css" href="http://www.cs.mu.oz.au/a_css.css"?>
+<!DOCTYPE Array--array-46array-40write_xml-46listPart-41 [
+
+<!-- Elements for functors of type "array.array(write_xml.listPart)" -->
-<!ELEMENT Array--array-46array-40write_xml-46mytype-41 ((Tag_List--write_xml-46mytype|Tag_String--write_xml-46mytype|Tag_Tag-45--write_xml-46mytype|a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype|a_map--write_xml-46mytype|a_pred--write_xml-46mytype|a_tuple--write_xml-46mytype|ctor--write_xml-46mytype|foreign--write_xml-46mytype|hello--write_xml-46mytype|pointer--write_xml-46mytype|t--write_xml-46mytype)*)>
-<!ATTLIST Array--array-46array-40write_xml-46mytype-41 field CDATA #IMPLIED>
-<!ATTLIST Array--array-46array-40write_xml-46mytype-41 typename CDATA #IMPLIED>
-<!ATTLIST Array--array-46array-40write_xml-46mytype-41 functor CDATA #FIXED "<<array>>">
-
-<!-- Elements for functors of type "write_xml.mytype" -->
-
-<!ELEMENT Tag_List--write_xml-46mytype (Nil--list-46list-40write_xml-46listPart-41|List--list-46list-40write_xml-46listPart-41)>
-<!ATTLIST Tag_List--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST Tag_List--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST Tag_List--write_xml-46mytype functor CDATA #FIXED "List">
-
-<!ELEMENT Tag_String--write_xml-46mytype (String)>
-<!ATTLIST Tag_String--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST Tag_String--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST Tag_String--write_xml-46mytype functor CDATA #FIXED "String">
-
-<!ELEMENT Tag_Tag-45--write_xml-46mytype (Int)>
-<!ATTLIST Tag_Tag-45--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST Tag_Tag-45--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST Tag_Tag-45--write_xml-46mytype functor CDATA #FIXED "Tag-">
-
-<!ELEMENT a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype (Int)>
-<!ATTLIST a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype functor CDATA #FIXED "a <!@#$%^&*()> functor name!!!">
-
-<!ELEMENT a_map--write_xml-46mytype (empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41)>
-<!ATTLIST a_map--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST a_map--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST a_map--write_xml-46mytype functor CDATA #FIXED "a_map">
-
-<!ELEMENT a_pred--write_xml-46mytype (Unrecognized)>
-<!ATTLIST a_pred--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST a_pred--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST a_pred--write_xml-46mytype functor CDATA #FIXED "a_pred">
-
-<!ELEMENT a_tuple--write_xml-46mytype (Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125)>
-<!ATTLIST a_tuple--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST a_tuple--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST a_tuple--write_xml-46mytype functor CDATA #FIXED "a_tuple">
-
-<!ELEMENT ctor--write_xml-46mytype (Unrecognized)>
-<!ATTLIST ctor--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST ctor--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST ctor--write_xml-46mytype functor CDATA #FIXED "ctor">
-
-<!ELEMENT foreign--write_xml-46mytype (Unrecognized)>
-<!ATTLIST foreign--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST foreign--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST foreign--write_xml-46mytype functor CDATA #FIXED "foreign">
-
-<!ELEMENT hello--write_xml-46mytype (String,Int,Char,Float,(no--bool-46bool|yes--bool-46bool))>
-<!ATTLIST hello--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST hello--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST hello--write_xml-46mytype functor CDATA #FIXED "hello">
-
-<!ELEMENT pointer--write_xml-46mytype (Unrecognized)>
-<!ATTLIST pointer--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST pointer--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST pointer--write_xml-46mytype functor CDATA #FIXED "pointer">
-
-<!ELEMENT t--write_xml-46mytype (Unrecognized)>
-<!ATTLIST t--write_xml-46mytype field CDATA #IMPLIED>
-<!ATTLIST t--write_xml-46mytype typename CDATA #IMPLIED>
-<!ATTLIST t--write_xml-46mytype functor CDATA #FIXED "t">
-
-<!-- Elements for functors of type "list.list(write_xml.listPart)" -->
-
-<!ELEMENT Nil--list-46list-40write_xml-46listPart-41 EMPTY>
-<!ATTLIST Nil--list-46list-40write_xml-46listPart-41 field CDATA #IMPLIED>
-<!ATTLIST Nil--list-46list-40write_xml-46listPart-41 typename CDATA #IMPLIED>
-<!ATTLIST Nil--list-46list-40write_xml-46listPart-41 functor CDATA #FIXED "[]">
-
-<!ELEMENT List--list-46list-40write_xml-46listPart-41 ((listPart--write_xml-46listPart|nothing--write_xml-46listPart),(Nil--list-46list-40write_xml-46listPart-41|List--list-46list-40write_xml-46listPart-41))>
-<!ATTLIST List--list-46list-40write_xml-46listPart-41 field CDATA #IMPLIED>
-<!ATTLIST List--list-46list-40write_xml-46listPart-41 typename CDATA #IMPLIED>
-<!ATTLIST List--list-46list-40write_xml-46listPart-41 functor CDATA #FIXED "[|]">
+<!ELEMENT Array--array-46array-40write_xml-46listPart-41 ((listPart--1--write_xml-46listPart|nothing--0--write_xml-46listPart)*)>
+<!ATTLIST Array--array-46array-40write_xml-46listPart-41 functor CDATA #IMPLIED>
+<!ATTLIST Array--array-46array-40write_xml-46listPart-41 field CDATA #IMPLIED>
+<!ATTLIST Array--array-46array-40write_xml-46listPart-41 type CDATA #FIXED "array.array(write_xml.listPart)">
+<!ATTLIST Array--array-46array-40write_xml-46listPart-41 arity CDATA #IMPLIED>
<!-- Elements for functors of type "write_xml.listPart" -->
-<!ELEMENT listPart--write_xml-46listPart (Int)>
-<!ATTLIST listPart--write_xml-46listPart field CDATA #IMPLIED>
-<!ATTLIST listPart--write_xml-46listPart typename CDATA #IMPLIED>
-<!ATTLIST listPart--write_xml-46listPart functor CDATA #FIXED "listPart">
-
-<!ELEMENT nothing--write_xml-46listPart EMPTY>
-<!ATTLIST nothing--write_xml-46listPart field CDATA #IMPLIED>
-<!ATTLIST nothing--write_xml-46listPart typename CDATA #IMPLIED>
-<!ATTLIST nothing--write_xml-46listPart functor CDATA #FIXED "nothing">
+<!ELEMENT listPart--1--write_xml-46listPart (Int)>
+<!ATTLIST listPart--1--write_xml-46listPart functor CDATA #FIXED "listPart">
+<!ATTLIST listPart--1--write_xml-46listPart field CDATA #IMPLIED>
+<!ATTLIST listPart--1--write_xml-46listPart type CDATA #FIXED "write_xml.listPart">
+<!ATTLIST listPart--1--write_xml-46listPart arity CDATA #FIXED "1">
+
+<!ELEMENT nothing--0--write_xml-46listPart EMPTY>
+<!ATTLIST nothing--0--write_xml-46listPart functor CDATA #FIXED "nothing">
+<!ATTLIST nothing--0--write_xml-46listPart field CDATA #IMPLIED>
+<!ATTLIST nothing--0--write_xml-46listPart type CDATA #FIXED "write_xml.listPart">
+<!ATTLIST nothing--0--write_xml-46listPart arity CDATA #FIXED "0">
-<!-- Elements for functors of type "tree234.tree234(int, string)" -->
+<!-- Elements for functors of type "int" -->
-<!ELEMENT empty--tree234-46tree234-40int-44-32string-41 EMPTY>
-<!ATTLIST empty--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
-<!ATTLIST empty--tree234-46tree234-40int-44-32string-41 typename CDATA #IMPLIED>
-<!ATTLIST empty--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "empty">
-
-<!ELEMENT four--tree234-46tree234-40int-44-32string-41 (Int,String,Int,String,Int,String,(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41),(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41),(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41),(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41))>
-<!ATTLIST four--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
-<!ATTLIST four--tree234-46tree234-40int-44-32string-41 typename CDATA #IMPLIED>
-<!ATTLIST four--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "four">
-
-<!ELEMENT three--tree234-46tree234-40int-44-32string-41 (Int,String,Int,String,(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41),(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41),(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41))>
-<!ATTLIST three--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
-<!ATTLIST three--tree234-46tree234-40int-44-32string-41 typename CDATA #IMPLIED>
-<!ATTLIST three--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "three">
-
-<!ELEMENT two--tree234-46tree234-40int-44-32string-41 (Int,String,(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41),(empty--tree234-46tree234-40int-44-32string-41|four--tree234-46tree234-40int-44-32string-41|three--tree234-46tree234-40int-44-32string-41|two--tree234-46tree234-40int-44-32string-41))>
-<!ATTLIST two--tree234-46tree234-40int-44-32string-41 field CDATA #IMPLIED>
-<!ATTLIST two--tree234-46tree234-40int-44-32string-41 typename CDATA #IMPLIED>
-<!ATTLIST two--tree234-46tree234-40int-44-32string-41 functor CDATA #FIXED "two">
-
-<!-- Elements for functors of type "{string, int, {character, float}}" -->
-
-<!ELEMENT Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 (String,Int,Tuple--Tag_-123character-44-32float-125)>
-<!ATTLIST Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 field CDATA #IMPLIED>
-<!ATTLIST Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 typename CDATA #IMPLIED>
-<!ATTLIST Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 functor CDATA #FIXED "{}">
-
-<!-- Elements for functors of type "{character, float}" -->
-
-<!ELEMENT Tuple--Tag_-123character-44-32float-125 (Char,Float)>
-<!ATTLIST Tuple--Tag_-123character-44-32float-125 field CDATA #IMPLIED>
-<!ATTLIST Tuple--Tag_-123character-44-32float-125 typename CDATA #IMPLIED>
-<!ATTLIST Tuple--Tag_-123character-44-32float-125 functor CDATA #FIXED "{}">
-
-<!-- Elements for functors of type "bool.bool" -->
-
-<!ELEMENT no--bool-46bool EMPTY>
-<!ATTLIST no--bool-46bool field CDATA #IMPLIED>
-<!ATTLIST no--bool-46bool typename CDATA #IMPLIED>
-<!ATTLIST no--bool-46bool functor CDATA #FIXED "no">
-
-<!ELEMENT yes--bool-46bool EMPTY>
-<!ATTLIST yes--bool-46bool field CDATA #IMPLIED>
-<!ATTLIST yes--bool-46bool typename CDATA #IMPLIED>
-<!ATTLIST yes--bool-46bool functor CDATA #FIXED "yes">
-
-<!-- The following types have been assigned to the `Unrecognised' element:
- c_pointer
- pred(int)
- type_desc.type_ctor_desc
- type_desc.type_desc
- write_xml.ftype
--->
-
-<!ELEMENT Unrecognized ANY>
-<!ATTLIST Unrecognized functor CDATA #REQUIRED>
-<!ATTLIST Unrecognized field CDATA #IMPLIED>
-<!ATTLIST Unrecognized typename CDATA #IMPLIED>
+<!ELEMENT Int (#PCDATA)>
+<!ATTLIST Int type CDATA #FIXED "int">
+<!ATTLIST Int field CDATA #IMPLIED>
-]>
-<Array--array-46array-40write_xml-46mytype-41 functor="<<array>>" typename="array.array(write_xml.mytype)">
- <Tag_Tag-45--write_xml-46mytype functor="Tag-" typename="write_xml.mytype">
- <Int>44</Int>
- </Tag_Tag-45--write_xml-46mytype>
- <Tag_String--write_xml-46mytype functor="String" typename="write_xml.mytype">
- <String>a string</String>
- </Tag_String--write_xml-46mytype>
- <hello--write_xml-46mytype functor="hello" typename="write_xml.mytype">
- <String field="field1">this
-is a <string>&</String>
- <Int field="Field<2>">-123</Int>
- <Char><</Char>
- <Float field="another field">1.12300000000000</Float>
- <yes--bool-46bool functor="yes" typename="bool.bool" />
- </hello--write_xml-46mytype>
- <a_tuple--write_xml-46mytype functor="a_tuple" typename="write_xml.mytype">
- <Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 functor="{}" typename="{string, int, {character, float}}">
- <String>some more stuf</String>
- <Int>123456</Int>
- <Tuple--Tag_-123character-44-32float-125 functor="{}" typename="{character, float}">
- <Char>a</Char>
- <Float>1.23553225220000e-97</Float>
- </Tuple--Tag_-123character-44-32float-125>
- </Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125>
- </a_tuple--write_xml-46mytype>
- <Tag_List--write_xml-46mytype functor="List" typename="write_xml.mytype">
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>1</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>2</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <nothing--write_xml-46listPart functor="nothing" typename="write_xml.listPart" />
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>4</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <nothing--write_xml-46listPart functor="nothing" typename="write_xml.listPart" />
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>6</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>7</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>8</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <nothing--write_xml-46listPart functor="nothing" typename="write_xml.listPart" />
- <Nil--list-46list-40write_xml-46listPart-41 functor="[]" typename="list.list(write_xml.listPart)" />
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </Tag_List--write_xml-46mytype>
- <a_map--write_xml-46mytype functor="a_map" typename="write_xml.mytype">
- <four--tree234-46tree234-40int-44-32string-41 functor="four" typename="tree234.tree234(int, string)">
- <Int>2</Int>
- <String>hello1</String>
- <Int>4</Int>
- <String>hello3</String>
- <Int>6</Int>
- <String>hello5</String>
- <two--tree234-46tree234-40int-44-32string-41 functor="two" typename="tree234.tree234(int, string)">
- <Int>1</Int>
- <String>hello</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </two--tree234-46tree234-40int-44-32string-41>
- <two--tree234-46tree234-40int-44-32string-41 functor="two" typename="tree234.tree234(int, string)">
- <Int>3</Int>
- <String>hello2</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </two--tree234-46tree234-40int-44-32string-41>
- <two--tree234-46tree234-40int-44-32string-41 functor="two" typename="tree234.tree234(int, string)">
- <Int>5</Int>
- <String>hello4</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </two--tree234-46tree234-40int-44-32string-41>
- <three--tree234-46tree234-40int-44-32string-41 functor="three" typename="tree234.tree234(int, string)">
- <Int>7</Int>
- <String>hello6</String>
- <Int>8</Int>
- <String>hello7</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </three--tree234-46tree234-40int-44-32string-41>
- </four--tree234-46tree234-40int-44-32string-41>
- </a_map--write_xml-46mytype>
- <a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype functor="a <!@#$%^&*()> functor name!!!" typename="write_xml.mytype">
- <Int>999</Int>
- </a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype>
- <a_pred--write_xml-46mytype functor="a_pred" typename="write_xml.mytype">
- <Unrecognized functor="p" typename="pred(int)">
- <Int>1</Int>
- <Int>2</Int>
- <hello--write_xml-46mytype functor="hello" typename="write_xml.mytype">
- <String field="field1">a string</String>
- <Int field="Field<2>">1</Int>
- <Char>c</Char>
- <Float field="another field">-1.00000000000000e-15</Float>
- <yes--bool-46bool functor="yes" typename="bool.bool" />
- </hello--write_xml-46mytype>
- </Unrecognized>
- </a_pred--write_xml-46mytype>
- <t--write_xml-46mytype functor="t" typename="write_xml.mytype">
- <Unrecognized functor="tree234" typename="type_desc.type_desc">
- <Unrecognized functor="int" typename="type_desc.type_desc" />
- <Unrecognized functor="string" typename="type_desc.type_desc" />
- </Unrecognized>
- </t--write_xml-46mytype>
- <ctor--write_xml-46mytype functor="ctor" typename="write_xml.mytype">
- <Unrecognized functor="tree234.tree234/2" typename="type_desc.type_ctor_desc" />
- </ctor--write_xml-46mytype>
- <foreign--write_xml-46mytype functor="foreign" typename="write_xml.mytype">
- <Unrecognized functor="<<foreign>>" typename="write_xml.ftype" />
- </foreign--write_xml-46mytype>
- <pointer--write_xml-46mytype functor="pointer" typename="write_xml.mytype">
- <Unrecognized functor="<<c_pointer>>" typename="c_pointer" />
- </pointer--write_xml-46mytype>
-</Array--array-46array-40write_xml-46mytype-41>
+]>
+<Array--array-46array-40write_xml-46listPart-41 functor="<<array>>" type="array.array(write_xml.listPart)" arity="9">
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">1</Int>
+ </listPart--1--write_xml-46listPart>
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">2</Int>
+ </listPart--1--write_xml-46listPart>
+ <nothing--0--write_xml-46listPart functor="nothing" type="write_xml.listPart" arity="0" />
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">4</Int>
+ </listPart--1--write_xml-46listPart>
+ <nothing--0--write_xml-46listPart functor="nothing" type="write_xml.listPart" arity="0" />
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">6</Int>
+ </listPart--1--write_xml-46listPart>
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">7</Int>
+ </listPart--1--write_xml-46listPart>
+ <listPart--1--write_xml-46listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">8</Int>
+ </listPart--1--write_xml-46listPart>
+ <nothing--0--write_xml-46listPart functor="nothing" type="write_xml.listPart" arity="0" />
+</Array--array-46array-40write_xml-46listPart-41>
+Result 4:
ok
<?xml version="1.0"?>
-<!DOCTYPE List--list-46list-40write_xml-46mytype-41 PUBLIC "test" "test.dtd">
-<List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <Tag_Tag-45--write_xml-46mytype functor="Tag-" typename="write_xml.mytype">
- <Int>44</Int>
- </Tag_Tag-45--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <Tag_String--write_xml-46mytype functor="String" typename="write_xml.mytype">
- <String>a string</String>
- </Tag_String--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <hello--write_xml-46mytype functor="hello" typename="write_xml.mytype">
- <String field="field1">this
+<!DOCTYPE List PUBLIC "test" "test.dtd">
+<List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <Tag_Tag-45 functor="Tag-" type="write_xml.mytype" arity="1">
+ <Int type="int">44</Int>
+ </Tag_Tag-45>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <Tag_String functor="String" type="write_xml.mytype" arity="1">
+ <String type="string">a string</String>
+ </Tag_String>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <hello functor="hello" type="write_xml.mytype" arity="5">
+ <String type="string">this
is a <string>&</String>
- <Int field="Field<2>">-123</Int>
- <Char><</Char>
- <Float field="another field">1.12300000000000</Float>
- <yes--bool-46bool functor="yes" typename="bool.bool" />
- </hello--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <a_tuple--write_xml-46mytype functor="a_tuple" typename="write_xml.mytype">
- <Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125 functor="{}" typename="{string, int, {character, float}}">
- <String>some more stuf</String>
- <Int>123456</Int>
- <Tuple--Tag_-123character-44-32float-125 functor="{}" typename="{character, float}">
- <Char>a</Char>
- <Float>1.23553225220000e-97</Float>
- </Tuple--Tag_-123character-44-32float-125>
- </Tuple--Tag_-123string-44-32int-44-32-123character-44-32float-125-125>
- </a_tuple--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <Tag_List--write_xml-46mytype functor="List" typename="write_xml.mytype">
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>1</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>2</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <nothing--write_xml-46listPart functor="nothing" typename="write_xml.listPart" />
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>4</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <nothing--write_xml-46listPart functor="nothing" typename="write_xml.listPart" />
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>6</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>7</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>8</Int>
- </listPart--write_xml-46listPart>
- <List--list-46list-40write_xml-46listPart-41 functor="[|]" typename="list.list(write_xml.listPart)">
- <nothing--write_xml-46listPart functor="nothing" typename="write_xml.listPart" />
- <Nil--list-46list-40write_xml-46listPart-41 functor="[]" typename="list.list(write_xml.listPart)" />
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </List--list-46list-40write_xml-46listPart-41>
- </Tag_List--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <a_map--write_xml-46mytype functor="a_map" typename="write_xml.mytype">
- <four--tree234-46tree234-40int-44-32string-41 functor="four" typename="tree234.tree234(int, string)">
- <Int>2</Int>
- <String>hello1</String>
- <Int>4</Int>
- <String>hello3</String>
- <Int>6</Int>
- <String>hello5</String>
- <two--tree234-46tree234-40int-44-32string-41 functor="two" typename="tree234.tree234(int, string)">
- <Int>1</Int>
- <String>hello</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </two--tree234-46tree234-40int-44-32string-41>
- <two--tree234-46tree234-40int-44-32string-41 functor="two" typename="tree234.tree234(int, string)">
- <Int>3</Int>
- <String>hello2</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </two--tree234-46tree234-40int-44-32string-41>
- <two--tree234-46tree234-40int-44-32string-41 functor="two" typename="tree234.tree234(int, string)">
- <Int>5</Int>
- <String>hello4</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </two--tree234-46tree234-40int-44-32string-41>
- <three--tree234-46tree234-40int-44-32string-41 functor="three" typename="tree234.tree234(int, string)">
- <Int>7</Int>
- <String>hello6</String>
- <Int>8</Int>
- <String>hello7</String>
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- <empty--tree234-46tree234-40int-44-32string-41 functor="empty" typename="tree234.tree234(int, string)" />
- </three--tree234-46tree234-40int-44-32string-41>
- </four--tree234-46tree234-40int-44-32string-41>
- </a_map--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype functor="a <!@#$%^&*()> functor name!!!" typename="write_xml.mytype">
- <Int>999</Int>
- </a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <a_pred--write_xml-46mytype functor="a_pred" typename="write_xml.mytype">
- <Unrecognized functor="<<predicate>>" typename="pred(int)" />
- </a_pred--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <t--write_xml-46mytype functor="t" typename="write_xml.mytype">
- <Unrecognized functor="tree234" typename="type_desc.type_desc">
- <Unrecognized functor="int" typename="type_desc.type_desc" />
- <Unrecognized functor="string" typename="type_desc.type_desc" />
- </Unrecognized>
- </t--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <ctor--write_xml-46mytype functor="ctor" typename="write_xml.mytype">
- <Unrecognized functor="tree234.tree234/2" typename="type_desc.type_ctor_desc" />
- </ctor--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <foreign--write_xml-46mytype functor="foreign" typename="write_xml.mytype">
- <Unrecognized functor="<<foreign>>" typename="write_xml.ftype" />
- </foreign--write_xml-46mytype>
- <List--list-46list-40write_xml-46mytype-41 functor="[|]" typename="list.list(write_xml.mytype)">
- <pointer--write_xml-46mytype functor="pointer" typename="write_xml.mytype">
- <Unrecognized functor="<<c_pointer>>" typename="c_pointer" />
- </pointer--write_xml-46mytype>
- <Nil--list-46list-40write_xml-46mytype-41 functor="[]" typename="list.list(write_xml.mytype)" />
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
- </List--list-46list-40write_xml-46mytype-41>
-</List--list-46list-40write_xml-46mytype-41>
+ <Int type="int">-123</Int>
+ <Char type="character"><</Char>
+ <Float type="float">1.12300000000000</Float>
+ <yes functor="yes" type="bool.bool" arity="0" />
+ </hello>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <a_tuple functor="a_tuple" type="write_xml.mytype" arity="1">
+ <Tuple functor="{}" type="{string, int, {character, float}}" arity="3">
+ <String type="string">some more stuf</String>
+ <Int type="int">123456</Int>
+ <Tuple functor="{}" type="{character, float}" arity="2">
+ <Char type="character">a</Char>
+ <Float type="float">1.23553225220000e-97</Float>
+ </Tuple>
+ </Tuple>
+ </a_tuple>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <Tag_List functor="List" type="write_xml.mytype" arity="1">
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">1</Int>
+ </listPart>
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">2</Int>
+ </listPart>
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <nothing functor="nothing" type="write_xml.listPart" arity="0" />
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">4</Int>
+ </listPart>
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <nothing functor="nothing" type="write_xml.listPart" arity="0" />
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">6</Int>
+ </listPart>
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">7</Int>
+ </listPart>
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <listPart functor="listPart" type="write_xml.listPart" arity="1">
+ <Int type="int">8</Int>
+ </listPart>
+ <List functor="[|]" type="list.list(write_xml.listPart)" arity="2">
+ <nothing functor="nothing" type="write_xml.listPart" arity="0" />
+ <Nil functor="[]" type="list.list(write_xml.listPart)" arity="0" />
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </Tag_List>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <a_map functor="a_map" type="write_xml.mytype" arity="1">
+ <four functor="four" type="tree234.tree234(int, string)" arity="10">
+ <Int type="int">2</Int>
+ <String type="string">hello1</String>
+ <Int type="int">4</Int>
+ <String type="string">hello3</String>
+ <Int type="int">6</Int>
+ <String type="string">hello5</String>
+ <two functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">1</Int>
+ <String type="string">hello</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two>
+ <two functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">3</Int>
+ <String type="string">hello2</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two>
+ <two functor="two" type="tree234.tree234(int, string)" arity="4">
+ <Int type="int">5</Int>
+ <String type="string">hello4</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </two>
+ <three functor="three" type="tree234.tree234(int, string)" arity="7">
+ <Int type="int">7</Int>
+ <String type="string">hello6</String>
+ <Int type="int">8</Int>
+ <String type="string">hello7</String>
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ <empty functor="empty" type="tree234.tree234(int, string)" arity="0" />
+ </three>
+ </four>
+ </a_map>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33 functor="a <!@#$%^&*()> functor name!!!" type="write_xml.mytype" arity="1">
+ <Int type="int">999</Int>
+ </a-32-60-33-64-35-36-37-94-38-42-40-41-62-32functor-32name-33-33-33>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <a_pred functor="a_pred" type="write_xml.mytype" arity="1">
+ <Unknown functor="<<predicate>>" type="pred(int)" arity="0" />
+ </a_pred>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <t functor="t" type="write_xml.mytype" arity="1">
+ <Unknown functor="tree234" type="type_desc.type_desc" arity="2">
+ <Unknown functor="int" type="type_desc.type_desc" arity="0" />
+ <Unknown functor="string" type="type_desc.type_desc" arity="0" />
+ </Unknown>
+ </t>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <ctor functor="ctor" type="write_xml.mytype" arity="1">
+ <Unknown functor="tree234.tree234/2" type="type_desc.type_ctor_desc" arity="0" />
+ </ctor>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <foreign functor="foreign" type="write_xml.mytype" arity="1">
+ <Unknown functor="<<foreign>>" type="write_xml.ftype" arity="0" />
+ </foreign>
+ <List functor="[|]" type="list.list(write_xml.mytype)" arity="2">
+ <pointer functor="pointer" type="write_xml.mytype" arity="1">
+ <Unknown functor="<<c_pointer>>" type="c_pointer" arity="0" />
+ </pointer>
+ <Nil functor="[]" type="list.list(write_xml.mytype)" arity="0" />
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+ </List>
+</List>
+Result 5:
ok
<?xml version="1.0"?>
-<listPart--write_xml-46listPart functor="listPart" typename="write_xml.listPart">
- <Int>666</Int>
-</listPart--write_xml-46listPart>
+<!DOCTYPE X SYSTEM "test">
+<X>
+ <X>666</X>
+</X>
+Result 6:
ok
+Result 7:
+duplicate_elements("X", [write_xml.listPart, write_xml.wrap(write_xml.listPart)])
+
+Result 8:
multiple_functors_for_root
+
+<?xml version="1.0"?>
+<ext--1--write_xml-46ext functor="ext" type="write_xml.ext" arity="1">
+ <Int type="int">1</Int>
+</ext--1--write_xml-46ext>
+Result 9:
+ok
Index: tests/hard_coded/write_xml.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/write_xml.m,v
retrieving revision 1.1
diff -u -r1.1 write_xml.m
--- tests/hard_coded/write_xml.m 7 Dec 2004 04:55:51 -0000 1.1
+++ tests/hard_coded/write_xml.m 8 Dec 2004 10:24:45 -0000
@@ -54,7 +54,14 @@
p(_, _, _, 1).
-:- type wrap ---> wrap(mytype).
+:- type wrap(T) ---> wrap(T).
+
+:- pred p1(type_desc::in, maybe_functor_info::in, string::out,
+ list(attribute)::out) is det.
+
+p1(_, _, "X", []).
+
+:- type ext ---> some [T] ext(T).
main(!IO) :-
some [!M] (
@@ -89,23 +96,74 @@
t(type_of(!.M)),
ctor(type_ctor(type_of(!.M))),
foreign(F),
- pointer(P)]),
+ pointer(P)],
+ Map = !.M
+ ),
array.from_list(X, A),
- write_xml_doc_cc(A, with_stylesheet("text/css",
+ write_xml_doc_cc(A, unique, with_stylesheet("text/css",
"http://www.cs.mu.oz.au/a_css.css"), embed, Result1, !IO),
+ write_string("Result 1:\n", !IO),
write(Result1, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc(X, no_stylesheet, external(public("test", "test.dtd")),
- Result2, !IO),
+ write_xml_doc_cc(A, unique, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), no_dtd, Result2, !IO),
+ write_string("Result 2:\n", !IO),
write(Result2, !IO),
nl(!IO),
nl(!IO),
- Simple = listPart(666),
- write_xml_doc(Simple, no_stylesheet, no_dtd, Result3, !IO),
+ write_xml_doc_cc(wrap(Map), unique, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed, Result3, !IO),
+ write_string("Result 3:\n", !IO),
write(Result3, !IO),
nl(!IO),
nl(!IO),
- write_xml_doc(yes, no_stylesheet, embed, Result4, !IO),
+ write_xml_doc_cc(wrap(Map), simple, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed, Result3_1, !IO),
+ write_string("Result 3_1:\n", !IO),
+ write(Result3_1, !IO),
+ nl(!IO),
+ nl(!IO),
+ array.from_list([listPart(1),listPart(2),
+ nothing,
+ listPart(4),
+ nothing,
+ listPart(6),
+ listPart(7),
+ listPart(8),
+ nothing], A2),
+ write_xml_doc(A2, unique, with_stylesheet("text/css",
+ "http://www.cs.mu.oz.au/a_css.css"), embed, Result4, !IO),
+ write_string("Result 4:\n", !IO),
write(Result4, !IO),
+ nl(!IO),
+ nl(!IO),
+ write_xml_doc(X, simple, no_stylesheet,
+ external(public("test", "test.dtd")), Result5, !IO),
+ write_string("Result 5:\n", !IO),
+ write(Result5, !IO),
+ nl(!IO),
+ nl(!IO),
+ Simple = listPart(666),
+ write_xml_doc(Simple, custom(p1), no_stylesheet, external(
+ system("test")), Result6, !IO),
+ write_string("Result 6:\n", !IO),
+ write(Result6, !IO),
+ nl(!IO),
+ nl(!IO),
+ write_xml_doc(wrap(Simple), custom(p1), no_stylesheet, embed,
+ Result7, !IO),
+ write_string("Result 7:\n", !IO),
+ write(Result7, !IO),
+ nl(!IO),
+ nl(!IO),
+ write_xml_doc(yes, unique, no_stylesheet, embed, Result8, !IO),
+ write_string("Result 8:\n", !IO),
+ write(Result8, !IO),
+ nl(!IO),
+ nl(!IO),
+ write_xml_doc('new ext'(1), unique, no_stylesheet, no_dtd,
+ Result9, !IO),
+ write_string("Result 9:\n", !IO),
+ write(Result9, !IO),
nl(!IO).
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list