diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

include XMLPL package.

Browse Source
This commit is contained in:
Vítor Santos Costa 2012-02-14 12:41:12 +00:00
parent 6c16f4e953
commit 8c556f21ba
34 changed files with 3568 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.in
View File

@ -861,6 +861,7 @@ install_copied_files:
@INSTALLCLP@(cd LGPL/clp ; $(MAKE) install)
(cd packages/CLPBN ; $(MAKE) install)
(cd packages/meld; $(MAKE) install)
(cd packages/xml; $(MAKE) install)
(cd packages/ProbLog ; $(MAKE) install)
##########

4
configure vendored
View File

@ -10124,6 +10124,7 @@ mkdir -p packages/RDF
mkdir -p packages/real
mkdir -p packages/semweb
mkdir -p packages/sgml
mkdir -p packages/xml
mkdir -p packages/zlib
ac_config_files="$ac_config_files Makefile"
@ -10170,6 +10171,8 @@ ac_config_files="$ac_config_files packages/cplint/slipcase/Makefile"
ac_config_files="$ac_config_files packages/meld/Makefile"
ac_config_files="$ac_config_files packages/xml/Makefile"
ac_config_files="$ac_config_files packages/ProbLog/Makefile"
@ -11002,6 +11005,7 @@ do
"packages/cplint/approx/simplecuddLPADs/Makefile") CONFIG_FILES="$CONFIG_FILES packages/cplint/approx/simplecuddLPADs/Makefile" ;;
"packages/cplint/slipcase/Makefile") CONFIG_FILES="$CONFIG_FILES packages/cplint/slipcase/Makefile" ;;
"packages/meld/Makefile") CONFIG_FILES="$CONFIG_FILES packages/meld/Makefile" ;;
"packages/xml/Makefile") CONFIG_FILES="$CONFIG_FILES packages/xml/Makefile" ;;
"packages/ProbLog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/ProbLog/Makefile" ;;
"packages/chr/Makefile") CONFIG_FILES="$CONFIG_FILES packages/chr/Makefile" ;;
"packages/clib/Makefile") CONFIG_FILES="$CONFIG_FILES packages/clib/Makefile" ;;

2
configure.in
View File

@ -2289,6 +2289,7 @@ mkdir -p packages/RDF
mkdir -p packages/real
mkdir -p packages/semweb
mkdir -p packages/sgml
mkdir -p packages/xml
mkdir -p packages/zlib
AC_CONFIG_FILES([Makefile])
@ -2313,6 +2314,7 @@ AC_CONFIG_FILES([packages/cplint/Makefile])
AC_CONFIG_FILES([packages/cplint/approx/simplecuddLPADs/Makefile])
AC_CONFIG_FILES([packages/cplint/slipcase/Makefile])
AC_CONFIG_FILES([packages/meld/Makefile])
AC_CONFIG_FILES([packages/xml/Makefile])
AC_CONFIG_FILES([packages/ProbLog/Makefile ])
if test "$ENABLE_CHR" = ""; then

19
docs/yap.tex
View File

@ -2309,6 +2309,25 @@ file into a module which is not the working one, prefix the file name
with the module name, in the form @code{@var{Module}:@var{File}}, when
loading the file.
@item export(+@var{PredicateIndicator})
@findex export/1
@snindex export/1
@cnindex export/1
Add predicates to the public list of the context module. This implies
the predicate will be imported into another module if this module is
imported with @code{use_module/[1,2]}. Note that predicates are normally
exported using the directive @code{module/2}. @code{export/1} is meant
to handle export from dynamically created modules.
@item export_list(?@var{Mod},?@var{ListOfPredicateIndicator})
@findex export_list/2
@snindex export_list/2
@cnindex export_list/2
The list @var{ListOfPredicateIndicator} contains all predicates exported
by module @var{Mod}.
@end table
@node Using Modules, Meta-Predicates in Modules, Defining Modules, Modules

3
packages/meld/Makefile.in
View File

@ -49,7 +49,8 @@ all:
install: $(PROGRAMS) $(EXAMPLES)
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/meld
mkdir -p $(DESTDIR)$(SHAREDIR)/share/Yap/examples/meld
$(INSTALL_DATA) $(srcdir)/meld.yap $(DESTDIR)$(SHAREDIR)/Yap
for p in $(MELD_PROGRAMS); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/Yap/meld; done
for p in $(MELD_EXAMPLES); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/Yap/meld; done
for p in $(MELD_EXAMPLES); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/share/Yap/examples/meld; done

2
packages/real

@ -1 +1 @@
Subproject commit f4c629b195e560662d211ad11054dda458de4ddb
Subproject commit c1584e1ac73304ffc83b5d75b91f5e785ce5d41e

71
packages/xml/Makefile.in Normal file
View File

@ -0,0 +1,71 @@
#
# default base directory for YAP installation
#
ROOTDIR = @prefix@
#
# where the binary should be
#
BINDIR = $(ROOTDIR)/bin
#
# where YAP should look for binary libraries
#
LIBDIR=@libdir@/Yap
#
# where YAP should look for architecture-independent Prolog libraries
#
SHAREDIR=$(ROOTDIR)/share
#
#
# You shouldn't need to change what follows.
#
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
srcdir=@srcdir@
YAP_EXTRAS=@YAP_EXTRAS@
EXDIR=$(srcdir)/examples
XML_PROGRAMS= \
$(srcdir)/xml_acquisition.pl \
$(srcdir)/xml_diagnosis.pl \
$(srcdir)/xml_driver.pl \
$(srcdir)/xml_generation.pl \
$(srcdir)/xml.iso.pl \
$(srcdir)/xml_pp.pl \
$(srcdir)/xml_utilities.pl
XML_EXAMPLES= \
$(srcdir)/xml_example/bib.xml \
$(srcdir)/xml_example/books.xml \
$(srcdir)/xml_example/misc.pl \
$(srcdir)/xml_example/prices.xml \
$(srcdir)/xml_example/q1.xml \
$(srcdir)/xml_example/q2.xml \
$(srcdir)/xml_example/q3.xml \
$(srcdir)/xml_example/q4.xml \
$(srcdir)/xml_example/q5.xml \
$(srcdir)/xml_example/q6.xml \
$(srcdir)/xml_example/q7.xml \
$(srcdir)/xml_example/q8.xml \
$(srcdir)/xml_example/q9.xml \
$(srcdir)/xml_example/q10.xml \
$(srcdir)/xml_example/q11.xml \
$(srcdir)/xml_example/q12.xml \
$(srcdir)/xml_example/reviews.xml \
$(srcdir)/xml_example/xml_example.pl
PROGRAMS= \
$(srcdir)/xml.pl \
$(XML_PROGRAMS)
all:
install: $(PROGRAMS) $(EXAMPLES)
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap
mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/xml
mkdir -p $(DESTDIR)$(SHAREDIR)/doc/Yap/examples/xml
$(INSTALL_DATA) $(srcdir)/xml.pl $(DESTDIR)$(SHAREDIR)/Yap
for p in $(XML_PROGRAMS); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/Yap/xml; done
for p in $(XML_EXAMPLES); do $(INSTALL_DATA) $$p $(DESTDIR)$(SHAREDIR)/doc/Yap/examples/xml; done

78
packages/xml/xml.iso.pl Normal file
View File

@ -0,0 +1,78 @@
/* xml.iso.pl : Wrapper for ISO Prolog.
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.3 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*
*/
:- module( xml,
[
xml_parse/2,
xml_parse/3,
xml_subterm/2,
xml_pp/1
] ).
/* xml is intended to be a rather modular module: it should be easy to
* build a program that can output XML, but not read it, or vice versa.
* Similarly, you may be happy to dispense with diagnosis once you are
* sure that your code will only try to make valid calls to xml_parse/2.
*
* It is intended that the code should be very portable too. Clearly,
* some small changes will be needed between platforms, but these should
* be limited to xml_utilities. xml_utilities contains most of the shared
* code and most of the potentially non-portable code.
*/
:- ensure_loaded( xml_driver ).
/* xml_exception( +Message, +Document, +Culprit, +Path ) is a hook to
* raise an exception to be raised in respect of a fault in the XML Term:
* Document.
* - Culprit is a sub-term of Document which cannot be serialized;
* - Message is an atom naming the type of error;
* - Path is a string encoding a list of SubTerm's ancestor elements in the
* form <tag>{(id)}* where <tag> is the element tag and <id> is the value
* of any attribute _named_ id.
*/
xml_exception( Message, Document, Culprit, Path ) :-
throw(
application_error('XML Parse: ~s in ~q~nCulprit: ~q~nPath: ~s',
[Message,Document,Culprit,Path] )
).
append( [], L, L ).
append( [H|T0], L, [H|T1] ) :-
append( T0, L, T1 ).
otherwise.
/* member( ?Element, ?List ) holds when Element is a member of List.
*/
member( H, [H|_] ).
member( H, [_|T] ):-
member( H, T ).
/* select( ?Element, ?List0, ?List1 ) is true if List1 is equal to List0
* with Element removed.
*/
select( H, [H|T], T ).
select( Element, [H|T0], [H|T1] ):-
select( Element, T0, T1 ).
end_of_file.
/* is_list( +List ) holds when List is a list. Built-in?
*/
is_list( List ) :-
nonvar( List ),
is_list1( List ).
is_list1( [] ).
is_list1( [_|_] ).

62
packages/xml/xml.lpa.pl Normal file
View File

@ -0,0 +1,62 @@
/* xml.lpa.pl : Wrapper for LPA Prolog.
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.3 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*
* xml is intended to be a rather modular module: it should be easy to
* build a program that can output XML, but not read it, or vice versa.
* Similarly, you may be happy to dispense with diagnosis once you are
* sure that your code will only try to make valid calls to xml_parse/2.
*
* It is intended that the code should be very portable too. Clearly,
* some small changes will be needed between platforms, but these should
* be limited to xml_utilities. xml_utilities contains most of the shared
* code and most of the potentially non-portable code.
*/
:- ensure_loaded( xml_driver ).
/* atom_codes/2, number_codes/2 and throw/1 are ISO predicates, mapped to
* the Quintus equivalent here.
*/
atom_codes( Atom, Codes ) :-
atom_chars( Atom, Codes ).
number_codes( Number, Codes ) :-
number_chars( Number, Codes ).
/* xml_exception( +Message, +Document, +Culprit, +Path ) is a hook to
* raise an exception to be raised in respect of a fault in the XML Term:
* Document.
* - Culprit is a sub-term of Document which cannot be serialized;
* - Message is an atom naming the type of error;
* - Path is a string encoding a list of SubTerm's ancestor elements in the
* form <tag>{(id)}* where <tag> is the element tag and <id> is the value
* of any attribute _named_ id.
*/
xml_exception( Message, Document, Culprit, Path ) :-
throw( 23, xml_error([Message,Document,Culprit,Path] ) ).
/* select( ?Element, ?List0, ?List1 ) is true if List1 is equal to List0
* with Element removed.
*/
select( H, [H|T], T ).
select( Element, [H|T0], [H|T1] ):-
select( Element, T0, T1 ).
/* is_list( +List ) holds when List is a list.
*/
is_list( List ) :-
nonvar( List ),
is_list1( List ).
is_list1( [] ).
is_list1( [_|_] ).

86
packages/xml/xml.pl Normal file
View File

@ -0,0 +1,86 @@
/* xml.pl : XML Module wrapper for Quintus Prolog.
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.3 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*
*/
:- module( xml,
[
xml_parse/2,
xml_parse/3,
xml_subterm/2,
xml_pp/1
] ).
/* xml is intended to be a rather modular module: it should be easy to
* build a program that can output XML, but not read it, or vice versa.
* Similarly, you may be happy to dispense with diagnosis once you are
* sure that your code will only try to make valid calls to xml_parse/2.
*
* It is intended that the code should be very portable too. Clearly,
* some small changes will be needed between platforms, but these should
* be limited to xml_utilities. xml_utilities contains most of the shared
* code and most of the potentially non-portable code.
*/
:- use_module( library(lists), [append/3] ).
:- ensure_loaded( xml/xml_driver ).
/* atom_codes/2, number_codes/2 and throw/1 are ISO predicates, mapped to
* the Quintus equivalent here.
*/
%atom_codes( Atom, Codes ) :-
% atom_chars( Atom, Codes ).
%number_codes( Number, Codes ) :-
% number_chars( Number, Codes ).
/* xml_exception( +Message, +Document, +Culprit, +Path ) is a hook to
* raise an exception to be raised in respect of a fault in the XML Term:
* Document.
* - Culprit is a sub-term of Document which cannot be serialized;
* - Message is an atom naming the type of error;
* - Path is a string encoding a list of SubTerm's ancestor elements in the
* form <tag>{(id)}* where <tag> is the element tag and <id> is the value
* of any attribute _named_ id.
*/
xml_exception( Message, Document, Culprit, Path ) :-
raise_exception(
application_error('XML Parse: ~s in ~q~nCulprit: ~q~nPath: ~s',
[Message,Document,Culprit,Path] )
).
/* member( ?Element, ?List ) holds when Element is a member of List.
*/
member( H, [H|_] ).
member( H, [_|T] ):-
member( H, T ).
/* select( ?Element, ?List0, ?List1 ) is true if List1 is equal to List0
* with Element removed.
*/
select( H, [H|T], T ).
select( Element, [H|T0], [H|T1] ):-
select( Element, T0, T1 ).
/* is_list( +List ) holds when List is a list.
*/
%is_list( List ) :-
% nonvar( List ),
% is_list1( List ).
%is_list1( [] ).
%is_list1( [_|_] ).

1117
packages/xml/xml_acquisition.pl Normal file
View File

File diff suppressed because it is too large Load Diff

84
packages/xml/xml_diagnosis.pl Normal file
View File

@ -0,0 +1,84 @@
/* xml_diagnosis.pl : XML exception diagnosis.
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.3 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*/
:- ensure_loaded( xml_generation ).
/* xml_fault( +Term, +Indentation, ?SubTerm, ?Path, ?Message ) identifies SubTerm
* as a sub-term of Term which cannot be serialized after Indentation.
* Message is an atom naming the type of error; Path is a string encoding a
* list of SubTerm's ancestor elements in the form <tag>{(id)}* where <tag> is the
* element tag and <id> is the value of any attribute _named_ id.
*/
xml_fault( Term, _Indent, Term, [], "Illegal Variable" ) :-
var( Term ).
xml_fault( xml(Attributes,_Content), _Indent, Term, [], Message ) :-
member( Attribute, Attributes ),
attribute_fault( Attribute, Term, Message ).
xml_fault( xml(_Attributes,Content), Indent, Culprit, Path, Message ) :-
xml_content_fault( Content, Indent, Culprit, Path, Message ).
xml_fault( Term, _Indent, Term, [], "Illegal Term" ).
xml_content_fault( Term, _Indent, Term, [], "Illegal Variable" ) :-
var( Term ).
xml_content_fault( pcdata(Chars), _Indent, Chars, [], "Invalid Character Data" ) :-
\+ is_chars( Chars ).
xml_content_fault( cdata(Chars), _Indent, Chars, [], "Invalid Character Data" ) :-
\+ is_chars( Chars ).
xml_content_fault( [H|_T], Indent, Culprit, Path, Message ) :-
xml_content_fault( H, Indent, Culprit, Path, Message ).
xml_content_fault( [_H|T], Indent, Culprit, Path, Message ) :-
xml_content_fault( T, Indent, Culprit, Path, Message ).
xml_content_fault( namespace(_URI,_Prefix,Element), Indent, Culprit, Path, Message ) :-
element_fault( Element, [0' |Indent], Culprit, Path, Message ).
xml_content_fault( Element, Indent, Culprit, Path, Message ) :-
element_fault( Element, [0' |Indent], Culprit, Path, Message ).
xml_content_fault( Term, Indent, Term, [], "Illegal Term" ) :-
\+ generation(Term, "", false, Indent, _Format, _Plus, _Minus ).
element_fault( element(Tag, _Attributes, _Contents), _Indent, Tag, [], "Tag must be an atom" ) :-
\+ atom( Tag ).
element_fault( element(Tag, Attributes, _Contents), _Indent, Tag, [], "Attributes must be instantiated" ) :-
var( Attributes ).
element_fault( element(Tag, Attributes, _Contents), _Indent, Faulty, Path, Message ) :-
fault_path( Tag, Attributes, Path, [] ),
member( Attribute, Attributes ),
attribute_fault( Attribute, Faulty, Message ).
element_fault( element(Tag, Attributes, Contents), Indent, Culprit, Path, Message ) :-
fault_path( Tag, Attributes, Path, Path1 ),
xml_content_fault( Contents, Indent, Culprit, Path1, Message ).
attribute_fault( Attribute, Attribute, "Illegal Variable" ) :-
var( Attribute ).
attribute_fault( Name=Value, Name=Value, "Attribute Name must be atom" ) :-
\+ atom(Name).
attribute_fault( Name=Value, Name=Value, "Attribute Value must be chars" ) :-
\+ is_chars( Value ).
attribute_fault( Attribute, Attribute, "Malformed Attribute" ) :-
\+ Attribute = (_Name=_Value).
is_chars( Chars ) :-
is_list( Chars ),
\+ (member( Char, Chars ), \+ (integer(Char), Char >=0, Char =< 255)).
fault_path( Tag, Attributes ) -->
{atom_codes( Tag, Chars )},
chars( Chars ),
fault_id( Attributes ),
" ".
fault_id( Attributes ) -->
{member( id=Chars, Attributes ), is_chars( Chars )},
!,
"(", chars(Chars), ")".
fault_id( _Attributes ) --> "".

131
packages/xml/xml_driver.pl Normal file
View File

@ -0,0 +1,131 @@
/* xml_driver.pl : Contains xml_parse/[2,3] a bi-directional XML parser written in
* Prolog.
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.3 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*
* xml_parse( {+Controls}, +?Chars, ?+Document ) parses Chars to/from a data
* structure of the form xml(<atts>, <content>). <atts> is a list of
* <atom>=<string> attributes from the (possibly implicit) XML signature of the
* document. <content> is a (possibly empty) list comprising occurrences of :
*
* pcdata(<string>) : Text
* comment(<string>) : An xml comment;
* element(<tag>,<atts>,<content>) : <tag>..</tag> encloses <content>
* : <tag /> if empty
* instructions(<atom>, <string>) : Processing <? <atom> <params> ?>"
* cdata( <string> ) : <![CDATA[ <string> ]]>
* doctype(<atom>, <doctype id>) : DTD <!DOCTYPE .. >
*
* The conversions are not completely symmetrical, in that weaker XML is
* accepted than can be generated. Specifically, in-bound (Chars -> Document)
* does not require strictly well-formed XML. Document is instantiated to the
* term malformed(Attributes, Content) if Chars does not represent well-formed
* XML. The Content of a malformed/2 structure can contain:
*
* unparsed( <string> ) : Text which has not been parsed
* out_of_context( <tag> ) : <tag> is not closed
*
* in addition to the standard term types.
*
* Out-bound (Document -> Chars) parsing _does_ require that Document defines
* strictly well-formed XML. If an error is detected a 'domain' exception is
* raised.
*
* The domain exception will attempt to identify the particular sub-term in
* error and the message will show a list of its ancestor elements in the form
* <tag>{(id)}* where <id> is the value of any attribute _named_ id.
*
* At this release, the Controls applying to in-bound (Chars -> Document)
* parsing are:
*
* extended_characters(<bool>) : Use the extended character
* : entities for XHTML (default true)
*
* format(<bool>) : Strip layouts when no character data
* : appears between elements.
* : (default true)
*
* remove_attribute_prefixes(<bool>) : Remove namespace prefixes from
* : attributes when it's the same as the
* : prefix of the parent element
* : (default false).
*
* allow_ampersand(<bool>) : Allow unescaped ampersand
* : characters (&) to occur in PCDATA.
* : (default false).
*
* [<bool> is one of 'true' or 'false']
*
* For out-bound (Document -> Chars) parsing, the only available option is:
*
* format(<Bool>) : Indent the element content
* : (default true)
*
* Different DCGs for input and output are used because input parsing is
* more flexible than output parsing. Errors in input are recorded as part
* of the data structure. Output parsing throws an exception if the document
* is not well-formed, diagnosis tries to identify the specific culprit term.
*/
xml_parse( Chars, Document ) :-
xml_parse( [], Chars, Document ).
xml_parse( Controls, Chars, Document ) :-
( ground( Chars ) ->
xml_to_document( Controls, Chars, Document )
; otherwise ->
document_to_xml( Controls, Document, Chars )
).
document_to_xml( Controls, Document, Chars ) :-
( member( format(false), Controls ) ->
Format = false
; otherwise ->
Format = true
),
( ground( Document ),
document_generation(Format, Document, Chars0, [] ) ->
Chars = Chars0
; otherwise ->
xml_fault( Document, [], Culprit, Path, Message ),
xml_exception( Message, Document, Culprit, Path )
).
/* xml_subterm( +XMLTerm, ?Subterm ) unifies Subterm with a sub-term of Term.
* Note that XMLTerm is a sub-term of itself.
*/
xml_subterm( Term, Term ).
xml_subterm( xml(_Attributes, Content), Term ) :-
xml_subterm( Content, Term ).
xml_subterm( [H|T], Term ) :-
( xml_subterm( H, Term )
; xml_subterm( T, Term )
).
xml_subterm( element(_Name,_Attributes,Content), Term ) :-
xml_subterm( Content, Term ).
xml_subterm( namespace(_URI,_Prefix,Content), Term ) :-
xml_subterm( Content, Term ).
/* xml is intended to be a rather modular module: it should be easy to
* build a program that can output XML, but not read it, or vice versa.
* Similarly, you may be happy to dispense with diagnosis once you are
* sure that your code will only try to make valid calls to xml_parse/2.
*
* It is intended that the code should be very portable too. Clearly,
* some small changes will be needed between platforms, but these should
* be limited to xml_utilities. xml_utilities contains most of the shared
* code and most of the potentially non-portable code.
*/
:- ensure_loaded( xml_acquisition ).
:- ensure_loaded( xml_diagnosis ).
:- ensure_loaded( xml_generation ).
:- ensure_loaded( xml_pp ).
:- ensure_loaded( xml_utilities ).

36
packages/xml/xml_example/bib.xml Normal file
View File

@ -0,0 +1,36 @@
<bib>
<book year="1994">
<title>TCP/IP Illustrated</title>
<author><last>Stevens</last><first>W.</first></author>
<publisher>Addison-Wesley</publisher>
<price> 65.95</price>
</book>
<book year="1992">
<title>Advanced Programming in the Unix environment</title>
<author><last>Stevens</last><first>W.</first></author>
<publisher>Addison-Wesley</publisher>
<price>65.95</price>
</book>
<book year="2000">
<title>Data on the Web</title>
<author><last>Abiteboul</last><first>Serge</first></author>
<author><last>Buneman</last><first>Peter</first></author>
<author><last>Suciu</last><first>Dan</first></author>
<publisher>Morgan Kaufmann Publishers</publisher>
<price>39.95</price>
</book>
<book year="1999">
<title>The Economics of Technology and Content for Digital TV</title>
<editor>
<last>Gerbarg</last><first>Darcy</first>
<affiliation>CITI</affiliation>
</editor>
<publisher>Kluwer Academic Publishers</publisher>
<price>129.95</price>
</book>
</bib>

15
packages/xml/xml_example/books.xml Normal file
View File

@ -0,0 +1,15 @@
<chapter>
<title>Data Model</title>
<section>
<title>Syntax For Data Model</title>
</section>
<section>
<title>XML</title>
<section>
<title>Basic Syntax</title>
</section>
<section>
<title>XML and Semistructured Data</title>
</section>
</section>
</chapter>

95
packages/xml/xml_example/misc.pl Normal file
View File

@ -0,0 +1,95 @@
% Utility Predicates
% The following predicates are used in the puzzle solutions.
% unique_solution( +Goal ) holds when Goal has one ground solution. Operationally,
% Goal may produce several solutions, ("don't care" non-deterministically), but they
% must all be identical (==).
unique_solution( Goal ) :-
findall( Goal, Goal, [Solution|Solutions] ),
same_solution( Solutions, Solution ),
Solution = Goal.
same_solution( [], _Solution ).
same_solution( [Solution0|Solutions], Solution ) :-
Solution0 == Solution,
same_solution( Solutions, Solution ).
% forall( +Enumerator, +Test ) is true if Enumerator and Test are goals and Test holds everywhere
% that Enumerator does. NB: does not further instantiate arguments.
%% forall( Enumerator, Test ) :-
%% \+ (call(Enumerator), \+ call(Test)).
% member( ?Element, ?List ) holds when Element is a member of List.
member( H, [H|_] ).
member( H, [_|T] ):-
member( H, T ).
% select( ?Element, ?List0, ?List1 ) is true if List1 is equal to List1 with Element removed.
select( H, [H|T], T ).
select( Element, [H|T0], [H|T1] ):-
select( Element, T0, T1 ).
% memberchk( +Element, +List ) succeeds (once) if Element is a member of List.
memberchk( Element, List ):-
member( Element, List ),
!.
% between( +Lower, +Upper, ?Index ) is true if Lower =< Index =< Upper. Two valid cases are
% possible:
% - Index is already instantiated to an integer so the checks on order are applied (test).
% - Index is a logical variable so a series of alternative solutions is generated as the
% monotonic sequence of values between Lower and Upper (non-deterministic generator).
%% between( Lower, Upper, Index ):-
%% integer( Lower ),
%% integer( Upper ),
%% Lower =< Upper,
%% ( integer( Index ) -> % Case 1: "test"
%% Index >= Lower,
%% Index =< Upper
%% ; var( Index ) -> % Case 2: "generate".
%% generate_between( Lower, Upper, Index )
%% ).
generate_between( Lower, Upper, Index ) :-
( Lower =:= Upper ->
Index = Lower
; Index = Lower
; Next is Lower + 1,
Next =< Upper,
generate_between( Next, Upper, Index )
).
% sum( +List, ?Sum ) holds when the List of numbers sum to Sum.
sum( [H|T], Sum ) :-
sum1( T, H, Sum ).
sum1( [], Sum, Sum ).
sum1( [H|T], Sum0, Sum ):-
Sum1 is Sum0 + H,
sum1( T, Sum1, Sum ).
% put_chars( +Chars ) if Chars is a (possibly empty) list of character codes and the
% corresponding characters are written to the current output stream.
put_chars( [] ).
put_chars( [Char|Chars] ) :-
put( Char ),
put_chars( Chars ).
% get_chars( ?Chars ) if Chars is a (possibly empty) list of character codes read
% from the current input stream.
get_chars( Input ) :-
get0( Char ),
( Char > -1 ->
Input = [Char|Chars],
get_chars( Chars )
; otherwise ->
Input = []
).

32
packages/xml/xml_example/prices.xml Normal file
View File

@ -0,0 +1,32 @@
<prices>
<book>
<title>Advanced Programming in the Unix environment</title>
<source>www.amazon.com</source>
<price>65.95</price>
</book>
<book>
<title>Advanced Programming in the Unix environment</title>
<source>www.bn.com</source>
<price>65.95</price>
</book>
<book>
<title>TCP/IP Illustrated</title>
<source>www.amazon.com</source>
<price>65.95</price>
</book>
<book>
<title>TCP/IP Illustrated</title>
<source>www.bn.com</source>
<price>65.95</price>
</book>
<book>
<title>Data on the Web</title>
<source>www.amazon.com</source>
<price>34.95</price>
</book>
<book>
<title>Data on the Web</title>
<source>www.bn.com</source>
<price>39.95</price>
</book>
</prices>

9
packages/xml/xml_example/q1.xml Normal file
View File

@ -0,0 +1,9 @@
<bib>
<book year="1994">
<title>TCP/IP Illustrated</title>
</book>
<book year="1992">
<title>Advanced Programming in the Unix environment</title>
</book>
</bib>

11
packages/xml/xml_example/q10.xml Normal file
View File

@ -0,0 +1,11 @@
<results>
<minprice title="Advanced Programming in the Unix environment">
<price>65.95</price>
</minprice>
<minprice title="TCP/IP Illustrated">
<price>65.95</price>
</minprice>
<minprice title="Data on the Web">
<price>34.95</price>
</minprice>
</results>

35
packages/xml/xml_example/q11.xml Normal file
View File

@ -0,0 +1,35 @@
<bib>
<book>
<title>TCP/IP Illustrated</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</book>
<book>
<title>Advanced Programming in the Unix environment</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</book>
<book>
<title>Data on the Web</title>
<author>
<last>Abiteboul</last>
<first>Serge</first>
</author>
<author>
<last>Buneman</last>
<first>Peter</first>
</author>
<author>
<last>Suciu</last>
<first>Dan</first>
</author>
</book>
<reference>
<title>The Economics of Technology and Content for Digital TV</title>
<affiliation>CITI</affiliation>
</reference>
</bib>

6
packages/xml/xml_example/q12.xml Normal file
View File

@ -0,0 +1,6 @@
<bib>
<book-pair>
<title>TCP/IP Illustrated</title>
<title>Advanced Programming in the Unix environment</title>
</book-pair>
</bib>

37
packages/xml/xml_example/q2.xml Normal file
View File

@ -0,0 +1,37 @@
<results>
<result>
<title>TCP/IP Illustrated</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</result>
<result>
<title>Advanced Programming in the Unix environment</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</result>
<result>
<title>Data on the Web</title>
<author>
<last>Abiteboul</last>
<first>Serge</first>
</author>
</result>
<result>
<title>Data on the Web</title>
<author>
<last>Buneman</last>
<first>Peter</first>
</author>
</result>
<result>
<title>Data on the Web</title>
<author>
<last>Suciu</last>
<first>Dan</first>
</author>
</result>
</results>

34
packages/xml/xml_example/q3.xml Normal file
View File

@ -0,0 +1,34 @@
<results>
<result>
<title>TCP/IP Illustrated</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</result>
<result>
<title>Advanced Programming in the Unix environment</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</result>
<result>
<title>Data on the Web</title>
<author>
<last>Abiteboul</last>
<first>Serge</first>
</author>
<author>
<last>Buneman</last>
<first>Peter</first>
</author>
<author>
<last>Suciu</last>
<first>Dan</first>
</author>
</result>
<result>
<title>The Economics of Technology and Content for Digital TV</title>
</result>
</results>

31
packages/xml/xml_example/q4.xml Normal file
View File

@ -0,0 +1,31 @@
<results>
<result>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
<title>TCP/IP Illustrated</title>
<title>Advanced Programming in the Unix environment</title>
</result>
<result>
<author>
<last>Abiteboul</last>
<first>Serge</first>
</author>
<title>Data on the Web</title>
</result>
<result>
<author>
<last>Buneman</last>
<first>Peter</first>
</author>
<title>Data on the Web</title>
</result>
<result>
<author>
<last>Suciu</last>
<first>Dan</first>
</author>
<title>Data on the Web</title>
</result>
</results>

18
packages/xml/xml_example/q5.xml Normal file
View File

@ -0,0 +1,18 @@
<books-with-prices>
<book-with-prices>
<title>TCP/IP Illustrated</title>
<price-amazon>65.95</price-amazon>
<price-bn> 65.95</price-bn>
</book-with-prices>
<book-with-prices>
<title>Advanced Programming in the Unix environment</title>
<price-amazon>65.95</price-amazon>
<price-bn>65.95</price-bn>
</book-with-prices>
<book-with-prices>
<title>Data on the Web</title>
<price-amazon>34.95</price-amazon>
<price-bn>39.95</price-bn>
</book-with-prices>
</books-with-prices>

28
packages/xml/xml_example/q6.xml Normal file
View File

@ -0,0 +1,28 @@
<bib>
<book>
<title>TCP/IP Illustrated</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</book>
<book>
<title>Advanced Programming in the Unix environment</title>
<author>
<last>Stevens</last>
<first>W.</first>
</author>
</book>
<book>
<title>Data on the Web</title>
<author>
<last>Abiteboul</last>
<first>Serge</first>
</author>
<author>
<last>Buneman</last>
<first>Peter</first>
</author>
<et-al/>
</book>
</bib>

9
packages/xml/xml_example/q7.xml Normal file
View File

@ -0,0 +1,9 @@
<bib>
<book year="1992">
<title>Advanced Programming in the Unix environment</title>
</book>
<book year="1994">
<title>TCP/IP Illustrated</title>
</book>
</bib>

10
packages/xml/xml_example/q8.xml Normal file
View File

@ -0,0 +1,10 @@
<bib>
<book>
<title>Data on the Web</title>
<author>
<last>Suciu</last>
<first>Dan</first>
</author>
</book>
</bib>

5
packages/xml/xml_example/q9.xml Normal file
View File

@ -0,0 +1,5 @@
<results>
<title>XML</title>
<title>XML and Semistructured Data</title>
</results>

25
packages/xml/xml_example/reviews.xml Normal file
View File

@ -0,0 +1,25 @@
<reviews>
<entry>
<title>Data on the Web</title>
<price>34.95</price>
<review>
A very good discussion of semi-structured database
systems and XML.
</review>
</entry>
<entry>
<title>Advanced Programming in the Unix environment</title>
<price>65.95</price>
<review>
A clear and detailed discussion of UNIX programming.
</review>
</entry>
<entry>
<title>TCP/IP Illustrated</title>
<price>65.95</price>
<review>
One of the best books on TCP/IP.
</review>
</entry>
</reviews>

388
packages/xml/xml_example/xml_example.pl Normal file
View File

@ -0,0 +1,388 @@
/* Using xml.pl to solve XML Query Cases - An Example
*
* The following is a complete example to illustrate how the module can be used;
* it exercises both the input and output parsing modes of xml_parse/[2,3], and
* illustrates the use of xml_subterm/2 to access the nodes of a "document value
* model". It's written for Quintus Prolog, but should port to other Prologs
* easily.
*
* The entry-point of the program is the test/1 predicate.
*
* test( +QueryId ) executes a Prolog implementation of a Query from Use Case
* "XMP": Experiences and Exemplars, in the W3C's XML Query Use Cases, which
* "contains several example queries that illustrate requirements gathered from
* the database and document communities".
* <http://www.w3.org/TR/2002/WD-xmlquery-use-cases-20021115/#xmp>
*
* QueryId is one of q1…q12 selecting which of the 12 use cases is executed.
* The XML output is written to the file [QueryId].xml in the current directory.
*
* xml_pp/1 is used to display the resulting "document value model"
% data-structures on the user output (stdout) stream.
*/
:- use_module(library(lists),[append/3]).
test( Query ) :-
xml_query( Query, ResultElement ),
% Parse output XML into the Output chars
xml_parse( Output, xml([], [ResultElement]) ),
absolute_file_name( Query, [extensions([xml])], OutputFile ),
% Write OutputFile from the Output list of chars
tell( OutputFile ),
put_chars( Output ),
told,
% Pretty print OutputXML
write( 'Output XML' ), nl,
xml_pp( xml([], [ResultElement]) ).
/* xml_query( +QueryNo, ?OutputXML ) when OutputXML is an XML Document Value Model
* produced by running an example taken, identified by QueryNo from the XML Query
* "XMP" use case.
*/
% Q1: List books published by Addison-Wesley after 1991, including their year and
% title.
xml_query( q1, element(bib, [], Books) ) :-
element_name( Title, title ),
element_name( Publisher, publisher ),
input_document( 'bib.xml', Bibliography ),
findall(
element(book, [year=Year], [Title]),
(
xml_subterm( Bibliography, element(book, Attributes, Content) ),
xml_subterm( Content, Publisher ),
xml_subterm( Publisher, Text ),
text_value( Text, "Addison-Wesley" ),
member( year=Year, Attributes ),
number_codes( YearNo, Year ),
YearNo > 1991,
xml_subterm( Content, Title )
),
Books
).
% Q2: Create a flat list of all the title-author pairs, with each pair enclosed
% in a "result" element.
xml_query( q2, element(results, [], Results) ) :-
element_name( Title, title ),
element_name( Author, author ),
element_name( Book, book ),
input_document( 'bib.xml', Bibliography ),
findall(
element(result, [], [Title,Author]),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Title ),
xml_subterm( Book, Author )
),
Results
).
% Q3: For each book in the bibliography, list the title and authors, grouped
% inside a "result" element.
xml_query( q3, element(results, [], Results) ) :-
element_name( Title, title ),
element_name( Author, author ),
element_name( Book, book ),
input_document( 'bib.xml', Bibliography ),
findall(
element(result, [], [Title|Authors]),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Title ),
findall( Author, xml_subterm(Book, Author), Authors )
),
Results
).
% Q4: For each author in the bibliography, list the author's name and the titles
% of all books by that author, grouped inside a "result" element.
xml_query( q4, element(results, [], Results) ) :-
element_name( Title, title ),
element_name( Author, author ),
element_name( Book, book ),
input_document( 'bib.xml', Bibliography ),
findall( Author, xml_subterm(Bibliography, Author), AuthorBag ),
sort( AuthorBag, Authors ),
findall(
element(result, [], [Author|Titles]),
(
member( Author, Authors ),
findall( Title, (
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Author ),
xml_subterm( Book, Title )
),
Titles
)
),
Results
).
% Q5: For each book found at both bn.com and amazon.com, list the title of the
% book and its price from each source.
xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :-
element_name( Title, title ),
element_name( Book, book ),
element_name( Review, entry ),
input_document( 'bib.xml', Bibliography ),
input_document( 'reviews.xml', Reviews ),
findall(
element('book-with-prices', [], [
Title,
element('price-bn',[], BNPrice ),
element('price-amazon',[], AmazonPrice )
] ),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Title ),
xml_subterm( Reviews, Review ),
xml_subterm( Review, Title ),
xml_subterm( Book, element(price,_, BNPrice) ),
xml_subterm( Review, element(price,_, AmazonPrice) )
),
BooksWithPrices
).
% Q6: For each book that has at least one author, list the title and first two
% authors, and an empty "et-al" element if the book has additional authors.
xml_query( q6, element(bib, [], Results) ) :-
element_name( Title, title ),
element_name( Author, author ),
element_name( Book, book ),
input_document( 'bib.xml', Bibliography ),
findall(
element(book, [], [Title,FirstAuthor|Authors]),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Title ),
findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ),
other_authors( Others, Authors )
),
Results
).
% Q7: List the titles and years of all books published by Addison-Wesley after
% 1991, in alphabetic order.
xml_query( q7, element(bib, [], Books) ) :-
element_name( Title, title ),
element_name( Publisher, publisher ),
input_document( 'bib.xml', Bibliography ),
findall(
Title-element(book, [year=Year], [Title]),
(
xml_subterm( Bibliography, element(book, Attributes, Book) ),
xml_subterm( Book, Publisher ),
xml_subterm( Publisher, Text ),
text_value( Text, "Addison-Wesley" ),
member( year=Year, Attributes ),
number_codes( YearNo, Year ),
YearNo > 1991,
xml_subterm( Book, Title )
),
TitleBooks
),
keysort( TitleBooks, TitleBookSet ),
range( TitleBookSet, Books ).
% Q8: Find books in which the name of some element ends with the string "or" and
% the same element contains the string "Suciu" somewhere in its content. For each
% such book, return the title and the qualifying element.
xml_query( q8, element(bib, [], Books) ) :-
element_name( Title, title ),
element_name( Book, book ),
element_name( QualifyingElement, QualifyingName ),
append( "Suciu", _Back, Suffix ),
input_document( 'bib.xml', Bibliography ),
findall(
element(book, [], [Title,QualifyingElement]),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, QualifyingElement ),
atom_codes( QualifyingName, QNChars ),
append( _QNPrefix, "or", QNChars ),
xml_subterm( QualifyingElement, TextItem ),
text_value( TextItem, TextValue ),
append( _Prefix, Suffix, TextValue ),
xml_subterm( Book, Title )
),
Books
).
% Q9: In the document "books.xml", find all section or chapter titles that
% contain the word "XML", regardless of the level of nesting.
xml_query( q9, element(results, [], Titles) ) :-
element_name( Title, title ),
append( "XML", _Back, Suffix ),
input_document( 'books.xml', Books ),
findall(
Title,
(
xml_subterm( Books, Title ),
xml_subterm( Title, TextItem ),
text_value( TextItem, TextValue ),
append( _Prefix, Suffix, TextValue )
),
Titles
).
% Q10: In the document "prices.xml", find the minimum price for each book, in the
% form of a "minprice" element with the book title as its title attribute.
xml_query( q10, element(results, [], MinPrices) ) :-
element_name( Title, title ),
element_name( Price, price ),
input_document( 'prices.xml', Prices ),
findall( Title, xml_subterm(Prices, Title), TitleBag ),
sort( TitleBag, TitleSet ),
element_name( Book, book ),
findall(
element(minprice, [title=TitleString], [MinPrice]),
(
member( Title, TitleSet ),
xml_subterm( Title, TitleText ),
text_value( TitleText, TitleString ),
findall( PriceValue-Price, (
xml_subterm( Prices, Book ),
xml_subterm( Book, Title ),
xml_subterm( Book, Price ),
xml_subterm( Price, Text ),
text_value( Text, PriceChars ),
number_codes( PriceValue, PriceChars )
),
PriceValues
),
minimum( PriceValues, PriceValue-MinPrice )
),
MinPrices
).
% Q11: For each book with an author, return the book with its title and authors.
% For each book with an editor, return a reference with the book title and the
% editor's affiliation.
xml_query( q11, element(bib, [], Results) ) :-
element_name( Title, title ),
element_name( Author, author ),
element_name( Book, book ),
element_name( Editor, editor ),
element_name( Affiliation, affiliation ),
input_document( 'bib.xml', Bibliography ),
findall(
element(book, [], [Title,FirstAuthor|Authors]),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Title ),
findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] )
),
Books
),
findall(
element(reference, [], [Title,Affiliation]),
(
xml_subterm( Bibliography, Book ),
xml_subterm( Book, Title ),
xml_subterm( Book, Editor ),
xml_subterm( Editor, Affiliation )
),
References
),
append( Books, References, Results ).
% Q12: Find pairs of books that have different titles but the same set of authors
% (possibly in a different order).
xml_query( q12, element(bib, [], Pairs) ) :-
element_name( Author, author ),
element_name( Book1, book ),
element_name( Book2, book ),
element_name( Title1, title ),
element_name( Title2, title ),
input_document( 'bib.xml', Bibliography ),
findall(
element('book-pair', [], [Title1,Title2]),
(
xml_subterm( Bibliography, Book1 ),
findall( Author, xml_subterm(Book1, Author), AuthorBag1 ),
sort( AuthorBag1, AuthorSet ),
xml_subterm( Bibliography, Book2 ),
Book2 @< Book1,
findall( Author, xml_subterm(Book2, Author), AuthorBag2 ),
sort( AuthorBag2, AuthorSet ),
xml_subterm( Book1, Title1 ),
xml_subterm( Book2, Title2 )
),
Pairs
).
% Auxilliary Predicates
other_authors( [], [] ).
other_authors( [Author|Authors], [Author|EtAl] ) :-
et_al( Authors, EtAl ).
et_al( [], [] ).
et_al( [_|_], [element('et-al',[],[])] ).
text_value( [pcdata(Text)], Text ).
text_value( [cdata(Text)], Text ).
element_name( element(Name, _Attributes, _Content), Name ).
/* range( +Pairs, ?Range ) when Pairs is a list of key-datum pairs and Range
* is the list of data.
*/
range( [], [] ).
range( [_Key-Datum|Pairs], [Datum|Data] ) :-
range( Pairs, Data ).
/* minimum( +List, ?Min ) is true if Min is the least member of List in the
* standard order.
*/
minimum( [H|T], Min ):-
minimum1( T, H, Min ).
minimum1( [], Min, Min ).
minimum1( [H|T], Min0, Min ) :-
compare( Relation, H, Min0 ),
minimum2( Relation, H, Min0, T, Min ).
minimum2( '=', Min0, Min0, T, Min ) :-
minimum1( T, Min0, Min ).
minimum2( '<', Min0, _Min1, T, Min ) :-
minimum1( T, Min0, Min ).
minimum2( '>', _Min0, Min1, T, Min ) :-
minimum1( T, Min1, Min ).
/* input_document( +File, ?XML ) reads File and parses the input into the
* "Document Value Model" XML.
*/
input_document( File, XML ) :-
% Read InputFile as a list of chars
see( File ),
get_chars( Input ),
seen,
% Parse the Input chars into the term XML
xml_parse( Input, XML ).
% Load the XML module.
:- use_module( library(xml) ).
% Load a small library of utilities.
:- ensure_loaded( misc ).

389
packages/xml/xml_generation.pl Normal file
View File

@ -0,0 +1,389 @@
/* xml_generation.pl : Document -> XML translation
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.7 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*/
:- ensure_loaded( xml_utilities ).
/* document_generation( +Format, +Document ) is a DCG generating Document
* as a list of character codes. Format is true|false defining whether layouts,
* to provide indentation, should be added between the element content of
* the resultant "string". Note that formatting is disabled for elements that
* are interspersed with pcdata/1 terms, such as XHTML's 'inline' elements.
* Also, Format is over-ridden, for an individual element, by an explicit
* 'xml:space'="preserve" attribute.
*/
document_generation( Format, xml(Attributes, Document) ) -->
document_generation_body( Attributes, Format, Document ).
document_generation_body( [], Format, Document ) -->
generation( Document, "", Format, [], _Format1 ).
document_generation_body( Attributes, Format, Document ) -->
{ Attributes = [_|_],
xml_declaration_attributes_valid( Attributes )
},
"<?xml",
generated_attributes( Attributes, Format, Format0 ),
"?>",
indent( true, [] ),
generation( Document, "", Format0, [], _Format1 ).
generation( [], _Prefix, Format, _Indent, Format ) --> [].
generation( [Term|Terms], Prefix, Format0, Indent, Format ) -->
generation( Term, Prefix, Format0, Indent, Format1 ),
generation( Terms, Prefix, Format1, Indent, Format ).
generation( doctype(Name, External), _Prefix, Format, [], Format ) -->
"<!DOCTYPE ",
generated_name( Name ),
generated_external_id( External ),
">".
generation( instructions(Target,Process), _Prefix, Format, Indent, Format ) -->
indent( Format, Indent ),
"<?", generated_name(Target), " ", chars( Process ) ,"?>".
generation( pcdata(Chars), _Prefix, Format0, _Indent, Format1 ) -->
pcdata_generation( Chars ),
{character_data_format( Chars, Format0, Format1 )}.
generation( comment( Comment ), _Prefix, Format, Indent, Format ) -->
indent( Format, Indent ),
"<!--", chars( Comment ), "-->".
generation( namespace(URI, Prefix, element(Name, Atts, Content)),
_Prefix0, Format, Indent, Format ) -->
indent( Format, Indent ),
"<", generated_prefixed_name( Prefix, Name ),
generated_prefixed_attributes( Prefix, URI, Atts, Format, Format1 ),
generated_content( Content, Format1, Indent, Prefix, Name ).
generation( element(Name, Atts, Content), Prefix, Format, Indent, Format ) -->
indent( Format, Indent ),
"<", generated_prefixed_name( Prefix, Name ),
generated_attributes( Atts, Format, Format1 ),
generated_content( Content, Format1, Indent, Prefix, Name ).
generation( cdata(CData), _Prefix, Format0, _Indent, Format1 ) -->
"<![CDATA[", cdata_generation(CData), "]]>",
{character_data_format( CData, Format0, Format1 )}.
generated_attributes( [], Format, Format ) --> [].
generated_attributes( [Name=Value|Attributes], Format0, Format ) -->
{( Name == 'xml:space',
Value="preserve" ->
Format1 = false
; otherwise ->
Format1 = Format0
)},
" ",
generated_name( Name ),
"=""",
quoted_string( Value ),
"""",
generated_attributes( Attributes, Format1, Format ).
generated_prefixed_name( [], Name ) -->
generated_name( Name ).
generated_prefixed_name( Prefix, Name ) -->
{Prefix = [_|_]},
chars( Prefix ), ":",
generated_name( Name ).
generated_content( [], _Format, _Indent, _Prefix, _Namespace ) -->
" />". % Leave an extra space for XHTML output.
generated_content( [H|T], Format, Indent, Prefix, Namespace ) -->
">",
generation( H, Prefix, Format, [0' |Indent], Format1 ),
generation( T, Prefix, Format1, [0' |Indent], Format2 ),
indent( Format2, Indent ),
"</", generated_prefixed_name( Prefix, Namespace ), ">".
generated_prefixed_attributes( [_|_Prefix], _URI, Atts, Format0, Format ) -->
generated_attributes( Atts, Format0, Format ).
generated_prefixed_attributes( [], URI, Atts, Format0, Format ) -->
{atom_codes( URI, Namespace ),
findall( Attr, (member(Attr, Atts), \+ Attr=(xmlns=_Val)), Atts1 )
},
generated_attributes( [xmlns=Namespace|Atts1], Format0, Format ).
generated_name( Name, Plus, Minus ) :-
atom_codes( Name, Chars ),
append( Chars, Minus, Plus ).
generated_external_id( local ) --> "".
generated_external_id( local(Literals) ) --> " [",
generated_doctype_literals( Literals ), "
]".
generated_external_id( system(URL) ) -->
" SYSTEM """,
chars( URL ),
"""".
generated_external_id( system(URL,Literals) ) -->
" SYSTEM """,
chars( URL ),
""" [",
generated_doctype_literals( Literals ), "
]".
generated_external_id( public(URN,URL) ) -->
" PUBLIC """,
chars( URN ),
""" """,
chars( URL ),
"""".
generated_external_id( public(URN,URL,Literals) ) -->
" PUBLIC """,
chars( URN ),
""" """,
chars( URL ),
""" [",
generated_doctype_literals( Literals ), "
]".
generated_doctype_literals( [] ) --> "".
generated_doctype_literals( [dtd_literal(String)|Literals] ) --> "
<!", cdata_generation( String ), ">",
generated_doctype_literals( Literals ).
/* quoted_string( +Chars ) is a DCG representing Chars, a list of character
* codes, as a legal XML attribute string. Any leading or trailing layout
* characters are removed. &, " and < characters are replaced by &amp;, &quot;
* and &lt; respectively, .
*/
quoted_string( Raw, Plus, Minus ) :-
quoted_string1( Raw, NoLeadingLayouts ),
quoted_string2( NoLeadingLayouts, Layout, Layout, Plus, Minus ).
quoted_string1( [], [] ).
quoted_string1( [Char|Chars], NoLeadingLayouts ) :-
( Char > 32 ->
NoLeadingLayouts = [Char|Chars]
; otherwise ->
quoted_string1( Chars, NoLeadingLayouts )
).
quoted_string2( [], _LayoutPlus, _LayoutMinus, List, List ).
quoted_string2( [Char|Chars], LayoutPlus, LayoutMinus, Plus, Minus ) :-
( Char =< " " ->
Plus = Plus1,
LayoutMinus = [Char|LayoutMinus1],
LayoutPlus = LayoutPlus1
; Char == 34 ->
Plus = LayoutPlus,
escaped_quote( LayoutMinus, Plus1 ),
LayoutPlus1 = LayoutMinus1
; Char == 39 ->
Plus = LayoutPlus,
apos( LayoutMinus, Plus1 ),
LayoutPlus1 = LayoutMinus1
; Char =< 127 ->
Plus = LayoutPlus,
pcdata_7bit( Char, LayoutMinus, Plus1 ),
LayoutPlus1 = LayoutMinus1
; legal_xml_unicode( Char ) ->
Plus = LayoutPlus,
number_codes( Char, Codes ),
pcdata_8bits_plus( Codes, LayoutMinus, Plus1 ),
LayoutPlus1 = LayoutMinus1
; otherwise ->
LayoutPlus = LayoutPlus1,
LayoutMinus = LayoutMinus1,
Plus = Plus1
),
quoted_string2( Chars, LayoutPlus1, LayoutMinus1, Plus1, Minus ).
indent( false, _Indent ) --> [].
indent( true, Indent ) -->
[10],
chars( Indent ).
apos --> "&apos;".
escaped_quote --> "&quot;".
/* pcdata_generation( +Chars ) is a DCG representing Chars, a list of character
* codes as legal XML "Parsed character data" (PCDATA) string. Any codes
* which cannot be represented by a 7-bit character are replaced by their
* decimal numeric character entity e.g. code 160 (non-breaking space) is
* represented as &#160;. Any character codes disallowed by the XML
* specification are not encoded.
*/
pcdata_generation( [], Plus, Plus ).
pcdata_generation( [Char|Chars], Plus, Minus ) :-
( Char =< 127 ->
pcdata_7bit( Char, Plus, Mid )
; legal_xml_unicode( Char ) ->
number_codes( Char, Codes ),
pcdata_8bits_plus( Codes, Plus, Mid )
; otherwise ->
Plus = Mid
),
pcdata_generation( Chars, Mid, Minus ).
/* pcdata_7bit(+Char) represents the ascii character set in its
* simplest format, using the character entities &amp; &lt; and &gt;.
*/
pcdata_7bit( 0 ) --> "".
pcdata_7bit( 1 ) --> "".
pcdata_7bit( 2 ) --> "".
pcdata_7bit( 3 ) --> "".
pcdata_7bit( 4 ) --> "".
pcdata_7bit( 5 ) --> "".
pcdata_7bit( 6 ) --> "".
pcdata_7bit( 7 ) --> "".
pcdata_7bit( 8 ) --> "".
pcdata_7bit( 9 ) --> [9].
pcdata_7bit( 10 ) --> [10].
pcdata_7bit( 11 ) --> "".
pcdata_7bit( 12 ) --> "".
pcdata_7bit( 13 ) --> [13].
pcdata_7bit( 14 ) --> "".
pcdata_7bit( 15 ) --> "".
pcdata_7bit( 16 ) --> "".
pcdata_7bit( 17 ) --> "".
pcdata_7bit( 18 ) --> "".
pcdata_7bit( 19 ) --> "".
pcdata_7bit( 20 ) --> "".
pcdata_7bit( 21 ) --> "".
pcdata_7bit( 22 ) --> "".
pcdata_7bit( 23 ) --> "".
pcdata_7bit( 24 ) --> "".
pcdata_7bit( 25 ) --> "".
pcdata_7bit( 26 ) --> "".
pcdata_7bit( 27 ) --> "".
pcdata_7bit( 28 ) --> "".
pcdata_7bit( 29 ) --> "".
pcdata_7bit( 30 ) --> "".
pcdata_7bit( 31 ) --> "".
pcdata_7bit( 32 ) --> " ".
pcdata_7bit( 33 ) --> "!".
pcdata_7bit( 34 ) --> [34].
pcdata_7bit( 35 ) --> "#".
pcdata_7bit( 36 ) --> "$".
pcdata_7bit( 37 ) --> "%".
pcdata_7bit( 38 ) --> "&amp;".
pcdata_7bit( 39 ) --> "'".
pcdata_7bit( 40 ) --> "(".
pcdata_7bit( 41 ) --> ")".
pcdata_7bit( 42 ) --> "*".
pcdata_7bit( 43 ) --> "+".
pcdata_7bit( 44 ) --> ",".
pcdata_7bit( 45 ) --> "-".
pcdata_7bit( 46 ) --> ".".
pcdata_7bit( 47 ) --> "/".
pcdata_7bit( 48 ) --> "0".
pcdata_7bit( 49 ) --> "1".
pcdata_7bit( 50 ) --> "2".
pcdata_7bit( 51 ) --> "3".
pcdata_7bit( 52 ) --> "4".
pcdata_7bit( 53 ) --> "5".
pcdata_7bit( 54 ) --> "6".
pcdata_7bit( 55 ) --> "7".
pcdata_7bit( 56 ) --> "8".
pcdata_7bit( 57 ) --> "9".
pcdata_7bit( 58 ) --> ":".
pcdata_7bit( 59 ) --> ";".
pcdata_7bit( 60 ) --> "&lt;".
pcdata_7bit( 61 ) --> "=".
pcdata_7bit( 62 ) --> "&gt;". % escaping necessary to prevent ']]>' sequences in pcdata.
pcdata_7bit( 63 ) --> "?".
pcdata_7bit( 64 ) --> "@".
pcdata_7bit( 65 ) --> "A".
pcdata_7bit( 66 ) --> "B".
pcdata_7bit( 67 ) --> "C".
pcdata_7bit( 68 ) --> "D".
pcdata_7bit( 69 ) --> "E".
pcdata_7bit( 70 ) --> "F".
pcdata_7bit( 71 ) --> "G".
pcdata_7bit( 72 ) --> "H".
pcdata_7bit( 73 ) --> "I".
pcdata_7bit( 74 ) --> "J".
pcdata_7bit( 75 ) --> "K".
pcdata_7bit( 76 ) --> "L".
pcdata_7bit( 77 ) --> "M".
pcdata_7bit( 78 ) --> "N".
pcdata_7bit( 79 ) --> "O".
pcdata_7bit( 80 ) --> "P".
pcdata_7bit( 81 ) --> "Q".
pcdata_7bit( 82 ) --> "R".
pcdata_7bit( 83 ) --> "S".
pcdata_7bit( 84 ) --> "T".
pcdata_7bit( 85 ) --> "U".
pcdata_7bit( 86 ) --> "V".
pcdata_7bit( 87 ) --> "W".
pcdata_7bit( 88 ) --> "X".
pcdata_7bit( 89 ) --> "Y".
pcdata_7bit( 90 ) --> "Z".
pcdata_7bit( 91 ) --> "[".
pcdata_7bit( 92 ) --> [92].
pcdata_7bit( 93 ) --> "]".
pcdata_7bit( 94 ) --> "^".
pcdata_7bit( 95 ) --> "_".
pcdata_7bit( 96 ) --> "&#96;".
pcdata_7bit( 97 ) --> "a".
pcdata_7bit( 98 ) --> "b".
pcdata_7bit( 99 ) --> "c".
pcdata_7bit( 100 ) --> "d".
pcdata_7bit( 101 ) --> "e".
pcdata_7bit( 102 ) --> "f".
pcdata_7bit( 103 ) --> "g".
pcdata_7bit( 104 ) --> "h".
pcdata_7bit( 105 ) --> "i".
pcdata_7bit( 106 ) --> "j".
pcdata_7bit( 107 ) --> "k".
pcdata_7bit( 108 ) --> "l".
pcdata_7bit( 109 ) --> "m".
pcdata_7bit( 110 ) --> "n".
pcdata_7bit( 111 ) --> "o".
pcdata_7bit( 112 ) --> "p".
pcdata_7bit( 113 ) --> "q".
pcdata_7bit( 114 ) --> "r".
pcdata_7bit( 115 ) --> "s".
pcdata_7bit( 116 ) --> "t".
pcdata_7bit( 117 ) --> "u".
pcdata_7bit( 118 ) --> "v".
pcdata_7bit( 119 ) --> "w".
pcdata_7bit( 120 ) --> "x".
pcdata_7bit( 121 ) --> "y".
pcdata_7bit( 122 ) --> "z".
pcdata_7bit( 123 ) --> "{".
pcdata_7bit( 124 ) --> "|".
pcdata_7bit( 125 ) --> "}".
pcdata_7bit( 126 ) --> [126].
pcdata_7bit( 127 ) --> "&#127;".
pcdata_8bits_plus( Codes ) -->
"&#", chars( Codes ), ";".
/* character_data_format( +Chars, +Format0, ?Format1 ) holds when Format0 and
* Format1 are the statuses of XML formatting before and after Chars -
* which may be null.
*/
character_data_format( [], Format, Format ).
character_data_format( [_Char|_Chars], _Format, false ).
/* cdata_generation( +Chars ) is a DCG representing Chars, a list of character
* codes as a legal XML CDATA string. Any character codes disallowed by the XML
* specification are not encoded.
*/
cdata_generation( [] ) --> "".
cdata_generation( [Char|Chars] ) -->
( {legal_xml_unicode( Char )}, !, [Char]
; ""
),
cdata_generation( Chars ).
legal_xml_unicode( 9 ).
legal_xml_unicode( 10 ).
legal_xml_unicode( 13 ).
legal_xml_unicode( Code ) :-
Code >= 32,
Code =< 55295.
legal_xml_unicode( Code ) :-
Code >= 57344,
Code =< 65533.
legal_xml_unicode( Code ) :-
Code >= 65536,
Code =< 1114111.

198
packages/xml/xml_pp.pl Normal file
View File

@ -0,0 +1,198 @@
/* xml_pp: "pretty print" an XML Document on the current output stream.
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.3 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*/
:- ensure_loaded( xml_utilities ).
/* xml_pp( +XMLDocument ) "pretty prints" XMLDocument on the current
* output stream.
*/
xml_pp( xml(Attributes, Document) ) :-
write( 'xml( ' ), pp_attributes( Attributes, 0 ), pp_comma, nl,
pp_list( Document, s(0) ),
write( ' ).' ), nl.
xml_pp( malformed(Attributes, Document) ) :-
write( 'malformed( ' ), pp_attributes( Attributes, 0 ), pp_comma, nl,
pp_list( Document, s(0) ),
write( ' ).' ), nl.
pp_indented( [], Indent ) :-
pp_indent( Indent), write( '[]' ).
pp_indented( List, Indent ) :-
List = [_|_],
pp_indent( Indent ),
pp_list( List, Indent ).
pp_indented( comment(Text), Indent ) :-
pp_indent( Indent ), write( 'comment(' ), pp_string(Text), write( ')' ).
pp_indented( namespace(URI,Prefix,Element), Indent ) :-
pp_indent( Indent ),
write( 'namespace( ' ), writeq( URI ), pp_comma_sp,
pp_string( Prefix ), pp_comma, nl,
pp_indented( Element, s(Indent) ), nl,
pp_indent( s(Indent) ), write( ')' ).
pp_indented( element(Tag,Attributes,Contents), Indent ) :-
pp_indent( Indent ), write( 'element( ' ), writeq( Tag ), pp_comma, nl,
pp_attributes( Attributes, s(Indent) ), pp_comma, nl,
pp_list( Contents, s(Indent) ), write( ' )' ).
pp_indented( instructions(Target, Processing), Indent ) :-
pp_indent( Indent ), write( 'instructions( ' ), writeq( Target ), pp_comma_sp,
pp_string(Processing), write( ')' ).
pp_indented( doctype(Name, DoctypeId), Indent ) :-
pp_indent( Indent ), write( 'doctype( ' ), writeq( Name ), pp_comma_sp,
pp_indented( DoctypeId, s(Indent) ), %'
write( ' )' ).
pp_indented( cdata(CData), Indent ) :-
pp_indent( Indent ), write( 'cdata(' ), pp_string(CData), write( ')' ).
pp_indented( pcdata(PCData), Indent ) :-
pp_indent( Indent ), write( 'pcdata(' ), pp_string(PCData), write( ')' ).
pp_indented( public(URN,URL), _Indent ) :-
write( 'public(' ), pp_string(URN), pp_comma_sp,
pp_string(URL), write( ')' ).
pp_indented( public(URN,URL,Literals), Indent ) :-
write( 'public(' ), pp_string(URN), pp_comma_sp,
pp_string(URL), pp_list( Literals, s(Indent) ), write( ')' ).
pp_indented( system(URL), _Indent ) :-
write( 'system(' ), pp_string(URL), write( ')' ).
pp_indented( system(URL,Literals), Indent ) :-
write( 'system(' ), pp_string(URL), pp_comma_sp,
pp_list( Literals, s(Indent) ), write( ')' ).
pp_indented( local, _Indent ) :-
write( local ).
pp_indented( local(Literals), Indent ) :-
write( 'local(' ), nl,
pp_list( Literals, s(Indent) ), write( ')' ).
pp_indented( dtd_literal(String), Indent ) :-
pp_indent( Indent ), write( 'dtd_literal(' ), pp_string(String), write( ')' ).
pp_indented( out_of_context(Tag), Indent ) :-
pp_indent( Indent ), write( '/* SYNTAX ERROR */ out_of_context( ' ),
writeq( Tag ), write( ' )' ).
pp_indented( unparsed(String), Indent ) :-
pp_indent( Indent ), write( '/* SYNTAX ERROR */ unparsed( ' ),
pp_string(String), write( ' )' ).
pp_list( [], Indent ) :-
pp_indent( Indent ), write( [] ).
pp_list( [H|T], Indent ) :-
pp_indent( Indent ), write( '[' ), nl,
pp_indented( H, Indent ),
pp_list1( T, Indent ),
pp_indent( Indent ), write( ']' ).
pp_list1( [], _Indent ) :-
nl.
pp_list1( [H|T], Indent ) :-
pp_comma, nl,
pp_indented( H, Indent ),
pp_list1( T, Indent ).
pp_attributes( [], Indent ) :-
pp_indent( Indent ), write( [] ).
pp_attributes( [Attribute|Attributes], Indent ) :-
pp_indent( Indent ), write( '[' ),
pp_attributes1( Attributes, Attribute ),
write( ']' ).
pp_attributes1( [], Name=Value ) :-
pp_name( Name ), pp_string( Value ).
pp_attributes1( [H|T], Name=Value ) :-
pp_name( Name ), pp_string( Value ), pp_comma_sp,
pp_attributes1( T, H ).
pp_name( Name ) :-
( possible_operator( Name ) ->
write( '(' ), write( Name ), write( ')=' )
; otherwise ->
writeq( Name ), write( '=' )
).
possible_operator( (abolish) ).
possible_operator( (attribute) ).
possible_operator( (check_advice) ).
possible_operator( (compile_command) ).
possible_operator( (delay) ).
possible_operator( (demon) ).
possible_operator( (discontiguous) ).
possible_operator( (div) ).
possible_operator( (do) ).
possible_operator( (document_export) ).
possible_operator( (document_import) ).
possible_operator( (dy) ).
possible_operator( (dynamic) ).
possible_operator( (edb) ).
possible_operator( (eexport) ).
possible_operator( (else) ).
possible_operator( (except) ).
possible_operator( (export) ).
possible_operator( (foreign_pred) ).
possible_operator( (from) ).
possible_operator( (from_chars) ).
possible_operator( (from_file) ).
possible_operator( (from_stream) ).
possible_operator( (global) ).
possible_operator( (help) ).
possible_operator( (hilog) ).
possible_operator( (if) ).
possible_operator( (import) ).
possible_operator( (index) ).
possible_operator( (initialization) ).
possible_operator( (is) ).
possible_operator( (listing) ).
possible_operator( (local) ).
possible_operator( (locked) ).
possible_operator( (meta_predicate) ).
possible_operator( (mod) ).
possible_operator( (mode) ).
possible_operator( (module_transparent) ).
possible_operator( (multifile) ).
possible_operator( (namic) ).
possible_operator( (nocheck_advice) ).
possible_operator( (nospy) ).
possible_operator( (not) ).
possible_operator( (of) ).
possible_operator( (once) ).
possible_operator( (onto_chars) ).
possible_operator( (onto_file) ).
possible_operator( (onto_stream) ).
possible_operator( (parallel) ).
possible_operator( (public) ).
possible_operator( (r) ).
possible_operator( (rem) ).
possible_operator( (skipped) ).
possible_operator( (spy) ).
possible_operator( (table) ).
possible_operator( (then) ).
possible_operator( (thread_local) ).
possible_operator( (ti) ).
possible_operator( (ti_off) ).
possible_operator( (traceable) ).
possible_operator( (unskipped) ).
possible_operator( (untraceable) ).
possible_operator( (use_subsumptive_tabling) ).
possible_operator( (use_variant_tabling) ).
possible_operator( (volatile) ).
possible_operator( (with) ).
possible_operator( (with_input_from_chars) ).
possible_operator( (with_output_to_chars) ).
possible_operator( (xor) ).
pp_indent( 0 ).
pp_indent( s(N) ) :-
write( ' ' ),
pp_indent( N ).
pp_comma :-
write( ',' ).
pp_comma_sp :-
write( ', ' ).

499
packages/xml/xml_utilities.pl Normal file
View File

@ -0,0 +1,499 @@
/* XML Utilities
*
* Copyright (C) 2001-2005 Binding Time Limited
* Copyright (C) 2005-2011 John Fletcher
*
* Current Release: $Revision: 3.4 $
*
* TERMS AND CONDITIONS:
*
* This program is offered free of charge, as unsupported source code. You may
* use it, copy it, distribute it, modify it or sell it without restriction,
* but entirely at your own risk.
*/
% Entity and Namespace map operations: these maps are usually quite small, so
% a linear list lookup is okay. They could be substituted by a logarithmic
% data structure - in extremis.
/* empty_map( ?Map ) is true if Map is a null map.
*/
empty_map( [] ).
/* map_member( +Key, +Map, ?Data ) is true if Map is a ordered map structure
* which records the pair Key-Data. Key must be ground.
*/
map_member( Key0, [Key1-Data1|Rest], Data0 ) :-
( Key0 == Key1 ->
Data0 = Data1
; Key0 @> Key1 ->
map_member( Key0, Rest, Data0 )
).
/* map_store( +Map0, +Key, +Data, ?Map1 ) is true if Map0 is an ordered map
* structure, Key must be ground, and Map1 is identical to Map0 except that
* the pair Key-Data is recorded by Map1.
*/
map_store( [], Key, Data, [Key-Data] ).
map_store( [Key0-Data0|Map0], Key, Data, Map ) :-
( Key == Key0 ->
Map = [Key-Data|Map0]
; Key @< Key0 ->
Map = [Key-Data,Key0-Data0|Map0]
; otherwise -> % >
Map = [Key0-Data0|Map1],
map_store( Map0, Key, Data, Map1 )
).
/* context(?Element, ?PreserveSpace, ?CurrentNS, ?DefaultNS, ?Entities, ?Namespaces )
* is an ADT hiding the "state" arguments for XML Acquisition
*/
initial_context(
Controls,
context(void,PreserveSpace,'','',Entities,Empty,
RemoveAttributePrefixes,AllowAmpersand)
) :-
empty_map( Empty ),
( member( extended_characters(false), Controls ) ->
Entities = Empty
; otherwise ->
extended_character_entities(Entities)
),
( member( format(false), Controls ) ->
PreserveSpace = true
; otherwise ->
PreserveSpace = false
),
( member( remove_attribute_prefixes(true), Controls ) ->
RemoveAttributePrefixes = true
; otherwise ->
RemoveAttributePrefixes = false
),
( member( allow_ampersand(true), Controls ) ->
AllowAmpersand = true
; otherwise ->
AllowAmpersand = false
).
context_update( current_namespace, Context0, URI, Context1 ) :-
Context0 = context(Element,Preserve,_Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,URI,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( element, Context0, Tag, Context1 ) :-
Context0 = context(_Element,Preserve,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(tag(Tag),Preserve,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( default_namespace, Context0, URI, Context1 ):-
Context0 = context(Element,Preserve,Current,_Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,Current,URI,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( space_preserve, Context0, Boolean, Context1 ):-
Context0 = context(Element,_Preserve,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Boolean,Current,Default,Entities,
Namespaces,RemoveAttributePrefixes,Amp).
context_update( ns_prefix(Prefix), Context0, URI, Context1 ) :-
Context0 = context(Element,Preserve,Current,Default,Entities,
Namespaces0,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,Current,Default,Entities,
Namespaces1,RemoveAttributePrefixes,Amp),
map_store( Namespaces0, Prefix, URI, Namespaces1 ).
context_update( entity(Name), Context0, String, Context1 ) :-
Context0 = context(Element,Preserve,Current,Default,Entities0,
Namespaces,RemoveAttributePrefixes,Amp),
Context1 = context(Element,Preserve,Current,Default,Entities1,
Namespaces,RemoveAttributePrefixes,Amp),
map_store( Entities0, Name, String, Entities1 ).
remove_attribute_prefixes( Context ) :-
Context = context(_Element,_Preserve,_Current,_Default,_Entities,
_Namespaces,true,_Amp).
current_tag( Context, Tag ) :-
Context = context(tag(Tag),_Preserve,_Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp).
current_namespace( Context, Current ) :-
Context = context(_Element,_Preserve,Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp).
default_namespace( Context, Default ) :-
Context = context(_Element,_Preserve,_Current,Default,_Entities,
_Namespaces,_RPFA,_Amp).
space_preserve( Context ) :-
Context = context(tag(_Tag),true,_Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp).
specific_namespace( Prefix, Context, URI ) :-
Context = context(_Element,_Preserve,_Current,_Default,_Entities,
Namespaces,_RPFA,_Amp),
map_member( Prefix, Namespaces, URI ).
defined_entity( Reference, Context, String ) :-
Context = context(_Element,_Preserve,_Current,_Default,Entities,
_Namespaces,_RPFA,_Amp),
map_member( Reference, Entities, String ).
close_context( Context, Terms, WellFormed ) :-
Context = context(Element,_Preserve,_Current,_Default,_Entities,
_Namespaces,_RPFA,_Amp),
close_context1( Element, Terms, WellFormed ).
close_context1( void, [], true ).
close_context1( tag(TagChars), [out_of_context(Tag)], false ) :-
atom_chars( Tag, TagChars ).
void_context(
context(void,_Preserve,_Current,_Default,_Entities,_Names,_RPFA,_Amp)
).
allow_ampersand(
context(_Void,_Preserve,_Current,_Default,_Entities,_Names,_RPFA,true)
).
/* pp_string( +String ) prints String onto the current output stream.
* If String contains only 7-bit chars it is printed in shorthand quoted
* format, otherwise it is written as a list.
* If your Prolog uses " to delimit a special string type, just use write/1.
*/
pp_string( Chars ) :-
( member( Char, Chars ),
not_shorthand( Char ) ->
write( Chars )
; otherwise ->
put_quote,
pp_string1( Chars ),
put_quote
).
not_shorthand( Char ) :-
Char > 255.
not_shorthand( Char ) :-
Char < 9.
not_shorthand( 126 ). % ~ gives syntax errors in LPA Prolog
put_quote :-
put( 0'" ). % '
pp_string1( [] ).
pp_string1( [Char|Chars] ) :-
( Char =:= """" -> % Meta-quote
put( Char ),
put( Char ),
pp_string1( Chars )
; Char =:= 13, % Handle Windows border-settings
Chars = [10|Chars1] ->
put( 10 ),
pp_string1( Chars1 )
; otherwise ->
put( Char ),
pp_string1( Chars )
).
xml_declaration_attributes_valid( [] ).
xml_declaration_attributes_valid( [Name=Value|Attributes] ) :-
xml_declaration_attribute_valid( Name, Value ),
xml_declaration_attributes_valid( Attributes ).
xml_declaration_attribute_valid( Name, Value ) :-
lowercase( Value, Lowercase ),
canonical_xml_declaration_attribute( Name, Lowercase ).
canonical_xml_declaration_attribute( version, "1.0" ).
canonical_xml_declaration_attribute( standalone, "yes" ).
canonical_xml_declaration_attribute( standalone, "no" ).
% The encodings here are all valid for the output produced.
canonical_xml_declaration_attribute( encoding, "utf-8" ).
% canonical_xml_declaration_attribute( encoding, "utf-16" ).
% This is erroneous for the output of this library
canonical_xml_declaration_attribute( encoding, "us-ascii" ).
canonical_xml_declaration_attribute( encoding, "ascii" ).
canonical_xml_declaration_attribute( encoding, "iso-8859-1" ).
canonical_xml_declaration_attribute( encoding, "iso-8859-2" ).
canonical_xml_declaration_attribute( encoding, "iso-8859-15" ).
canonical_xml_declaration_attribute( encoding, "windows-1252" ).
% In general, it's better not to specify an encoding.
/* lowercase( +MixedCase, ?Lowercase ) holds when Lowercase and MixedCase are
* lists of character codes, and Lowercase is identical to MixedCase with
* every uppercase character replaced by its lowercase equivalent.
*/
lowercase( [], [] ).
lowercase( [Char|Chars], [Lower|LowerCase] ) :-
( Char >= "A", Char =< "Z" ->
Lower is Char + "a" - "A"
; otherwise ->
Lower = Char
),
lowercase( Chars, LowerCase ).
extended_character_entities( [
"AElig"-[198], % latin capital letter AE
"Aacute"-[193], % latin capital letter A with acute,
"Acirc"-[194], % latin capital letter A with circumflex,
"Agrave"-[192], % latin capital letter A with grave
"Alpha"-[913], % greek capital letter alpha, U+0391
"Aring"-[197], % latin capital letter A with ring above
"Atilde"-[195], % latin capital letter A with tilde,
"Auml"-[196], % latin capital letter A with diaeresis,
"Beta"-[914], % greek capital letter beta, U+0392
"Ccedil"-[199], % latin capital letter C with cedilla,
"Chi"-[935], % greek capital letter chi, U+03A7
"Dagger"-[8225], % double dagger, U+2021 ISOpub
"Delta"-[916], % greek capital letter delta,
"ETH"-[208], % latin capital letter ETH, U+00D0 ISOlat1>
"Eacute"-[201], % latin capital letter E with acute,
"Ecirc"-[202], % latin capital letter E with circumflex,
"Egrave"-[200], % latin capital letter E with grave,
"Epsilon"-[917], % greek capital letter epsilon, U+0395
"Eta"-[919], % greek capital letter eta, U+0397
"Euml"-[203], % latin capital letter E with diaeresis,
"Gamma"-[915], % greek capital letter gamma,
"Iacute"-[205], % latin capital letter I with acute,
"Icirc"-[206], % latin capital letter I with circumflex,
"Igrave"-[204], % latin capital letter I with grave,
"Iota"-[921], % greek capital letter iota, U+0399
"Iuml"-[207], % latin capital letter I with diaeresis,
"Kappa"-[922], % greek capital letter kappa, U+039A
"Lambda"-[923], % greek capital letter lambda,
"Mu"-[924], % greek capital letter mu, U+039C
"Ntilde"-[209], % latin capital letter N with tilde,
"Nu"-[925], % greek capital letter nu, U+039D
"OElig"-[338], % latin capital ligature OE,
"Oacute"-[211], % latin capital letter O with acute,
"Ocirc"-[212], % latin capital letter O with circumflex,
"Ograve"-[210], % latin capital letter O with grave,
"Omega"-[937], % greek capital letter omega,
"Omicron"-[927], % greek capital letter omicron, U+039F
"Oslash"-[216], % latin capital letter O with stroke
"Otilde"-[213], % latin capital letter O with tilde,
"Ouml"-[214], % latin capital letter O with diaeresis,
"Phi"-[934], % greek capital letter phi,
"Pi"-[928], % greek capital letter pi, U+03A0 ISOgrk3
"Prime"-[8243], % double prime = seconds = inches,
"Psi"-[936], % greek capital letter psi,
"Rho"-[929], % greek capital letter rho, U+03A1
"Scaron"-[352], % latin capital letter S with caron,
"Sigma"-[931], % greek capital letter sigma,
"THORN"-[222], % latin capital letter THORN,
"Tau"-[932], % greek capital letter tau, U+03A4
"Theta"-[920], % greek capital letter theta,
"Uacute"-[218], % latin capital letter U with acute,
"Ucirc"-[219], % latin capital letter U with circumflex,
"Ugrave"-[217], % latin capital letter U with grave,
"Upsilon"-[933], % greek capital letter upsilon,
"Uuml"-[220], % latin capital letter U with diaeresis,
"Xi"-[926], % greek capital letter xi, U+039E ISOgrk3
"Yacute"-[221], % latin capital letter Y with acute,
"Yuml"-[376], % latin capital letter Y with diaeresis,
"Zeta"-[918], % greek capital letter zeta, U+0396
"aacute"-[225], % latin small letter a with acute,
"acirc"-[226], % latin small letter a with circumflex,
"acute"-[180], % acute accent = spacing acute,
"aelig"-[230], % latin small letter ae
"agrave"-[224], % latin small letter a with grave
"alefsym"-[8501], % alef symbol = first transfinite cardinal,
"alpha"-[945], % greek small letter alpha,
"and"-[8743], % logical and = wedge, U+2227 ISOtech
"ang"-[8736], % angle, U+2220 ISOamso
"aring"-[229], % latin small letter a with ring above
"asymp"-[8776], % almost equal to = asymptotic to,
"atilde"-[227], % latin small letter a with tilde,
"auml"-[228], % latin small letter a with diaeresis,
"bdquo"-[8222], % double low-9 quotation mark, U+201E NEW
"beta"-[946], % greek small letter beta, U+03B2 ISOgrk3
"brvbar"-[166], % broken bar = broken vertical bar,
"bull"-[8226], % bullet = black small circle,
"cap"-[8745], % intersection = cap, U+2229 ISOtech
"ccedil"-[231], % latin small letter c with cedilla,
"cedil"-[184], % cedilla = spacing cedilla, U+00B8 ISOdia>
"cent"-[162], % cent sign, U+00A2 ISOnum>
"chi"-[967], % greek small letter chi, U+03C7 ISOgrk3
"circ"-[710], % modifier letter circumflex accent,
"clubs"-[9827], % black club suit = shamrock,
"cong"-[8773], % approximately equal to, U+2245 ISOtech
"copy"-[169], % copyright sign, U+00A9 ISOnum>
"crarr"-[8629], % downwards arrow with corner leftwards
"cup"-[8746], % union = cup, U+222A ISOtech
"curren"-[164], % currency sign, U+00A4 ISOnum>
"dArr"-[8659], % downwards double arrow, U+21D3 ISOamsa
"dagger"-[8224], % dagger, U+2020 ISOpub
"darr"-[8595], % downwards arrow, U+2193 ISOnum
"deg"-[176], % degree sign, U+00B0 ISOnum>
"delta"-[948], % greek small letter delta,
"diams"-[9830], % black diamond suit, U+2666 ISOpub
"divide"-[247], % division sign, U+00F7 ISOnum>
"eacute"-[233], % latin small letter e with acute,
"ecirc"-[234], % latin small letter e with circumflex,
"egrave"-[232], % latin small letter e with grave,
"empty"-[8709], % empty set = null set = diameter,
"emsp"-[8195], % em space, U+2003 ISOpub
"ensp"-[8194], % en space, U+2002 ISOpub
"epsilon"-[949], % greek small letter epsilon,
"equiv"-[8801], % identical to, U+2261 ISOtech
"eta"-[951], % greek small letter eta, U+03B7 ISOgrk3
"eth"-[240], % latin small letter eth, U+00F0 ISOlat1>
"euml"-[235], % latin small letter e with diaeresis,
"euro"-[8364], % euro sign, U+20AC NEW
"exist"-[8707], % there exists, U+2203 ISOtech
"fnof"-[402], % latin small f with hook = function
"forall"-[8704], % for all, U+2200 ISOtech
"frac12"-[189], % vulgar fraction one half
"frac14"-[188], % vulgar fraction one quarter
"frac34"-[190], % vulgar fraction three quarters
"frasl"-[8260], % fraction slash, U+2044 NEW
"gamma"-[947], % greek small letter gamma,
"ge"-[8805], % greater-than or equal to,
"hArr"-[8660], % left right double arrow,
"harr"-[8596], % left right arrow, U+2194 ISOamsa
"hearts"-[9829], % black heart suit = valentine,
"hellip"-[8230], % horizontal ellipsis = three dot leader,
"iacute"-[237], % latin small letter i with acute,
"icirc"-[238], % latin small letter i with circumflex,
"iexcl"-[161], % inverted exclamation mark, U+00A1 ISOnum>
"igrave"-[236], % latin small letter i with grave,
"image"-[8465], % blackletter capital I = imaginary part,
"infin"-[8734], % infinity, U+221E ISOtech
"int"-[8747], % integral, U+222B ISOtech
"iota"-[953], % greek small letter iota, U+03B9 ISOgrk3
"iquest"-[191], % inverted question mark
"isin"-[8712], % element of, U+2208 ISOtech
"iuml"-[239], % latin small letter i with diaeresis,
"kappa"-[954], % greek small letter kappa,
"lArr"-[8656], % leftwards double arrow, U+21D0 ISOtech
"lambda"-[955], % greek small letter lambda,
"lang"-[9001], % left-pointing angle bracket = bra,
"laquo"-[171], % left-pointing double angle quotation mark
"larr"-[8592], % leftwards arrow, U+2190 ISOnum
"lceil"-[8968], % left ceiling = apl upstile,
"ldquo"-[8220], % left double quotation mark,
"le"-[8804], % less-than or equal to, U+2264 ISOtech
"lfloor"-[8970], % left floor = apl downstile,
"lowast"-[8727], % asterisk operator, U+2217 ISOtech
"loz"-[9674], % lozenge, U+25CA ISOpub
"lrm"-[8206], % left-to-right mark, U+200E NEW RFC 2070
"lsaquo"-[8249], % single left-pointing angle quotation mark,
"lsquo"-[8216], % left single quotation mark,
"macr"-[175], % macron = spacing macron = overline
"mdash"-[8212], % em dash, U+2014 ISOpub
"micro"-[181], % micro sign, U+00B5 ISOnum>
"middot"-[183], % middle dot = Georgian comma
"minus"-[8722], % minus sign, U+2212 ISOtech
"mu"-[956], % greek small letter mu, U+03BC ISOgrk3
"nabla"-[8711], % nabla = backward difference,
"nbsp"-[160], % no-break space = non-breaking space,
"ndash"-[8211], % en dash, U+2013 ISOpub
"ne"-[8800], % not equal to, U+2260 ISOtech
"ni"-[8715], % contains as member, U+220B ISOtech
"not"-[172], % not sign, U+00AC ISOnum>
"notin"-[8713], % not an element of, U+2209 ISOtech
"nsub"-[8836], % not a subset of, U+2284 ISOamsn
"ntilde"-[241], % latin small letter n with tilde,
"nu"-[957], % greek small letter nu, U+03BD ISOgrk3
"oacute"-[243], % latin small letter o with acute,
"ocirc"-[244], % latin small letter o with circumflex,
"oelig"-[339], % latin small ligature oe, U+0153 ISOlat2
"ograve"-[242], % latin small letter o with grave,
"oline"-[8254], % overline = spacing overscore,
"omega"-[969], % greek small letter omega,
"omicron"-[959], % greek small letter omicron, U+03BF NEW
"oplus"-[8853], % circled plus = direct sum,
"or"-[8744], % logical or = vee, U+2228 ISOtech
"ordf"-[170], % feminine ordinal indicator, U+00AA ISOnum>
"ordm"-[186], % masculine ordinal indicator,
"oslash"-[248], % latin small letter o with stroke,
"otilde"-[245], % latin small letter o with tilde,
"otimes"-[8855], % circled times = vector product,
"ouml"-[246], % latin small letter o with diaeresis,
"para"-[182], % pilcrow sign = paragraph sign,
"part"-[8706], % partial differential, U+2202 ISOtech
"permil"-[8240], % per mille sign, U+2030 ISOtech
"perp"-[8869], % up tack = orthogonal to = perpendicular,
"phi"-[966], % greek small letter phi, U+03C6 ISOgrk3
"pi"-[960], % greek small letter pi, U+03C0 ISOgrk3
"piv"-[982], % greek pi symbol, U+03D6 ISOgrk3
"plusmn"-[177], % plus-minus sign = plus-or-minus sign,
"pound"-[163], % pound sign, U+00A3 ISOnum>
"prime"-[8242], % prime = minutes = feet, U+2032 ISOtech
"prod"-[8719], % n-ary product = product sign,
"prop"-[8733], % proportional to, U+221D ISOtech
"psi"-[968], % greek small letter psi, U+03C8 ISOgrk3
"rArr"-[8658], % rightwards double arrow,
"radic"-[8730], % square root = radical sign,
"rang"-[9002], % right-pointing angle bracket = ket,
"raquo"-[187], % right-pointing double angle quotation mark
"rarr"-[8594], % rightwards arrow, U+2192 ISOnum
"rceil"-[8969], % right ceiling, U+2309 ISOamsc
"rdquo"-[8221], % right double quotation mark,
"real"-[8476], % blackletter capital R = real part symbol,
"reg"-[174], % registered sign = registered trade mark sign,
"rfloor"-[8971], % right floor, U+230B ISOamsc
"rho"-[961], % greek small letter rho, U+03C1 ISOgrk3
"rlm"-[8207], % right-to-left mark, U+200F NEW RFC 2070
"rsaquo"-[8250], % single right-pointing angle quotation mark,
"rsquo"-[8217], % right single quotation mark,
"sbquo"-[8218], % single low-9 quotation mark, U+201A NEW
"scaron"-[353], % latin small letter s with caron,
"sdot"-[8901], % dot operator, U+22C5 ISOamsb
"sect"-[167], % section sign, U+00A7 ISOnum>
"shy"-[173], % soft hyphen = discretionary hyphen,
"sigma"-[963], % greek small letter sigma,
"sigmaf"-[962], % greek small letter final sigma,
"sim"-[8764], % tilde operator = varies with = similar to,
"spades"-[9824], % black spade suit, U+2660 ISOpub
"sub"-[8834], % subset of, U+2282 ISOtech
"sube"-[8838], % subset of or equal to, U+2286 ISOtech
"sum"-[8721], % n-ary sumation, U+2211 ISOamsb
"sup"-[8835], % superset of, U+2283 ISOtech
"sup1"-[185], % superscript one = superscript digit one,
"sup2"-[178], % superscript two = superscript digit two
"sup3"-[179], % superscript three = superscript digit three
"supe"-[8839], % superset of or equal to,
"szlig"-[223], % latin small letter sharp s = ess-zed,
"tau"-[964], % greek small letter tau, U+03C4 ISOgrk3
"there4"-[8756], % therefore, U+2234 ISOtech
"theta"-[952], % greek small letter theta,
"thetasym"-[977], % greek small letter theta symbol,
"thinsp"-[8201], % thin space, U+2009 ISOpub
"thorn"-[254], % latin small letter thorn with,
"tilde"-[732], % small tilde, U+02DC ISOdia
"times"-[215], % multiplication sign, U+00D7 ISOnum>
"trade"-[8482], % trade mark sign, U+2122 ISOnum
"uArr"-[8657], % upwards double arrow, U+21D1 ISOamsa
"uacute"-[250], % latin small letter u with acute,
"uarr"-[8593], % upwards arrow, U+2191 ISOnum
"ucirc"-[251], % latin small letter u with circumflex,
"ugrave"-[249], % latin small letter u with grave,
"uml"-[168], % diaeresis = spacing diaeresis,
"upsih"-[978], % greek upsilon with hook symbol,
"upsilon"-[965], % greek small letter upsilon,
"uuml"-[252], % latin small letter u with diaeresis,
"weierp"-[8472], % script capital P = power set
"xi"-[958], % greek small letter xi, U+03BE ISOgrk3
"yacute"-[253], % latin small letter y with acute,
"yen"-[165], % yen sign = yuan sign, U+00A5 ISOnum>
"yuml"-[255], % latin small letter y with diaeresis,
"zeta"-[950], % greek small letter zeta, U+03B6 ISOgrk3
"zwj"-[8205], % zero width joiner, U+200D NEW RFC 2070
"zwnj"-[8204] % zero width non-joiner,
] ).
/* chars( ?Chars, ?Plus, ?Minus ) used as chars( ?Chars ) in a DCG to
* copy the list Chars inline.
*
* This is best expressed in terms of append/3 where append/3 is built-in.
* For other Prologs, a straightforward specification can be used:
*
* chars( [] ) --> "".
* chars( [Char|Chars] ) -->
* [Char],
* chars( Chars ).
*/
chars( Chars, Plus, Minus ) :-
append( Chars, Minus, Plus ).