packages feed

swish (empty) → 0.2.1

raw patch · 90 files changed

+40270/−0 lines, 90 filesdep +HUnitdep +arraydep +basesetup-changed

Dependencies added: HUnit, array, base, binary, bytestring, containers, mtl, old-time, parallel, parsec, random

Files

+ LICENSE view
@@ -0,0 +1,510 @@++                  GNU LESSER GENERAL PUBLIC LICENSE+                       Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+	51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++[This is the first released version of the Lesser GPL.  It also counts+ as the successor of the GNU Library Public License, version 2, hence+ the version number 2.1.]++                            Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+Licenses are intended to guarantee your freedom to share and change+free software--to make sure the software is free for all its users.++  This license, the Lesser General Public License, applies to some+specially designated software packages--typically libraries--of the+Free Software Foundation and other authors who decide to use it.  You+can use it too, but we suggest you first think carefully about whether+this license or the ordinary General Public License is the better+strategy to use in any particular case, based on the explanations+below.++  When we speak of free software, we are referring to freedom of use,+not price.  Our General Public Licenses are designed to make sure that+you have the freedom to distribute copies of free software (and charge+for this service if you wish); that you receive source code or can get+it if you want it; that you can change the software and use pieces of+it in new free programs; and that you are informed that you can do+these things.++  To protect your rights, we need to make restrictions that forbid+distributors to deny you these rights or to ask you to surrender these+rights.  These restrictions translate to certain responsibilities for+you if you distribute copies of the library or if you modify it.++  For example, if you distribute copies of the library, whether gratis+or for a fee, you must give the recipients all the rights that we gave+you.  You must make sure that they, too, receive or can get the source+code.  If you link other code with the library, you must provide+complete object files to the recipients, so that they can relink them+with the library after making changes to the library and recompiling+it.  And you must show them these terms so they know their rights.++  We protect your rights with a two-step method: (1) we copyright the+library, and (2) we offer you this license, which gives you legal+permission to copy, distribute and/or modify the library.++  To protect each distributor, we want to make it very clear that+there is no warranty for the free library.  Also, if the library is+modified by someone else and passed on, the recipients should know+that what they have is not the original version, so that the original+author's reputation will not be affected by problems that might be+introduced by others.++  Finally, software patents pose a constant threat to the existence of+any free program.  We wish to make sure that a company cannot+effectively restrict the users of a free program by obtaining a+restrictive license from a patent holder.  Therefore, we insist that+any patent license obtained for a version of the library must be+consistent with the full freedom of use specified in this license.++  Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License.  This license, the GNU Lesser+General Public License, applies to certain designated libraries, and+is quite different from the ordinary General Public License.  We use+this license for certain libraries in order to permit linking those+libraries into non-free programs.++  When a program is linked with a library, whether statically or using+a shared library, the combination of the two is legally speaking a+combined work, a derivative of the original library.  The ordinary+General Public License therefore permits such linking only if the+entire combination fits its criteria of freedom.  The Lesser General+Public License permits more lax criteria for linking other code with+the library.++  We call this license the "Lesser" General Public License because it+does Less to protect the user's freedom than the ordinary General+Public License.  It also provides other free software developers Less+of an advantage over competing non-free programs.  These disadvantages+are the reason we use the ordinary General Public License for many+libraries.  However, the Lesser license provides advantages in certain+special circumstances.++  For example, on rare occasions, there may be a special need to+encourage the widest possible use of a certain library, so that it+becomes a de-facto standard.  To achieve this, non-free programs must+be allowed to use the library.  A more frequent case is that a free+library does the same job as widely used non-free libraries.  In this+case, there is little to gain by limiting the free library to free+software only, so we use the Lesser General Public License.++  In other cases, permission to use a particular library in non-free+programs enables a greater number of people to use a large body of+free software.  For example, permission to use the GNU C Library in+non-free programs enables many more people to use the whole GNU+operating system, as well as its variant, the GNU/Linux operating+system.++  Although the Lesser General Public License is Less protective of the+users' freedom, it does ensure that the user of a program that is+linked with the Library has the freedom and the wherewithal to run+that program using a modified version of the Library.++  The precise terms and conditions for copying, distribution and+modification follow.  Pay close attention to the difference between a+"work based on the library" and a "work that uses the library".  The+former contains code derived from the library, whereas the latter must+be combined with the library in order to run.++                  GNU LESSER GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License Agreement applies to any software library or other+program which contains a notice placed by the copyright holder or+other authorized party saying it may be distributed under the terms of+this Lesser General Public License (also called "this License").+Each licensee is addressed as "you".++  A "library" means a collection of software functions and/or data+prepared so as to be conveniently linked with application programs+(which use some of those functions and data) to form executables.++  The "Library", below, refers to any such software library or work+which has been distributed under these terms.  A "work based on the+Library" means either the Library or any derivative work under+copyright law: that is to say, a work containing the Library or a+portion of it, either verbatim or with modifications and/or translated+straightforwardly into another language.  (Hereinafter, translation is+included without limitation in the term "modification".)++  "Source code" for a work means the preferred form of the work for+making modifications to it.  For a library, complete source code means+all the source code for all modules it contains, plus any associated+interface definition files, plus the scripts used to control+compilation and installation of the library.++  Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running a program using the Library is not restricted, and output from+such a program is covered only if its contents constitute a work based+on the Library (independent of the use of the Library in a tool for+writing it).  Whether that is true depends on what the Library does+and what the program that uses the Library does.++  1. You may copy and distribute verbatim copies of the Library's+complete source code as you receive it, in any medium, provided that+you conspicuously and appropriately publish on each copy an+appropriate copyright notice and disclaimer of warranty; keep intact+all the notices that refer to this License and to the absence of any+warranty; and distribute a copy of this License along with the+Library.++  You may charge a fee for the physical act of transferring a copy,+and you may at your option offer warranty protection in exchange for a+fee.++  2. You may modify your copy or copies of the Library or any portion+of it, thus forming a work based on the Library, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) The modified work must itself be a software library.++    b) You must cause the files modified to carry prominent notices+    stating that you changed the files and the date of any change.++    c) You must cause the whole of the work to be licensed at no+    charge to all third parties under the terms of this License.++    d) If a facility in the modified Library refers to a function or a+    table of data to be supplied by an application program that uses+    the facility, other than as an argument passed when the facility+    is invoked, then you must make a good faith effort to ensure that,+    in the event an application does not supply such function or+    table, the facility still operates, and performs whatever part of+    its purpose remains meaningful.++    (For example, a function in a library to compute square roots has+    a purpose that is entirely well-defined independent of the+    application.  Therefore, Subsection 2d requires that any+    application-supplied function or table used by this function must+    be optional: if the application does not supply it, the square+    root function must still compute square roots.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Library,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Library, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote+it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Library.++In addition, mere aggregation of another work not based on the Library+with the Library (or with a work based on the Library) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may opt to apply the terms of the ordinary GNU General Public+License instead of this License to a given copy of the Library.  To do+this, you must alter all the notices that refer to this License, so+that they refer to the ordinary GNU General Public License, version 2,+instead of to this License.  (If a newer version than version 2 of the+ordinary GNU General Public License has appeared, then you can specify+that version instead if you wish.)  Do not make any other change in+these notices.++  Once this change is made in a given copy, it is irreversible for+that copy, so the ordinary GNU General Public License applies to all+subsequent copies and derivative works made from that copy.++  This option is useful when you wish to copy part of the code of+the Library into a program that is not a library.++  4. You may copy and distribute the Library (or a portion or+derivative of it, under Section 2) in object code or executable form+under the terms of Sections 1 and 2 above provided that you accompany+it with the complete corresponding machine-readable source code, which+must be distributed under the terms of Sections 1 and 2 above on a+medium customarily used for software interchange.++  If distribution of object code is made by offering access to copy+from a designated place, then offering equivalent access to copy the+source code from the same place satisfies the requirement to+distribute the source code, even though third parties are not+compelled to copy the source along with the object code.++  5. A program that contains no derivative of any portion of the+Library, but is designed to work with the Library by being compiled or+linked with it, is called a "work that uses the Library".  Such a+work, in isolation, is not a derivative work of the Library, and+therefore falls outside the scope of this License.++  However, linking a "work that uses the Library" with the Library+creates an executable that is a derivative of the Library (because it+contains portions of the Library), rather than a "work that uses the+library".  The executable is therefore covered by this License.+Section 6 states terms for distribution of such executables.++  When a "work that uses the Library" uses material from a header file+that is part of the Library, the object code for the work may be a+derivative work of the Library even though the source code is not.+Whether this is true is especially significant if the work can be+linked without the Library, or if the work is itself a library.  The+threshold for this to be true is not precisely defined by law.++  If such an object file uses only numerical parameters, data+structure layouts and accessors, and small macros and small inline+functions (ten lines or less in length), then the use of the object+file is unrestricted, regardless of whether it is legally a derivative+work.  (Executables containing this object code plus portions of the+Library will still fall under Section 6.)++  Otherwise, if the work is a derivative of the Library, you may+distribute the object code for the work under the terms of Section 6.+Any executables containing that work also fall under Section 6,+whether or not they are linked directly with the Library itself.++  6. As an exception to the Sections above, you may also combine or+link a "work that uses the Library" with the Library to produce a+work containing portions of the Library, and distribute that work+under terms of your choice, provided that the terms permit+modification of the work for the customer's own use and reverse+engineering for debugging such modifications.++  You must give prominent notice with each copy of the work that the+Library is used in it and that the Library and its use are covered by+this License.  You must supply a copy of this License.  If the work+during execution displays copyright notices, you must include the+copyright notice for the Library among them, as well as a reference+directing the user to the copy of this License.  Also, you must do one+of these things:++    a) Accompany the work with the complete corresponding+    machine-readable source code for the Library including whatever+    changes were used in the work (which must be distributed under+    Sections 1 and 2 above); and, if the work is an executable linked+    with the Library, with the complete machine-readable "work that+    uses the Library", as object code and/or source code, so that the+    user can modify the Library and then relink to produce a modified+    executable containing the modified Library.  (It is understood+    that the user who changes the contents of definitions files in the+    Library will not necessarily be able to recompile the application+    to use the modified definitions.)++    b) Use a suitable shared library mechanism for linking with the+    Library.  A suitable mechanism is one that (1) uses at run time a+    copy of the library already present on the user's computer system,+    rather than copying library functions into the executable, and (2)+    will operate properly with a modified version of the library, if+    the user installs one, as long as the modified version is+    interface-compatible with the version that the work was made with.++    c) Accompany the work with a written offer, valid for at least+    three years, to give the same user the materials specified in+    Subsection 6a, above, for a charge no more than the cost of+    performing this distribution.++    d) If distribution of the work is made by offering access to copy+    from a designated place, offer equivalent access to copy the above+    specified materials from the same place.++    e) Verify that the user has already received a copy of these+    materials or that you have already sent this user a copy.++  For an executable, the required form of the "work that uses the+Library" must include any data and utility programs needed for+reproducing the executable from it.  However, as a special exception,+the materials to be distributed need not include anything that is+normally distributed (in either source or binary form) with the major+components (compiler, kernel, and so on) of the operating system on+which the executable runs, unless that component itself accompanies+the executable.++  It may happen that this requirement contradicts the license+restrictions of other proprietary libraries that do not normally+accompany the operating system.  Such a contradiction means you cannot+use both them and the Library together in an executable that you+distribute.++  7. You may place library facilities that are a work based on the+Library side-by-side in a single library together with other library+facilities not covered by this License, and distribute such a combined+library, provided that the separate distribution of the work based on+the Library and of the other library facilities is otherwise+permitted, and provided that you do these two things:++    a) Accompany the combined library with a copy of the same work+    based on the Library, uncombined with any other library+    facilities.  This must be distributed under the terms of the+    Sections above.++    b) Give prominent notice with the combined library of the fact+    that part of it is a work based on the Library, and explaining+    where to find the accompanying uncombined form of the same work.++  8. You may not copy, modify, sublicense, link with, or distribute+the Library except as expressly provided under this License.  Any+attempt otherwise to copy, modify, sublicense, link with, or+distribute the Library is void, and will automatically terminate your+rights under this License.  However, parties who have received copies,+or rights, from you under this License will not have their licenses+terminated so long as such parties remain in full compliance.++  9. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Library or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Library (or any work based on the+Library), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Library or works based on it.++  10. Each time you redistribute the Library (or any work based on the+Library), the recipient automatically receives a license from the+original licensor to copy, distribute, link with or modify the Library+subject to these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties with+this License.++  11. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Library at all.  For example, if a patent+license would not permit royalty-free redistribution of the Library by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Library.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply, and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  12. If the distribution and/or use of the Library is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Library under this License+may add an explicit geographical distribution limitation excluding those+countries, so that distribution is permitted only in or among+countries not thus excluded.  In such case, this License incorporates+the limitation as if written in the body of this License.++  13. The Free Software Foundation may publish revised and/or new+versions of the Lesser General Public License from time to time.+Such new versions will be similar in spirit to the present version,+but may differ in detail to address new problems or concerns.++Each version is given a distinguishing version number.  If the Library+specifies a version number of this License which applies to it and+"any later version", you have the option of following the terms and+conditions either of that version or of any later version published by+the Free Software Foundation.  If the Library does not specify a+license version number, you may choose any version ever published by+the Free Software Foundation.++  14. If you wish to incorporate parts of the Library into other free+programs whose distribution conditions are incompatible with these,+write to the author to ask for permission.  For software which is+copyrighted by the Free Software Foundation, write to the Free+Software Foundation; we sometimes make exceptions for this.  Our+decision will be guided by the two goals of preserving the free status+of all derivatives of our free software and of promoting the sharing+and reuse of software generally.++                            NO WARRANTY++  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH+DAMAGES.++                     END OF TERMS AND CONDITIONS++           How to Apply These Terms to Your New Libraries++  If you develop a new library, and you want it to be of the greatest+possible use to the public, we recommend making it free software that+everyone can redistribute and change.  You can do so by permitting+redistribution under these terms (or, alternatively, under the terms+of the ordinary General Public License).++  To apply these terms, attach the following notices to the library.+It is safest to attach them to the start of each source file to most+effectively convey the exclusion of warranty; and each file should+have at least the "copyright" line and a pointer to where the full+notice is found.+++    <one line to give the library's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This library is free software; you can redistribute it and/or+    modify it under the terms of the GNU Lesser General Public+    License as published by the Free Software Foundation; either+    version 2.1 of the License, or (at your option) any later version.++    This library is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU+    Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General Public+    License along with this library; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA++Also add information on how to contact you by electronic and paper mail.++You should also get your employer (if you work as a programmer) or+your school, if any, to sign a "copyright disclaimer" for the library,+if necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the+  library `Frob' (a library for tweaking knobs) written by James+  Random Hacker.++  <signature of Ty Coon>, 1 April 1990+  Ty Coon, President of Vice++That's all there is to it!++
+ README view
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ Swish/HaskellRDF/BuiltInDatatypes.hs view
@@ -0,0 +1,96 @@+--------------------------------------------------------------------------------
+--  $Id: BuiltInDatatypes.hs,v 1.2 2003/12/18 20:46:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  BuiltInDatatypes
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module collects references and provides access to all of the
+--  datatypes built in to Swish.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.BuiltInDatatypes
+    ( allDatatypes, findRDFDatatype )
+where
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..), mapFindMaybe
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..) )
+
+import Swish.HaskellRDF.RDFDatatypeXsdString
+    ( rdfDatatypeXsdString )
+
+import Swish.HaskellRDF.RDFDatatypeXsdInteger
+    ( rdfDatatypeXsdInteger )
+
+------------------------------------------------------------
+--  Declare datatype map
+------------------------------------------------------------
+
+allDatatypes :: [RDFDatatype]
+allDatatypes =
+    [ rdfDatatypeXsdString
+    , rdfDatatypeXsdInteger
+    ]
+
+findRDFDatatype :: ScopedName -> Maybe RDFDatatype
+findRDFDatatype nam = mapFindMaybe nam (LookupMap allDatatypes)
+
+------------------------------------------------------------
+--  Declare datatype subtypes map
+------------------------------------------------------------
+
+allDatatypeSubtypes :: [xxx]
+allDatatypeSubtypes = []
+--  [[[details TBD]]]
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/BuiltInDatatypes.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: BuiltInDatatypes.hs,v $
+-- Revision 1.2  2003/12/18 20:46:24  graham
+-- Added xsd:string module to capture equivalence of xsd:string
+-- and plain literals without a language tag
+--
+-- Revision 1.1  2003/12/17 16:56:39  graham
+-- Split content of BuiltInMap into separate modules, to avoid recursive
+-- module dependency with RDFProofContext.
+--

+ Swish/HaskellRDF/BuiltInMap.hs view
@@ -0,0 +1,77 @@+--------------------------------------------------------------------------------
+--  $Id: BuiltInMap.hs,v 1.5 2003/12/18 18:27:46 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  BuiltInMap
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module collects references and provides access to all of the
+--  datatypes, variable binding modifiers and variable binding filters
+--  built in to Swish.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.BuiltInMap
+    ( findRDFOpenVarBindingModifier
+    , findRDFDatatype
+    , rdfRulesetMap
+    , allRulesets, allDatatypeRulesets
+    )
+where
+
+import Swish.HaskellRDF.BuiltInDatatypes
+import Swish.HaskellRDF.BuiltInRules
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/BuiltInMap.hs,v $
+-- $Author: graham $
+-- $Revision: 1.5 $
+-- $Log: BuiltInMap.hs,v $
+-- Revision 1.5  2003/12/18 18:27:46  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.4  2003/12/17 16:56:39  graham
+-- Split content of BuiltInMap into separate modules, to avoid recursive
+-- module dependency with RDFProofContext.
+--
+-- Revision 1.3  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.2  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.1  2003/12/08 23:56:07  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--

+ Swish/HaskellRDF/BuiltInMapTest.hs view
@@ -0,0 +1,299 @@+--------------------------------------------------------------------------------
+--  $Id: BuiltInMapTest.hs,v 1.5 2004/01/06 13:53:10 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  BuiltInMapTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test cases for thje funtion for accessing built-in
+--  variable binding modifiers.
+--
+--------------------------------------------------------------------------------
+
+--    WNH RIP OUT   module Swish.HaskellRDF.BuiltInMapTest where
+
+import Swish.HaskellRDF.BuiltInMap
+    ( findRDFOpenVarBindingModifier
+    , findRDFDatatype
+    , rdfRulesetMap
+    , allRulesets
+    )
+
+import Swish.HaskellRDF.RDFDatatypeXsdInteger
+    ( typeNameXsdInteger, namespaceXsdInteger
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..)
+    , getContextAxiom, getMaybeContextAxiom
+    , getContextRule,  getMaybeContextRule
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..) )
+
+import Swish.HaskellRDF.Vocabulary
+    ( swishName
+    , scopeRDF
+    , scopeRDFS
+    , scopeRDFD
+    , namespaceXsdType
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( mapFindMaybe )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , Assertion
+    , assertBool, assertEqual, assertString, assertFailure
+    , runTestTT, runTestText, putTextToHandle
+    )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    )
+
+import Control.Monad
+    ( unless )
+
+import Data.List
+    ( sort, union, intersect )
+
+import Data.Maybe
+    ( isJust, fromJust, fromMaybe )
+
+
+------------------------------------------------------------
+--  Test case helpers
+------------------------------------------------------------
+
+assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
+assertMember preface expected actual =
+  unless (expected `elem` actual ) (assertFailure msg)
+  where msg = (if null preface then "" else preface ++ "\n") ++
+             "expected: " ++ show expected ++ "\nbut got: " ++ show actual
+
+test :: String -> Bool -> Test
+test lab bv =
+    TestCase ( assertBool ("test:"++lab) bv )
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
+
+testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
+testElem lab a1 as =
+    TestCase ( assertMember ("testElem:"++lab) a1 as )
+
+testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
+testLe lab eq a1 a2 =
+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
+
+-- Test for Just x or Nothing
+
+testJust :: String -> Maybe a -> Test
+testJust lab av =
+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
+
+testNothing :: String -> Maybe a -> Test
+testNothing lab av =
+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
+
+-- Compare lists and lists of lists and Maybe lists for set equivalence:
+
+data ListTest a = ListTest [a]
+
+instance (Eq a) => Eq (ListTest a) where
+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
+
+instance (Show a) => Show (ListTest a) where
+    show (ListTest a) = show a
+
+data MaybeListTest a = MaybeListTest (Maybe [a])
+
+instance (Eq a) => Eq (MaybeListTest a) where
+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
+    MaybeListTest Nothing   == MaybeListTest Nothing   = True
+    _                       == _                       = False
+
+instance (Show a) => Show (MaybeListTest a) where
+    show (MaybeListTest a) = show a
+
+testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
+testEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
+
+testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
+testEqvEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest $ map ListTest a1
+        ma2 = ListTest $ map ListTest a2
+
+testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
+testHasEqv lab a1 a2 =
+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest a1
+        ma2 = map ListTest a2
+
+testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
+testMaybeEqv lab a1 a2 =
+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = (MaybeListTest a1)
+        ma2 = (MaybeListTest a2)
+
+------------------------------------------------------------
+--  Test finding built-in variable binding modifiers
+------------------------------------------------------------
+
+testVarMod01 = testJust "testVarMod01" $
+    findRDFOpenVarBindingModifier (swishName "rdfVarBindingUriRef")
+testVarMod02 = testJust "testVarMod02" $
+    findRDFOpenVarBindingModifier (swishName "rdfVarBindingDatatyped")
+testVarMod03 = testJust "testVarMod03" $
+    findRDFOpenVarBindingModifier (swishName "varFilterNE")
+testVarMod04 = testJust "testVarMod04" $
+    findRDFOpenVarBindingModifier (swishName "nullVarBindingModify")
+testVarMod05 = testJust "testVarMod05" $
+    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "abs")
+testVarMod06 = testJust "testVarMod06" $
+    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "divmod")
+testVarMod07 = testJust "testVarMod07" $
+    findRDFOpenVarBindingModifier (ScopedName namespaceXsdInteger "ge")
+
+testVarModSuite = TestList
+    [ testVarMod01, testVarMod02, testVarMod03, testVarMod04
+    , testVarMod05, testVarMod06, testVarMod07
+    ]
+
+------------------------------------------------------------
+--  Test finding built-in datatypes
+------------------------------------------------------------
+
+testDatatype01 = testJust "testDatatype01" $ findRDFDatatype typeNameXsdInteger
+
+testDatatypeSuite = TestList
+    [ testDatatype01
+    ]
+
+------------------------------------------------------------
+--  Test finding built-in rulesets
+------------------------------------------------------------
+
+testRuleset01 = testJust "testRuleset01" $
+    mapFindMaybe scopeRDF rdfRulesetMap
+
+testRulesetSuite = TestList
+    [ testRuleset01
+    ]
+
+------------------------------------------------------------
+--  Test finding arbitrary axioms and rules
+------------------------------------------------------------
+
+testFindAxiom01 = testJust "testFindAxiom01" $
+    getMaybeContextAxiom (ScopedName scopeRDF "a1") allRulesets
+testFindAxiom02 = testJust "testFindAxiom02" $
+    getMaybeContextAxiom (ScopedName scopeRDFS "a01") allRulesets
+testFindAxiom03 = testJust "testFindAxiom03" $
+    getMaybeContextAxiom (ScopedName (namespaceXsdType "integer") "dt")
+        allRulesets
+
+testFindAxiomSuite = TestList
+    [ testFindAxiom01, testFindAxiom02, testFindAxiom03
+    ]
+
+testFindRule01 = testJust "testFindRule01" $
+    getMaybeContextRule (ScopedName scopeRDF "r1") allRulesets
+testFindRule02 = testJust "testFindRule02" $
+    getMaybeContextRule (ScopedName scopeRDFS "r1") allRulesets
+testFindRule03 = testJust "testFindRule03" $
+    getMaybeContextRule (ScopedName scopeRDFD "r1") allRulesets
+testFindRule04 = testJust "testFindRule04" $
+    getMaybeContextRule (ScopedName (namespaceXsdType "integer") "Abs")
+        allRulesets
+
+testFindRuleSuite = TestList
+    [ testFindRule01, testFindRule02, testFindRule03, testFindRule04
+    ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+    [ testVarModSuite
+    , testDatatypeSuite
+    , testRulesetSuite
+    , testFindAxiomSuite
+    , testFindRuleSuite
+    ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/BuiltInMapTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.5 $
+-- $Log: BuiltInMapTest.hs,v $
+-- Revision 1.5  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.4  2003/12/18 18:27:46  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.3  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.2  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.1  2003/12/08 23:56:07  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--

+ Swish/HaskellRDF/BuiltInRules.hs view
@@ -0,0 +1,175 @@+--------------------------------------------------------------------------------
+--  $Id: BuiltInRules.hs,v 1.2 2003/12/18 18:27:46 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  BuiltInRules
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module collects references and provides access to all of the
+--  rulesets, variable binding modifiers and variable binding filters
+--  built in to Swish.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.BuiltInRules
+    ( findRDFOpenVarBindingModifier
+    , rdfRulesetMap
+    , allRulesets, allDatatypeRulesets
+    )
+where
+
+import Swish.HaskellRDF.BuiltInDatatypes
+    ( allDatatypes )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFOpenVarBindingModify
+    , rdfVarBindingUriRef, rdfVarBindingBlank
+    , rdfVarBindingLiteral
+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
+    , rdfVarBindingMemberProp
+    )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFRuleset, RDFRulesetMap )
+
+import Swish.HaskellRDF.RDFProofContext
+    ( rulesetRDF
+    , rulesetRDFS
+    , rulesetRDFD )
+
+import Swish.HaskellRDF.VarBinding
+    ( nullVarBindingModify
+    , makeVarFilterModify
+    , varFilterEQ, varFilterNE
+    )
+
+import Swish.HaskellRDF.Datatype
+    ( typeRules
+    , typeMkModifiers
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..)
+    , mapFindMaybe
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..) )
+
+------------------------------------------------------------
+--  Declare variable binding filters list
+------------------------------------------------------------
+
+-- |List of rdfOpenVarBindingModify values for predefined filters
+--
+rdfVarBindingFilters :: [RDFOpenVarBindingModify]
+rdfVarBindingFilters =
+    [ filter1 rdfVarBindingUriRef
+    , filter1 rdfVarBindingBlank
+    , filter1 rdfVarBindingLiteral
+    , filter1 rdfVarBindingUntypedLiteral
+    , filter1 rdfVarBindingTypedLiteral
+    , filter1 rdfVarBindingXMLLiteral
+    , filter1 rdfVarBindingMemberProp
+    , filter2 rdfVarBindingDatatyped
+    -- , filterN nullVarBindingModify
+    , filter2 varFilterEQ
+    , filter2 varFilterNE
+    ]
+    where
+        filter1 f lbs = makeVarFilterModify $ f (lbs!!0)
+        filter2 f lbs = makeVarFilterModify $ f (lbs!!0) (lbs!!1)
+        -- filterN f lbs = makeVarFilterModify $ f ...
+
+------------------------------------------------------------
+--  Declare variable binding modifiers map
+------------------------------------------------------------
+
+rdfVarBindingModifiers :: [RDFOpenVarBindingModify]
+rdfVarBindingModifiers =
+    [ nullVarBindingModify
+    ]
+
+------------------------------------------------------------
+--  Find a named built-in OpenVarBindingModifier
+------------------------------------------------------------
+
+allOpenVarBindingModify :: [RDFOpenVarBindingModify]
+allOpenVarBindingModify =
+    rdfVarBindingFilters    ++
+    rdfVarBindingModifiers  ++
+    dtsVarBindingModifiers
+
+-- dtsVarBindingModifiers = concatMap dtVarBindingModifiers allDatatypes
+dtsVarBindingModifiers = concatMap typeMkModifiers allDatatypes
+
+{-
+dtVarBindingModifiers dtval =
+    map (makeRdfDtOpenVarBindingModify dtval) (tvalMod dtval)
+-}
+
+findRDFOpenVarBindingModifier :: ScopedName -> Maybe RDFOpenVarBindingModify
+findRDFOpenVarBindingModifier nam =
+    mapFindMaybe nam (LookupMap allOpenVarBindingModify)
+
+------------------------------------------------------------
+--  Lookup map for built-in rulesets
+------------------------------------------------------------
+
+rdfRulesetMap :: RDFRulesetMap
+rdfRulesetMap = LookupMap allRulesets
+
+allRulesets :: [RDFRuleset]
+allRulesets =
+    [ rulesetRDF
+    , rulesetRDFS
+    , rulesetRDFD
+    ]
+    ++ allDatatypeRulesets
+
+allDatatypeRulesets :: [RDFRuleset]
+allDatatypeRulesets = map typeRules allDatatypes
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/BuiltInRules.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: BuiltInRules.hs,v $
+-- Revision 1.2  2003/12/18 18:27:46  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.1  2003/12/17 16:56:39  graham
+-- Split content of BuiltInMap into separate modules, to avoid recursive
+-- module dependency with RDFProofContext.
+--

+ Swish/HaskellRDF/ClassRestrictionRule.hs view
@@ -0,0 +1,666 @@+{-# OPTIONS -XMultiParamTypeClasses #-}+--------------------------------------------------------------------------------
+--  $Id: ClassRestrictionRule.hs,v 1.15 2004/01/07 19:49:12 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ClassRestrictionRule
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module implements an inference rule based on a restruction on class
+--  membership of one or more values.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.ClassRestrictionRule
+    ( ClassRestriction(..), ClassRestrictionFn
+    , makeDatatypeRestriction, makeDatatypeRestrictionFn
+    , makeRDFClassRestrictionRules
+    , makeRDFDatatypeRestrictionRules
+    , falseGraph, falseGraphStr
+    )
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..)
+    , getScopedName
+    , RDFGraph
+    , getArcs
+    , merge
+    , toRDFGraph, emptyRDFGraph
+    , Arc(..)
+    , res_rdf_type
+    , res_rdfd_maxCardinality
+    )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFRule
+    , makeRDFGraphFromN3String
+    )
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatypeVal
+    , fromRDFLabel, toRDFLabel
+    )
+
+import Swish.HaskellRDF.RDFQuery
+    ( rdfQueryFind
+    , rdfFindValSubj, rdfFindPredVal, rdfFindPredInt
+    , rdfFindList
+    )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding )
+
+import Swish.HaskellRDF.Datatype
+    ( DatatypeVal(..)
+    , DatatypeRel(..), DatatypeRelFn
+    )
+
+import Swish.HaskellRDF.Rule
+    ( Rule(..)
+    , bwdCheckInference
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDFD
+    )
+
+import Swish.HaskellUtils.PartOrderedCollection
+    ( minima, maxima
+    , partCompareEq, partComparePair
+    , partCompareListMaybe
+    , partCompareListSubset
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , mapFindMaybe
+    )
+
+import Swish.HaskellUtils.ListHelpers
+    ( powerSet )
+
+import Data.Maybe
+    ( Maybe(..)
+    , isJust, fromJust, fromMaybe, catMaybes )
+
+import Data.List
+    ( delete, nub, (\\) )
+
+import Control.Monad
+    ( liftM )
+
+import Swish.HaskellUtils.TraceHelpers
+    ( trace )
+
+------------------------------------------------------------
+--  Class restriction data type
+------------------------------------------------------------
+
+-- |Type of function that evaluates missing node values in a
+--  restriction from those supplied.
+type ClassRestrictionFn = [Maybe RDFLabel] -> Maybe [[RDFLabel]]
+
+-- |Datatype for named class restriction
+data ClassRestriction = ClassRestriction
+    { crName    :: ScopedName
+    , crFunc    :: ClassRestrictionFn
+    }
+
+instance Eq ClassRestriction where
+    cr1 == cr2  =  crName cr1 == crName cr2
+
+instance Show ClassRestriction where
+    show cr = "ClassRestriction:"++(show $ crName cr)
+
+instance LookupEntryClass ClassRestriction ScopedName ClassRestriction
+    where
+    newEntry (_,fn) = fn
+    keyVal cr = (crName cr, cr)
+
+------------------------------------------------------------
+--  Instantiate a class restriction from a datatype relation
+------------------------------------------------------------
+
+-- |Make a class restriction from a datatype relation.
+--
+--  This "lifts" application of the datatype relation to operate
+--  on RDFLabel values, which are presumed to contain appropriately
+--  datatyped values.
+--
+makeDatatypeRestriction ::
+    RDFDatatypeVal vt -> DatatypeRel vt -> ClassRestriction
+makeDatatypeRestriction dtv dtrel = ClassRestriction
+    { crName = dtRelName dtrel
+    , crFunc = makeDatatypeRestrictionFn dtv (dtRelFunc dtrel)
+    }
+
+-- |Make a class restriction function from a datatype relation function.
+--
+--  The core logic is something like (map toLabels . dtrelfn . map frLabel)
+--  but the extra lifting and catMaybes are needed to get the final result
+--  type in the right form.
+--
+--  ClassRestrictionFn = [Maybe RDFLabel] -> Maybe [[RDFLabel]]
+--
+makeDatatypeRestrictionFn ::
+    RDFDatatypeVal vt -> DatatypeRelFn vt -> ClassRestrictionFn
+makeDatatypeRestrictionFn dtv dtrelfn =
+    liftM (catMaybes . map toLabels) . dtrelfn . (map frLabel)
+    where
+        frLabel Nothing  = Nothing
+        frLabel (Just l) = fromRDFLabel dtv l
+        toLabels         = sequence . map toLabel   -- Maybe [RDFLabel]
+        toLabel          = toRDFLabel dtv
+
+------------------------------------------------------------
+--  Make rules from supplied class restrictions and graph
+------------------------------------------------------------
+
+ruleQuery :: RDFGraph+ruleQuery = makeRDFGraphFromN3String $
+    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
+    " ?c a rdfd:GeneralRestriction ; " ++
+    "    rdfd:onProperties ?p ; "      ++
+    "    rdfd:constraint   ?r . "
+
+--  Placeholder false graph for now.
+falseGraph :: RDFGraph+falseGraph = makeRDFGraphFromN3String $
+    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
+    falseGraphStr
+
+falseGraphStr :: String+falseGraphStr = "_:a rdfd:false _:b . "
+
+-- |Make a list of class restriction rules given a list of class restriction
+--  values and a graph containing one or more class restriction definitions.
+--
+makeRDFClassRestrictionRules :: [ClassRestriction] -> RDFGraph -> [RDFRule]
+makeRDFClassRestrictionRules crs gr =
+    catMaybes $ ( map constructRule . queryForRules ) gr
+    where
+        queryForRules = rdfQueryFind ruleQuery
+        constructRule = makeRestrictionRule1 crs gr
+
+makeRestrictionRule1 ::
+    [ClassRestriction] -> RDFGraph -> RDFVarBinding -> Maybe RDFRule
+makeRestrictionRule1 crs gr vb =
+    {-
+    trace "\nmakeRestrictionRule1:" $
+    -- seq (traceShow "\ngr:" gr)
+    seq (traceShow "\nvb:" vb) $
+    seq (traceShow "\nc:" c) $
+    seq (traceShow "\np:" p) $
+    seq (traceShow "\nr:" r) $
+    seq (traceShow "\nps:" ps) $
+    -- seq (traceShow "\nrn:" rn) $
+    -}
+    makeRestrictionRule2 rn c ps cs
+    where
+        c  = fromMaybe NoNode $ vbMap vb (Var "c")
+        p  = fromMaybe NoNode $ vbMap vb (Var "p")
+        r  = fromMaybe NoNode $ vbMap vb (Var "r")
+        cs = filter (>0) $ map fromInteger $
+             rdfFindPredInt c res_rdfd_maxCardinality gr
+        ps = rdfFindList gr p
+        rn = mapFindMaybe (getScopedName r) (LookupMap crs)
+
+makeRestrictionRule2 ::
+    Maybe ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int]
+    -> Maybe RDFRule
+makeRestrictionRule2 (Just restriction) cls@(Res cname) props cs =
+    {-
+    trace "\nmakeRestrictionRule2:" $
+    seq (traceShow "\ncls:" cls)
+    seq (traceShow "\nprops:" props) $
+    -}
+    Just restrictionRule
+    where
+        restrictionRule = Rule
+            { ruleName = cname
+              -- fwdApply :: [ex] -> [ex]
+            , fwdApply = fwdApplyRestriction restriction cls props cs
+              -- bwdApply :: ex -> [[ex]]
+            , bwdApply = bwdApplyRestriction restriction cls props cs
+            , checkInference = bwdCheckInference restrictionRule
+            }
+makeRestrictionRule2 _ _ _ _ =
+    trace "\nmakeRestrictionRule: missing class restriction" $
+    Nothing
+
+--  Forward apply class restriction.
+fwdApplyRestriction ::
+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> [RDFGraph]
+    -> [RDFGraph]
+fwdApplyRestriction restriction cls props cs antgrs =
+    if isJust newgrs then concat $ fromJust newgrs else [falseGraph]
+    where
+        -- Instances of the named class in the graph:
+        ris = nub $ rdfFindValSubj res_rdf_type cls antgr
+        --  Merge antecedent graphs into one (with bnode renaming):
+        --  (Uses 'if' and 'foldl1' to avoid merging in the common case
+        --  of just one graph supplied.)
+        antgr = if null antgrs then emptyRDFGraph else foldl1 merge antgrs
+        --  Apply class restriction to single instance of the restricted class
+        newgr :: RDFLabel -> Maybe [RDFGraph]
+        newgr ri = fwdApplyRestriction1 restriction ri props cs antgr
+        newgrs :: Maybe [[RDFGraph]]
+        newgrs = sequence $ map newgr ris
+
+--  Forward apply class restriction to single class instance (ci).
+--  Return single set of inferred results, for each combination of
+--  property values, or an empty list, or Nothing if the supplied values
+--  are inconsistent with the restriction.
+fwdApplyRestriction1 ::
+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
+    -> Maybe [RDFGraph]
+fwdApplyRestriction1 restriction ci props cs antgr =
+    {-
+    trace "\nfwdApplyRestriction1:" $
+    seq (traceShow "\nci:" ci)
+    seq (traceShow "\nprops:" props)
+    seq (traceShow "\nantgr:" antgr) $
+    -}
+    if grConsistent then Just newgrs else Nothing
+    where
+        --  Apply restriction to graph
+        (grConsistent,_,_,sts) = applyRestriction restriction ci props cs antgr
+        --  Select results, eliminate those with unknowns
+        nts :: [[RDFLabel]]
+        nts = catMaybes $ map sequence sts
+        --  Make new graph from results, including only newly generated arcs
+        newarcs = nub [Arc ci p v | vs <- nts, (p,v) <- zip props vs ]
+                  \\ getArcs antgr
+        newgrs  = if null newarcs then [] else [toRDFGraph newarcs]
+
+--  Backward apply class restriction.
+--
+--  Returns a list of alternatives, any one of which is sufficient to
+--  satisfy the given consequent.
+--
+bwdApplyRestriction ::
+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
+    -> [[RDFGraph]]
+bwdApplyRestriction restriction cls props cs congr =
+    if isJust newgrs then fromJust newgrs else [[falseGraph]]
+    where
+        -- Instances of the named class in the graph:
+        ris = rdfFindValSubj res_rdf_type cls congr
+        --  Apply class restriction to single instance of the restricted class
+        newgr :: RDFLabel -> Maybe [[RDFGraph]]
+        newgr ri = bwdApplyRestriction1 restriction cls ri props cs congr
+        --  'map newgr ris' is conjunction of disjunctions, where
+        --  each disjunction is itself a conjunction of conjunctions.
+        --  'sequence' distributes the conjunction over the disjunction,
+        --  yielding an equivalent disjunction of conjunctions
+        --  map concat flattens the conjunctions of conjuctions
+        newgrs :: Maybe [[RDFGraph]]
+        newgrs = liftM (map concat . sequence) $ sequence $ map newgr ris
+
+--  Backward apply a class restriction to single class instance (ci).
+--  Return one or more sets of antecedent results from which the consequence
+--  can be derived in the defined relation, an empty list if the supplied
+--  consequence cannot be inferred, or Nothing if the consequence is
+--  inconsistent with the restriction.
+bwdApplyRestriction1 ::
+    ClassRestriction -> RDFLabel -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
+    -> Maybe [[RDFGraph]]
+bwdApplyRestriction1 restriction cls ci props cs congr =
+    if grConsistent then Just grss else Nothing
+    {-
+    trace "\nfwdApplyRestriction1:" $
+    seq (traceShow "\nci:" ci)
+    seq (traceShow "\nprops:" props)
+    seq (traceShow "\ncongr:" congr) $
+    -}
+    where
+        --  Apply restriction to graph
+        (grConsistent,pvs,cts,_) =
+            applyRestriction restriction ci props cs congr
+        --  Build list of all full tuples consistent with the values supplied
+        fts :: [[RDFLabel]]
+        fts = concatMap snd cts
+        --  Construct partial tuples from members of fts from which at least
+        --  one of the supplied values can be derived
+        pts :: [([Maybe RDFLabel],[RDFLabel])]
+        pts = concatMap (deriveTuple restriction) fts
+        --  Select combinations of members of pts from which all the
+        --  supplied values can be derived
+        dtss :: [[[Maybe RDFLabel]]]
+        dtss = coverSets pvs pts
+        --  Filter members of dtss that fully cover the values
+        --  obtained from the consequence graph.
+        ftss :: [[[Maybe RDFLabel]]]
+        ftss = filter (not . (\t -> coversVals deleteMaybe t pvs)) dtss
+        --  Make new graphs for all alternatives
+        grss :: [[RDFGraph]]
+        grss = map ( makeGraphs . newArcs ) ftss
+        --  Collect arcs for one alternative
+        newArcs dts =
+            [ Arc ci p v | mvs <- dts, (p,Just v) <- zip props mvs ]
+        --  Make graphs for one alternative
+        makeGraphs = map (toRDFGraph . (:[])) . ((Arc ci res_rdf_type cls):)
+
+--  Helper function to select sub-tuples from which some of a set of
+--  values can be derived using a class restriction.
+--
+--  restriction is the restriction being evaluated.
+--  ft          is a full tuple of values known to be consistent with
+--              the restriction
+--
+--  The result returned is a list of pairs, whose first member is a partial
+--  tuples from which the full tuple supplied can be derived, and the second
+--  is the supplied tuple calculated from that input.
+--
+deriveTuple ::
+    ClassRestriction -> [RDFLabel]
+    -> [([Maybe RDFLabel],[RDFLabel])]
+deriveTuple restriction ft =
+    map (tosnd ft) $ minima partCompareListMaybe $ filter derives partials
+    where
+        partials = sequence $ map (\x -> [Nothing,Just x]) ft
+        derives  = ([ft]==) . fromJust . crFunc restriction
+        tosnd    = flip (,)
+
+--  Helper function to apply a restriction to selected information from
+--  a supplied graph, and returns a tuple containing:
+--  (a) an indication of whether the graph is consistent with the
+--      restriction
+--  (b) a list of values specified in the graph for each property
+--  (c) a complete list of tuples that use combinations of values from
+--      the graph and are consistent with the restriction.
+--      Each member is a pair consisting of some combination of input
+--      values, and a list of complete tuple values that can be
+--      calculated from those inputs, or an empty list if there is
+--      insufficient information.
+--  (d) a set of tuples that are consistent with the restriction and use
+--      as much information from the graph as possible.  This set is
+--      minimal in the sense that they must all correspond to different
+--      complete input tuples satisfying the restriction.
+--
+--  This function factors out logic that is common to forward and
+--  backward chaining of a class restriction.
+--
+--  restriction is the class restriction being applied
+--  ci          is the identifier of a graph node to be tested
+--  props       is a list of properties of the graph noode whose values
+--              are constrained by the class restriction.
+--  cs          is a list of max cardinality constraints on the restriction,
+--              the minimum of which is used as the cardinality constraint
+--              on the restriction.  If the list is null, no cardinality
+--              constraint is applied.
+--  gr          is the graph from which property values are extracted.
+--
+applyRestriction ::
+    ClassRestriction -> RDFLabel -> [RDFLabel] -> [Int] -> RDFGraph
+    -> ( Bool
+       , [[RDFLabel]]
+       , [([Maybe RDFLabel],[[RDFLabel]])]
+       , [[Maybe RDFLabel]]
+       )
+applyRestriction restriction ci props cs gr =
+    ( (coversVals deleteMaybe sts pvs) && cardinalityOK, pvs, cts, sts )
+    where
+        --  Extract from the antecedent graph all specified values of the
+        --  restricted properties (constructs inner list for each property)
+        pvs :: [[RDFLabel]]
+        pvs = [ rdfFindPredVal ci p gr | p <- props ]
+        --  Convert tuple of alternatives to list of alternative tuples
+        --  (Each tuple is an inner list)
+        pts :: [[Maybe RDFLabel]]
+        pts = sequence $ map allJustAndNothing pvs
+        --  Try class restriction calculation for each tuple
+        --  For each, result may be:
+        --    Nothing  (inconsistent)
+        --    Just []  (underspecified)
+        --    Just [t] (single tuple of values derived from given values)
+        --    Just ts  (alternative tuples derived from given values)
+        rts :: [Maybe [[RDFLabel]]]
+        rts = map (crFunc restriction) pts
+        --  Extract list of consistent tuples of given values
+        cts :: [([Maybe RDFLabel],[[RDFLabel]])]
+        cts = map sndFromJust $ filter (isJust . snd) (zip pts rts)
+        --  Build list of consistent tuples with maximum information
+        --  based on that supplied and available
+        -- mts = concatMap mostValues cts
+        mts = map mostOneValue cts
+        --  Eliminate consistent results subsumed by others.
+        --  This results in a mimimal possible set of consistent inputs,
+        --  because if any pair could be consistently unified then their
+        --  common subsumer would still be in the list, and both would be
+        --  thereby eliminated.
+        sts :: [[Maybe RDFLabel]]
+        sts = maxima partCompareListMaybe mts
+        --  Check the cardinality constraint
+        cardinalityOK = null cs || length sts <= minimum cs
+        --  Remove Maybe wrapper from second component of a pair
+        sndFromJust :: (a,Maybe b) -> (a,b)
+        sndFromJust (a,Just b) = (a,b)
+
+--  Map a non-empty list of values to a list of Just values,
+--  preceding each with a Nothing element.
+--
+--  Nothing corresponds to an unknown value.  This logic is used
+--  as part of constructing a list of alternative tuples of known
+--  data values (either supplied or calculated from the class
+--  restriction).
+--
+allJustAndNothing :: [a] -> [Maybe a]
+allJustAndNothing as = Nothing:map Just as
+
+--  Get maximum information about possible tuple values from a
+--  given pair of input tuple, which is known to be consistent with
+--  the restriction, and calculated result tuples.  Where the result
+--  tuple is not exactly calculated, return the input tuple.
+--
+--  imvs    tuple of Maybe element values, with Nothing for
+--          unspecified values
+--  movss   Maybe list of possible fully-specified result tuples,
+--          an empty list if no result tuples can be computed
+--          based on the input tuple, or Nothing if the input
+--          tuple is inconsistent.
+--
+mostValues :: ([Maybe a],[[a]]) -> [[Maybe a]]
+mostValues (imvs,([])) = [imvs]
+mostValues (_,movss) = map (map Just) movss
+
+--  Get maximum information about possible tuple values from a
+--  given pair of input and possible result tuples, which is
+--  known to be consistent with the restriction.  If the result
+--  tuple is not exactly calculated, return the input tuple.
+--
+--  This is a variant of mostValues that returns a single vector.
+--  Multiple possible values are considered to be equivalent to
+--  Just [], i.e. unknown result.
+--
+--  imvs    tuple of Maybe element values, with Nothing for
+--          unspecified values
+--  movss   Maybe list of possible fully-specified result tuples,
+--          or an empty list if no result tuples can be computed
+--          based on the input tuple.
+--
+mostOneValue :: ([Maybe a],[[a]]) -> [Maybe a]
+mostOneValue (_,[movs]) = map Just movs
+mostOneValue (imvs,_)   = imvs
+
+--  Helper function that returns subsets of dts that "cover" the indicated
+--  values;  i.e. from which all of the supplied values can be deduced
+--  by the enumerated function results.  The minima of all such subsets is
+--  returned, as each of these corresponds to some minimum information needed
+--  to deduce all of the given values.
+--
+--  pvs     is a list of lists of values to be covered.  The inner list
+--          contains multiple values for each member of a tuple.
+--  dts     is an enumerated list of function values from some subset of
+--          the tuple space to complete tuples.  Each member is a pair
+--          containing the partial tuple (using Nothing for unspecified
+--          values) and the full tuple calculated from it.
+--
+--  The return value is a disjunction of conjunctions of partial tuples
+--  that cover the indicated parameter values.
+--
+--  NOTE:
+--  The result minimization is not perfect (cf. test2 below), but I believe
+--  it is adequate for the practical situations I envisage, and in any
+--  case will not result in incorrect values.  It's significance is for
+--  search-tree pruning.  A perfect minimization might be achieved by
+--  using a more subtle partial ordering that takes account of both subsets
+--  and the partial ordering of set members in place of 'partCompareListSubset'.
+--
+coverSets  :: (Eq a) => [[a]] -> [([Maybe a],[a])] -> [[[Maybe a]]]
+coverSets pvs dts =
+    minima partCompareListSubset $ map (map fst) ctss
+    where
+        ctss = filter (coverspvs) $ powerSet cts
+        cts  = minima (partComparePair partCompareListMaybe partCompareEq) dts
+        coverspvs cts = coversVals delete (map snd cts) pvs
+
+--  Does a supplied list of tuples cover a list of possible alternative
+--  values for each tuple member?
+--
+coversVals :: (a->[b]->[b]) -> [[a]] -> [[b]] -> Bool
+coversVals dropVal ts vss =
+    -- all null (foldr dropUsed vss ts)
+    any (all null) (scanr dropUsed vss ts)
+    where
+        --  Remove single tuple values from the list of supplied values:
+        dropUsed []       []     = []
+        dropUsed (t:ts) (vs:vss) = dropVal t vs:dropUsed ts vss
+        dropUsed _ _ = error "coversVals.dropUsed: list length mismatch"
+
+{-
+--  Does a supplied list of possible alternative values for each
+--  element of a tuple cover every tuple in a supplied list?
+--
+--  (See module spike-coverVals.hs for test cases)
+--
+coversAll :: ([a]->b->Bool) -> [[a]] -> [[b]] -> Bool
+coversAll matchElem vss ts = all (invss vss) ts
+    where
+        --  Test if a given tuple is covered by vss
+        invss vss t = and $ zipWith matchElem vss t
+
+--  Test if the value in a Maybe is contained in a list.
+maybeElem :: (Eq a) => Maybe a -> [a] -> Bool
+maybeElem Nothing  = const True
+maybeElem (Just t) = elem t
+-}
+
+-- |Delete a Maybe value from a list
+deleteMaybe :: (Eq a) => Maybe a -> [a] -> [a]
+deleteMaybe Nothing  as = as
+deleteMaybe (Just a) as = delete a as
+
+------------------------------------------------------------
+--  Make restriction rules from supplied datatype and graph
+------------------------------------------------------------
+
+makeRDFDatatypeRestrictionRules :: RDFDatatypeVal vt -> RDFGraph -> [RDFRule]
+makeRDFDatatypeRestrictionRules dtval gr =
+    makeRDFClassRestrictionRules dcrs gr
+    where
+        dcrs = map (makeDatatypeRestriction dtval) (tvalRel dtval)
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/ClassRestrictionRule.hs,v $
+-- $Author: graham $
+-- $Revision: 1.15 $
+-- $Log: ClassRestrictionRule.hs,v $
+-- Revision 1.15  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.14  2003/12/20 12:53:39  graham
+-- Fix up code to compile and test with GHC 5.04.3
+--
+-- Revision 1.13  2003/12/20 12:00:14  graham
+-- Introduced new TraceHelpers module for Hugs-2003 compatibility.
+--
+-- Revision 1.12  2003/12/19 21:01:25  graham
+-- Change Debug.Trace import (from Hugs.Trace)
+--
+-- Revision 1.11  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.10  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.9  2003/11/28 00:17:55  graham
+-- Datatype constraint test cases all passed.
+--
+-- Revision 1.8  2003/11/27 11:35:49  graham
+-- Variable modifier tests all run.
+-- Initial class constraint reasoning tests pass.
+-- Fixed bug in class constraint backward-chained reasoning that returned
+-- multiple instances of some statements, and did not filter out all occurrences
+-- of the original statements.
+--
+-- Revision 1.7  2003/11/24 22:13:09  graham
+-- Working on reworking datatype variable modifiers to work with
+-- revised datatype framework.
+--
+-- Revision 1.6  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.5  2003/11/20 17:58:09  graham
+-- Class-constraint backward chaining: all test cases passed.
+--
+-- Revision 1.4  2003/11/19 22:13:03  graham
+-- Some backward chaining tests passed
+--
+-- Revision 1.3  2003/11/17 21:53:30  graham
+-- Datatype inference forward chaining updated to allow inconsistent
+-- partial inputs to be detected.  All forward chaining test cases passed.
+-- Need to develop backward chaining test cases.
+--
+-- Revision 1.2  2003/11/14 21:48:35  graham
+-- First cut cardinality-checked datatype-constraint rules to pass test cases.
+-- Backward chaining is still to do.
+--
+-- Revision 1.1  2003/11/13 01:15:23  graham
+-- Working on ClassRestrictionRule.
+-- Code almost complete, some test cases missing.
+--

+ Swish/HaskellRDF/Datatype.hs view
@@ -0,0 +1,1082 @@+{-# OPTIONS -XExistentialQuantification #-}+{-# OPTIONS -XMultiParamTypeClasses #-}++--------------------------------------------------------------------------------
+--  $Id: Datatype.hs,v 1.21 2003/12/18 18:27:46 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Datatype
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + existential types + rank 2 polymorphism
+--
+--  This module defines the structures used by Swish to represent and
+--  manipulate datatypes.  It is designed as a basis for handling datatyped
+--  RDF literals, but the functions in this module are more generic.
+--
+--  Testing note:  this module supports a number of specific datatypes.
+--  It is intended that functionality in this module will be tested via
+--  modules RDFDatatype, ClassRestrictionRule and RDFDatatypeXsdInteger.
+--  See also module ClassRestrictionRuleTest for test cases.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.Datatype
+    ( Datatype(..)
+    , typeName, typeRules, typeMkRules, typeMkModifiers, typeMkCanonicalForm
+    , getTypeAxiom, getTypeRule
+    , DatatypeVal(..)
+    , getDTMod
+    , getDTRel
+    , tvalMkCanonicalForm
+    , DatatypeMap(..)
+    , DatatypeRel(..), DatatypeRelFn, DatatypeRelPr
+    , altArgs
+    , UnaryFnDescr,    UnaryFnTable,    UnaryFnApply,    unaryFnApp
+    , BinaryFnDescr,   BinaryFnTable,   BinaryFnApply,   binaryFnApp
+    , BinMaybeFnDescr, BinMaybeFnTable, BinMaybeFnApply, binMaybeFnApp
+    , ListFnDescr,     ListFnTable,     ListFnApply,     listFnApp
+    , DatatypeMod(..), ModifierFn
+    , ApplyModifier
+    , nullDatatypeMod
+    -- , applyDatatypeMod
+    , makeVmod_1_1_inv, makeVmod_1_1
+    , makeVmod_2_1_inv, makeVmod_2_1
+    , makeVmod_2_0
+    , makeVmod_2_2
+    , makeVmod_N_1
+    , DatatypeSub(..)
+    )
+where
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..)
+    , getRulesetAxiom, getRulesetRule
+    )
+
+import Swish.HaskellRDF.Rule
+    ( Formula(..)
+    , Rule(..)
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..)
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( swishName )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    , addVarBinding+    , VarBindingModify(..), OpenVarBindingModify, nullVarBindingModify
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , mapFindMaybe+    )
+
+import Swish.HaskellUtils.ListHelpers
+    ( flist
+    , deleteIndex
+    )
+
+import Data.Maybe( isJust, catMaybes )
+
+import Control.Monad( join, liftM )
+
+------------------------------------------------------------
+--  Datatype framework
+------------------------------------------------------------
+
+-- |Datatype wraps a DatatypeVal value, hiding the value type that
+--  is used only in implementations of the datatype.
+--  Users see just the datatype name and associated ruleset.
+--
+--  Note, the 'forall' is used in the sense of existentially quantified:
+--  see the Glasgow Haskell Compiler (GHC) user guide, section 7.3.12
+--
+data Datatype ex lb vn = forall vt . Datatype (DatatypeVal ex vt lb vn)
+
+instance LookupEntryClass
+        (Datatype ex lb vn) ScopedName (Datatype ex lb vn)
+    where
+    newEntry (_,dt) = dt
+    keyVal dt       = (typeName dt, dt)
+
+-- |Get type name from Datatype value
+typeName :: Datatype ex lb vn -> ScopedName
+typeName (Datatype dtv) = tvalName  dtv
+
+-- |Get static rules from Datatype value
+typeRules :: Datatype ex lb vn -> Ruleset ex
+typeRules (Datatype dtv) = tvalRules dtv
+
+-- |Make rules for Datatype value based on supplied expression
+typeMkRules :: Datatype ex lb vn -> ex -> [Rule ex]
+typeMkRules (Datatype dtv) = tvalMkRules dtv
+
+-- |Make variable binding modifiers based on values supplied
+typeMkModifiers :: Datatype ex lb vn -> [OpenVarBindingModify lb vn]
+typeMkModifiers (Datatype dtv) = tvalMkMods dtv
+
+-- |Get named axiom from Datatype value
+getTypeAxiom :: ScopedName -> Datatype ex lb vn -> Maybe (Formula ex)
+getTypeAxiom nam dt = getRulesetAxiom nam (typeRules dt)
+
+-- |Get named rule from Datatype value
+getTypeRule :: ScopedName -> Datatype ex lb vn -> Maybe (Rule ex)
+getTypeRule  nam dt = getRulesetRule  nam (typeRules dt)
+
+-- |Get cacnonical form of datatype value
+typeMkCanonicalForm :: Datatype ex lb vn -> String -> Maybe String
+typeMkCanonicalForm (Datatype dtv) valstr = tvalMkCanonicalForm dtv valstr
+
+------------------------------------------------------------
+--  DatatypeVal
+------------------------------------------------------------
+
+-- |DatatypeVal is a structure that defines a number of functions
+--  and values that characterize the behaviour of a datatype.
+--
+--  A datatype is specified with respect to (polymophic in) a given
+--  type of (syntactic) expression with which it may be used, and
+--  a value type (whos existence is hidden as an existential type
+--  within DatatypeMap
+--
+--  (I tried hiding the value type with an internal existential
+--  declaration, but that wouldn't wash.  Hence this two-part
+--  structure with Datatype (above) in which the internal detail
+--  of the value type is hidden from users of the Datatype class.)
+--
+--  The datatype characteristic functions have two goals:
+--  - to support the general datatype entailment rules defined by
+--    the RDF semantics specification, and
+--  - to define additional datatype-specific inference patterns by
+--    means of which provide additional base functionality to
+--    applications based on RDF inference.
+--
+--  Datatype-specific inferences are provided using the DatatypeRel
+--  structure for a datatype, which allows a number of named relations
+--  to be defined on datatype values, and provides mechanisms to
+--  calculate missing values in a partially-specified member of
+--  a relation.
+--
+--  Note that rules and variable binding modifiers that deal with
+--  combined values of more than one datatype may be defined
+--  separately.  Definitions in this module are generally applicable
+--  only when using a single datatype.
+--
+--  An alternative model for datatype value calculations is inspired
+--  by that introduced by CWM for arithmetic operations, e.g.
+--       (1 2 3) math:sum ?x => ?x rdf:value 6
+--  (where the bare integer n here is shorthand for "n"^^xsd:integer)
+--
+--  Datatype-specific inference patterns are provided in two ways:
+--  (a) by variable binding modifiers that can be combined with the
+--      query results during forward- for backward-chaining of
+--      inference rules, and
+--  (b) by the definition of inference rulesets that involve
+--      datatype values.
+--  I believe the first method to be more flexible than the second,
+--  in that it more readily supports forward and backward chaining,
+--  but can be used only through the definition of new rules.
+--
+--  Type parameters:
+--  ex      is the type of expression with which the datatype may be used.
+--  vt      is the internal value type with which the labels are associated.
+--  lb      is the type of label that may be used as a variable in an
+--          expression or rule.
+--  vn      is the type of node that may be used to carry a value in an
+--          expression or rule.
+--
+data DatatypeVal ex vt lb vn = DatatypeVal
+    { tvalName      :: ScopedName
+                                -- ^Identifies the datatype, and also
+                                --  its value space class.
+    , tvalRules     :: Ruleset ex
+                                -- ^A set of named expressions and rules
+                                --  that are valid in in any theory that
+                                --  recognizes the current datatype.
+    , tvalMkRules   :: ex -> [Rule ex]
+                                -- ^A function that accepts an expression
+                                --  and devives some datatype-dependent
+                                --  rules from it.  This is provided as a
+                                --  hook for creating datatyped class
+                                --  restriction rules.
+    , tvalMkMods    :: [OpenVarBindingModify lb vn]
+                                -- ^Constructs a list of open variable
+                                --  binding modifiers based on tvalMod,
+                                --  but hiding the actual value type.
+    , tvalMap       :: DatatypeMap vt
+                                -- ^Lexical to value mapping, where 'vt' is
+                                --  a datatype used within a Haskell program
+                                --  to represent and manipulate values in
+                                --  the datatype's value space
+    , tvalRel       :: [DatatypeRel vt]
+                                -- ^A set of named relations on datatype
+                                --  values.  Each relation accepts a list
+                                --  of (Maybe vt), and computes any
+                                --  unspecified values that are in the
+                                --  relation with values supplied.
+    , tvalMod       :: [DatatypeMod vt lb vn]
+                                -- ^A list of named values that are used to
+                                --  construct variable binding modifiers, which
+                                --  in turn may be used by a rule definition.
+                                --  [[[TODO: In due course, this value may be
+                                --  calculated automatically from the supplied
+                                --  value for tvalRel.]]]
+    }
+
+--  Other accessor functions
+
+getDTRel ::
+    ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeRel vt)
+getDTRel nam dtv =
+    mapFindMaybe nam (LookupMap (tvalRel dtv))
+
+getDTMod ::
+    ScopedName -> DatatypeVal ex vt lb vn -> Maybe (DatatypeMod vt lb vn)
+getDTMod nam dtv =
+    mapFindMaybe nam (LookupMap (tvalMod dtv))
+
+-- |Get canonical form of datatype value, or None
+--
+tvalMkCanonicalForm :: DatatypeVal ex vt lb vn -> String -> Maybe String
+tvalMkCanonicalForm dtv str = can
+    where
+        val  = mapL2V (tvalMap dtv) str
+        can = join $ liftM (mapV2L (tvalMap dtv)) val
+
+-- |DatatypeMap consists of methods that perform lexical-to-value
+--  and value-to-canonical-lexical mappings for a datatype.
+--
+--  The datatype mappings apply to string lexical forms.
+--
+data DatatypeMap vt = DatatypeMap
+    { mapL2V  :: String -> Maybe vt
+                            -- ^ Function to map lexical string to
+                            --   datatype value.  This effectively
+                            --   defines the lexical space of the
+                            --   datatype to be all strings for which
+                            --   yield a value other than Nothing.
+    , mapV2L  :: vt -> Maybe String
+                            -- ^ Function to map a value to its canonical
+                            --   lexical form, if it has such.
+    }
+
+-- |Type for a datatype relation inference function.
+--
+--  A datatype relation defines tuples of values that satisfy some
+--  relation.  A datatype relation inference function calculates
+--  values that complete a relation with values supplied.
+--
+--  The function accepts a list of Maybe vt, where vt is the
+--  datatype value type.  It returns:
+--  (a) Just a list of lists, where each inner list returned is a
+--      complete set of values, including the values supplied, that
+--      are in the relation.
+--  (b) Just an empty list is returned if the supplied values are
+--      insufficient to compute any complete sets of values in the
+--      relation.
+--  (c) Nothing if the supplied values are not consistent with
+--      the relation.
+--
+type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]
+
+-- |Type for datatype relation predicate:  accepts a list of values
+--  and determines whether or not they satisfy the relation.
+--
+type DatatypeRelPr vt = [vt] -> Bool
+
+-- |Datatype for a named relation on values of a datatype.
+--
+data DatatypeRel vt = DatatypeRel
+    { dtRelName :: ScopedName
+    , dtRelFunc :: DatatypeRelFn vt
+    }
+
+instance LookupEntryClass (DatatypeRel vt) ScopedName (DatatypeRel vt)
+    where
+    newEntry (_,relf) = relf
+    keyVal dtrel = (dtRelName dtrel, dtrel)
+
+-- |Datatype value modifier functions type
+--
+--  Each function accepts a list of values and returns a list of values.
+--  The exact significance of the different values supplied and returned
+--  depends on the variable binding pattern used (cf. ApplyModifier),
+--  but in all cases an empty list returned means that the corresponding
+--  inputs are not consistent with the function and cannot be used.
+--
+type ModifierFn vn = [vn] -> [vn]
+
+-- |Type of function used to apply a data value modifier to specified
+--  variables in a supplied variable binding.  It also accepts the
+--  name of the datatype modifier and carries it into the resulting
+--  variable binding modifier.
+--
+--  (Note that vn is not necessarily the same as vt, the datatype value
+--  type:  the modifier functions may be "lifted" or otherwise adapted
+--  to operate on some other type from which the raw data values are
+--  extracted.)
+--
+type ApplyModifier lb vn =
+    ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn
+
+-- |Wrapper for data type variable binding modifier included in
+--  a datatype value.
+--
+data DatatypeMod vt lb vn = DatatypeMod
+    { dmName :: ScopedName
+    , dmModf :: [ModifierFn vt]
+    , dmAppf :: ApplyModifier lb vn
+    }
+
+instance LookupEntryClass
+        (DatatypeMod vt lb vn) ScopedName (DatatypeMod vt lb vn)
+    where
+    newEntry (_,dmod) = dmod
+    keyVal dmod = (dmName dmod, dmod)
+
+-- |Null datatype value modifier
+nullDatatypeMod :: DatatypeMod vt lb vn
+nullDatatypeMod = DatatypeMod
+    { dmName = swishName "nullDatatypeMod"
+    , dmModf = []
+    , dmAppf = nullAppf
+    }
+    where
+        -- nullAppf :: ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn
+        nullAppf nam _ lbs = (nullVarBindingModify lbs) { vbmName = nam }
+
+{-
+-- |Apply datatype variable binding modifier value to list of labels and
+--  a variable binding.
+applyDatatypeMod :: (Eq lb, Show lb, Eq vn, Show vn)
+    => DatatypeMod vt lb vn -> OpenVarBindingModify lb vn
+applyDatatypeMod dtmod = dmAppf dtmod (dmName dtmod) (dmModf dtmod)
+-}
+
+{-
+dmName dtmod :: ScopedName
+dmModf dtmod :: [ModifierFn vt]
+             :: [[vt] -> [vt]]
+dmAppf dtmod :: ApplyModifier lb vn
+             :: ScopedName -> [ModifierFn vn] -> OpenVarBindingModify lb vn
+             :: ScopedName -> [[vn] -> [vn]] -> OpenVarBindingModify lb vn
+dmAppf dtmod (dmName dtmod)
+             :: [[vn] -> [vn]] -> OpenVarBindingModify lb vn
+-}
+
+--------------------------------------------------------------
+--  Functions for creating datatype variable binding modifiers
+--------------------------------------------------------------
+
+-- |ApplyModifier function for use with DatatypeMod in cases
+--  when the value mapping is a 1->1 function and inverse, such
+--  as negate.
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (0) is [x,y] -> [?], used as a filter (i.e. not creating any
+--              new variable bindings), returning a non-empty list if x and y
+--              are in the appropriate relationship.
+--          (1) is [y] -> [x], used to perform the calculation in a forward
+--              direction.
+--          (2) is [x] -> [y], used to perform the calculation in a backward
+--              direction.  This may be the same as (2) (e.g. for negation)
+--              or may be different (e.g. increment).
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.  (The intent is that a variable-free
+--          value can be generated as a Curried function, and instantiated
+--          for particular variables as required.)
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+--  type ApplyModifer lb vn = [ModifierFn vn] -> [lb] -> VarBindingModify lb vn
+--
+makeVmod_1_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_1_1_inv nam [f0,f1,f2] lbs@(~[lb1,lb2]) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[],[lb1],[lb2]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 [(Just v1),(Just v2)] vbind = selv     (f0 [v1,v2]) vbind
+        app2 [(Nothing),(Just v2)] vbind = addv lb1 (f1 [v2])    vbind
+        app2 [(Just v1),(Nothing)] vbind = addv lb2 (f2 [v1])    vbind
+        app2 _                     _     = []
+makeVmod_1_1_inv _ _ _ =
+    error "makeVmod_1_1_inv: requires 3 functions and 2 labels"
+
+-- |ApplyModifier function for use with DatatypeMod in cases when
+--  the value mapping is a non-invertable 1->1 injection, such as
+--  absolute value.
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (0) is [x,y] -> [?], used as a filter (i.e. not creating any
+--              new variable bindings), returning a non-empty list if x and y
+--              are in the appropriate relationship.
+--          (1) is [x] -> [y], used to perform the calculation.
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+makeVmod_1_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_1_1 nam [f0,f1] lbs@(~[lb1,_]) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[],[lb1]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 [(Just v1),(Just v2)] vbind = selv (f0 [v1,v2])  vbind
+        app2 [(Nothing),(Just v2)] vbind = addv lb1 (f1 [v2]) vbind
+        app2 _                     _     = []
+makeVmod_1_1 _ _ _ =
+    error "makeVmod_1_1: requires 2 functions and 2 labels"
+
+-- |ApplyModifier function for use with DatatypeMod in cases
+--  when the value mapping is a 2->1 invertable function, such as
+--  addition or subtraction.
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (1) is [x,y,z] -> [?], used as a filter (i.e. not creating any
+--              new variable bindings), returning a non-empty list if
+--              x, y and z are in the appropriate relationship.
+--          (2) is [y,z] -> [x], used to perform the calculation in a
+--              forward direction.
+--          (3) is [x,z] -> [y], used to run the calculation backwards to
+--              determine the first input argument
+--          (4) is [x,y] -> [z], used to run the calculation backwards to
+--              determine the second input argument
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+makeVmod_2_1_inv :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_2_1_inv nam [f0,f1,f2,f3] lbs@(~[lb1,lb2,lb3]) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[],[lb1],[lb2],[lb3]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 [(Just v1),(Just v2),(Just v3)] vbind = selv (f0 [v1,v2,v3]) vbind
+        app2 [(Nothing),(Just v2),(Just v3)] vbind = addv lb1 (f1 [v2,v3]) vbind
+        app2 [(Just v1),(Nothing),(Just v3)] vbind = addv lb2 (f2 [v1,v3]) vbind
+        app2 [(Just v1),(Just v2),(Nothing)] vbind = addv lb3 (f3 [v1,v2]) vbind
+        app2 _                               _     = []
+makeVmod_2_1_inv _ _ _ =
+    error "makeVmod_2_1_inv: requires 4 functions and 3 labels"
+
+-- |ApplyModifier function for use with DatatypeMod in cases
+--  when the value mapping is a 2->1 non-invertable function, such as
+--  logical AND or OR.
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (1) is [x,y,z] -> [?], used as a filter (i.e. not creating any
+--              new variable bindings), returning a non-empty list if
+--              x, y and z are in the appropriate relationship.
+--          (2) is [y,z] -> [x], used to perform the calculation in a
+--              forward direction.
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+makeVmod_2_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_2_1 nam [f0,f1] lbs@(~[lb1,_,_]) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[],[lb1]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 [(Just v1),(Just v2),(Just v3)] vbind = selv (f0 [v1,v2,v3]) vbind
+        app2 [(Nothing),(Just v2),(Just v3)] vbind = addv lb1 (f1 [v2,v3]) vbind
+        app2 _                               _     = []
+makeVmod_2_1 _ _ _ =
+    error "makeVmod_2_1: requires 2 functions and 3 labels"
+
+-- |ApplyModifier function for use with DatatypeMod in cases
+--  when the value mapping is a simple comparson of two values.
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (1) is [x,y] -> [?], used as a filter (i.e. not creating any
+--              new variable bindings), returning a non-empty list if
+--              x and y are in the appropriate relationship.
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+makeVmod_2_0 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_2_0 nam [f0] lbs@(~[_,_]) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 [(Just v1),(Just v2)] vbind = selv (f0 [v1,v2]) vbind
+        app2 _                     _     = []
+makeVmod_2_0 _ _ _ =
+    error "makeVmod_2_0: requires 1 function and 2 labels"
+
+-- |ApplyModifier function for use with DatatypeMod in cases
+--  when the value mapping is a 2->2 non-invertable function, such as
+--  quotient/remainder
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (1) is [w,x,y,z] -> [?], used as a filter (i.e. not creating
+--              any new variable bindings), returning a non-empty list if
+--              w, x, y and z are in the appropriate relationship.
+--          (2) is [y,z] -> [w,x], used to perform the calculation given
+--              two input values.
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+--  [[[NOTE: this might be generalized to allow one of w or x to be
+--  specified, and return null if it doesn't match the calculated value.]]]
+--
+makeVmod_2_2 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_2_2 nam [f0,f1] lbs@(~[lb1,lb2,_,_]) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[],[lb1,lb2]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 [(Just v1),(Just v2),(Just v3),(Just v4)] vbind =
+            selv (f0 [v1,v2,v3,v4]) vbind
+        app2 [(Nothing),(Nothing),(Just v3),(Just v4)] vbind =
+            addv2 lb1 lb2 (f1 [v3,v4]) vbind
+        app2 _                               _     = []
+makeVmod_2_2 _ _ _ =
+    error "makeVmod_2_2: requires 2 functions and 4 labels"
+
+-- |ApplyModifier function for use with DatatypeMod in cases
+--  when the value mapping is a N->1 function,
+--  such as Sigma (sum) of a vector.
+--
+--  nam     ia the name from the DatatypeMod value that is carried into
+--          the resulting variable binding modifier.
+--  fns     are functions used to implement details of the variable
+--          binding modifier:
+--          (1) is [x,y...] -> [?], used as a filter (i.e. not creating
+--              any new variable bindings), returning a non-empty list if
+--              x and y... are in the appropriate relationship.
+--          (2) is [y...] -> [x], used to perform the calculation.
+--  lbs     is a list of specific label values for which a variable binding
+--          modifier will be generated.
+--
+--  Note: an irrefutable pattern match for 'lbs' is used so that a name
+--  for the VarBindingModify value can be extracted using an undefined
+--  label value.
+--
+makeVmod_N_1 :: (Eq lb, Show lb, Eq vn, Show vn) => ApplyModifier lb vn
+makeVmod_N_1 nam [f0,f1] lbs@(~(lb1:_)) = VarBindingModify
+    { vbmName   = nam
+    , vbmApply  = concatMap app1
+    , vbmVocab  = lbs
+    , vbmUsage  = [[],[lb1]]
+    }
+    where
+        app1 vbind = app2 (map (vbMap vbind) lbs) vbind
+        app2 vs@(v1:_) vbind
+            | isJust v1 && isJustvs = selv (f0 jvs) vbind
+            | isJustvs              = addv lb1 (f1 jvs) vbind
+            | otherwise             = []
+            where
+                isJustvs = all isJust vs
+                jvs      = catMaybes vs
+makeVmod_N_1 _ _ _ =
+    error "makeVmod_N_1: requires 2 functions and at 1 or more labels"
+
+--------------------------------------------------------
+--  Local helper functions for makeVmodXXX variants
+--------------------------------------------------------
+
+--  Add value to variable variable binding, if value is singleton list,
+--  otherwise return empty list.
+addv :: (Eq lb, Show lb, Eq vt, Show vt)
+    => lb -> [vt] -> VarBinding lb vt
+    -> [VarBinding lb vt]
+addv lb [val] vbind = [addVarBinding lb val vbind]
+addv _  _     _     = []
+
+--  Add two entries to variable variable binding, if value supplied is
+--  a doubleton list, otherwise return empty list.
+addv2 :: (Eq lb, Show lb, Eq vt, Show vt)
+    => lb -> lb -> [vt] -> VarBinding lb vt
+    -> [VarBinding lb vt]
+addv2 lb1 lb2 [val1,val2] vbind = [addVarBinding lb1 val1 $
+                                   addVarBinding lb2 val2 vbind]
+addv2 _   _   _           _     = []
+
+--  If supplied value is non-empty list return supplied variable binding,
+--  otherwise return empty list.
+selv :: [vt] -> varBinding lb vt -> [varBinding lb vt]
+selv [] _     = []
+selv _  vbind = [vbind]
+
+--------------------------------------------------------------
+--  Functions for evaluating arguments in a datatype relation
+--------------------------------------------------------------
+--
+--  altArgs is a generic function for evaluating datatype relation
+--          values, based on suppied functions and argument values
+--
+--  UnaryFnDescr, UnaryFnApply and unaryFnApp:
+--          are support types and function for using altArgs to
+--          evaluate relations on unary functions (binary relations).
+--
+--  BinaryFnDescr, BinaryFnApply and binaryFnApp:
+--          are support types and function for using altArgs to
+--          evaluate relations on binary functions (3-way relations).
+--
+--  ListFnDescr, ListFnApply and listFnApp:
+--          are support types and function for using altArgs to
+--          evaluate relations on list functions (n-way relations),
+--          where the first member of the list is the value of a
+--          fold of a function over the rest of the list.
+--
+--  See experimental module spike-altargs.hs for test cases and
+--  development steps for this function.
+
+-- |Given a list of argument values and a list of functions for
+--  calculating new values from supplied values, return a list
+--  of argument values, or Nothing if the supplied values are
+--  inconsistent with the calculations specified.
+--
+--  Each list of values returned corresponds to a set of values that
+--  satisfy the relation, consistent with the values supplied.
+--
+--  Functions are described as tuple consisting of
+--  (a) a predicate that the argument is required to satisfy
+--  (b) a function to apply,
+--  (c) a function to apply function (b) to a list of arguments
+--  (d) argument list index values to which the function is applied.
+--
+--  Each supplied argument is of the form 'Maybe a', where the argument
+--  has value type a.  'Nothing' indicates arguments of unknown value.
+--
+--  The basic idea is that, for each argument position in the relation,
+--  a function may be supplied to calculate that argument's possible values
+--  from some combination of the other arguments.  The results calculated
+--  in this way are compared with the original arguments provided:
+--  if the values conflict then the relation is presumed to be
+--  unsatisfiable with the supplied values, and 'Nothing' is returned;
+--  if there are any calculated values for arguments supplied without
+--  any values, then tbe calculated values are used.
+--  If there are any arguments for which no values are supplied or
+--  calculated, then the relation is presumed to be underdetermined,
+--  and 'Just []' is returned.
+--
+--  fnss    is a list of argument value predicates and
+--          function descriptors.  The predicate indicates any
+--          additional constraints on argument values (e.g. the result
+--          of abs must be positive).  Use (const True) for the predicate
+--          associated with unconstrained relation arguments.
+--          For each argument, a list of function descriptors is
+--          supplied corresponding to alternative values (e.g. a square
+--          relation would offer two alternative values for the root.)
+--  apfn    is a function that takes an argument value predicate,
+--          a function descriptor and applies it to a supplied argument
+--          list to return:
+--          Just a calculated list of one or more possible argument values,
+--          Just [] indicating insufficient information provided, or
+--          Nothing indicating inconsistent information provided.
+--          May be one of unaryFnApp, binaryFnApp, listFnApp or
+--          some other caller-supplied value.
+--          The value used must match the type of 'fnss' used.
+--
+--  Returns a 'DatatypeRelFn vt' value that can be used as the
+--  'dtRelFunc' component of a DatatypeRel value.
+--  cf. type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]
+--
+-- type DatatypeRelFn vt = [Maybe vt] -> Maybe [[vt]]
+-- type DatatypeRelPr vt = [vt] -> Bool
+--
+altArgs :: (Eq vt)
+    => DatatypeRelPr vt -> [(vt->Bool,[b])]
+    -> ((vt->Bool)->b->[Maybe vt]->Maybe [vt])
+    -> DatatypeRelFn vt
+altArgs pr fnss apfn args = cvals4 cvals3
+    where
+        --  Calculate new value(s) for each argument from supplied values, and
+        --  lift inconsistency indicator (Just/Nothing) to outermost Monad.
+        --    cvals1 :: [Maybe [vt]]
+        cvals1 = flist (map (applyFdescToTuple apfn) fnss) args
+        --  Merge calculated values with supplied arguments, and again
+        --  lift inconsistency indicator (Just/Nothing) to outermost Monad.
+        --    cvals2 :: Maybe [[vt]]
+        cvals2 = sequence $ mergeTupleVals (map fst fnss) args cvals1
+        --  Map list of alternative values for each tuple member to
+        --  a list of alternative tuples.
+        cvals3 = liftM sequence cvals2
+        --  Check each tuple against the supplied predicate.
+        --  If any of the alternative tuples does not match the predicate
+        --  then signal an inconsistency.
+        cvals4 Nothing       = Nothing
+        cvals4 cvs@(Just ts) = if all pr ts then cvs else Nothing
+
+--  Perform alternative calculations for single result value
+--  Each result value is a list of zero or more alternatives
+--  that can be calculated from available parameters, or
+--  Nothing if the available parameters are inconsistent.
+--
+--  apfn    is the function that actually applies an element of
+--          the function descriptor to a tuple of Maybe arguments
+--          (where Nothing is used to indicate an unknown value)
+--  (p,fns) is a pair consisting of a value-checking predicate
+--          for the corresponding tuple member, and a list of
+--          function descriptors that each return one or more
+--          values the tuple member, calculated from other values
+--          that are present.  Just [] means no values are
+--          calculated for this member, and Nothing means the
+--          calculation has detected tuple values supplied that
+--          are inconsistent with the datatype relation concerned.
+--  args    is a tuple of Maybe tuple elements, (where Nothing
+--          indicates an unknown value).
+--
+--  Returns Maybe a list of alternative values for the member,
+--  Just [] to indicate insufficient information to calculate
+--  any new values, and Nothing to indicate an inconsistency.
+--
+applyFdescToTuple ::
+    ((vt->Bool)->b->[Maybe vt]->Maybe [vt]) -> (vt->Bool,[b]) -> [Maybe vt]
+    -> Maybe [vt]
+applyFdescToTuple apfn (p,fns) args =
+    liftM concat $ sequence cvals
+    where
+        -- cvals :: [Maybe [vt]]
+        cvals = flist (map (apfn p) fns) args
+
+--  Merge calculated tuple values with supplied tuple, checking for consistency.
+--
+--  ps      predicates used for isolated validation of each tuple member
+--  args    supplied tuple values, with Nothing for unknown values
+--  cvals   list of alternative calculated values for each tuple member,
+--          or Nothing if an inconsistency has been detected by the
+--          tuple-calculation functions.  Note that this list may contain
+--          more entries than args; the surplus entries are ignored
+--          (see list functions for how this is used).
+--
+--  Returns a tuple of Maybe lists of values for each tuple member,
+--  containing Nothing if an inconsistency has been detected in the
+--  supplied values.
+--
+mergeTupleVals  :: (Eq a) => [a->Bool] -> [Maybe a] -> [Maybe [a]] -> [Maybe [a]]
+mergeTupleVals _ _  (Nothing:_) = [Nothing]
+mergeTupleVals (_:ps) (Nothing:a1s) (Just a2s:a2ss)
+                             = Just a2s:mergeTupleVals ps a1s a2ss
+mergeTupleVals (p:ps) (Just a1:a1s) (Just []:a2ss)
+    | p a1                   = Just [a1]:mergeTupleVals ps a1s a2ss
+    | otherwise              = [Nothing]
+mergeTupleVals (p:ps) (Just a1:a1s) (Just a2s:a2ss)
+    | p a1 && elem a1 a2s    = Just [a1]:mergeTupleVals ps a1s a2ss
+    | otherwise              = [Nothing]
+mergeTupleVals _ [] _        = []
+mergeTupleVals _ _  _        = [Nothing]
+
+-- |altArgs support for unary functions: function descriptor type
+type UnaryFnDescr a = (a->a,Int)
+
+-- |altArgs support for unary functions: function descriptor table type
+type UnaryFnTable a = [(a->Bool,[UnaryFnDescr a])]
+
+-- |altArgs support for unary functions: function applicator type
+type UnaryFnApply a = (a->Bool) -> UnaryFnDescr a -> [Maybe a] -> Maybe [a]
+
+-- |altArgs support for unary functions: function applicator
+unaryFnApp :: UnaryFnApply a
+unaryFnApp p (f1,n) args = apf p f1 (args!!n)
+    where
+        apf p f1 (Just a) = if p r then Just [r] else Nothing where r = f1 a
+        apf _ _ Nothing   = Just []
+
+-- |altArgs support for binary functions: function descriptor type
+type BinaryFnDescr a = (a->a->a,Int,Int)
+
+-- |altArgs support for binary functions: function descriptor table type
+type BinaryFnTable a = [(a->Bool,[BinaryFnDescr a])]
+
+-- |altArgs support for binary functions: function applicator type
+type BinaryFnApply a =
+    (a->Bool) -> BinaryFnDescr a -> [Maybe a] -> Maybe [a]
+
+-- |altArgs support for binary functions: function applicator
+binaryFnApp :: BinaryFnApply a
+binaryFnApp p (f,n1,n2) args = apf p f (args!!n1) (args!!n2)
+    where
+        apf p f (Just a1) (Just a2) = if p r then Just [r] else Nothing
+            where r = f a1 a2
+        apf _ _ _ _  = Just []
+
+-- |altArgs support for binary function with provision for indicating
+--  inconsistent supplied values:  function descriptor type
+type BinMaybeFnDescr a = (a->a->Maybe [a],Int,Int)
+
+-- |altArgs support for binary function with provision for indicating
+--  inconsistent supplied values:  function descriptor table type
+type BinMaybeFnTable a = [(a->Bool,[BinMaybeFnDescr a])]
+
+-- |altArgs support for binary function with provision for indicating
+--  inconsistent supplied values:  function applicator type
+type BinMaybeFnApply a =
+    (a->Bool) -> BinMaybeFnDescr a -> [Maybe a] -> Maybe [a]
+
+-- |altArgs support for binary function with provision for indicating
+--  inconsistent supplied values:  function applicator
+binMaybeFnApp :: BinMaybeFnApply a
+binMaybeFnApp p (f,n1,n2) args = apf p f (args!!n1) (args!!n2)
+    where
+        apf p f (Just a1) (Just a2) = if pm r then r else Nothing
+            where
+                r = f a1 a2
+                pm Nothing  = False
+                pm (Just r) = all p r
+        apf _ _ _ _  = Just []
+
+-- |altArgs support for list functions (e.g. sum over list of args),
+--  where first element of list is a fold over the rest of the list,
+--  and remaining elements of list can be calculated in terms
+--  of the result of the fold and the remaining elements
+--
+--  List function descriptor is
+--  (a) list-fold function, f  (e.g. (+)
+--  (b) list-fold identity, z  (e.g. 0)
+--  (c) list-fold-function inverse, g (e.g. (-))
+--  (d) index of element to evaluate
+--  such that:
+--      (a `f` z) == (z `f` a) == a
+--      (a `g` c) == b <=> a == b `f` c
+--      (a `g` z) == a
+--      (a `g` a) == z
+--  and the result of the folded function does not depend on
+--  the order that the list elements are processed.
+--
+--  NOTE:  the list of 'ListFnDescr' values supplied to altArgs must
+--  be at least as long as the argument list.  In many cases, Haskell
+--  lazy evaluation can be used to supply an arbitrarily long list.
+--  See test cases in spike-altargs.hs for an example.
+--
+--  Function descriptor type
+type ListFnDescr a = (a->a->a,a,a->a->a,Int)
+
+-- |Function table type
+type ListFnTable a = [(a->Bool,[ListFnDescr a])]
+
+-- |altArgs support for list functions:  function applicator type
+type ListFnApply a = (a->Bool) -> ListFnDescr a -> [Maybe a] -> Maybe [a]
+
+-- |altArgs support for list functions:  function applicator
+listFnApp :: ListFnApply a
+listFnApp p (f,z,g,n) (a0:args)
+    | n == 0    =
+        app p $ foldr (apf f) (Just [z]) args
+    | otherwise =
+        app p $ apf g a0 (foldr (apf f) (Just [z]) (args `deleteIndex` (n-1)))
+    where
+        apf :: (a->a->a) -> Maybe a -> Maybe [a] -> Maybe [a]
+        apf f (Just a1) (Just [a2]) = Just [f a1 a2]
+        apf _ _         _           = Just []
+        app :: (a->Bool) -> Maybe [a] -> Maybe [a]
+        app p Nothing      = Nothing
+        app p r@(Just [a]) = if p a then r else Nothing
+        app _ _            = Just []
+
+--------------------------------------------------------
+--  Datatype sub/supertype description
+--------------------------------------------------------
+
+-- |Describe a subtype/supertype relationship between a pair of datatypes.
+--
+--  Originally, I had this as a supertype field of the DatatypeVal structure,
+--  but that suffered from some problems:
+--  (a) supertypes may be introduced retrospectively,
+--  (b) the relationship expressed with respect to a single datatype
+--      cannot indicate hiow to do injections/restrictions between the
+--      underlying value types.
+--
+--  ex      is the type of expression with which the datatype may be used.
+--  lb      is the type of the variable labels used.
+--  vn      is the type of value node used to contain a datatyped value
+--  supvt   is the internal value type of the super-datatype
+--  subvt   is the internal value type of the sub-datatype
+--
+data DatatypeSub ex lb vn supvt subvt = DatatypeSub
+    { trelSup   :: DatatypeVal ex supvt lb vn
+                                -- ^ Datatype that is a supertype of trelSub,
+                                --   having value space supvt.
+    , trelSub   :: DatatypeVal ex subvt lb vn
+                                -- ^ Datatype that is a subtype of trelSup,
+                                --   having value space supvt.
+    , trelToSup :: subvt -> supvt
+                                -- ^ Function that maps subtype value to
+                                --   corresponding supertype value.
+    , trelToSub :: supvt -> Maybe subvt
+                                -- ^ Function that maps supertype value to
+                                --   corresponding subtype value, if there
+                                --   is such a value.
+    }
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/Datatype.hs,v $
+-- $Author: graham $
+-- $Revision: 1.21 $
+-- $Log: Datatype.hs,v $
+-- Revision 1.21  2003/12/18 18:27:46  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.20  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.19  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.18  2003/12/08 17:29:19  graham
+-- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
+--
+-- Revision 1.17  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.16  2003/11/28 00:17:55  graham
+-- Datatype constraint test cases all passed.
+--
+-- Revision 1.15  2003/11/27 11:35:49  graham
+-- Variable modifier tests all run.
+-- Initial class constraint reasoning tests pass.
+-- Fixed bug in class constraint backward-chained reasoning that returned
+-- multiple instances of some statements, and did not filter out all occurrences
+-- of the original statements.
+--
+-- Revision 1.14  2003/11/25 23:02:17  graham
+-- Reworked datatype variable modifier logic.
+-- Limited range of test cases so far all pass.
+--
+-- Revision 1.13  2003/11/24 22:13:09  graham
+-- Working on reworking datatype variable modifiers to work with
+-- revised datatype framework.
+--
+-- Revision 1.12  2003/11/17 21:53:31  graham
+-- Datatype inference forward chaining updated to allow inconsistent
+-- partial inputs to be detected.  All forward chaining test cases passed.
+-- Need to develop backward chaining test cases.
+--
+-- Revision 1.11  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.10  2003/11/11 21:02:55  graham
+-- Working on datatype class-constraint inference rule.  Incomplete.
+--
+-- Revision 1.9  2003/11/07 21:45:47  graham
+-- Started rework of datatype to use new DatatypeRel structure.
+--
+-- Revision 1.8  2003/11/06 17:58:33  graham
+-- About to rework Datatype to better support class-based reasoning.
+--
+-- Revision 1.7  2003/10/24 21:05:08  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.6  2003/10/22 15:47:46  graham
+-- Working on datatype inference support.
+--
+-- Revision 1.5  2003/10/09 13:58:59  graham
+-- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
+-- of using just QueryBindingModifier.
+--
+-- Revision 1.4  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.3  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.2  2003/09/22 23:25:01  graham
+-- Add some tweaks to the datatyping framework
+--
+-- Revision 1.1  2003/07/03 20:31:07  graham
+-- Add initial draft of datatype framework.
+--

+ Swish/HaskellRDF/Dfa/Dfa.lhs view
@@ -0,0 +1,614 @@+> {-# OPTIONS -fglasgow-exts #-}+> {-# LANGUAGE UndecidableInstances #-}++> module Swish.HaskellRDF.Dfa.Dfa (+>     Re(..),+>     matchRe,+>     matchRe2+> ) where++> import Control.Monad.Identity+> import Control.Monad.Reader+> import Control.Monad.State+> import qualified Data.List as L+> import qualified Data.Map as M+> import qualified Data.Array as A+> import Data.Maybe++import IOExts+++The type of a regular expression.++> data Re t+>   = ReOr [Re t]+>   | ReCat [Re t]+>   | ReStar (Re t)+>   | RePlus (Re t)+>   | ReOpt (Re t)+>   | ReTerm [t]+>       deriving (Show)+++The internal type of a regular expression.++> type SimplRe t = Int+> data SimplRe' t+>   = SReOr (SimplRe t) (SimplRe t)+>   | SReCat (SimplRe t) (SimplRe t)+>   | SReStar (SimplRe t)+>   | SReLambda+>   | SReNullSet+>   | SReTerm t+>       deriving (Eq, Ord, Show)+++The regular expression builder monad.++> data (Ord t) => ReRead t+>  = ReRead {+>       rerNullSet      :: SimplRe t,+>       rerLambda       :: SimplRe t+>  }++> data (Ord t) => ReState t+>   = ReState {+>       resFwdMap       :: M.Map (SimplRe t) (ReInfo t),+>       resBwdMap       :: M.Map (SimplRe' t) (SimplRe t),+>       resNext         :: Int,+>       resQueue        :: ([SimplRe t], [SimplRe t]),+>       resStatesDone   :: [SimplRe t]+>     }++> type ReM m t a = StateT (ReState t) (ReaderT (ReRead t) m) a++++Running the monad is tricky because the reader transformer (which+is the _inner_ transformer) requires information gained from+initialising the mutable state.  We could do some trickiness with+lazy evaluation, but it would be hard to get right.++What we do instead is run a "bootstrap" monad which does the+initialisation then returns the state.  Then we construct a new+monad using that initial state.  Simple but effective.  The only+thing to be careful about is to make sure that the bootstrap code+does not depend on the reader state.  As it happens, we only call+remInsert which only touches mutable state.+++> remRun :: (ReVars m t) => ReM m t a -> m a+> remRun m+>  = do (inits, initr) <- runReaderT (evalStateT bootstrap initState) initRead+>       runReaderT (evalStateT m inits) initr+>  where+>       initState+>         = ReState {+>               resFwdMap = M.empty,+>               resBwdMap = M.empty,+>               resNext = 0,+>               resQueue = ([],[]),+>               resStatesDone = []+>         }+>       initRead+>         = ReRead { rerNullSet = undefined, rerLambda = undefined }+>       bootstrap+>          = do+>               nulli <- remInsert (reiMake SReNullSet False)+>               lami  <- remInsert (reiMake SReLambda  True)+>               s <- get+>               r <- ask+>               return (s, r { rerNullSet = nulli, rerLambda = lami })+++++Utility typeclasses for enforcing all the constraints we need+on our monad's free type variables.  Note that this requires both+-fglasgow-exts and -fallow-undecidable-instances in GHC to work+properly.++> class (Monad m, Ord t) => ReVars m t where { }+> instance (Monad m, Ord t) => ReVars m t where { }+++Operations on the monad.++> remNullSet :: (ReVars m t) => ReM m t (SimplRe t)+> remNullSet = asks rerNullSet++> remLambda :: (ReVars m t) => ReM m t (SimplRe t)+> remLambda = asks rerLambda++> remStateDone :: (ReVars m t) => SimplRe t -> ReM m t ()+> remStateDone re+>   = do s <- get+>        put (s { resStatesDone = re:resStatesDone s })++> remPush :: (ReVars m t) => [SimplRe t] -> ReM m t ()+> remPush res+>   = do s <- get+>        let (qf,qb) = resQueue s+>        put (s { resQueue = (qf, res ++ qb) })++> remPop :: (ReVars m t) => ReM m t (Maybe (SimplRe t))+> remPop+>   = get >>= \s ->+>       let (qf,qb) = resQueue s+>       in+>           case qf of+>               (re:res) -> put (s { resQueue = (res,qb) }) >> return (Just re)+>               []       -> if null qb then return Nothing+>                           else put (s { resQueue = (reverse qb,[]) })+>                                       >> remPop++++> remInsert :: (ReVars m t) => ReInfo t -> ReM m t (SimplRe t)+> remInsert reinfo+>   = do s <- get+>        let fwd = resFwdMap s+>            bwd = resBwdMap s+>            newre = resNext s+>        put (s { resFwdMap = M.insert newre reinfo fwd,         -- PROBLEM+>                resBwdMap = M.insert (reiSRE reinfo) newre bwd,+>                resNext = newre + 1 })+>        return newre+++> remLookupFwd :: (ReVars m t) => SimplRe t -> ReM m t (ReInfo t)+> remLookupFwd re+>   = do fwd <- gets resFwdMap+>        let { Just reinfo = M.lookup re fwd }                    -- PROBLEM+>        return reinfo+++> remLookupBwd :: (ReVars m t) => SimplRe' t+>       -> ReM m t (Maybe (SimplRe t))+> remLookupBwd re+>   = do bwd <- gets resBwdMap+>        return (M.lookup re bwd)                                -- PROBLEM+++remAdd implements hash consing.  Given a SimplRe' in as close+to "canonical" form as possible, this tries to find a SimplRe+that matches (if possible), and otherwise constructs a new one.++> remAdd :: (ReVars m t) => SimplRe' t -> ReM m t (SimplRe t)+> remAdd sre+>   = remLookupBwd sre >>= \ maybere ->+>       case maybere of+>           Just re -> return re+>           Nothing -> doInsert+>   where+>       doInsert+>         = remNullable sre >>= \nullable ->+>               remInsert (reiMake sre nullable)+++> remSetDfaState :: (ReVars m t) => SimplRe t -> ReDfaState t ->+>                       ReM m t (ReDfaState t)+> remSetDfaState re dfa+>   = do s <- get+>        let    Just reinfo = M.lookup re (resFwdMap s)              -- PROBLEM+>               reinfo' = reinfo { reiDfa = Just dfa }+>        put (s { resFwdMap = M.insert  re reinfo' (resFwdMap s) })    -- PROBLEM+>        return dfa+++The ReInfo type++> data ReInfo t+>   = ReInfo {+>       reiSRE          :: SimplRe' t,+>       reiNullable     :: Bool,+>       reiDfa          :: Maybe (ReDfaState t)+>     }+>       deriving (Show)++> reiMake :: SimplRe' t -> Bool -> ReInfo t+> reiMake re nullable+>   = ReInfo { reiSRE = re, reiNullable = nullable, reiDfa = Nothing }+++Regular expression builder.++> remNullable :: (ReVars m t) => SimplRe' t -> ReM m t Bool+> remNullable (SReOr e1 e2)+>   = do ei1 <- remLookupFwd e1+>        ei2 <- remLookupFwd e2+>        return $ reiNullable ei1 || reiNullable ei2+> remNullable (SReCat e1 e2)+>   = do ei1 <- remLookupFwd e1+>        ei2 <- remLookupFwd e2+>        return $ reiNullable ei1 && reiNullable ei2+> remNullable (SReStar _)+>   = return True+> remNullable SReLambda+>   = return True+> remNullable SReNullSet+>   = return False+> remNullable (SReTerm _)+>   = return False++++> remBuildOne :: (ReVars m t) => SimplRe' t ->+>               ReM m t (SimplRe t)++> remBuildOne re@(SReOr e1 e2)+>   | e1 == e2   = return e1+>   | e1 > e2    = remBuildOne (SReOr e2 e1)+>   | otherwise+>       = do ei1 <- remLookupFwd e1+>            ei2 <- remLookupFwd e2+>            remBuildOr e1 e2 (reiSRE ei1) (reiSRE ei2)+>       where+>           remBuildOr _  e3 (SReOr e1 e2) _+>             = remBuildOne (SReOr e2 e3) >>= \ e2' ->+>               remBuildOne (SReOr e1 e2')+>           remBuildOr _  e2 SReNullSet _ = return e2+>           remBuildOr e1 _  _ SReNullSet = return e1+>           remBuildOr _  _  _ _ = remAdd re++> remBuildOne re@(SReCat e1 e2)+>   = do ei1 <- remLookupFwd e1+>        ei2 <- remLookupFwd e2+>        remBuildCat e1 e2 (reiSRE ei1) (reiSRE ei2)+>   where+>       remBuildCat _  e3 (SReCat e1 e2) _+>         = remBuildOne (SReCat e2 e3) >>= \ e2' ->+>           remBuildOne (SReCat e1 e2')+>       remBuildCat e1 _  SReNullSet _ = return e1+>       remBuildCat _  e2 SReLambda  _ = return e2+>       remBuildCat _  e2 _ SReNullSet = return e2+>       remBuildCat e1 _  _ SReLambda  = return e1+>       remBuildCat _  _  _ _ = remAdd re++> remBuildOne re@(SReStar e)+>   = do ei <- remLookupFwd e+>        remBuildStar e (reiSRE ei)+>   where+>       remBuildStar e (SReStar _) = return e+>       remBuildStar e SReLambda   = return e+>       remBuildStar e SReNullSet  = remLambda+>       remBuildStar _ _           = remAdd re++> remBuildOne re@SReLambda = remLambda++> remBuildOne re@SReNullSet = remNullSet++> remBuildOne re@(SReTerm t) = remAdd re++++> remBuild :: (ReVars m t) => Re t -> ReM m t (SimplRe t)+> remBuild (ReOr [])+>   = remNullSet+> remBuild (ReOr [e])+>   = remBuild e+> remBuild (ReOr (e:es))+>   = do es' <- remBuild (ReOr es)+>        e'  <- remBuild e+>        remBuildOne (SReOr e' es')+> remBuild (ReCat [])+>   = remLambda+> remBuild (ReCat [e])+>   = remBuild e+> remBuild (ReCat (e:es))+>   = do es' <- remBuild (ReCat es)+>        e'  <- remBuild e+>        remBuildOne (SReCat e' es')+> remBuild (ReOpt e)+>   = do e2 <- remBuild e+>        e1 <- remLambda+>        remBuildOne (SReOr e1 e2)+> remBuild (ReStar e)+>   = do e' <- remBuild e+>        remBuildOne (SReStar e')+> remBuild (RePlus e)+>   = do e1 <- remBuild e+>        e2 <- remBuildOne (SReStar e1)+>        remBuildOne (SReCat e1 e2)+> remBuild (ReTerm [])+>   = remLambda+> remBuild (ReTerm [t])+>   = remBuildOne (SReTerm t)+> remBuild (ReTerm (t:ts))+>   = do ts' <- remBuild (ReTerm ts)+>        t'  <- remBuildOne (SReTerm t)+>        remBuildOne (SReCat t' ts')+++Dfa construction++> data ReDfaState t+>   = ReDfaState {+>         dfaFinal :: Bool,+>       dfaTrans :: [(t, SimplRe t)]+>   }+>       deriving (Show)++> remMakeDfa :: (ReVars m t) => SimplRe t -> ReM m t ()+> remMakeDfa start+>   = do lams  <- remLambda+>        nulls <- remNullSet+>        remPush [lams, nulls, start]+>        remMakeDfa'+>   where+>     remMakeDfa'+>       = remPop >>= \ maybere ->+>           case maybere of+>               Just re -> processState re >> remStateDone re >> remMakeDfa'+>               Nothing -> return ()++>     processState re+>       = remLookupFwd re >>= \ info ->+>           case reiDfa info of+>               Just dfa -> return dfa+>               Nothing  -> expandState re info (reiSRE info)++>     expandState re info (SReCat e1 e2)+>       = do    dfa1 <- processState e1+>               trans1 <- makeCatTrans (dfaTrans dfa1) e2+>               trans <- if dfaFinal dfa1+>                        then processState e2 >>= \dfa2 ->+>                               makeOrTrans trans1 (dfaTrans dfa2)+>                        else return trans1+>               remPush (map snd trans)+>               remSetDfaState re+>                       (ReDfaState {+>                               dfaFinal = reiNullable info,+>                               dfaTrans = trans+>                       })+>     expandState re info (SReOr e1 e2)+>       = do    dfa1 <- processState e1+>               dfa2 <- processState e2+>               trans <- makeOrTrans (dfaTrans dfa1) (dfaTrans dfa2)+>               remPush (map snd trans)+>               remSetDfaState re+>                       (ReDfaState {+>                               dfaFinal = reiNullable info,+>                               dfaTrans = trans+>                       })+>     expandState re info (SReStar e)+>       = do    dfa <- processState e+>               let trans' = dfaTrans dfa+>               trans <- makeCatTrans trans' re+>               remPush (map snd trans)+>               remSetDfaState re+>                       (ReDfaState {+>                               dfaFinal = True,+>                               dfaTrans = trans+>                       })+>     expandState re info (SReTerm t)+>       = do    e2' <- remLambda+>               remPush [e2']+>               remSetDfaState re+>                       (ReDfaState {+>                               dfaFinal = False,+>                               dfaTrans = [(t,e2')]+>                       })+>     expandState re info SReLambda+>       = remSetDfaState re (ReDfaState { dfaFinal = True, dfaTrans = [] })+>     expandState re info SReNullSet+>       = remSetDfaState re (ReDfaState { dfaFinal = False, dfaTrans = [] })++> makeOrTrans :: (ReVars m t) => [(t, SimplRe t)]+>                       -> [(t, SimplRe t)] -> ReM m t [(t, SimplRe t)]+> makeOrTrans [] ts2+>     = return ts2+> makeOrTrans ts1 []+>     = return ts1+> makeOrTrans ts1'@(tr1@(t1,s1):ts1) ts2'@(tr2@(t2,s2):ts2)+>     | t1 < t2   = makeOrTrans ts1 ts2' >>= \ts -> return (tr1:ts)+>     | t1 > t2   = makeOrTrans ts1' ts2 >>= \ts -> return (tr2:ts)+>     | otherwise = remBuildOne (SReOr s1 s2) >>= \t ->+>                       makeOrTrans ts1 ts2 >>= \ts ->+>                           return ((t1,t):ts)++> makeCatTrans :: (ReVars m t) => [(t, SimplRe t)]+>                       -> SimplRe t -> ReM m t [(t, SimplRe t)]+> makeCatTrans [] _+>     = return []+> makeCatTrans ((t,s):ts) next+>     = do+>        s'  <- remBuildOne (SReCat s next)+>        ts' <- makeCatTrans ts next+>        return ((t,s'):ts')+++Recursive Dfa++> data RDfa t+>   = RDfa Bool [(t, RDfa t)]++> matchRecursiveDfa :: (Ord t) => RDfa t -> [t] -> Bool+> matchRecursiveDfa (RDfa final trans) []+>   = final+> matchRecursiveDfa (RDfa final trans) (x:xs)+>   = case [ s | (t, s) <- trans, t == x ] of+>       []    -> False+>       (s:_) -> matchRecursiveDfa s xs++> remMakeRecursiveDfa :: (ReVars m t) => SimplRe t -> ReM m t (RDfa t)+> remMakeRecursiveDfa start+>   = do max1 <- gets resNext+>        fwd <- gets resFwdMap+>        let max = max1 - 1+>            stateArray = A.array (0,max)+>               [ (i, makeState stateArray fwd i) | i <- [0..max] ]+>        return (stateArray A.! start)                              -- PROBLEM+>   where+>       makeState :: (Ord t) => A.Array (SimplRe t) (RDfa t) ->+>                       M.Map (SimplRe t) (ReInfo t) ->+>                       SimplRe t -> RDfa t+>       makeState stateArray fwd s+>         = RDfa (dfaFinal dfastate) [ (t, stateArray A.! ts)        -- PROBLEM+>               | (t, ts) <- dfaTrans dfastate ]+>         where+>               Just reinfo = M.lookup s fwd                          -- PROBLEM+>               Just dfastate = reiDfa reinfo+++Code generation.  This is very, very ugly.++> data BinTree a = BTZ | BTB (BinTree a) a (BinTree a) deriving (Show)++> listToBinTree :: [a] -> BinTree a+> listToBinTree l+>  = listToBinTree' (length l) l+>  where+>       listToBinTree' _ [] = BTZ+>       listToBinTree' n ls+>         = BTB (listToBinTree' n2 (take n2 ls)) t (listToBinTree' (n-n2-1) ts)+>         where+>               n2 = n `div` 2+>               t:ts = drop n2 ls++> remCodeGen :: (ReVars m t) => SimplRe t -> ReM m t ([t] -> Bool)+> remCodeGen start+>  = do max1 <- gets resNext+>       fwd <- gets resFwdMap+>       let max = max1 - 1+>           stateArray = A.array (0,max)+>               [ (i, makeState stateArray fwd i) | i <- [0..max] ]+>       return $ (stateArray A.! start)                              -- PROBLEM+>  where+>       globalFail = False+>       globalSucc = True+>+>       makeState :: (Ord t) => A.Array (SimplRe t) ([t] -> Bool) ->+>                       M.Map (SimplRe t) (ReInfo t) ->+>                       SimplRe t -> ([t] -> Bool)+>       makeState stateArray fwd s+>         | dfaFinal dfastate+>               = \ts -> -- trace ("In state " ++ show s) $+>                       case ts of+>                           []     -> globalSucc+>                           (t:ts) -> transition t ts+>         | otherwise+>               = \ts -> -- trace ("In state " ++ show s) $+>                       case ts of+>                           []     -> globalFail+>                           (t:ts) -> transition t ts+>         where+>               Just reinfo = M.lookup s fwd                         -- PROBLEM+>               Just dfastate = reiDfa reinfo+>+>               transition t ts+>                 = transition' (listToBinTree (dfaTrans dfastate)) t ts+>                 where+>                       transition' BTZ = \t ts -> globalFail+>                       transition' (BTB BTZ (x,st) BTZ)+>                         = \t ts ->+>                               if x == t then (stateArray A.! st) ts  -- PROBLEM+>                               else globalFail+>                       transition' (BTB l (x,st) r)+>                         = \t ts ->+>                               if t < x then transition' l t ts+>                               else if t > x then transition' r t ts+>                               else (stateArray A.! st) ts++Debug code.  Note that we need some extra constraints so we can+actually show regular expression states.++> class (ReVars m t, MonadIO m, Show t) => ReVarsIO m t where { }+> instance (ReVars m t, MonadIO m, Show t) => ReVarsIO m t where { }++> remDump :: (ReVarsIO m t) => ReM m t ()+> remDump+>   = do states <- gets (M.toList . resFwdMap)+>        remDumpStates states+>   where+>       remDumpStates [] = return ()+>       remDumpStates ((s,sr):ss)+>         = do  info <- remLookupFwd s+>               liftIO . putStrLn $ show s ++ ": " ++ show sr+>               remDumpStates ss++> remDumpDfa :: (ReVarsIO m t) => SimplRe t -> ReM m t ()+> remDumpDfa start+>   = do states <- gets (nodups . L.sort . resStatesDone)+>        liftIO (putStrLn $ "Initial state: " ++ show start)+>        remDumpStates states+>   where+>       nodups [] = []+>       nodups (x:xs)+>         = x : nodups (dropWhile (==x) xs)+>       remDumpStates [] = return ()+>       remDumpStates (s:ss)+>         = do  info <- remLookupFwd s+>               let Just dfaState = reiDfa info+>               liftIO . putStrLn $ show s ++ ": " ++ show dfaState+>               remDumpStates ss++> remTestBuild :: (ReVarsIO m t) => Re t -> m ()+> remTestBuild re+>  = remRun testBuild+>  where+>    testBuild+>       = do    s <- remBuild re+>               liftIO . putStrLn $ "Initial node: " ++ show s+>               remDump++> remTestDfa :: (ReVarsIO m t) => Re t -> m ()+> remTestDfa re+>  = remRun testDfa+>  where+>    testDfa+>       = do    s <- remBuild re+>               remMakeDfa s+>               remDumpDfa s++Wrapper++> makeDfa :: (Ord t) => Re t -> RDfa t+> makeDfa re+>   = runIdentity . remRun $ builder+>   where+>       builder+>         = do  s <- remBuild re+>               remMakeDfa s+>               remMakeRecursiveDfa s++> makeCode :: (Ord t) => Re t -> [t] -> Bool+> makeCode re+>   = runIdentity . remRun $ builder+>   where+>       builder+>         = do  s <- remBuild re+>               remMakeDfa s+>               remCodeGen s++> matchRe :: (Ord t) => Re t -> [t] -> Bool+> matchRe re+>   = makeCode re++> matchRe2 :: (Ord t) => Re t -> [t] -> Bool+> matchRe2 re+>   = matchRecursiveDfa (makeDfa re)++Test cases++> re1 :: Re Char+> re1 = ReOr [ReStar (ReCat [re0, re01]), ReStar (ReCat [re01, re0])]+>     where+>       re01 = ReOr [re0, re1]+>       re0 = ReTerm "0"+>       re1 = ReTerm "1"++[+\-]?{digit}*(\.{digit}+)?([eE][+\-]?{digit}+)?++> re2 :: Re Char+> re2 = ReCat [ReOpt (alt "+-"),+>       ReOr [ReCat [digits1, ReOpt (ReCat [dot, digits0])],+>             ReCat [digits0, dot, digits1]],+>       ReOpt (ReCat [alt "eE", ReOpt (alt "+-"), digits1])]+>     where+>       alt cs = ReOr $ map (\c -> ReTerm [c]) cs+>       digits0 = ReStar digit+>       digits1 = RePlus digit+>       digit = alt "0123456789"+>       dot = ReTerm "."+
+ Swish/HaskellRDF/GraphClass.hs view
@@ -0,0 +1,271 @@+{-# OPTIONS -XMultiParamTypeClasses #-}+++--------------------------------------------------------------------------------
+--  $Id: GraphClass.hs,v 1.16 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  GraphClass
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a Labelled Directed Graph and Label classes,
+--  and the Arc datatype.
+--
+--------------------------------------------------------------------------------
+
+------------------------------------------------------------
+-- Define LDGraph, arc and related classes and types
+------------------------------------------------------------
+
+module Swish.HaskellRDF.GraphClass
+    ( LDGraph(..), replaceArcs
+    , Label(..)
+    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple
+    , Selector
+    , hasLabel, arcLabels
+    )
+where
+
+import Swish.HaskellUtils.ListHelpers
+    ( subset )
+
+import Swish.HaskellUtils.FunctorM
+    ( FunctorM(..) )
+
+import Data.List
+    ( nub, union, (\\) )
+
+--------------------------------
+--  Labelled Directed Graph class
+--------------------------------
+--
+--  Minimum required implementation:  setArcs, getArcs
+--
+--  NOTE:  I wanted to declare this as a subclass of Functor, but
+--  the constraint on the label type seems to prevent that.
+--  So I've just declared specific instances to be Functors.
+class (Eq (lg lb), Eq lb ) => LDGraph lg lb
+    where
+    --  empty graph
+    --  emptyGr     :: lg lb    [[[TODO?]]]
+    --  component-level operations
+    setArcs     :: [Arc lb] -> lg lb -> lg lb       -- setarcs [arcs] in g2 -> g3
+    getArcs     :: lg lb -> [Arc lb]                -- g1 -> [arcs]
+    --  extract arcs from a graph
+    extract     :: Selector lb -> lg lb -> lg lb    -- select f1 from g2 -> g3
+    extract sel = update (filter sel)
+    --  graph-level operations
+    add         :: lg lb -> lg lb -> lg lb          -- g1 + g2 -> g3
+    add    addg = update (union (getArcs addg))
+    delete      :: lg lb -> lg lb -> lg lb          -- g2 - g1 -> g3
+    delete delg = update (flip (\\) (getArcs delg))
+    --  enumerate distinct labels contained in a graph
+    labels      :: lg lb -> [lb]      -- g1 -> [labels]
+    labels g    = foldl union [] (map arcLabels (getArcs g))
+    --  enumerate distinct labels contained in a graph
+    nodes       :: lg lb -> [lb]      -- g1 -> [labels]
+    nodes g     = foldl union [] (map arcNodes (getArcs g))
+    --  test for graph containment in another
+    containedIn :: lg lb -> lg lb -> Bool           -- g1 <= g2?
+    -- g1 update arcs in a graph using a supplied function:
+    update      :: ( [Arc lb] -> [Arc lb] ) -> lg lb -> lg lb
+    update f g  = setArcs ( f (getArcs g) ) g
+
+-- |Function to replace arcs in a graph with a given list of arcs
+replaceArcs :: (LDGraph lg lb) => lg lb -> [Arc lb] -> lg lb
+replaceArcs gr as = update (const as) gr
+
+---------------
+--  Label class
+---------------
+--
+--  A label may have a fixed binding, which means that the label identifies (is) a
+--  particular graph node, and different such labels are always distinct nodes.
+--  Alternatively, a label may be unbound (variable), which means that it is a
+--  placeholder for an unknown node label.  Unbound node labels are used as
+--  graph-local identifiers for indicating when the same node appears in
+--  several arcs.
+--
+--  For the purposes of graph-isomorphism testing, fixed labels are matched when they
+--  are the same.  Variable labels may be matched with any other variable label.
+--  Our definition of isomorphism (for RDF graphs) does not match variable labels
+--  with fixed labels.
+
+class (Eq lb, Show lb, Ord lb) => Label lb where
+    labelIsVar  :: lb -> Bool           -- does this node have a variable binding?
+    labelHash   :: Int -> lb -> Int     -- calculate hash of label using supplied seed
+    getLocal    :: lb -> String         -- extract local id from variable node
+    makeLabel   :: String -> lb         -- make label value given local id
+    -- compare     :: lb -> lb -> Ordering
+    -- compare l1 l2 = compare (show l1) (show l2)
+
+------------
+--  Arc type
+------------
+
+data Arc lb = Arc { asubj, apred, aobj :: lb }
+    deriving Eq
+
+arcSubj :: Arc lb -> lb
+arcSubj = asubj
+
+arcPred :: Arc lb -> lb
+arcPred = apred
+
+arcObj :: Arc lb -> lb
+arcObj = aobj
+
+arc :: lb -> lb -> lb -> Arc lb
+arc s p o = Arc s p o
+
+arcToTriple :: Arc lb -> (lb,lb,lb)
+arcToTriple a = (asubj a,apred a,aobj a)
+
+arcFromTriple :: (lb,lb,lb) -> Arc lb
+arcFromTriple (s,p,o) = Arc s p o
+
+instance Ord lb => Ord (Arc lb) where
+    compare (Arc s1 p1 o1) (Arc s2 p2 o2) =
+        if cs /= EQ then cs else
+        if cp /= EQ then cp else co
+        where
+            cs = compare s1 s2
+            cp = compare p1 p2
+            co = compare o1 o2
+    (Arc s1 p1 o1) <= (Arc s2 p2 o2) =
+        if (s1 /= s2) then (s1 <= s2) else
+        if (p1 /= p2) then (p1 <= p2) else (o1 <= o2)
+
+instance Functor Arc where
+    -- fmap :: (lb -> l2) -> Arc lb -> Arc l2
+    fmap f (Arc s p o) = Arc (f s) (f p) (f o)
+
+instance FunctorM Arc where
+    -- fmapM :: (lb -> m l2) -> Arc lb -> m (Arc l2)
+    fmapM f (Arc s p o) =
+        do  { s' <- f s
+            ; p' <- f p
+            ; o' <- f o
+            ; return $ Arc s' p' o'
+            }
+
+instance (Show lb) => Show (Arc lb) where
+    show (Arc lb1 lb2 lb3) =
+        "("++(show lb1)++","++(show lb2)++","++(show lb3)++")"
+
+type Selector lb = Arc lb -> Bool
+
+hasLabel :: (Eq lb) => lb -> Arc lb -> Bool
+hasLabel lbv (Arc lb1 lb2 lb3) = (lbv==lb1) || (lbv==lb2) || (lbv==lb3)
+
+arcLabels :: Arc lb -> [lb]
+arcLabels (Arc lb1 lb2 lb3) = [lb1,lb2,lb3]
+
+arcNodes :: Arc lb -> [lb]
+arcNodes (Arc lb1 _ lb3) = [lb1,lb3]
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/GraphClass.hs,v $
+-- $Author: graham $
+-- $Revision: 1.16 $
+-- $Log: GraphClass.hs,v $
+-- Revision 1.16  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.15  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.14  2003/06/30 19:07:00  graham
+-- Instance entailment, subgraph entailment and simple entailment
+-- tests now working.
+--
+-- Revision 1.13  2003/06/27 20:46:00  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.12  2003/06/10 17:38:34  graham
+-- Remove some unneeded calss constraints from data type declarations
+-- Reworked NSGraph to be an instance of Functor, replacing function
+-- gmap with fmap.  Graph formulae are still not handled well:  the data types
+-- will need re-working so that a "Formula lb" type constructor can be
+-- introduced having the correct (* -> *) kind to be a Functor.
+--
+-- Revision 1.11  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.10  2003/05/30 15:04:56  graham
+-- Fix references to defunct GraphHelpers module
+--
+-- Revision 1.9  2003/05/29 01:50:56  graham
+-- More performance tuning, courtesy of GHC profiler.
+-- All modules showing reasonable performance now.
+--
+-- Revision 1.8  2003/05/28 17:39:30  graham
+-- Trying to track down N3 formatter performance problem.
+--
+-- Revision 1.7  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.6  2003/05/23 16:29:20  graham
+-- Partial code cleanup:
+-- - Arc is an alebraic type
+-- - Arc is an instance of Functor
+-- - add gmap function to Graph interface
+-- - remove some duplicate functions from GraphMatch
+-- This in preparation for adding graph merge facility with
+-- blank node renaming.
+--
+-- Revision 1.5  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.4  2003/04/10 13:35:34  graham
+-- Separated GraphMatch logic from GraphMem
+--
+-- Revision 1.3  2003/04/10 08:36:06  graham
+-- Graph matching passes battery of new tests
+-- Started work on RDF graph
+--
+-- Revision 1.2  2003/03/31 20:52:23  graham
+-- Restructure graph matching to deal with same unbound node names in
+-- different graphs.  It shows signs that it might be working now.
+-- More testing is needed.
+--
+-- Revision 1.1  2003/03/28 21:50:22  graham
+-- Graph equality coded and nearly working
+--

+ Swish/HaskellRDF/GraphMatch.hs view
@@ -0,0 +1,741 @@+{-# OPTIONS -XFlexibleInstances #-}
+{-# OPTIONS -XTypeSynonymInstances #-}
+{-# OPTIONS -XMultiParamTypeClasses #-}
+
+--------------------------------------------------------------------------------
+--  $Id: GraphMatch.hs,v 1.19 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  GraphMatch
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains graph-matching logic.
+--
+--  The algorithm used is derived from a paper on RDF graph matching
+--  by Jeremy Carroll [1].
+--
+--  [1] http://www.hpl.hp.com/techreports/2001/HPL-2001-293.html
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.GraphMatch
+      ( graphMatch,
+        -- The rest exported for testing only
+        LabelMap, GenLabelMap(..), LabelEntry, GenLabelEntry(..),
+        ScopedLabel(..), makeScopedLabel, makeScopedArc,
+        LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,
+        labelIsVar, labelHash,
+        mapLabelIndex, setLabelHash, newLabelMap,
+        graphLabels, assignLabelMap, newGenerationMap,
+        graphMatch1, graphMatch2, equivalenceClasses, reclassify
+      ) where
+
+import Swish.HaskellUtils.LookupMap
+import Swish.HaskellUtils.ListHelpers
+import Swish.HaskellUtils.MiscHelpers
+import Swish.HaskellUtils.TraceHelpers( trace, traceShow )
+import Swish.HaskellRDF.GraphClass
+import Data.Maybe( isJust )
+import Data.List( nub, sortBy, partition )
+import qualified Data.List
+
+--------------------------
+--  Label index value type
+--------------------------
+--
+--  LabelIndex is a unique value assigned to each label, such that
+--  labels with different values are definitely different values
+--  in the graph;  e.g. do not map to each other in the graph
+--  bijection.  The first member is a generation counter that
+--  ensures new values are distinct from earlier passes.
+
+type LabelIndex = (Int,Int)
+
+nullLabelVal :: LabelIndex
+nullLabelVal = (0,0)
+
+-----------------------
+--  Label mapping types
+-----------------------
+
+data (Label lb) => GenLabelEntry lb lv = LabelEntry lb lv
+
+type LabelEntry lb = GenLabelEntry lb LabelIndex
+
+instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
+    => LookupEntryClass (GenLabelEntry lb lv) lb lv where
+    keyVal   (LabelEntry k v) = (k,v)
+    newEntry (k,v)            = LabelEntry k v
+
+instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
+    => Show (GenLabelEntry lb lv) where
+    show = entryShow
+
+instance (Label lb, Eq lb, Show lb, Eq lv, Show lv)
+    => Eq (GenLabelEntry lb lv) where
+    (==) = entryEq
+
+--  Type for label->index lookup table
+data (Label lb, Eq lv, Show lv) => GenLabelMap lb lv =
+    LabelMap Int (LookupMap (GenLabelEntry lb lv))
+
+type LabelMap lb = GenLabelMap lb LabelIndex
+
+instance (Label lb) => Show (LabelMap lb) where
+    show = showLabelMap
+
+instance (Label lb) => Eq (LabelMap lb) where
+    LabelMap gen1 lmap1 == LabelMap gen2 lmap2 =
+        (gen1 == gen2) && (es1 `equiv` es2)
+        where
+            es1 = listLookupMap lmap1
+            es2 = listLookupMap lmap2
+
+emptyMap :: (Label lb) => LabelMap lb
+emptyMap = LabelMap 1 $ makeLookupMap []
+
+--------------------------
+--  Equivalence class type
+--------------------------
+--
+--  Type for equivalence class description
+--  (An equivalence class is a collection of labels with
+--  the same LabelIndex value.)
+
+type EquivalenceClass lb = (LabelIndex,[lb])
+
+ecIndex :: EquivalenceClass lb -> LabelIndex
+ecIndex = fst
+
+ecLabels :: EquivalenceClass lb -> [lb]
+ecLabels = snd
+
+ecSize :: EquivalenceClass lb -> Int
+ecSize (_,ls) = length ls
+
+ecRemoveLabel :: (Label lb) => EquivalenceClass lb -> lb -> EquivalenceClass lb
+ecRemoveLabel (lv,ls) l = (lv,Data.List.delete l ls)
+
+------------------------------------------------------------
+--  Augmented graph label value - for graph matching
+------------------------------------------------------------
+--
+--  This instance of class label adds a graph identifier to
+--  each variable label, so that variable labels from
+--  different graphs are always seen as distinct values.
+--
+--  The essential logic added by this class instance is embodied
+--  in the eq and hash functions.  Note that variable label hashes
+--  depend only on the graph in which they appear, and non-variable
+--  label hashes depend only on the variable.  Label hash values are
+--  used when initializing a label equivalence-class map (and, for
+--  non-variable labels, also for resolving hash collisions).
+
+data (Label lb) => ScopedLabel lb = ScopedLabel Int lb
+
+makeScopedLabel :: (Label lb) => Int -> lb -> ScopedLabel lb
+makeScopedLabel scope lab = ScopedLabel scope lab
+
+makeScopedArc :: (Label lb) => Int -> Arc lb -> Arc (ScopedLabel lb)
+makeScopedArc scope a1 = arc (s arcSubj a1) (s arcPred a1) (s arcObj a1)
+    where
+        s f a = (ScopedLabel scope (f a))
+
+instance (Label lb) => Label (ScopedLabel lb) where
+    getLocal  lab    = error $ "getLocal for ScopedLabel: "++show lab
+    makeLabel locnam = error $ "makeLabel for ScopedLabel: "++locnam
+    labelIsVar (ScopedLabel _ lab)   = labelIsVar lab
+    labelHash seed (ScopedLabel scope lab)
+        | labelIsVar lab    = hash seed $ (show scope)++"???"
+        | otherwise         = labelHash seed lab
+
+instance (Label lb) => Eq (ScopedLabel lb) where
+    (ScopedLabel s1 l1) == (ScopedLabel s2 l2)
+        = ( l1 == l2 ) && (s1 == s2)
+
+instance (Label lb) => Show (ScopedLabel lb) where
+    show (ScopedLabel s1 l1) = (show s1) ++ ":" ++ (show l1)
+
+instance (Label lb) => Ord (ScopedLabel lb) where
+    compare (ScopedLabel s1 l1) (ScopedLabel s2 l2) =
+        case (compare s1 s2) of
+            LT -> LT
+            EQ -> compare l1 l2
+            GT -> GT
+
+--------------
+--  graphMatch
+--------------
+--
+--  Graph matching function accepting two lists of arcs and
+--  returning a node map if successful
+--
+--  matchable
+--          is a function that tests for additional constraints
+--          that may prevent the matching of a supplied pair
+--          of nodes.  Returns True if the supplied nodes may be
+--          matched.  (Used in RDF graph matching for checking
+--          that formula assignments are compatible.)
+--  gs1     is the first of two graphs to be compared,
+--          supplied as a list of arcs.
+--  gs2     is the second of two graphs to be compared,
+--          supplied as a list of arcs.
+--
+--  returns a label map that maps each label to an equivalence
+--          class identifier, or Nothing if the graphs cannot be
+--          matched.
+
+graphMatch :: (Label lb) =>
+    (lb -> lb -> Bool) -> [Arc lb] -> [Arc lb]
+    -> (Bool,LabelMap (ScopedLabel lb))
+graphMatch matchable gs1 gs2 =
+    let
+        sgs1    = {- trace "sgs1 " $ -} map (makeScopedArc 1) gs1
+        sgs2    = {- trace "sgs2 " $ -} map (makeScopedArc 2) gs2
+        ls1     = {- traceShow "ls1 " $ -} graphLabels sgs1
+        ls2     = {- traceShow "ls2 " $ -} graphLabels sgs2
+        lmap    = {- traceShow "lmap " $ -}
+                  newGenerationMap $
+                  assignLabelMap ls1 $
+                  assignLabelMap ls2 emptyMap
+        ec1     = {- traceShow "ec1 " $ -} equivalenceClasses lmap ls1
+        ec2     = {- traceShow "ec2 " $ -} equivalenceClasses lmap ls2
+        ecpairs = zip (pairSort ec1) (pairSort ec2)
+        matchableScoped (ScopedLabel _ l1) (ScopedLabel _ l2) = matchable l1 l2
+        match   = graphMatch1 False matchableScoped sgs1 sgs2 lmap ecpairs
+    in
+        if (length ec1) /= (length ec2) then (False,emptyMap) else match
+
+--  Recursive graph matching function
+--  This function assumes that no variable label appears in both graphs.
+--  (Function graphMatch, which calls this, ensures that all variable
+--  labels are distinct.)
+--
+--  matchable
+--          is a function that tests for additional constraints
+--          that may prevent the matching of a supplied pair
+--          of nodes.  Returns True if the supplied nodes may be
+--          matched.
+--  guessed is True if a guess has been used before trying this comparison,
+--          False if nodes are being matched without any guesswork.
+--  gs1     is the first of two lists of arcs (triples) to be compared
+--  gs2     is the second of two lists of arcs (triples) to be compared
+--  lmap    is the map so far used to map label values to equivalence
+--          class values
+--  ecpairs list of pairs of corresponding equivalence classes of nodes
+--          from gs1 and gs2 that have not been confirmed in 1:1
+--          correspondence with each other.
+--          Each pair of equivalence classes contains nodes that must
+--          be placed in 1:1 correspondence with each other.
+--
+--  returns a pair (match,map), where 'match' is Tue if the supplied
+--          sets of arcs can be matched, in which case 'map' is a
+--          corresponding map from labels to equivalence class identifiers.
+--          When 'match' is False, 'map' is the most detailed equivalence
+--          class map obtained before a mismatch was detected or a guess
+--          was required -- this is intended to help identify where the
+--          graph mismatch may be.
+--
+-- [[[TODO:  replace Equivalence class pair by (index,[lb],[lb]) ?]]]
+-- [[[TODO:  possible optimization:  the graphMapEq test should be
+--           needed only if graphMatch2 has been used to guess a
+--           mapping;  either (a) supply flag saying guess has been
+--           used, or (b) move test to graphMatch2 and use different
+--           test to prevent rechecking for each guess used.]]]
+
+graphMatch1 :: (Label lb) =>  Bool -> (lb -> lb -> Bool)
+    -> [Arc lb] -> [Arc lb]
+    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
+    -> (Bool,(LabelMap lb))
+graphMatch1 guessed matchable gs1 gs2 lmap ecpairs =
+    let
+        (secs,mecs) = partition uniqueEc ecpairs
+        uniqueEc ( (_,[_])  , (_,[_])  ) = True
+        uniqueEc (  _       ,  _       ) = False
+        doMatch  ( (_,[l1]) , (_,[l2]) ) = labelMatch matchable lmap l1 l2
+        ecEqSize ( (_,ls1)  , (_,ls2)  ) = (length ls1) == (length ls2)
+        ecSize   ( (_,ls1)  , _        ) = length ls1
+        ecCompareSize ec1 ec2 = compare (ecSize ec1) (ecSize ec2)
+        (lmap',mecs',newEc,matchEc) = reclassify gs1 gs2 lmap mecs
+        match2 = graphMatch2 matchable gs1 gs2 lmap $ sortBy ecCompareSize mecs
+    in
+        -- trace ("graphMatch1\nsingle ECs:\n"++show secs++
+        --                   "\nmultiple ECs:\n"++show mecs++
+        --                   "\n\n") $
+        --  if mismatch in singleton equivalence classes, fail
+        if not $ all doMatch secs then (False,lmap)
+        else
+        --  if no multi-member equivalence classes,
+        --  check and return label map supplied
+        -- trace ("graphMatch1\ngraphMapEq: "++show (graphMapEq lmap gs1 gs2)) $
+        if null mecs then (graphMapEq lmap gs1 gs2,lmap)
+        else
+        --  if size mismatch in equivalence classes, fail
+        -- trace ("graphMatch1\nall ecEqSize mecs: "++show (all ecEqSize mecs)) $
+        if not $ all ecEqSize mecs then (False,lmap)
+        else
+        --  invoke reclassification, and deal with result
+        if not matchEc then (False,lmap)
+        else
+        if newEc then graphMatch1 guessed matchable gs1 gs2 lmap' mecs'
+        else
+        --  if guess does not result in a match, return supplied label map
+        if fst match2 then match2 else (False,lmap)
+
+--  Auxiliary graph matching function
+--  This function is called when deterministic decomposition of node
+--  mapping equivalence classes has run its course.
+--
+--  It picks a pair of equivalence classes in ecpairs, and arbitrarily matches
+--  pairs of nodes in those equivalence classes, recursively calling the
+--  graph matching function until a suitable node mapping is discovered
+--  (success), or until all such pairs have been tried (failure).
+--
+--  This function represents a point to which arbitrary choices are backtracked.
+--  The list comprehension 'glp' represents the alternative choices at the
+--  point of backtracking
+--
+--  The selected pair of nodes are placed in a new equivalence class based on their
+--  original equivalence class value, but with a new NodeVal generation number.
+
+graphMatch2 :: (Label lb) => (lb -> lb -> Bool)
+    -> [Arc lb] -> [Arc lb]
+    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
+    -> (Bool,(LabelMap lb))
+graphMatch2 matchable gs1 gs2 lmap ((ec1@(ev1,ls1),ec2@(ev2,ls2)):ecpairs) =
+    let
+        (_,v1) = ev1
+        (_,v2) = ev2
+        --  Return any equivalence-mapping obtained by matching a pair
+        --  of labels in the supplied list, or Nothing.
+        try []            = (False,lmap)
+        try ((l1,l2):lps) = if equiv try1 l1 l2 then try1 else try lps
+            where
+                try1     = graphMatch1 True matchable gs1 gs2 lmap' ecpairs'
+                lmap'    = newLabelMap lmap [(l1,v1),(l2,v1)]
+                ecpairs' = ((ev',[l1]),(ev',[l2])):ec':ecpairs
+                ev'      = mapLabelIndex lmap' l1
+                ec'      = (ecRemoveLabel ec1 l1,ecRemoveLabel ec2 l2)
+                -- [[[TODO: replace this: if isJust try ?]]]
+                equiv (False,_)   _  _  = False
+                equiv (True,lmap) l1 l2 =
+                    (mapLabelIndex m1 l1) == (mapLabelIndex m2 l2)
+                    where
+                        m1 = remapLabels gs1 lmap [l1]
+                        m2 = remapLabels gs2 lmap [l2]
+        --  glp is a list of label-pair candidates for matching,
+        --  selected from the first label-equivalence class.
+        --  NOTE:  final test is call of external matchable function
+        glp = [ (l1,l2) | l1 <- ls1 , l2 <- ls2 , matchable l1 l2 ]
+    in
+        assert (ev1==ev2) "GraphMatch2: Equivalence class value mismatch" $
+        try glp
+
+----------------------
+--  LabelMap functions
+----------------------
+
+----------------
+--  showLabelMap
+----------------
+--
+--  Returns a string representation  of a LabelMap value
+
+showLabelMap :: (Label lb) => LabelMap lb -> String
+showLabelMap (LabelMap gn lmap) =
+    "LabelMap gen="++(Prelude.show gn)++", map="++
+    foldl (++) "" ((map ("\n    "++)) (map Prelude.show es ))
+    where
+        es = listLookupMap lmap
+
+-----------------
+--  mapLabelIndex
+-----------------
+--
+--  Map a label to its corresponding label index value in the supplied LabelMap
+
+mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
+mapLabelIndex (LabelMap _ lxms) lb = mapFind nullLabelVal lb lxms
+
+--------------
+--  labelMatch
+--------------
+--
+--  Confirm that a given pair of labels are matchable, and are
+--  mapped to the same value by the supplied label map
+
+labelMatch :: (Label lb)
+    =>  (lb -> lb -> Bool) -> LabelMap lb -> lb -> lb -> Bool
+labelMatch matchable lmap l1 l2 =
+    (matchable l1 l2) && ((mapLabelIndex lmap l1) == (mapLabelIndex lmap l1))
+
+---------------
+--  newLabelMap
+---------------
+--
+--  Replace selected values in a label map with new values from the supplied
+--  list of labels and new label index values.  The generation number is
+--  supplied from the current label map.  The generation number in the
+--  resulting label map is incremented.
+
+newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb
+newLabelMap (LabelMap g f) [] = (LabelMap (g+1) f) -- new generation
+newLabelMap lmap (lv:lvs)     = setLabelHash (newLabelMap lmap lvs) lv
+
+----------------
+--  setLabelHash
+----------------
+--
+--  setLabelHash replaces a label and its associated value in a label map
+--  with a new value using the supplied hash value and the current
+--  LabelMap generation number.  If the key is not found, then no change
+--  is made to the label map.
+
+setLabelHash :: (Label lb)
+    => LabelMap lb -> (lb,Int) -> LabelMap lb
+setLabelHash  (LabelMap g lmap) (lb,lh) =
+    LabelMap g ( mapReplaceAll lmap $ newEntry (lb,(g,lh)) )
+
+--------------------
+--  newGenerationMap
+--------------------
+--
+--  Increment generation of label map.
+--  Returns a new label map identical to the supplied value
+--  but with an incremented generation number.
+
+newGenerationMap :: (Label lb) => LabelMap lb -> LabelMap lb
+newGenerationMap (LabelMap g lvs) = (LabelMap (g+1) lvs)
+
+------------------
+--  assignLabelMap
+------------------
+--
+--  Scan label list, assigning initial label map values,
+--  adding new values to the label map supplied.
+--
+--  Label map values are assigned on the basis of the
+--  label alone, without regard for it's connectivity in
+--  the graph.  (cf. reClassify)
+--
+--  All variable node labels are assigned the same initial
+--  value, as they may be matched with each other.
+
+assignLabelMap :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb
+assignLabelMap [] lmap      = lmap
+assignLabelMap (n:ns) lmap  = assignLabelMap ns (assignLabelMap1 n lmap)
+
+assignLabelMap1 :: (Label lb) => lb -> LabelMap lb -> LabelMap lb
+assignLabelMap1 lab (LabelMap g lvs) = LabelMap g lvs'
+    where
+        lvs' = (mapAddIfNew lvs $ newEntry (lab,(g,initVal lab)))
+
+--  Calculate initial value for a node
+
+initVal :: (Label lb) => lb -> Int
+initVal n = hashVal 0 n
+
+hashVal :: (Label lb) => Int -> lb -> Int
+hashVal seed lab =
+    if (labelIsVar lab) then (hash seed "???") else (labelHash seed lab)
+
+----------------------
+--  equivalenceClasses
+----------------------
+--
+--  lmap    label map
+--  ls      list of nodes to be reclassified
+--
+--  return  list of equivalence classes of the supplied labels under
+--          the supplied label map.
+
+equivalenceClasses :: (Label lb) => LabelMap lb -> [lb] -> [EquivalenceClass lb]
+equivalenceClasses lmap ls =
+    pairGroup $ map labelPair ls
+    where
+        labelPair l = (mapLabelIndex lmap l,l)
+
+--------------
+--  reclassify
+--------------
+--
+--  Reclassify labels
+--
+--  Examines the supplied label equivalence classes (based on the supplied
+--  label map), and evaluates new equivalence subclasses based on node
+--  values and adjacency (for variable nodes) and rehashing
+--  (for non-variable nodes).
+--
+--  Note, assumes that all all equivalence classes supplied are
+--  non-singletons;  i.e. contain more than one label.
+--
+--  gs1     is the first of two lists of arcs (triples) to perform a
+--          basis for reclassifying the labels in the first equivalence
+--          class in each pair of 'ecpairs'.
+--  gs2     is the second of two lists of arcs (triples) to perform a
+--          basis for reclassifying the labels in the second equivalence
+--          class in each pair of 'ecpairs'.
+--  lmap    is a label map used for classification of the labels in
+--          the supplied equivalence classes.
+--  ecpairs a list of pairs of corresponding equivalence classes of
+--          nodes from gs1 and gs2 that have not been confirmed
+--          in 1:1 correspondence with each other.
+--
+--  return  a quadruple of:
+--          (a) a revised label map reflecting the reclassification,
+--          (b) a new list of equivalence class pairs based on the
+--          new node map, and
+--          (c) if the reclassification partitions any of the
+--          supplied equivalence classes then True, else False.
+--          any of the supplied equivalence classes
+--          (d) if reclassification results in each equivalence class
+--          being split same-sized equivalence classes in the two graphs,
+--          then True, otherwise False.
+
+reclassify :: (Label lb) =>
+    [Arc lb] -> [Arc lb]
+    -> LabelMap lb -> [(EquivalenceClass lb,EquivalenceClass lb)]
+    -> (LabelMap lb,[(EquivalenceClass lb,EquivalenceClass lb)],Bool,Bool)
+reclassify gs1 gs2 lmap@(LabelMap _ lm) ecpairs =
+    assert (gen1==gen2) "Label map generation mismatch" $
+    (LabelMap gen1 lm',ecpairs',newPart,matchPart)
+    where
+        LabelMap gen1 lm1 =
+            remapLabels gs1 lmap $ foldl1 (++) $ map (ecLabels . fst) ecpairs
+        LabelMap gen2 lm2 =
+            remapLabels gs2 lmap $ foldl1 (++) $ map (ecLabels . snd) ecpairs
+        lm' = mapReplaceMap lm $ mapMerge lm1 lm2
+        -- ecGroups :: [([EquivalenceClass lb],[EquivalenceClass lb])]
+        ecGroups  = [ (remapEc ec1,remapEc ec2) | (ec1,ec2) <- ecpairs ]
+        ecpairs'  = concat $ map (uncurry zip) ecGroups
+        newPart   = or  $ map pairG1 lenGroups
+        matchPart = and $ map pairEq lenGroups
+        lenGroups = map subLength ecGroups
+        pairEq (p1,p2) = p1 == p2
+        pairG1 (p1,p2) = (p1 > 1) || (p2 > 1)
+        subLength (ls1,ls2) = (length ls1,length ls2)
+        remapEc ec = pairGroup $ map (newIndex lm') $ pairUngroup ec
+        newIndex lm (_,lab) = (mapFind nullLabelVal lab lm,lab)
+
+---------------
+--  remapLabels
+---------------
+--
+--  Calculate a new index value for a supplied list of labels based on the
+--  supplied label map and adjacency calculations in the supplied graph
+--
+--  gs      is a list of Arcs used for adjacency calculations when remapping
+--  lmap    is a label map used for obtaining current label index values
+--  ls      is a list of graph labels for which new mappings are to be
+--          created and returned.
+--  return  a new label map containing recalculated label index values
+--          for the labels in ls.  The label map generation number is
+--          incremented by 1 from the supplied 'lmap' value.
+
+remapLabels :: (Label lb) =>
+    [Arc lb] -> LabelMap lb -> [lb] -> LabelMap lb
+remapLabels gs lmap@(LabelMap gen _) ls =
+    LabelMap gen' (LookupMap newEntries)
+    where
+        gen'                = gen+1
+        newEntries          = [ newEntry (l, (gen',newIndex l)) | l <- ls ]
+        newIndex l
+            | labelIsVar l  = mapAdjacent l     -- adjacency classifies variable labels
+            | otherwise     = hashVal gen l     -- otherwise rehash (to disentangle collisions)
+        mapAdjacent l       = ( sum (sigsOver l) ) `rem` hashModulus
+        sigsOver l          = select (hasLabel l) gs (arcSignatures lmap gs)
+
+-----------------------------
+--  Graph auxiliary functions
+-----------------------------
+
+---------------
+--  graphLabels
+---------------
+--
+--  Return list of distinct labels used in a graph
+
+graphLabels :: (Label lb) => [Arc lb] -> [lb]
+graphLabels gs = nub $ concat $ map arcLabels gs
+
+{-  OLD CODE:
+graphLabels gs = graphLabels1 gs []
+
+graphLabels1 (t:gs) ls = graphLabels1 gs $
+                         foldl (flip addSetElem) ls (arcLabels t)
+graphLabels1 [] ls     = ls
+-}
+
+-- addSetElem ::  lb -> [lb] -> [lb]
+
+-----------------
+--  arcSignatures
+-----------------
+--
+--  Calculate a signature value for each arc that can be used in constructing an
+--  adjacency based value for a node.  The adjacancy value for a label is obtained
+--  by summing the signatures of all statements containing that label.
+--
+--  lmap    is a label map used for obtaining current label index values
+--  gs      is the list of arcs for which signaturews are calculated
+--  return  a list of signature values in correspondence with gs
+
+arcSignatures :: (Label lb) => LabelMap lb -> [Arc lb] -> [Int]
+arcSignatures lmap gs =
+    map (sigCalc . arcToTriple) gs
+    where
+        sigCalc (s,p,o)     =
+            ( (labelVal2 s) +
+              (labelVal2 p)*3 +
+              (labelVal2 o)*5 ) `rem` hashModulus
+        labelVal l          = mapLabelIndex lmap l
+        labelVal2           = (\v -> (fst v) * (snd v) ) . labelVal
+
+------------
+--  graphMap
+------------
+--
+--  Return new graph that is supplied graph with every node/arc
+--  mapped to a new value according to the supplied function.
+--
+--  Used for testing for graph equivalence under a supplied
+--  label mapping;  e.g.
+--
+--    if ( graphMap nodeMap gs1 ) `equiv` ( graphMap nodeMap gs2 ) then (same)
+
+graphMap :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc LabelIndex]
+graphMap lmap = map $ fmap (mapLabelIndex lmap) -- graphMapStmt
+
+--------------
+--  graphMapEq
+--------------
+--
+--  Compare a pair of graphs for equivalence under a given mapping
+--  function.
+--
+--  This is used to perform the ultimate test that two graphs are
+--  indeed equivalent:  guesswork in graphMatch2 means that it is
+--  occasionally possible to construct a node mapping that generates
+--  the required singleton equivalence classes, but does not fully
+--  reflect the topology of the graphs.
+
+graphMapEq :: (Label lb) => LabelMap lb -> [Arc lb] -> [Arc lb] -> Bool
+graphMapEq lmap gs1 gs2 = (graphMap lmap gs1) `equiv` (graphMap lmap gs2)
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/GraphMatch.hs,v $
+-- $Author: graham $
+-- $Revision: 1.19 $
+-- $Log: GraphMatch.hs,v $
+-- Revision 1.19  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.18  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.17  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.16  2003/10/24 21:03:25  graham
+-- Changed kind-structure of LookupMap type classes.
+--
+-- Revision 1.15  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.14  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.13  2003/05/29 01:50:56  graham
+-- More performance tuning, courtesy of GHC profiler.
+-- All modules showing reasonable performance now.
+--
+-- Revision 1.12  2003/05/28 19:57:50  graham
+-- Adjusting code to compile with GHC
+--
+-- Revision 1.11  2003/05/23 16:29:20  graham
+-- Partial code cleanup:
+-- - Arc is an alebraic type
+-- - Arc is an instance of Functor
+-- - add gmap function to Graph interface
+-- - remove some duplicate functions from GraphMatch
+-- This in preparation for adding graph merge facility with
+-- blank node renaming.
+--
+-- Revision 1.10  2003/05/14 11:13:15  graham
+-- Fixed bug in graph matching.
+-- (A graph-equivalence check is needed to weed out false matches
+-- caused by the "guessing" stage.)
+--
+-- Revision 1.9  2003/05/14 02:01:59  graham
+-- GraphMatch recoded and almost working, but
+-- there are a couple of
+-- obscure bugs that are proving rather stubborn to squash.
+--
+-- Revision 1.8  2003/05/09 00:29:14  graham
+-- Started to restructure graph matching code
+--
+-- Revision 1.7  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.6  2003/05/01 23:15:44  graham
+-- GraphTest passes all tests using refactored LookupMap
+-- Extensive changes to GraphMatch were required.
+--
+-- Revision 1.5  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.4  2003/04/11 18:12:10  graham
+-- Renamed GraphHelpers to ListHelpers
+-- LookupMapTest, GraphTest, RDFGraphTest all run OK
+--
+-- Revision 1.3  2003/04/11 18:04:49  graham
+-- Rename GraphLookupMap to LookupMap:
+-- GraphTest runs OK.
+--
+-- Revision 1.2  2003/04/10 16:47:04  graham
+-- Minor code cleanup
+--
+-- Revision 1.1  2003/04/10 13:35:34  graham
+-- Separated GraphMatch logic from GraphMem
+--

+ Swish/HaskellRDF/GraphMem.hs view
@@ -0,0 +1,264 @@+{-# OPTIONS -XFlexibleInstances #-}+{-# OPTIONS -XMultiParamTypeClasses #-}++--------------------------------------------------------------------------------
+--  $Id: GraphMem.hs,v 1.16 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  GraphMem
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a simple memory-based graph instance.
+--
+--------------------------------------------------------------------------------
+
+------------------------------------------------------------
+-- Simple labelled directed graph value
+------------------------------------------------------------
+
+module Swish.HaskellRDF.GraphMem
+    ( GraphMem(..)
+    , setArcs, getArcs, add, delete, extract, labels
+    , LabelMem(..)
+    , labelIsVar, labelHash
+      -- For debug/test:
+    , matchGraphMem
+    ) where
+
+import Swish.HaskellUtils.LookupMap
+import Swish.HaskellRDF.GraphClass
+import Swish.HaskellRDF.GraphMatch
+import Swish.HaskellUtils.MiscHelpers
+    ( hash )
+import Swish.HaskellUtils.FunctorM
+    ( FunctorM(..) )
+import Data.List
+    ( nub, union, (\\), group, sort, sortBy, any )
+import Data.Maybe
+    ( isJust )
+
+-----------------------------------------------------
+--  Memory-based graph type and graph class functions
+-----------------------------------------------------
+
+data GraphMem lb = GraphMem { arcs :: [Arc lb] }
+
+instance (Label lb) => LDGraph GraphMem lb where
+    getArcs      = arcs
+    setArcs as g = g { arcs=as }
+    -- gmap f g = g { arcs = (map $ fmap f) (arcs g) }
+
+instance (Label lb) => Eq (GraphMem lb) where
+    (==) = graphEq
+
+instance (Label lb) => Show (GraphMem lb) where
+    show = graphShow
+
+instance Functor GraphMem where
+    fmap f g = GraphMem $ map (fmap f) (arcs g)
+
+instance FunctorM GraphMem where
+    fmapM f g =
+        do  { arcs <- mapM (fmapM f) (arcs g)
+            ; return $ GraphMem arcs
+            }
+
+graphShow   :: (Label lb) => GraphMem lb -> String
+graphShow g = "Graph:"++(foldr (++) "" (map ("\n    "++) (map show (arcs g))))
+
+toGraph :: (Label lb) => [Arc lb] -> GraphMem lb
+toGraph as = GraphMem { arcs=(nub as) }
+
+-----------
+--  graphEq
+-----------
+--
+--  Return Boolean graph equality
+
+graphEq :: (Label lb) => GraphMem lb -> GraphMem lb -> Bool
+graphEq g1 g2 = fst ( matchGraphMem g1 g2 )
+
+-----------------
+--  matchGraphMem
+-----------------
+--
+--  GraphMem matching function accepting GraphMem value and returning
+--  node map if successful
+--
+--  g1      is the first of two graphs to be compared
+--  g2      is the second of two graphs to be compared
+--
+--  returns a label map that maps each label to an equivalence
+--          class identifier, or Nothing if the graphs cannot be
+--          matched.
+
+matchGraphMem :: (Label lb) => GraphMem lb -> GraphMem lb
+                            -> (Bool,LabelMap (ScopedLabel lb))
+matchGraphMem g1 g2 =
+    let
+        gs1     = arcs g1
+        gs2     = arcs g2
+        matchable l1 l2
+            | (labelIsVar l1) && (labelIsVar l2) = True
+            | (labelIsVar l1) || (labelIsVar l2) = False
+            | otherwise                          = l1 == l2
+    in
+        graphMatch matchable gs1 gs2
+
+---------------
+--  graphBiject
+---------------
+--
+--  Return bijection between two graphs, or empty list
+{-
+graphBiject :: (Label lb) => GraphMem lb -> GraphMem lb -> [(lb,lb)]
+graphBiject g1 g2 = if null lmap then [] else zip (sortedls g1) (sortedls g2)
+    where
+        lmap        = graphMatch g1 g2
+        sortedls g  = map snd $
+                      (sortBy indexComp) $
+                      equivalenceClasses (graphLabels $ arcs g) lmap
+        classComp ec1 ec2 = indexComp (classIndexVal ec1) (classIndexVal ec2)
+        indexComp (g1,v1) (g2,v2)
+            | g1 == g2  = compare v1 v2
+            | otherwise = compare g1 g2
+-}
+
+------------------------------------------------------------
+--  Minimal graph label value - for testing
+------------------------------------------------------------
+
+data LabelMem
+    = LF String
+    | LV String
+
+instance Label LabelMem where
+    labelIsVar (LV _)   = True
+    labelIsVar _        = False
+    getLocal   (LV loc) = loc
+    getLocal   lab      = error "getLocal of non-variable label: "++(show lab)
+    makeLabel  loc      = LV loc
+    labelHash  seed lb  = hash seed (show lb)
+
+instance Eq LabelMem where
+    (LF l1) == (LF l2)  = l1 == l2
+    (LV l1) == (LV l2)  = l1 == l2
+    _ == _              = False
+
+instance Show LabelMem where
+    show (LF l1)        = "!"++l1
+    show (LV l2)        = "?"++l2
+
+instance Ord LabelMem where
+    compare l1 l2 = compare (show l1) (show l2)
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/GraphMem.hs,v $
+-- $Author: graham $
+-- $Revision: 1.16 $
+-- $Log: GraphMem.hs,v $
+-- Revision 1.16  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.15  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.14  2003/06/10 17:38:34  graham
+-- Remove some unneeded calss constraints from data type declarations
+-- Reworked NSGraph to be an instance of Functor, replacing function
+-- gmap with fmap.  Graph formulae are still not handled well:  the data types
+-- will need re-working so that a "Formula lb" type constructor can be
+-- introduced having the correct (* -> *) kind to be a Functor.
+--
+-- Revision 1.13  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.12  2003/05/30 15:04:56  graham
+-- Fix references to defunct GraphHelpers module
+--
+-- Revision 1.11  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.10  2003/05/23 16:29:20  graham
+-- Partial code cleanup:
+-- - Arc is an alebraic type
+-- - Arc is an instance of Functor
+-- - add gmap function to Graph interface
+-- - remove some duplicate functions from GraphMatch
+-- This in preparation for adding graph merge facility with
+-- blank node renaming.
+--
+-- Revision 1.9  2003/05/14 02:01:59  graham
+-- GraphMatch recoded and almost working, but
+-- there are a couple of
+-- obscure bugs that are proving rather stubborn to squash.
+--
+-- Revision 1.8  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.7  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.6  2003/04/11 18:04:49  graham
+-- Rename GraphLookupMap to LookupMap:
+-- GraphTest runs OK.
+--
+-- Revision 1.5  2003/04/10 13:41:22  graham
+-- More graph code tidying
+-- Graph test cases still run OK
+--
+-- Revision 1.4  2003/04/10 13:35:34  graham
+-- Separated GraphMatch logic from GraphMem
+--
+-- Revision 1.3  2003/04/10 08:36:06  graham
+-- Graph matching passes battery of new tests
+-- Started work on RDF graph
+--
+-- Revision 1.2  2003/03/31 20:52:23  graham
+-- Restructure graph matching to deal with same unbound node names in
+-- different graphs.  It shows signs that it might be working now.
+-- More testing is needed.
+--
+-- Revision 1.1  2003/03/28 21:50:22  graham
+-- Graph equality coded and nearly working
+--

+ Swish/HaskellRDF/GraphPartition.hs view
@@ -0,0 +1,560 @@+--------------------------------------------------------------------------------
+--  $Id: GraphPartition.hs,v 1.3 2004/02/11 14:19:36 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  GraphPartition
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains functions for partitioning a graph into subgraphs
+--  that rooted from different subject nodes.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.GraphPartition
+    ( PartitionedGraph(..), getArcs, getPartitions
+    , GraphPartition(..), node, toArcs
+    , partitionGraph, comparePartitions
+    , partitionShowP
+    )
+where
+
+import Swish.HaskellRDF.GraphClass
+    ( Label(..)
+    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple
+    -- , hasLabel, arcLabels
+    )
+
+import Data.List
+    ( partition )
+
+import Control.Monad.State
+    ( MonadState(..), State(..), evalState )
+
+import Data.Maybe
+    ( isJust, fromJust, catMaybes, listToMaybe )
+
+
+------------------------------------------------------------
+--  Data type for a partitioned graph
+------------------------------------------------------------
+
+-- |Representation of a graph as a collection of (possibly nested)
+--  partitions.  Each node in the graph appears at least once as the
+--  root value of a GraphPartition value:
+--
+--  * Nodes that are the subject of at least one statement appear as
+--    the first value of exactly one PartSub constructor, and may
+--    also appear in any number of PartObj constructors.
+--
+--  * Nodes appearing only as objects of statements appear only in
+--    PartObj constructors.
+
+data PartitionedGraph lb = PartitionedGraph [GraphPartition lb]
+    deriving (Eq,Show)
+
+getArcs :: PartitionedGraph lb -> [Arc lb]
+getArcs (PartitionedGraph ps) = concatMap toArcs ps
+
+getPartitions :: PartitionedGraph lb -> [GraphPartition lb]
+getPartitions (PartitionedGraph ps) = ps
+
+data GraphPartition lb
+    = PartObj lb
+    | PartSub lb [(lb,GraphPartition lb)]
+
+node :: GraphPartition lb -> lb
+node (PartObj ob)   = ob
+node (PartSub sb _) = sb
+
+toArcs :: GraphPartition lb -> [Arc lb]
+toArcs (PartObj _)      = []
+toArcs (PartSub sb prs) = concat $ map toArcs1 prs
+    where
+        toArcs1 (pr,ob) = (Arc sb pr (node ob)):toArcs ob
+
+instance (Label lb) => Eq (GraphPartition lb) where
+    (==) = partitionEq
+
+instance (Label lb) => Show (GraphPartition lb) where
+    show = partitionShow
+
+--  Equality is based on total structural equivalence.
+--  This is not the same as graph equality.
+partitionEq :: (Label lb) => (GraphPartition lb) -> (GraphPartition lb) -> Bool
+partitionEq (PartObj o1)    (PartObj o2)    = o1 == o2
+partitionEq (PartSub s1 p1) (PartSub s2 p2) = (s1 == s2) && (p1==p2)
+partitionEq  _               _              = False
+
+partitionShow :: (Label lb) => (GraphPartition lb) -> String
+partitionShow (PartObj ob)          = show ob
+partitionShow (PartSub sb (pr:prs)) =
+    "("++ show sb ++ " " ++ showpr pr ++ concatMap ((" ; "++).showpr) prs ++ ")"
+    where
+        showpr (pr,ob) = show pr ++ " " ++ show ob
+
+partitionShowP :: (Label lb) => String -> (GraphPartition lb) -> String
+partitionShowP pref (PartObj ob)          = show ob
+partitionShowP pref (PartSub sb (pr:prs)) =
+    pref++"("++ show sb ++ " " ++ showpr pr ++ concatMap (((pref++"  ; ")++).showpr) prs ++ ")"
+    where
+        showpr (pr,ob) = show pr ++ " " ++ partitionShowP (pref++"  ") ob
+
+------------------------------------------------------------
+--  Creating partitioned graphs
+------------------------------------------------------------
+--
+-- |Turning a partitioned graph into a flat graph is easy.
+--  The interesting challenge is to turn a flat graph into a
+--  partitioned graph that is more useful for certain purposes.
+--  Currently, I'm interested in:
+--  (a) isolating differences between graphs
+--  (b) pretty-printing graphs
+--
+--  For (a), the goal is to separate subgraphs that are known
+--  to be equivalent from subgraphs that are known to be different,
+--  such that (i) different sub-graphs are minimized, (ii) different
+--  sub-graphs are placed into 1:1 correspondence (possibly with null
+--  subgraphs), and (iii) only deterministic matching decisions are made.
+--
+--  For (b), the goal is to decide when a subgraph is to be treated
+--  as nested in another partition, or treated as a new top-level partition.
+--  If a subgraph is referenced by exactly one graph partition, it should
+--  be nested in that partition, otherwise it should be a new top-level
+--  partition.
+--
+--  Strategy.  Examining just subject and object nodes:
+--  1. all non-blank subject nodes are the root of a top-level partition
+--  2. blank subject nodes that are not the object of exactly one statement
+--     are the root of a top-level partition.
+--  3. blank nodes referenced as the object of exactly 1 statement
+--     of an existing partition are the root of a sub-partition of the
+--     refering partition.
+--  4. what remain are circular chains of blank nodes not referenced
+--     elsewhere:  for each such chain, pick a root node arbitrarily.
+--
+partitionGraph :: (Label lb) => [Arc lb] -> PartitionedGraph lb
+partitionGraph arcs =
+    makePartitions fixs topv1 intv1
+    where
+        (fixs,vars)  = partition isNonVar $ collect arcSubj arcs
+        vars1        = collectMore arcObj arcs vars
+        (intv,topv)  = partition objOnce vars1
+        intv1        = map stripObj intv
+        topv1        = map stripObj topv
+        isNonVar     = not . labelIsVar . fst
+        objOnce      = isSingle . snd . snd
+        isSingle [_] = True
+        isSingle _   = False
+        stripObj (k,(s,_)) = (k,s)
+
+-- Local state type for partitioning function
+type MakePartitionState lb = ([(lb,[Arc lb])],[(lb,[Arc lb])],[(lb,[Arc lb])])
+
+makePartitions :: (Eq lb) =>
+    [(lb,[Arc lb])] -> [(lb,[Arc lb])] -> [(lb,[Arc lb])] -> PartitionedGraph lb
+makePartitions fixs topv intv =
+    PartitionedGraph $ evalState (makePartitions1 []) (fixs,topv,intv)
+
+-- Use a state monad to keep track of arcs that have been incorporated into
+-- the resulting list of graph partitions.  The collections of arcs used to
+-- generate the list of partitions are supplied as theinitial state of the
+-- monad (see call of evalState above).
+--
+makePartitions1 :: (Eq lb) =>
+    [(lb,[Arc lb])] -> State (MakePartitionState lb) [GraphPartition lb]
+makePartitions1 [] =
+    do  { s <- pickNextSubject
+        ; if null s then return [] else makePartitions1 s
+        }
+makePartitions1 (sub:subs) =
+    do  { ph <- makePartitions2 sub
+        ; pt <- makePartitions1 subs
+        ; return $ ph++pt
+        }
+
+makePartitions2 :: (Eq lb) =>
+    (lb,[Arc lb]) -> State (MakePartitionState lb) [GraphPartition lb]
+makePartitions2 subs =
+    do  { (part,moresubs) <- makeStatements subs
+        ; moreparts <- if (not $ null moresubs) then
+            makePartitions1 moresubs
+          else
+            return []
+        ; return $ part:moreparts
+        }
+
+makeStatements :: (Eq lb) =>
+    (lb,[Arc lb])
+    -> State (MakePartitionState lb) (GraphPartition lb,[(lb,[Arc lb])])
+makeStatements (sub,stmts) =
+    do  { propmore <- sequence (map makeStatement stmts)
+        ; let (props,moresubs) = unzip propmore
+        ; return (PartSub sub props,concat moresubs)
+        }
+
+makeStatement :: (Eq lb) =>
+    Arc lb
+    -> State (MakePartitionState lb) ((lb,GraphPartition lb),[(lb,[Arc lb])])
+makeStatement (Arc sub prop obj) =
+    do  { intobj <- pickIntSubject obj
+        ; (gpobj,moresubs) <- if null intobj
+          then
+            do  { ms <- pickVarSubject obj
+                ; return (PartObj obj,ms)
+                }
+          else
+            makeStatements (head intobj)
+        ; return ((prop,gpobj),moresubs)
+        }
+
+pickNextSubject :: State (MakePartitionState lb) [(lb,[Arc lb])]
+pickNextSubject =
+    do  { (s1,s2,s3) <- get
+        ; let (s,st) = case (s1,s2,s3) of
+                (s1h:s1t,s2,s3) -> ([s1h],(s1t,s2,s3))
+                ([],s2h:s2t,s3) -> ([s2h],([],s2t,s3))
+                ([],[],s3h:s3t) -> ([s3h],([],[],s3t))
+                ([],[],[])      -> ([]   ,([],[],[] ))
+        ; put st
+        ; return s
+        }
+
+pickIntSubject :: (Eq lb) =>
+    lb -> State (MakePartitionState lb) [(lb,[Arc lb])]
+pickIntSubject sub =
+    do  { (s1,s2,s3) <- get
+        ; let varsub = removeBy (\x->(x==).fst) sub s3
+        ; if (isJust varsub) then
+            do  { let (vs,s3new) = fromJust varsub
+                ; put (s1,s2,s3new)
+                ; return [vs]
+                }
+          else
+            return []
+        }
+
+pickVarSubject :: (Eq lb) =>
+    lb -> State (MakePartitionState lb) [(lb,[Arc lb])]
+pickVarSubject sub =
+    do  { (s1,s2,s3) <- get
+        ; let varsub = removeBy (\x->(x==).fst) sub s2
+        ; if (isJust varsub) then
+            do  { let (vs,s2new) = fromJust varsub
+                ; put (s1,s2new,s3)
+                ; return [vs]
+                }
+          else
+            return []
+        }
+
+------------------------------------------------------------
+--  Other useful functions
+------------------------------------------------------------
+--
+--  Create a list of pairs of corresponding Partitions that
+--  are unequal
+
+comparePartitions :: (Label lb) =>
+    PartitionedGraph lb -> PartitionedGraph lb
+    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
+comparePartitions (PartitionedGraph gp1) (PartitionedGraph gp2) =
+    comparePartitions1 (reverse gp1) (reverse gp2)
+
+comparePartitions1 :: (Label lb) =>
+    [GraphPartition lb] -> [GraphPartition lb]
+    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
+comparePartitions1 pg1 pg2 =
+        ds ++ [ (Just r1p,Nothing) | r1p<-r1 ]
+           ++ [ (Nothing,Just r2p) | r2p<-r2 ]
+    where
+        (ds,r1,r2) = listDifferences comparePartitions2 pg1 pg2
+
+--  Compare two graph partitions, with three possible outcomes:
+--    Nothing    -> no match
+--    Just []    -> total match
+--    Just [...] -> partial match, with mismatched sub-partitions listed.
+--
+--  A partial match occurs when the leading nodes are non-variable and
+--  equal, but something else in the partition does not match.
+--
+--  A complete match can be achieved with variable nodes that have
+--  different labels
+--
+comparePartitions2 :: (Label lb) =>
+    GraphPartition lb -> GraphPartition lb
+    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
+comparePartitions2 (PartObj l1) (PartObj l2) =
+    if matchNodes l1 l2 then Just [] else Nothing
+comparePartitions2 pg1@(PartSub l1 p1s) pg2@(PartSub l2 p2s) =
+    if match then comp1 else Nothing
+    where
+        comp1  = case comparePartitions3 l1 l2 p1s p2s of
+                    Nothing -> if matchVar then Nothing
+                                           else Just [(Just pg1,Just pg2)]
+                    Just [] -> Just []
+                    Just ps -> {- if matchVar then Nothing else -} Just ps
+        matchVar = labelIsVar l1 && labelIsVar l2
+        match    = matchVar || (l1 == l2)
+comparePartitions2 pg1 pg2 =
+    if not (labelIsVar l1) && (l1==l2)
+        then Just [(Just pg1,Just pg2)]
+        else Nothing
+    where
+        l1 = node pg1
+        l2 = node pg2
+
+comparePartitions3 :: (Label lb) =>
+    lb -> lb -> [(lb,GraphPartition lb)] -> [(lb,GraphPartition lb)]
+    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
+comparePartitions3 l1 l2 s1s s2s = Just $
+        ds ++ [ (Just (PartSub l1 [r1p]),Nothing) | r1p<-r1 ]
+           ++ [ (Nothing,Just (PartSub l2 [r2p])) | r2p<-r2 ]
+    where
+        (ds,r1,r2) = listDifferences (comparePartitions4 l1 l2) s1s s2s
+
+comparePartitions4 :: (Label lb) =>
+    lb -> lb -> (lb,GraphPartition lb) -> (lb,GraphPartition lb)
+    -> Maybe [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
+comparePartitions4 s1 s2 po1@(p1,o1) po2@(p2,o2) =
+    if matchNodes p1 p2 then comp1 else Nothing
+    where
+        comp1   = case comparePartitions2 o1 o2 of
+                    Nothing -> Just [((Just o1),(Just o2))]
+                    ds      -> ds
+        -- nomatch = (Just (PartSub s1 [po1]),Just (PartSub s2 [po2]))
+
+matchNodes :: (Label lb) => lb -> lb -> Bool
+matchNodes l1 l2
+    | labelIsVar l1 = labelIsVar l2
+    | otherwise     = l1 == l2
+
+
+------------------------------------------------------------
+--  Helpers
+------------------------------------------------------------
+
+-- |Collect a list of items by some comparison of a selected component
+--  or other derived value.
+--
+--  cmp     a comparison function that determines if a pair of values
+--          should be grouped together
+--  sel     a function that selects a value from any item
+--
+--  Example:    collect fst [(1,'a'),(2,'b'),(1,'c')] =
+--                  [(1,[(1,'a'),(1,'c')]),(2,[(2,'b')])]
+--
+collect :: (Eq b) => (a->b) -> [a] -> [(b,[a])]
+collect = collectBy (==)
+
+collectBy :: (b->b->Bool) -> (a->b) -> [a] -> [(b,[a])]
+collectBy cmp sel = map reverseCollection . collectBy1 cmp sel []
+
+collectBy1 :: (b->b->Bool) -> (a->b) -> [(b,[a])] -> [a] -> [(b,[a])]
+collectBy1 cmp sel sofar []     = sofar
+collectBy1 cmp sel sofar (a:as) =
+    collectBy1 cmp sel (collectBy2 cmp sel a sofar) as
+
+collectBy2 :: (b->b->Bool) -> (a->b) -> a -> [(b,[a])] -> [(b,[a])]
+collectBy2 cmp sel a [] = [(sel a,[a])]
+collectBy2 cmp sel a (col@(k,as):cols)
+    | cmp ka k  = (k,a:as):cols
+    | otherwise = col:collectBy2 cmp sel a cols
+    where
+        ka = sel a
+
+reverseCollection :: (b,[a]) -> (b,[a])
+reverseCollection (k,as) = (k,reverse as)
+
+-- Example/test:
+testCollect1 = collect fst [(1,'a'),(2,'b'),(1,'c'),(1,'d'),(2,'d'),(3,'d')]
+testCollect2 = testCollect1
+                == [ (1,[(1,'a'),(1,'c'),(1,'d')])
+                   , (2,[(2,'b'),(2,'d')])
+                   , (3,[(3,'d')])
+                   ]
+
+-- |Add new values to an existing list of collections.
+--  The list of collections is not extended, but each collection is
+--  augmented with a further list of values from the supplied list,
+--  each of which are related to the existing collection in some way.
+--
+--  [[[NOTE: the basic pattern of collect and collectMore is similar,
+--  and might be generalized into a common set of core functions.]]]
+--
+collectMore :: (Eq b) => (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]
+collectMore = collectMoreBy (==)
+
+collectMoreBy ::
+    (b->b->Bool) -> (a->b) -> [a] -> [(b,c)] -> [(b,(c,[a]))]
+collectMoreBy cmp sel as cols =
+    map reverseMoreCollection $
+    collectMoreBy1 cmp sel as (map (\ (b,cs) -> (b,(cs,[])) ) cols)
+
+collectMoreBy1 ::
+    (b->b->Bool) -> (a->b) -> [a] -> [(b,(c,[a]))] -> [(b,(c,[a]))]
+collectMoreBy1 cmp sel []     cols = cols
+collectMoreBy1 cmp sel (a:as) cols =
+    collectMoreBy1 cmp sel as (collectMoreBy2 cmp sel a cols)
+
+collectMoreBy2 ::
+    (b->b->Bool) -> (a->b) -> a -> [(b,(c,[a]))] -> [(b,(c,[a]))]
+collectMoreBy2 cmp sel a [] = []
+collectMoreBy2 cmp sel a (col@(k,(b,as)):cols)
+    | cmp (sel a) k = (k,(b,a:as)):cols
+    | otherwise     = col:collectMoreBy2 cmp sel a cols
+
+reverseMoreCollection :: (b,(c,[a])) -> (b,(c,[a]))
+reverseMoreCollection (k,(c,as)) = (k,(c,reverse as))
+
+-- Example/test:
+testCollectMore1 =
+    collectMore snd [(111,1),(112,1),(211,2),(311,3),(411,4)] testCollect1
+testCollectMore2 = testCollectMore1
+                == [ (1,([(1,'a'),(1,'c'),(1,'d')],[(111,1),(112,1)]))
+                   , (2,([(2,'b'),(2,'d')],[(211,2)]))
+                   , (3,([(3,'d')],[(311,3)]))
+                   ]
+
+-- |Remove supplied element from a list using the supplied test
+--  function, and return Just the element remoived and the
+--  remaining list, or Nothing if no element was matched for removal.
+--
+remove :: (Eq a) => a -> [a] -> Maybe (a,[a])
+remove = removeBy (==)
+
+removeBy :: (b->a->Bool) -> b -> [a] -> Maybe (a,[a])
+removeBy cmp a0 as = removeBy1 cmp a0 as []
+
+removeBy1 :: (b->a->Bool) -> b -> [a] -> [a] -> Maybe (a,[a])
+removeBy1 _   _  []     _     = Nothing
+removeBy1 cmp a0 (a:as) sofar
+    | cmp a0 a  = Just (a,reverseTo sofar as)
+    | otherwise = removeBy1 cmp a0 as (a:sofar)
+
+testRemove1  = remove 3 [1,2,3,4,5]
+testRemove2  = testRemove1 == Just (3,[1,2,4,5])
+testRemove3  = remove 3 [1,2,4,5]
+testRemove4  = testRemove3 == Nothing
+testRemove5  = remove 5 [1,2,4,5]
+testRemove6  = testRemove5 == Just (5,[1,2,4])
+testRemove7  = remove 1 [1,2,4]
+testRemove8  = testRemove7 == Just (1,[2,4])
+testRemove9  = remove 2 [2]
+testRemove10 = testRemove9 == Just (2,[])
+
+-- |Reverse first argument, prepending the result to the second argument
+--
+reverseTo :: [a] -> [a] -> [a]
+reverseTo []        back = back
+reverseTo (a:front) back = reverseTo front (a:back)
+
+-- |Remove each element from a list, returning a list of pairs,
+--  each of which is the element removed and the list remaining.
+--
+removeEach :: [a] -> [(a,[a])]
+removeEach [] = []
+removeEach (a:as) = (a,as):[ (a1,a:a1s) | (a1,a1s) <- removeEach as ]
+
+testRemoveEach1 = removeEach [1,2,3,4,5]
+testRemoveEach2 = testRemoveEach1 ==
+    [ (1,[2,3,4,5])
+    , (2,[1,3,4,5])
+    , (3,[1,2,4,5])
+    , (4,[1,2,3,5])
+    , (5,[1,2,3,4])
+    ]
+
+-- |List differences between the members of two lists, where corresponding
+--  elements may appear at arbitrary locations in the corresponding lists.
+--
+--  Elements are compared using the function 'cmp', which returns:
+--  * Nothing  if the elements are completely unrelated
+--  * Just []  if the elements are identical
+--  * Just ds  if the elements are related but not identical, in which case
+--             ds is a list of values describing differences between them.
+--
+--  Returns (ds,u1,u2), where:
+--  ds is null if the related elements from each list are identical,
+--  otherwise is a list of differences between the related elements.
+--  u1 is a list of elements in a1 not related to elements in a2.
+--  u2 is a list of elements in a2 not related to elements in a1.
+--
+listDifferences :: (a->a->Maybe [d]) -> [a] -> [a] -> ([d],[a],[a])
+listDifferences cmp []       a2s = ([],[],a2s)
+listDifferences cmp (a1:a1t) a2s =
+    case mcomp of
+        Nothing       -> morediffs [] [a1] a1t a2s
+        Just (ds,a2t) -> morediffs ds []   a1t a2t
+    where
+        -- mcomp finds identical match, if there is one, or
+        -- the first element in a2s related to a1, or Nothing
+        -- [choose was listToMaybe,
+        --  but that didn't handle repeated properties well]
+        mcomp = choose $ catMaybes $ map maybeResult comps
+        comps = [ (cmp a1 a2,a2t) | (a2,a2t) <- removeEach a2s ]
+        maybeResult (Nothing,_)   = Nothing
+        maybeResult (Just ds,a2t) = Just (ds,a2t)
+        morediffs ds a1h a1t a2t  = (ds++ds1,a1h++a1r,a2r)
+            where
+                (ds1,a1r,a2r) = listDifferences cmp a1t a2t
+        choose  []       = Nothing
+        choose  ds@(d:_) = choose1 d ds
+        choose1 _ (d@([],dr):_) = Just d
+        choose1 d []            = Just d
+        choose1 d (_:ds)        = choose1 d ds
+
+testcmp (l1,h1) (l2,h2)
+    | (l1 >= h2) || (l2 >= h1) = Nothing
+    | (l1 == l2) && (h1 == h2) = Just []
+    | otherwise                = Just [((l1,h1),(l2,h2))]
+
+testdiff1 = listDifferences testcmp
+                [(12,15),(1,2),(3,4),(5,8),(10,11)]
+                [(10,11),(0,1),(3,4),(6,9),(13,15)]
+testdiff2 = testdiff1 == ([((12,15),(13,15)),((5,8),(6,9))],[(1,2)],[(0,1)])
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/GraphPartition.hs,v $
+-- $Author: graham $
+-- $Revision: 1.3 $
+-- $Log: GraphPartition.hs,v $
+-- Revision 1.3  2004/02/11 14:19:36  graham
+-- Add graph-difference option to Swish
+--
+-- Revision 1.2  2004/02/10 20:24:48  graham
+-- Graph difference code now works.
+--
+-- Revision 1.1  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.

+ Swish/HaskellRDF/GraphPartitionTest.hs view
@@ -0,0 +1,527 @@+--------------------------------------------------------------------------------
+--  $Id: GraphPartitionTest.hs,v 1.2 2004/02/10 20:24:48 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  GraphPartitionTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test cases for graph partitioning logic.
+--
+--------------------------------------------------------------------------------
+
+--module Swish.HaskellRDF.GraphPartitionTest where
+-- module Main(main) where -- WNH++
+import Swish.HaskellRDF.GraphPartition
+    ( PartitionedGraph(..), getArcs
+    , GraphPartition(..), node, toArcs
+    , partitionGraph, comparePartitions
+    )
+
+import Swish.HaskellRDF.GraphClass
+    ( Label(..)
+    , Arc(..), arcSubj, arcPred, arcObj, arc, arcToTriple, arcFromTriple
+    -- , hasLabel, arcLabels
+    )
+
+import Swish.HaskellRDF.GraphMem
+    -- ( GraphMem(..)
+    -- , setArcs, getArcs, add, delete, extract, labels
+    ( LabelMem(..)
+    , labelIsVar, labelHash
+    )
+
+import Swish.HaskellUtils.TestHelpers
+    ( test, testEq, 
+    --     WNH FIX testNe, 
+    testLe, testGe, testElem
+    , testJust, testNothing
+    , testEqv, 
+    --   WNH FIXtestNotEqv, 
+    testEqv2, testHasEqv, testMaybeEqv
+    )
++import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , Assertion
+    , assertBool, assertEqual, assertString, assertFailure
+    , runTestTT, runTestText, putTextToHandle
+    )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    )
+
+import Control.Monad
+    ( unless )
+
+import Data.List
+    ( sort, union, intersect )
+
+import Data.Maybe
+    ( isJust, fromJust, fromMaybe )
+
+------------------------------------------------------------
+--  Basic GraphPartition tests
+------------------------------------------------------------
+
+gp1 = PartitionedGraph [ p11 ]
+gp2 = PartitionedGraph [ p11, p12 ]
+gp3 = PartitionedGraph [ p11, p13 ]
+gp4 = PartitionedGraph [ p11, p14 ]
+gp5 = PartitionedGraph [ p11, p12, p15 ]
+
+p11 = PartSub (LF "s1") [ (LF "p11",PartObj (LF "o11")) ]
+p12 = PartSub (LF "s2") [ (LF "p21",PartObj (LF "o21"))
+                        , (LF "p22",PartObj (LF "o22"))
+                        ]
+p13 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))
+                        , (LF "p32",p12)
+                        , (LF "p33",PartObj (LF "s3"))
+                        ]
+p14 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))
+                        , (LF "p33",PartObj (LF "s3"))
+                        , (LF "p32",p12)
+                        ]
+p15 = PartSub (LF "s3") [ (LF "p31",PartObj (LF "o31"))
+                        , (LF "p32",PartObj (LF "s2"))
+                        , (LF "p33",PartObj (LF "s3"))
+                        ]
+
+ga1 =
+    [ Arc (LF "s1") (LF "p11") (LF "o11")
+    ]
+
+ga2 =
+    [ Arc (LF "s1") (LF "p11") (LF "o11")
+    , Arc (LF "s2") (LF "p21") (LF "o21")
+    , Arc (LF "s2") (LF "p22") (LF "o22")
+    ]
+
+ga3 =
+    [ Arc (LF "s1") (LF "p11") (LF "o11")
+    , Arc (LF "s3") (LF "p31") (LF "o31")
+    , Arc (LF "s3") (LF "p32") (LF "s2")
+    , Arc (LF "s2") (LF "p21") (LF "o21")
+    , Arc (LF "s2") (LF "p22") (LF "o22")
+    , Arc (LF "s3") (LF "p33") (LF "s3")
+    ]
+ga4 =
+    [ Arc (LF "s1") (LF "p11") (LF "o11")
+    , Arc (LF "s3") (LF "p31") (LF "o31")
+    , Arc (LF "s3") (LF "p33") (LF "s3")
+    , Arc (LF "s3") (LF "p32") (LF "s2")
+    , Arc (LF "s2") (LF "p21") (LF "o21")
+    , Arc (LF "s2") (LF "p22") (LF "o22")
+    ]
+ga5 =
+    [ Arc (LF "s1") (LF "p11") (LF "o11")
+    , Arc (LF "s2") (LF "p21") (LF "o21")
+    , Arc (LF "s2") (LF "p22") (LF "o22")
+    , Arc (LF "s3") (LF "p31") (LF "o31")
+    , Arc (LF "s3") (LF "p32") (LF "s2")
+    , Arc (LF "s3") (LF "p33") (LF "s3")
+    ]
+
+testBasic01 = testEq "testBasic01" gp1 gp1
+testBasic02 = testEq "testBasic02" gp2 gp2
+testBasic03 = testEq "testBasic03" gp3 gp3
+testBasic04 = testEq "testBasic04" gp4 gp4
+testBasic05 = testEq "testBasic05" gp5 gp5
+{-     WNH FIX 
+testBasic06 = testNe "testBasic06" gp2 gp3
+testBasic07 = testNe "testBasic07" gp3 gp4
+-}
+
+testBasic11 = testEq "testBasic11"
+        "PartitionedGraph [(!s1 !p11 !o11)]"
+        (show gp1)
+testBasic12 = testEq "testBasic12"
+        ( "PartitionedGraph "++
+          "[(!s1 !p11 !o11)"++
+          ",(!s2 !p21 !o21 ; !p22 !o22)"++
+          "]"
+        )
+        (show gp2)
+testBasic13 = testEq "testBasic13"
+        ( "PartitionedGraph "++
+          "[(!s1 !p11 !o11)"++
+          ",(!s3 !p31 !o31 ; !p32 (!s2 !p21 !o21 ; !p22 !o22) ; !p33 !s3)"++
+          "]"
+        )
+        (show gp3)
+testBasic14 = testEq "testBasic14"
+        ( "PartitionedGraph "++
+          "[(!s1 !p11 !o11)"++
+          ",(!s3 !p31 !o31 ; !p33 !s3 ; !p32 (!s2 !p21 !o21 ; !p22 !o22))"++
+          "]"
+        )
+        (show gp4)
+testBasic15 = testEq "testBasic15"
+        ( "PartitionedGraph "++
+          "[(!s1 !p11 !o11)"++
+          ",(!s2 !p21 !o21 ; !p22 !o22)"++
+          ",(!s3 !p31 !o31 ; !p32 !s2 ; !p33 !s3)"++
+          "]"
+        )
+        (show gp5)
+
+testBasic21 = testEq "testBasic21" (LF "s1") (node p11)
+testBasic22 = testEq "testBasic22" (LF "s2") (node p12)
+testBasic23 = testEq "testBasic23" (LF "s3") (node p13)
+testBasic24 = testEq "testBasic24" (LF "s3") (node p14)
+testBasic25 = testEq "testBasic25" (LF "s3") (node p15)
+
+testBasic31 = testEq "testBasic31" ga1 (getArcs gp1)
+testBasic32 = testEq "testBasic32" ga2 (getArcs gp2)
+testBasic33 = testEq "testBasic33" ga3 (getArcs gp3)
+testBasic34 = testEq "testBasic34" ga4 (getArcs gp4)
+testBasic35 = testEq "testBasic35" ga5 (getArcs gp5)
+--     WNH FIX testBasic36 = testNotEqv "testBasic36" (getArcs gp2) (getArcs gp3)
+testBasic37 = testEqv    "testBasic37" (getArcs gp3) (getArcs gp4)
+testBasic38 = testEqv    "testBasic38" (getArcs gp3) (getArcs gp5)
+
+testBasicSuite = TestList
+    [ testBasic01
+    , testBasic02
+    , testBasic03
+    , testBasic04
+    , testBasic05
+    --   WNH FIX, testBasic06
+    --   WNH FIX, testBasic07
+    , testBasic11
+    , testBasic12
+    , testBasic13
+    , testBasic14
+    , testBasic15
+    , testBasic21
+    , testBasic22
+    , testBasic23
+    , testBasic24
+    , testBasic25
+    , testBasic31
+    , testBasic32
+    , testBasic33
+    , testBasic34
+    , testBasic35
+    -- WNH FIX, testBasic36
+    , testBasic37
+    , testBasic38
+    ]
+
+------------------------------------------------------------
+--  Creating GraphPartition tests
+------------------------------------------------------------
+
+pa1 =
+    [ Arc (LF "s1") (LF "p") (LF "o11")
+    ]
+
+pa2 =
+    [ Arc (LF "s1") (LF "p") (LF "o11")
+    , Arc (LF "s2") (LF "p1") (LF "o21")
+    , Arc (LF "s2") (LF "p2") (LF "o22")
+    ]
+
+pa3 =
+    [ Arc (LF "s1") (LF "p") (LF "o11")
+    , Arc (LF "s2") (LF "p1") (LF "o21")
+    , Arc (LF "s2") (LF "p2") (LF "o22")
+    , Arc (LV "b3") (LF "p") (LF "o31")
+    , Arc (LV "b3") (LF "p") (LF "s2")
+    , Arc (LV "b3") (LF "p") (LV "b3")
+    ]
+
+pa4 =
+    [ Arc (LF "s1") (LF "p") (LF "o11")
+    , Arc (LF "s2") (LF "p1") (LF "o21")
+    , Arc (LF "s2") (LF "p2") (LF "o22")
+    , Arc (LV "b3") (LF "p") (LF "o31")
+    , Arc (LV "b3") (LF "p") (LF "s2")
+    , Arc (LV "b3") (LF "p") (LV "b3")
+    , Arc (LV "b3") (LF "p") (LV "b4")
+    , Arc (LV "b4") (LF "p") (LF "s2")
+    , Arc (LV "b4") (LF "p") (LV "b3")
+    ]
+
+pa5 =
+    [ Arc (LF "s1") (LF "p") (LF "o11")
+    , Arc (LF "s2") (LF "p1") (LF "o21")
+    , Arc (LF "s2") (LF "p2") (LF "o22")
+    , Arc (LV "b3") (LF "p") (LF "o31")
+    , Arc (LV "b3") (LF "p") (LF "s2")
+    , Arc (LV "b3") (LF "p") (LV "b3")
+    , Arc (LV "b3") (LF "p") (LV "b4")
+    , Arc (LV "b4") (LF "p") (LF "s2")
+    , Arc (LV "b4") (LF "p") (LV "b3")
+    , Arc (LV "b5a") (LF "p") (LV "b5b")
+    , Arc (LV "b5b") (LF "p") (LV "b5c")
+    , Arc (LV "b5c") (LF "p") (LV "b5a")
+    ]
+
+pa6 =
+    [ Arc (LF "s1") (LF "p") (LF "o11")
+    , Arc (LF "s2") (LF "p1") (LF "o21")
+    , Arc (LF "s2") (LF "p2") (LF "o22")
+    , Arc (LV "b3") (LF "p") (LF "o31")
+    , Arc (LV "b3") (LF "p") (LF "s2")
+    , Arc (LV "b3") (LF "p") (LV "b3")
+    , Arc (LV "b3") (LF "p") (LV "b4")
+    , Arc (LV "b4") (LF "p") (LF "s2")
+    , Arc (LV "b4") (LF "p") (LV "b3")
+    , Arc (LV "b4") (LF "p") (LV "b5b")
+    , Arc (LV "b5a") (LF "p") (LV "b5b")
+    , Arc (LV "b5b") (LF "p") (LV "b5c")
+    , Arc (LV "b5c") (LF "p") (LV "b5a")
+    ]
+
+pp1  = PartitionedGraph [ ps1 ]
+pp2f = PartitionedGraph [ ps1,  ps2f ]
+pp2r = PartitionedGraph [ ps2r, ps1 ]
+pp3f = PartitionedGraph [ ps1,  ps2f, pb3f ]
+pp3r = PartitionedGraph [ ps2r, ps1,  pb3r ]
+pp4f = PartitionedGraph [ ps1,  ps2f, pb3af ]
+pp4r = PartitionedGraph [ ps2r, ps1,  pb3ar ]
+pp5f = PartitionedGraph [ ps1,  ps2f, pb3af, pb5a1 ]
+pp5r = PartitionedGraph [ ps2r, ps1,  pb3ar, pb5c3 ]
+pp6f = PartitionedGraph [ ps1,  ps2f, pb3bf, pb5b2 ]
+pp6r = PartitionedGraph [ ps2r, ps1,  pb5b2, pb3br ]
+
+ps1  = PartSub (LF "s1") [ (LF "p",PartObj (LF "o11")) ]
+ps2f = PartSub (LF "s2") [ (LF "p1",PartObj (LF "o21"))
+                         , (LF "p2",PartObj (LF "o22"))
+                         ]
+ps2r = PartSub (LF "s2") [ (LF "p2",PartObj (LF "o22"))
+                         , (LF "p1",PartObj (LF "o21"))
+                         ]
+pb3f = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))
+                         , (LF "p",PartObj (LF "s2"))
+                         , (LF "p",PartObj (LV "b3"))
+                         ]
+pb3r = PartSub (LV "b3") [ (LF "p",PartObj (LV "b3"))
+                         , (LF "p",PartObj (LF "s2"))
+                         , (LF "p",PartObj (LF "o31"))
+                         ]
+
+pb3af = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))
+                          , (LF "p",PartObj (LF "s2"))
+                          , (LF "p",PartObj (LV "b3"))
+                          , (LF "p",pb4af)
+                          ]
+pb3ar = PartSub (LV "b3") [ (LF "p",pb4ar)
+                          , (LF "p",PartObj (LV "b3"))
+                          , (LF "p",PartObj (LF "s2"))
+                          , (LF "p",PartObj (LF "o31"))
+                          ]
+pb4af = PartSub (LV "b4") [ (LF "p",PartObj (LF "s2"))
+                          , (LF "p",PartObj (LV "b3"))
+                          ]
+pb4ar = PartSub (LV "b4") [ (LF "p",PartObj (LV "b3"))
+                          , (LF "p",PartObj (LF "s2"))
+                          ]
+pb5a1 = PartSub (LV "b5a") [ (LF "p",pb5b1) ]
+pb5b1 = PartSub (LV "b5b") [ (LF "p",pb5c1) ]
+pb5c1 = PartSub (LV "b5c") [ (LF "p",PartObj (LV "b5a")) ]
+
+pb3bf = PartSub (LV "b3") [ (LF "p",PartObj (LF "o31"))
+                          , (LF "p",PartObj (LF "s2"))
+                          , (LF "p",PartObj (LV "b3"))
+                          , (LF "p",pb4bf)
+                          ]
+pb3br = PartSub (LV "b3") [ (LF "p",pb4br)
+                          , (LF "p",PartObj (LV "b3"))
+                          , (LF "p",PartObj (LF "s2"))
+                          , (LF "p",PartObj (LF "o31"))
+                          ]
+pb4bf = PartSub (LV "b4") [ (LF "p",PartObj (LF "s2"))
+                          , (LF "p",PartObj (LV "b3"))
+                          , (LF "p",PartObj (LV "b5b"))
+                          ]
+pb4br = PartSub (LV "b4") [ (LF "p",PartObj (LV "b5b"))
+                          , (LF "p",PartObj (LV "b3"))
+                          , (LF "p",PartObj (LF "s2"))
+                          ]
+pb5a2 = PartSub (LV "b5a") [ (LF "p",PartObj (LV "b5b")) ]
+pb5b2 = PartSub (LV "b5b") [ (LF "p",pb5c2) ]
+pb5c2 = PartSub (LV "b5c") [ (LF "p",pb5a2) ]
+
+pb5a3 = PartSub (LV "b5a") [ (LF "p",pb5b3) ]
+pb5b3 = PartSub (LV "b5b") [ (LF "p",PartObj (LV "b5c")) ]
+pb5c3 = PartSub (LV "b5c") [ (LF "p",pb5a3) ]
+
+testPartition11 = testEq "testPartition11" pp1  (partitionGraph pa1)
+testPartition12 = testEq "testPartition12" pp2f (partitionGraph pa2)
+testPartition13 = testEq "testPartition13" pp3f (partitionGraph pa3)
+testPartition14 = testEq "testPartition15" pp4f (partitionGraph pa4)
+testPartition15 = testEq "testPartition14" pp5f (partitionGraph pa5)
+testPartition16 = testEq "testPartition16" pp6f (partitionGraph pa6)
+
+testPartition21 = testEq "testPartition21" pp1  (partitionGraph $ reverse pa1)
+testPartition22 = testEq "testPartition22" pp2r (partitionGraph $ reverse pa2)
+testPartition23 = testEq "testPartition23" pp3r (partitionGraph $ reverse pa3)
+testPartition24 = testEq "testPartition24" pp4r (partitionGraph $ reverse pa4)
+testPartition25 = testEq "testPartition25" pp5r (partitionGraph $ reverse pa5)
+testPartition26 = testEq "testPartition26" pp6r (partitionGraph $ reverse pa6)
+
+testPartition31 = testEqv "testPartition31" pa1  (getArcs pp1)
+testPartition32 = testEqv "testPartition32" pa2  (getArcs pp2f)
+testPartition33 = testEqv "testPartition33" pa3  (getArcs pp3f)
+testPartition34 = testEqv "testPartition35" pa4  (getArcs pp4f)
+testPartition35 = testEqv "testPartition34" pa5  (getArcs pp5f)
+testPartition36 = testEqv "testPartition36" pa6  (getArcs pp6f)
+
+testPartition41 = testEqv "testPartition41" pa1  (getArcs pp1 )
+testPartition42 = testEqv "testPartition42" pa2  (getArcs pp2r)
+testPartition43 = testEqv "testPartition43" pa3  (getArcs pp3r)
+testPartition44 = testEqv "testPartition44" pa4  (getArcs pp4r)
+testPartition45 = testEqv "testPartition45" pa5  (getArcs pp5r)
+testPartition46 = testEqv "testPartition46" pa6  (getArcs pp6r)
+
+testPartition51 = testEqv "testPartition51" []   (comparePartitions pp1  pp1)
+testPartition52 = testEqv "testPartition52" []   (comparePartitions pp2f pp2r)
+testPartition53 = testEqv "testPartition53" []   (comparePartitions pp3f pp3r)
+testPartition54 = testEqv "testPartition54" []   (comparePartitions pp4f pp4r)
+testPartition55 = testEqv "testPartition55" []   (comparePartitions pp5f pp5r)
+testPartition56 = testEqv "testPartition56" []   (comparePartitions pp6f pp6r)
+testPartition57 = testEqv "testPartition57"
+        [(Nothing,Just $ PartSub (LV "b3") [(LF "p",pb4af)])]
+        (comparePartitions pp3f pp4f)
+testPartition58 = testEqv "testPartition58"
+        [(Nothing,Just pb5a1)]
+        (comparePartitions pp4f pp5f)
+testPartition59 = testEqv "testPartition59"
+        [(Nothing,Just $ PartSub (LV "b4") [(LF "p",PartObj (LV "b5b"))])]
+        (comparePartitions pp5f pp6f)
+
+testPartitionSuite = TestList
+    [ testPartition11
+    , testPartition12
+    , testPartition13
+    , testPartition14
+    , testPartition15
+    , testPartition16
+    , testPartition21
+    , testPartition22
+    , testPartition23
+    , testPartition24
+    , testPartition25
+    , testPartition26
+    , testPartition31
+    , testPartition32
+    , testPartition33
+    , testPartition34
+    , testPartition35
+    , testPartition36
+    , testPartition41
+    , testPartition42
+    , testPartition43
+    , testPartition44
+    , testPartition45
+    , testPartition46
+    , testPartition51
+    , testPartition52
+    , testPartition53
+    , testPartition54
+    , testPartition55
+    , testPartition56
+    , testPartition57
+    , testPartition58
+    , testPartition59
+    ]
+
+
+------------------------------------------------------------
+--  GraphPartition compare test with partial matching
+------------------------------------------------------------
+
+pgc1a = PartitionedGraph [ c11, c12a ]
+pgc1b = PartitionedGraph [ c11, c12b ]
+
+c11  = PartSub (LF "s1") [ (LF "p11",PartObj (LF "o11")) ]
+c12a = PartSub (LF "s2") [ (LF "p21",c13a)
+                         , (LF "p22",PartObj (LF "o22"))
+                         ]
+c12b = PartSub (LF "s2") [ (LF "p22",PartObj (LF "o22"))
+                         , (LF "p21",c13b)
+                         ]
+c13a = PartSub (LV "b3") [ (LF "p31",PartObj (LF "o31"))
+                         , (LF "p33",PartObj (LF "o33a"))
+                         ]
+c13b = PartSub (LV "b3") [ (LF "p31",PartObj (LF "o31"))
+                         , (LF "p33",PartObj (LF "o33b"))
+                         ]
+testCompare01 = testEqv "testCompare01"
+        [(Just (PartObj (LF "o33a")),Just (PartObj (LF "o33b")))]
+        (comparePartitions pgc1a pgc1b)
+
+
+testCompareSuite = TestList
+    [ testCompare01
+    ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+    [ testBasicSuite
+    , testPartitionSuite
+    , testCompareSuite
+    ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/GraphPartitionTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: GraphPartitionTest.hs,v $
+-- Revision 1.2  2004/02/10 20:24:48  graham
+-- Graph difference code now works.
+--
+-- Revision 1.1  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.

+ Swish/HaskellRDF/GraphTest.hs view
@@ -0,0 +1,1730 @@+--------------------------------------------------------------------------------
+--  $Id: GraphTest.hs,v 1.24 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  GraphTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + multi-parameter classes
+--
+--  This module defines test cases for module Graph.
+--
+--------------------------------------------------------------------------------
+
+
+-- WNH module Swish.HaskellRDF.GraphTest where
+
+import System.IO
+      ( Handle, IOMode(WriteMode),
+        openFile, hClose, hPutStr, hPutStrLn )
+import Test.HUnit
+      ( Test(TestCase,TestList,TestLabel),
+        assertEqual, runTestTT, runTestText, putTextToHandle )
+import Data.List( elemIndex )
+import Data.Maybe( fromJust )
+
+import Swish.HaskellUtils.ListHelpers
+import Swish.HaskellUtils.MiscHelpers
+import Swish.HaskellRDF.GraphClass (Arc(..),Label(..),arcFromTriple,arcToTriple)
+import Swish.HaskellRDF.GraphMem
+import Swish.HaskellRDF.GraphMatch
+      ( graphMatch,
+        -- The rest exported for testing only
+        LabelMap(..), GenLabelMap(..), LabelEntry(..), GenLabelEntry(..),
+        ScopedLabel(..), makeScopedLabel, makeScopedArc,
+        LabelIndex, EquivalenceClass, nullLabelVal, emptyMap,
+        labelIsVar, labelHash,
+        mapLabelIndex, {-mapLabelList,-} setLabelHash, newLabelMap,
+        graphLabels, assignLabelMap, newGenerationMap,
+        graphMatch1, graphMatch2, equivalenceClasses, reclassify
+      )
+import Swish.HaskellUtils.LookupMap
+      ( LookupEntryClass(..), LookupMap(..), makeLookupMap
+      , mapSortByKey, mapSortByVal
+      )
+
+default ( Int )
+
+------------------------------------------------------------
+-- Define some common values
+------------------------------------------------------------
+
+base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
+base2 = "http://id.ninebynine.org/wip/2003/test/graph2/node/"
+base3 = "http://id.ninebynine.org/wip/2003/test/graph3/node"
+base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+
+------------------------------------------------------------
+--  Set, get graph arcs as lists of triples
+------------------------------------------------------------
+
+setArcsT a = setArcs $ map arcFromTriple a
+getArcsT g = map arcToTriple $ getArcs g
+
+toStatement s p o = Arc s p o
+
+------------------------------------------------------------
+--  Test class helper
+------------------------------------------------------------
+
+testeq :: (Show a, Eq a) => String -> a -> a -> Test
+testeq lab req got =
+    TestCase ( assertEqual ("test"++lab) req got )
+
+testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test
+testeqv lab req got =
+    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )
+
+------------------------------------------------------------
+--  Label map and entry creation helpers
+------------------------------------------------------------
+
+tstLabelMap :: (Label lb) => Int -> [(lb,LabelIndex)] -> LabelMap lb
+tstLabelMap gen lvs = LabelMap gen (makeLookupMap $ makeEntries lvs)
+
+makeEntries :: (Label lb) => [(lb,LabelIndex)] -> [LabelEntry lb]
+makeEntries lvs = map newEntry lvs
+
+labelMapSortByVal :: (Label lb) => LabelMap lb -> LabelMap lb
+labelMapSortByVal (LabelMap gen lmap) = LabelMap gen (mapSortByVal lmap)
+
+------------------------------------------------------------
+--  Graph helper function tests
+------------------------------------------------------------
+
+-- select
+
+testSelect :: String -> [Char] -> [Char] -> Test
+testSelect lab l1 l2 = testeq ("Select"++lab ) l1 l2
+
+testSelect01 = testSelect "01"
+                (select (1==) [0,1,2,0,1,2] ['a','b','c','a','b','c'])
+                ['b','b']
+testSelect02 = testSelect "02"
+                (select (1==) [1,1,1,1,1,1] ['a','b','c','a','b','c'])
+                ['a','b','c','a','b','c']
+testSelect03 = testSelect "03"
+                (select (1==) [0,0,0,0,0,0] ['a','b','c','a','b','c'])
+                []
+testSelect04 = testSelect "04"
+                (select (1==) []            []                       )
+                []
+
+testSelectSuite = TestList
+    [
+    testSelect01, testSelect02, testSelect03, testSelect04
+    ]
+
+-- mapset
+
+mf   :: Int -> Char
+mf n = "_abcde" !! n
+
+testMapset :: String -> [Int] -> [Char] -> Test
+testMapset lab l1 l2 = testeq ("Mapset"++lab ) l2 (mapset mf l1)
+
+testMapset01 = testMapset "01" [0,1,2,3,4,5] ['_','a','b','c','d','e']
+testMapset02 = testMapset "02" [1,1,3,3,5,5] ['a','c','e']
+testMapset03 = testMapset "03" [5,4,3,2,1,0] ['e','d','c','b','a','_']
+testMapset04 = testMapset "04" []            []
+testMapset05 = testMapset "05" [1,2,3,4,5,0] ['a','b','c','d','e','_']
+
+testMapsetSuite = TestList
+    [
+    testMapset01, testMapset02, testMapset03, testMapset04,
+    testMapset05
+    ]
+
+-- subset
+
+testSubset :: String -> Bool -> [Int] -> [Int] -> Test
+testSubset lab res l1 l2 = testeq ("Mapset"++lab ) res (l1 `subset` l2)
+
+testSubset01 = testSubset "01" True  [1,2,3]       [0,1,2,3,4,5]
+testSubset02 = testSubset "02" True  [5,3,1]       [0,1,2,3,4,5]
+testSubset03 = testSubset "03" True  [5,4,3,2,1,0] [0,1,2,3,4,5]
+testSubset04 = testSubset "04" True  []            []
+testSubset05 = testSubset "05" False [0,1,2,3,4,5] [1,2,3]
+testSubset06 = testSubset "06" False [0,1,2,3,4,5] [5,3,1]
+testSubset07 = testSubset "07" True  []            [1,2,3]
+testSubset08 = testSubset "08" False [1,2,3]       []
+
+testSubsetSuite = TestList
+    [
+    testSubset01, testSubset02, testSubset03, testSubset04,
+    testSubset05, testSubset06, testSubset07, testSubset08
+    ]
+
+-- hash
+
+testHash :: String -> Bool -> Int -> Int -> Test
+testHash lab eq h1 h2 = testeq ("Hash"++lab ) eq (h1 == h2)
+testHashEq lab h1 h2  = testeq ("Hash"++lab ) h1 h2
+
+testHash01 = testHash "01" True  (hash 0 base1) (hash 0 base1)
+testHash02 = testHash "02" True  (hash 2 "")    (hash 2 "")
+testHash03 = testHash "03" False (hash 3 base1) (hash 3 base2)
+testHash04 = testHash "04" False (hash 4 base1) (hash 5 base1)
+testHash05 = testHash "05" False (hash 2 "")    (hash 3 "")
+testHash06 = testHashEq "06"     1424775        (hash 3 base1)
+testHash07 = testHashEq "07"     11801303       (hash 3 base2)
+
+testHashSuite = TestList
+    [
+    testHash01, testHash02, testHash03, testHash04,
+    testHash05, testHash06, testHash07
+    ]
+
+------------------------------------------------------------
+--  Simple graph label tests
+------------------------------------------------------------
+
+testLab01 = testeq "Lab01" False (labelIsVar lab1f)
+testLab02 = testeq "Lab02" True  (labelIsVar lab1v)
+testLab03 = testeq "Lab03" False (labelIsVar lab2f)
+testLab04 = testeq "Lab04" True  (labelIsVar lab2v)
+
+testLab05 = testeq "Lab05"  3436883 (labelHash 1 lab1f)
+testLab06 = testeq "Lab06" 10955600 (labelHash 1 lab1v)
+testLab07 = testeq "Lab07"  3436884 (labelHash 1 lab2f)
+testLab08 = testeq "Lab08" 10955601 (labelHash 1 lab2v)
+
+testLab09 = testeq "Lab09" "!lab1" (show lab1f)
+testLab10 = testeq "Lab10" "?lab1" (show lab1v)
+testLab11 = testeq "Lab11" "!lab2" (show lab2f)
+testLab12 = testeq "Lab12" "?lab2" (show lab2v)
+
+testLab13 = testeq "Lab13" "lab1" (getLocal lab1v)
+testLab14 = testeq "Lab14" "lab2" (getLocal lab2v)
+testLab15 = testeq "Lab15" lab1v  (makeLabel "lab1")
+testLab16 = testeq "Lab16" lab2v  (makeLabel "lab2")
+
+testLabSuite = TestList
+    [
+    testLab01, testLab02, testLab03, testLab04,
+    testLab05, testLab06, testLab07, testLab08,
+    testLab09, testLab10, testLab11, testLab12,
+    testLab13, testLab14, testLab15, testLab16
+    ]
+
+------------------------------------------------------------
+--  Simple graph tests
+------------------------------------------------------------
+
+lab1f = LF "lab1"
+lab1v = LV "lab1"
+lab2f = LF "lab2"
+lab2v = LV "lab2"
+
+gr1 = GraphMem { arcs=[]::[Arc LabelMem] }
+ga1 =
+    [
+    (lab1f,lab1f,lab1f),
+    (lab1v,lab1v,lab1v),
+    (lab2f,lab2f,lab2f),
+    (lab2v,lab2v,lab2v),
+    (lab1f,lab1f,lab1v),
+    (lab1f,lab1f,lab2f),
+    (lab1f,lab1f,lab2v),
+    (lab1v,lab1v,lab1f),
+    (lab1v,lab1v,lab2f),
+    (lab1v,lab1v,lab2v),
+    (lab1f,lab1v,lab2f),
+    (lab1f,lab1v,lab2v),
+    (lab1v,lab2f,lab2v)
+    ]
+
+gs4 (Arc _ _ (LV "lab2")) = True
+gs4 (Arc _ _  _         ) = False
+ga4 =
+    [
+    (lab2v,lab2v,lab2v),
+    (lab1f,lab1f,lab2v),
+    (lab1v,lab1v,lab2v),
+    (lab1f,lab1v,lab2v),
+    (lab1v,lab2f,lab2v)
+    ]
+
+gr2 = GraphMem { arcs=[]::[Arc LabelMem] }
+ga2 =
+    [
+    (lab1f,lab1f,lab1f),
+    (lab1v,lab1v,lab1v),
+    (lab2f,lab2f,lab2f),
+    (lab2v,lab2v,lab2v)
+    ]
+
+gr3 = GraphMem { arcs=[]::[Arc LabelMem] }
+ga3 =
+    [
+    (lab1f,lab1f,lab1v),
+    (lab1f,lab1f,lab2f),
+    (lab1f,lab1f,lab2v),
+    (lab1v,lab1v,lab1f),
+    (lab1v,lab1v,lab2f),
+    (lab1v,lab1v,lab2v),
+    (lab1f,lab1v,lab2f),
+    (lab1f,lab1v,lab2v),
+    (lab1v,lab2f,lab2v)
+    ]
+
+gl4 = [lab1f,lab1v,lab2f,lab2v]
+
+
+gr1a = setArcsT ga1 gr1
+testGraph01 = testeq "Graph01" ga1 (getArcsT gr1a)
+
+gr2a = setArcsT ga2 gr2
+testGraph02 = testeq "Graph01" ga2 (getArcsT gr2a)
+
+gr3a = setArcsT ga3 gr3
+testGraph03 = testeq "Graph03" ga3 (getArcsT gr3a)
+
+gr4a = add gr2a gr3a
+testGraph04 = testeqv "Graph04" ga1 (getArcsT gr4a)
+
+gr4b = add gr3a gr2a
+testGraph05 = testeqv "Graph05" ga1 (getArcsT gr4b)
+
+gr4c = delete gr2a gr4a
+testGraph06 = testeqv "Graph06" ga3 (getArcsT gr4c)
+
+gr4d = delete gr3a gr4a
+testGraph07 = testeqv "Graph07" ga2 (getArcsT gr4d)
+
+gr4e = extract gs4 gr4a
+testGraph08 = testeqv "Graph08" ga4 (getArcsT gr4e)
+gr4ee = map gs4 (getArcs gr4a)
+
+gl4f = labels gr4a
+testGraph09 = testeqv "Graph09" gl4 gl4f
+
+gr4g = add gr2a gr4a
+testGraph10 = testeq "Graph10" ga1 (getArcsT gr4g)
+
+testGraphSuite = TestList
+    [
+    testGraph01, testGraph02, testGraph03, testGraph04,
+    testGraph05, testGraph06, testGraph07, testGraph08,
+    testGraph09, testGraph10
+    ]
+
+------------------------------------------------------------
+--
+------------------------------------------------------------
+
+------------------------------------------------------------
+-- Define some common values
+------------------------------------------------------------
+
+s1 = LF "s1"
+s2 = LF "s2"
+s3 = LF "s3"
+s4 = LF ""
+s5 = LV "s5"
+s6 = LF "basemore"
+s7 = LF ("base"++"more")
+s8 = LV "s8"
+
+b1 = LV "b1"
+b2 = LV "b2"
+b3 = LV "b3"
+b4 = LV "b4"
+
+p1 = LF "p1"
+p2 = LF "p2"
+p3 = LF "p3"
+p4 = LF "p4"
+
+o1 = LF "o1"
+o2 = LF "o2"
+o3 = LF "o3"
+o4 = LF ""
+o5 = LV "o5"
+o6 = LV "s5"
+
+l1  = LF "l1"
+l2  = LF "l2-en"
+l3  = LF "l2-fr"
+l4  = LF "l4-type1"
+l5  = LF "l4-type1"
+l6  = LF "l4-type1"
+l7  = LF "l4-type2"
+l8  = LF "l4-type2"
+l9  = LF "l4-type2"
+l10 = LF "l10-xml"
+l11 = LF "l10-xml-en"
+l12 = LF "l10-xml-fr"
+
+v1  = LV "v1"
+v2  = LV "v2"
+v3  = LV "v3"
+v4  = LV "v4"
+
+------------------------------------------------------------
+--  Label construction and equality tests
+------------------------------------------------------------
+
+testLabelEq :: String -> Bool -> LabelMem -> LabelMem -> Test
+testLabelEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
+
+nodelist =
+  [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5),
+    ("s6",s6), ("s7",s7), ("s8",s8),
+    ("o5",o5),
+    ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4),
+    ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4),
+    ("l1",l1), ("l2",l2), ("l3",l3), ("l4",l4), ("l5",l5),
+    ("l6",l6), ("l7",l7), ("l8",l8), ("l9",l9),
+    ("l10",l10), ("l11",l11), ("l12",l12),
+    ("v1",v1), ("v2",v2)
+  ]
+
+nodeeqlist =
+  [
+    ("s4","o4"),
+    ("s5","o6"),
+    ("s6","s7"),
+    ("l4","l5"),
+    ("l4","l6"),
+    ("l5","l6"),
+    ("l7","l8"),
+    ("l7","l9"),
+    ("l8","l9")
+  ]
+
+testLabelEqSuite = TestList
+  [ testLabelEq (testLab l1 l2) (testEq  l1 l2) n1 n2
+      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` nodeeqlist ||
+            (l2,l1) `elem` nodeeqlist
+
+
+------------------------------------------------------------
+--  Label ordering tests
+------------------------------------------------------------
+
+testLabelOrd :: String -> Ordering -> LabelMem -> LabelMem -> Test
+testLabelOrd lab order n1 n2 =
+    TestCase ( assertEqual ("testLabelOrd:"++lab) order (compare n1 n2) )
+
+nodeorder =
+  [
+    "o4",
+    "s4", "s6", "s7",
+    "l1", "l10", "l11", "l12", "l2", "l3", "l4", "l5", "l6", "l7", "l8", "l9",
+    "o1", "o2", "o3",
+    "p1", "p2", "p3", "p4",
+    "s1", "s2", "s3",
+    "b1", "b2", "b3", "b4",
+    "o5",
+    "s5", "s8",
+    "v1", "v2"
+  ]
+
+testLabelOrdSuite = TestList
+  [ testLabelOrd (testLab l1 l2) (testOrd l1 l2) n1 n2
+      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testOrd l1 l2
+      | testEq l1 l2  = EQ
+      | otherwise     = compare (fromJust $ elemIndex l1 nodeorder)
+                                (fromJust $ elemIndex l2 nodeorder)
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` nodeeqlist ||
+            (l2,l1) `elem` nodeeqlist
+
+
+------------------------------------------------------------
+-- Statement construction and equality tests
+------------------------------------------------------------
+
+type Statement = Arc LabelMem
+
+testStmtEq :: String -> Bool -> Statement -> Statement -> Test
+testStmtEq lab eq t1 t2 =
+    TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) )
+
+slist =
+  [
+    ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)
+  ]
+
+plist =
+  [
+    ("p1",p1)
+  ]
+
+olist =
+  [ ("o1",o1), ("o4",o4), ("o5",o5),
+    ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)
+  ]
+
+tlist =
+  [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ]
+    where
+    lab (s,_) (p,_) (o,_) = s++"."++p++"."++o
+    trp (_,s) (_,p) (_,o) = Arc s p o
+
+stmteqlist =
+  [
+    ("s6.p1.l1", "s7.p1.l1"),
+    ("s6.p1.l4", "s7.p1.l4"),
+    ("s6.p1.l7", "s7.p1.l7"),
+    ("s6.p1.l7", "s7.p1.l8"),
+    ("s6.p1.l8", "s7.p1.l7"),
+    ("s6.p1.l8", "s7.p1.l8"),
+    ("s6.p1.l10","s7.p1.l10"),
+    ("s6.p1.o1", "s7.p1.o1"),
+    ("s6.p1.o4", "s7.p1.o4"),
+    ("s6.p1.o5", "s7.p1.o5"),
+    ("s1.p1.l7", "s1.p1.l8"),
+    ("s4.p1.l7", "s4.p1.l8"),
+    ("s5.p1.l7", "s5.p1.l8"),
+    ("s6.p1.l7", "s6.p1.l8"),
+    ("s7.p1.l7", "s7.p1.l8")
+  ]
+
+testStmtEqSuite = TestList
+  [ testStmtEq (testLab l1 l2) (testEq  l1 l2) t1 t2
+      | (l1,t1) <- tlist , (l2,t2) <- tlist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` stmteqlist ||
+            (l2,l1) `elem` stmteqlist
+
+------------------------------------------------------------
+--  Graph element handling support routines
+------------------------------------------------------------
+
+lmap = tstLabelMap 5 [(s1,(1,1)),(s2,(2,2)),(s3,(3,3)),(s4,(4,4)),
+                      (o1,(1,1)),(o2,(2,2)),(o3,(3,3))]
+llst = ["s1","s2","s3","s4","o1","o2","o3"]
+
+-- showLabelMap :: (Label lb) => LabelMap lb -> String
+testShowLabelMap = testeq "showLabelMap" showMap (show lmap)
+    where
+        showMap = "LabelMap gen=5, map=\n"++
+                  "    !s1:(1,1)\n"++
+                  "    !s2:(2,2)\n"++
+                  "    !s3:(3,3)\n"++
+                  "    !:(4,4)\n"++
+                  "    !o1:(1,1)\n"++
+                  "    !o2:(2,2)\n"++
+                  "    !o3:(3,3)"
+
+-- mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex
+testMapLabelIndex01 = testeq "testMapLabelIndex01" (1,1) (mapLabelIndex lmap s1 )
+testMapLabelIndex02 = testeq "testMapLabelIndex02" (2,2) (mapLabelIndex lmap s2 )
+testMapLabelIndex03 = testeq "testMapLabelIndex03" (3,3) (mapLabelIndex lmap s3 )
+testMapLabelIndex04 = testeq "testMapLabelIndex04" (4,4) (mapLabelIndex lmap s4 )
+testMapLabelIndex05 = testeq "testMapLabelIndex05" (1,1) (mapLabelIndex lmap o1 )
+testMapLabelIndex06 = testeq "testMapLabelIndex06" (4,4) (mapLabelIndex lmap o4 )
+testMapLabelIndex07 = testeq "testMapLabelIndex07" nullLabelVal (mapLabelIndex lmap o5 )
+testMapLabelIndex08 = testeq "testMapLabelIndex08" nullLabelVal (mapLabelIndex lmap o6 )
+
+-- setLabelHash :: (Label lb) => LabelMap lb -> (lb,Int) -> LabelMap lb
+lmap1 = setLabelHash lmap (s2,22)
+
+testMapLabelHash00 = testeq "mapLabelHash00" showMap (show lmap1)
+    where
+        showMap = "LabelMap gen=5, map=\n"++
+                  "    !s1:(1,1)\n"++
+                  "    !s2:(5,22)\n"++
+                  "    !s3:(3,3)\n"++
+                  "    !:(4,4)\n"++
+                  "    !o1:(1,1)\n"++
+                  "    !o2:(2,2)\n"++
+                  "    !o3:(3,3)"
+
+testMapLabelHash01 = testeq "MapLabelHash01" (1,1)  (mapLabelIndex lmap1 s1 )
+testMapLabelHash02 = testeq "MapLabelHash02" (5,22) (mapLabelIndex lmap1 s2 )
+testMapLabelHash03 = testeq "MapLabelHash03" (3,3)  (mapLabelIndex lmap1 s3 )
+testMapLabelHash04 = testeq "MapLabelHash04" (4,4)  (mapLabelIndex lmap1 s4 )
+testMapLabelHash05 = testeq "MapLabelHash05" (1,1)  (mapLabelIndex lmap1 o1 )
+testMapLabelHash06 = testeq "MapLabelHash06" (4,4)  (mapLabelIndex lmap1 o4 )
+testMapLabelHash07 = testeq "MapLabelHash07" nullLabelVal (mapLabelIndex lmap1 o5 )
+testMapLabelHash08 = testeq "MapLabelHash08" nullLabelVal (mapLabelIndex lmap1 o6 )
+
+lmap2a = setLabelHash lmap1  (o1,66)
+lmap2b = setLabelHash lmap2a (o5,67)
+testMapLabelHash11 = testeq "MapLabelHash11" (1,1)  (mapLabelIndex lmap2b s1 )
+testMapLabelHash12 = testeq "MapLabelHash12" (5,22) (mapLabelIndex lmap2b s2 )
+testMapLabelHash13 = testeq "MapLabelHash13" (3,3)  (mapLabelIndex lmap2b s3 )
+testMapLabelHash14 = testeq "MapLabelHash14" (4,4)  (mapLabelIndex lmap2b s4 )
+testMapLabelHash15 = testeq "MapLabelHash15" (5,66) (mapLabelIndex lmap2b o1 )
+testMapLabelHash16 = testeq "MapLabelHash16" (2,2)  (mapLabelIndex lmap2b o2 )
+testMapLabelHash17 = testeq "MapLabelHash17" (4,4)  (mapLabelIndex lmap2b o4 )
+testMapLabelHash18 = testeq "MapLabelHash18" nullLabelVal (mapLabelIndex lmap1 o5 )
+
+-- newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb
+lmap3 = newLabelMap lmap [(s1,61),(s3,63),(o2,66)]
+testLabelMap01 = testeq "LabelMap01" (6,61) (mapLabelIndex lmap3 s1 )
+testLabelMap02 = testeq "LabelMap02" (2,2)  (mapLabelIndex lmap3 s2 )
+testLabelMap03 = testeq "LabelMap03" (6,63) (mapLabelIndex lmap3 s3 )
+testLabelMap04 = testeq "LabelMap04" (4,4)  (mapLabelIndex lmap3 s4 )
+testLabelMap05 = testeq "LabelMap05" (1,1)  (mapLabelIndex lmap3 o1 )
+testLabelMap06 = testeq "LabelMap06" (6,66) (mapLabelIndex lmap3 o2 )
+
+testLabelMapSuite = TestList
+  [ testShowLabelMap
+  , testMapLabelIndex01
+  , testMapLabelIndex02
+  , testMapLabelIndex03
+  , testMapLabelIndex04
+  , testMapLabelIndex05
+  , testMapLabelIndex06
+  , testMapLabelIndex07
+  , testMapLabelIndex08
+  , testMapLabelHash00
+  , testMapLabelHash01
+  , testMapLabelHash02
+  , testMapLabelHash03
+  , testMapLabelHash04
+  , testMapLabelHash05
+  , testMapLabelHash06
+  , testMapLabelHash07
+  , testMapLabelHash08
+  , testMapLabelHash11
+  , testMapLabelHash12
+  , testMapLabelHash13
+  , testMapLabelHash14
+  , testMapLabelHash15
+  , testMapLabelHash16
+  , testMapLabelHash17
+  , testMapLabelHash18
+  , testLabelMap01
+  , testLabelMap02
+  , testLabelMap03
+  , testLabelMap04
+  , testLabelMap05
+  ]
+
+------------------------------------------------------------
+--  Graph matching support
+------------------------------------------------------------
+
+t01 = toStatement s1 p1 o1
+t02 = toStatement s2 p1 o2
+t03 = toStatement s3 p1 o3
+t04 = toStatement s1 p1 l1
+t05 = toStatement s2 p1 l4
+t06 = toStatement s3 p1 l10
+
+t10 = toStatement s1 p1 b1
+t11 = toStatement b1 p2 b2
+t12 = toStatement b2 p3 o1
+
+t20 = toStatement s1 p1 b3
+t21 = toStatement b3 p2 b4
+t22 = toStatement b4 p3 o1
+
+as1 = [t01]
+
+as2 = [t01,t02,t03,t04,t05,t06]
+
+as4 = [t01,t02,t03,t04,t05,t06,t10,t11,t12]
+
+as5 = [t01,t02,t03,t04,t05,t06,t20,t21,t22]
+
+as6 = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]
+
+
+-- graphLabels :: (Label lb) => [Arc lb] -> [lb]
+ls4 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2]
+testGraphLabels04 = testeqv "GraphLabels04" ls4 (graphLabels as4)
+testGraphLabels14 = testeq  "GraphLabels14" str (show (graphLabels as4))
+    where
+        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3]"
+        -- str = "[!p3,?b2,!p2,?b1,!l10-xml,!l4-type1,!l1,!o3,!s3,!o2,!s2,!o1,!p1,!s1]"
+
+ls5 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4]
+testGraphLabels05 = testeqv "GraphLabels05" ls5 (graphLabels as5)
+testGraphLabels15 = testeq  "GraphLabels15" str (show (graphLabels as5))
+    where
+        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b3,!p2,?b4,!p3]"
+        -- str = "[!p3,?b4,!p2,?b3,!l10-xml,!l4-type1,!l1,!o3,!s3,!o2,!s2,!o1,!p1,!s1]"
+
+ls6 = [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4]
+testGraphLabels06 = testeqv "GraphLabels05" ls6 (graphLabels as6)
+testGraphLabels16 = testeq  "GraphLabels16" str (show (graphLabels as6))
+    where
+        str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3"++
+              ",!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3,?b3,?b4]"
+        -- str = "[?b4,?b3,!p3,?b2,!p2,?b1,!l10-xml,!l4-type1,!l1"++
+        --       ",!o3,!s3,!o2,!s2,!o1,!p1,!s1]"
+
+-- assignLabels :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb
+
+lmap5 = tstLabelMap 2 [(s1,(1,142577)),(s2,(1,142578)),(s3,(1,142579)),
+                       (p1,(1,142385)),(p2,(1,142386)),(p3,(1,142387)),
+                       (o1,(1,142321)),(o2,(1,142322)),(o3,(1,142323)),
+                       (l1,(1,142129)),(l4,(1,1709580)),(l10,(1,3766582)),
+                       (b3,(1,262143)),(b4,(1,262143))]
+testAssignLabelMap05 = testeq "AssignLabels05" lmap5
+                        (newGenerationMap $ assignLabelMap ls5 emptyMap)
+
+lmap6 = tstLabelMap 2 [(s1,(1,142577)),(s2,(1,142578)),(s3,(1,142579)),
+                       (p1,(1,142385)),(p2,(1,142386)),(p3,(1,142387)),
+                       (o1,(1,142321)),(o2,(1,142322)),(o3,(1,142323)),
+                       (l1,(1,142129)),(l4,(1,1709580)),(l10,(1,3766582)),
+                       (b1,(2,262143)),(b2,(2,262143)),(b3,(1,262143)),(b4,(1,262143))]
+testAssignLabelMap06 = testeq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5)
+
+
+lmapc = tstLabelMap 1 [(s1,(1,11)),(s2,(1,12)),(s3,(1,13)),
+                       (p1,(1,21)),(p2,(1,22)),(p3,(1,13)),
+                       (o1,(1,31)),(o2,(1,32)),(o3,(1,13)),
+                       (l1,(1,41)),(l4,(1,42)),(l10,(1,43)),
+                       (b1,(1,51)),(b2,(1,51)),(b3,(1,51)),(b4,(1,51))]
+
+-- [[[TODO: test hash value collision on non-variable label]]]
+
+testGraphMatchSupportSuite = TestList
+  [ testGraphLabels04
+  , testGraphLabels14
+  , testGraphLabels05
+  , testGraphLabels15
+  , testGraphLabels06
+  , testGraphLabels16
+  , testAssignLabelMap05
+  , testAssignLabelMap06
+  ]
+
+------------------------------------------------------------
+--  Test steps in graph equality test
+------------------------------------------------------------
+
+matchable l1 l2 = True
+
+s1_1 = makeScopedLabel 1 s1
+s2_1 = makeScopedLabel 1 s2
+s3_1 = makeScopedLabel 1 s3
+p1_1 = makeScopedLabel 1 p1
+p2_1 = makeScopedLabel 1 p2
+p3_1 = makeScopedLabel 1 p3
+o1_1 = makeScopedLabel 1 o1
+o2_1 = makeScopedLabel 1 o2
+o3_1 = makeScopedLabel 1 o3
+l1_1 = makeScopedLabel 1 l1
+l4_1 = makeScopedLabel 1 l4
+l10_1 = makeScopedLabel 1 l10
+b1_1 = makeScopedLabel 1 b1
+b2_1 = makeScopedLabel 1 b2
+b3_1 = makeScopedLabel 1 b3
+b4_1 = makeScopedLabel 1 b4
+
+s1_2 = makeScopedLabel 2 s1
+s2_2 = makeScopedLabel 2 s2
+s3_2 = makeScopedLabel 2 s3
+p1_2 = makeScopedLabel 2 p1
+p2_2 = makeScopedLabel 2 p2
+p3_2 = makeScopedLabel 2 p3
+o1_2 = makeScopedLabel 2 o1
+o2_2 = makeScopedLabel 2 o2
+o3_2 = makeScopedLabel 2 o3
+l1_2 = makeScopedLabel 2 l1
+l4_2 = makeScopedLabel 2 l4
+l10_2 = makeScopedLabel 2 l10
+b1_2 = makeScopedLabel 2 b1
+b2_2 = makeScopedLabel 2 b2
+b3_2 = makeScopedLabel 2 b3
+b4_2 = makeScopedLabel 2 b4
+
+t01_1 = makeScopedArc 1 t01
+
+t01_2 = makeScopedArc 2 t01
+t02_2 = makeScopedArc 2 t02
+t03_2 = makeScopedArc 2 t03
+t04_2 = makeScopedArc 2 t04
+t05_2 = makeScopedArc 2 t05
+t06_2 = makeScopedArc 2 t06
+
+t10_1 = makeScopedArc 1 t10
+t11_1 = makeScopedArc 1 t11
+t12_1 = makeScopedArc 1 t12
+t20_1 = makeScopedArc 1 t20
+t21_1 = makeScopedArc 1 t21
+t22_1 = makeScopedArc 1 t22
+
+t10_2 = makeScopedArc 2 t10
+t11_2 = makeScopedArc 2 t11
+t12_2 = makeScopedArc 2 t12
+t20_2 = makeScopedArc 2 t20
+t21_2 = makeScopedArc 2 t21
+t22_2 = makeScopedArc 2 t22
+
+-- Compare graph as6 with self, in steps
+
+as61 = map (makeScopedArc 1) as6
+as62 = map (makeScopedArc 2) as6
+
+eq1lmap     = newGenerationMap $
+              assignLabelMap (graphLabels as62) $
+              assignLabelMap (graphLabels as61) emptyMap
+eq1ltst     = tstLabelMap 2 [
+                             (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
+                             (b1_1,(1,262143)),(b2_1,(1,262143)),(b3_1,(1,262143)),(b4_1,(1,262143)),
+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
+                             (b1_2,(1,262143)),(b2_2,(1,262143)),(b3_2,(1,262143)),(b4_2,(1,262143))
+                            ]
+testEqAssignMap01 = testeq "EqAssignMap01" eq1ltst eq1lmap
+
+eq1hs1      = [t10_1,t11_1,t12_1,t20_1,t21_1,t22_1]
+eq1hs2      = [t10_2,t11_2,t12_2,t20_2,t21_2,t22_2]
+
+eq1lmap'    = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
+                             (b1_1,(2,3880463)),(b2_1,(2,3400925)),
+                                                (b3_1,(2,3880463)),
+                                                (b4_1,(2,3400925)),
+                             (b1_2,(2,3880463)),(b2_2,(2,3400925)),
+                                                (b3_2,(2,3880463)),
+                                                (b4_2,(2,3400925))]
+
+eq1lmap''   = newLabelMap eq1lmap'
+                [
+                (b1_1,2576315),(b2_1,3400925),(b3_1,1571691),
+                (b1_2,2576315),(b2_2,3400925),(b3_2,1571691)
+                ]
+eq1ltst''   = tstLabelMap 3 [
+                            (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
+                            (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
+                            (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
+                            (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
+                            (b1_1,(3,2576315)),
+                            (b2_1,(3,3400925)),
+                            (b3_1,(3,1571691)),
+                            (b4_1,(2,3400925)),
+                            (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
+                            (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
+                            (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
+                            (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
+                            (b1_2,(3,2576315)),
+                            (b2_2,(3,3400925)),
+                            (b3_2,(3,1571691)),
+                            (b4_2,(2,3400925))
+                            ]
+testEqNewLabelMap07 = testeq "EqNewLabelMap07" eq1ltst'' eq1lmap''
+
+-- Repeat same tests for as4...
+
+as41 = map (makeScopedArc 1) as4
+as42 = map (makeScopedArc 2) as4
+
+eq2lmap     = newGenerationMap $
+              assignLabelMap (graphLabels as42) $
+              assignLabelMap (graphLabels as41) emptyMap
+eq2ltst     = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
+                             (b1_1,(1,262143)),(b2_1,(1,262143)),
+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
+                             (b1_2,(1,262143)),(b2_2,(1,262143))]
+testEqAssignMap21 = testeq "EqAssignMap21" eq2ltst eq2lmap
+
+eq2hs1      = [t10_1,t11_1,t12_1]
+eq2hs2      = [t10_2,t11_2,t12_2]
+
+eq2lmap'    = tstLabelMap 2 [
+                             (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
+                             (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
+                             (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
+                             (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
+                             (b1_1,(2,3880463)),(b2_1,(2,3400925)),
+                             (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
+                             (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
+                             (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
+                             (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
+                             (b1_2,(2,3880463)),(b2_2,(2,3400925))
+                            ]
+
+eq2lmap''   = newLabelMap eq2lmap'
+                [
+                (b2_1,3400925),
+                (b2_2,3400925)
+                ]
+eq2ltst''   = tstLabelMap 3 [
+                            (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)),
+                            (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)),
+                            (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)),
+                            (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)),
+                            (b1_1,(2,3880463)),
+                            (b2_1,(3,3400925)),
+                            (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)),
+                            (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)),
+                            (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)),
+                            (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)),
+                            (b1_2,(2,3880463)),
+                            (b2_2,(3,3400925))
+                            ]
+testEqNewLabelMap27 = testeq "EqNewLabelMap27" eq2ltst'' eq2lmap''
+
+-- Compare as1 with as2, in steps
+
+as11 = map (makeScopedArc 1) as1
+as22 = map (makeScopedArc 2) as2
+
+eq3hs1   = [t01_1]
+eq3hs2   = [t01_2,t02_2,t03_2,t04_2,t05_2,t06_2]
+
+testEqGraphMap31_1 = testeq "testEqGraphMap31_1" eq3hs1 as11
+testEqGraphMap31_2 = testeq "testEqGraphMap31_2" eq3hs2 as22
+
+eq3lmap     = newGenerationMap $
+              assignLabelMap (graphLabels as11) $
+              assignLabelMap (graphLabels as22) emptyMap
+eq3ltst     = tstLabelMap 2
+    [ (s1_1,(1,142577))
+    , (p1_1,(1,142385))
+    , (o1_1,(1,142321))
+    , (s1_2,(1,142577)), (s2_2,(1,142578)), (s3_2,(1,142579))
+    , (p1_2,(1,142385))
+    , (o1_2,(1,142321)), (o2_2,(1,142322)), (o3_2,(1,142323))
+    , (l1_2,(1,142129)), (l4_2,(1,1709580)), (l10_2,(1,3766582))
+    ]
+testEqAssignMap32 = testeq "EqAssignMap32" eq3ltst eq3lmap
+
+ec31     = equivalenceClasses eq3lmap (graphLabels as11)
+ec31test =
+    [ ((1,142321),[o1_1])
+    , ((1,142385),[p1_1])
+    , ((1,142577),[s1_1])
+    ]
+
+ec32 = equivalenceClasses eq3lmap (graphLabels as22)
+ec32test =
+    [ ((1,142129),[l1_2])
+    , ((1,142321),[o1_2])
+    , ((1,142322),[o2_2])
+    , ((1,142323),[o3_2])
+    , ((1,142385),[p1_2])
+    , ((1,142577),[s1_2])
+    , ((1,142578),[s2_2])
+    , ((1,142579),[s3_2])
+    , ((1,1709580),[l4_2])
+    , ((1,3766582),[l10_2])
+    ]
+
+testEquivClass33_1 = testeq "EquivClass33_1" ec31test ec31
+testEquivClass33_2 = testeq "EquivClass33_2" ec32test ec32
+
+-- This value is nonsense for this test,
+-- but a parameter is needed for graphMatch1 (below)
+ec3pairs = zip (pairSort ec31) (pairSort ec32)
+ec3test  =
+    [ ( ((1,142321),[o1_1]), ((1,142321),[o1_2]) )
+    , ( ((1,142385),[p1_1]), ((1,142385),[p1_2]) )
+    , ( ((1,142577),[s1_1]), ((1,142577),[s1_2]) )
+    ]
+
+{-  This is a pointless test in this case
+testEquivClass33_3 = testeq "EquivClass33_3" ec3test ec3pairs
+-}
+
+eq3lmap1 = graphMatch1 False matchable eq3hs1 eq3hs2 eq3lmap ec3pairs
+eq3ltst1 = tstLabelMap 2
+    [ (o1_1,(1,142321))
+    , (p1_1,(1,142385))
+    , (s1_1,(1,142577))
+    , (l10_2,(1,3766582))
+    , (l4_2,(1,1709580))
+    , (l1_2,(1,142129))
+    , (o3_2,(1,142323))
+    , (s3_2,(1,142579))
+    , (o2_2,(1,142322))
+    , (s2_2,(1,142578))
+    , (o1_2,(1,142321))
+    , (p1_2,(1,142385))
+    , (s1_2,(1,142577))
+    ]
+-- testEqAssignMap34 = testeq "EqAssignMap34" (Just eq3ltst1) eq3lmap1
+-- testEqAssignMap34 = testeq "EqAssignMap34" Nothing eq3lmap1
+testEqAssignMap34 = testeq "EqAssignMap34" False (fst eq3lmap1)
+
+{-
+eq3rc1      = reclassify eq3hs1 eq3lmap
+eq3rctst1   = []
+testEqReclassify35_1 = testeqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1
+eq3rc2      = reclassify eq3hs2 eq3lmap
+eq3rctst2   = []
+testEqReclassify35_2 = testeqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2
+-}
+
+
+-- Test suite
+
+testGraphMatchStepSuite = TestList
+  [ testEqAssignMap01
+  -- , testEqReclassify03_1, testEqReclassify03_2
+  , testEqNewLabelMap07
+  -- , testEqGraphMatch08
+  , testEqAssignMap21
+  -- , testEqReclassify23_1, testEqReclassify23_2
+  , testEqNewLabelMap27
+  -- , testEqGraphMatch28
+  , testEqGraphMap31_1, testEqGraphMap31_2
+  , testEqAssignMap32
+  , testEquivClass33_1, testEquivClass33_2 -- , testEquivClass33_3
+  , testEqAssignMap34
+  -- , testEqReclassify35_1, testEqReclassify35_2
+  ]
+
+------------------------------------------------------------
+--  Graph equality tests
+------------------------------------------------------------
+
+testGraphEq :: ( Label lb ) => String -> Bool -> GraphMem lb -> GraphMem lb -> Test
+testGraphEq lab eq g1 g2 =
+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
+
+g1 = GraphMem { arcs = [t01] }
+
+g2 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06] }
+
+g3 = GraphMem { arcs = [t06,t05,t04,t03,t02,t01] }
+
+g4 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t10,t11,t12] }
+
+g5 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t20,t21,t22] }
+
+g6 = GraphMem { arcs = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22] }
+
+g7 = GraphMem { arcs = [t01,t02] }
+
+g8 = GraphMem { arcs = [t02,t01] }
+
+glist =
+  [ ("g1",g1), ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6) ]
+
+grapheqlist =
+  [ ("g2","g3")
+  , ("g4","g5")
+  ]
+
+testGraphEqSuitePart = TestLabel "testGraphEqSuitePart" $ TestList
+  [ testGraphEq "g1-g2" False g1 g2
+  , testGraphEq "g2-g1" False g2 g1
+  , testGraphEq "g2-g2" True  g2 g2
+  , testGraphEq "g2-g3" True  g2 g3
+  , testGraphEq "g1-g4" False g1 g4
+  , testGraphEq "g2-g4" False g2 g4
+  , testGraphEq "g3-g4" False g3 g4
+  , testGraphEq "g4-g3" False g4 g3
+  , testGraphEq "g4-g4" True  g4 g4
+  , testGraphEq "g4-g5" True  g4 g5
+  , testGraphEq "g4-g6" False g4 g6
+  , testGraphEq "g6-g6" True  g6 g6
+  , testGraphEq "g7-g7" True  g7 g7
+  , testGraphEq "g7-g8" True  g7 g8
+  , testGraphEq "g8-g7" True  g8 g7
+  ]
+
+testGraphEqSuite = TestLabel "testGraphEqSuite" $ TestList
+  [ testGraphEq (testLab l1 l2) (testEq l1 l2) g1 g2
+      | (l1,g1) <- glist , (l2,g2) <- glist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` grapheqlist ||
+            (l2,l1) `elem` grapheqlist
+
+-- Selected tests for debugging
+geq12 = testGraphEq "g1-g2" False g1 g2
+geq21 = testGraphEq "g2-g1" False g2 g1
+geq22 = testGraphEq "g2-g2" True  g2 g2
+geq23 = testGraphEq "g2-g3" True  g2 g3
+geq14 = testGraphEq "g1-g4" False g1 g4
+geq24 = testGraphEq "g2-g4" False g2 g4
+geq77 = testGraphEq "g7-g7" True  g7 g7
+geq78 = testGraphEq "g7-g8" True  g7 g8
+geq87 = testGraphEq "g8-g7" True  g8 g7
+
+
+------------------------------------------------------------
+--  More graph equality tests
+------------------------------------------------------------
+--
+--  These tests are based on the 10-node, triply connected
+--  graph examples in Jeremy Carroll's paper on matching RDF
+--  graphs.
+
+--  Graph pattern 1:
+--  pentangle-in-pentangle, corresponding vertices linked upward
+
+v101  = LV "v101"
+v102  = LV "v102"
+v103  = LV "v103"
+v104  = LV "v104"
+v105  = LV "v105"
+v106  = LV "v106"
+v107  = LV "v107"
+v108  = LV "v108"
+v109  = LV "v109"
+v110  = LV "v110"
+
+p101  = LV "p101"
+p102  = LV "p102"
+p103  = LV "p103"
+p104  = LV "p104"
+p105  = LV "p105"
+p106  = LV "p106"
+p107  = LV "p107"
+p108  = LV "p108"
+p109  = LV "p109"
+p110  = LV "p110"
+p111  = LV "p111"
+p112  = LV "p112"
+p113  = LV "p113"
+p114  = LV "p114"
+p115  = LV "p115"
+
+t10102 = toStatement v101 p101 v102
+t10203 = toStatement v102 p102 v103
+t10304 = toStatement v103 p103 v104
+t10405 = toStatement v104 p104 v105
+t10501 = toStatement v105 p105 v101
+t10106 = toStatement v101 p106 v106
+t10207 = toStatement v102 p107 v107
+t10308 = toStatement v103 p108 v108
+t10409 = toStatement v104 p109 v109
+t10510 = toStatement v105 p110 v110
+t10607 = toStatement v106 p111 v107
+t10708 = toStatement v107 p112 v108
+t10809 = toStatement v108 p113 v109
+t10910 = toStatement v109 p114 v110
+t11006 = toStatement v110 p115 v106
+
+--  Graph pattern 2:
+--  pentangle-in-pentangle, corresponding vertices linked downward
+
+v201  = LV "v201"
+v202  = LV "v202"
+v203  = LV "v203"
+v204  = LV "v204"
+v205  = LV "v205"
+v206  = LV "v206"
+v207  = LV "v207"
+v208  = LV "v208"
+v209  = LV "v209"
+v210  = LV "v210"
+
+p201  = LV "p201"
+p202  = LV "p202"
+p203  = LV "p203"
+p204  = LV "p204"
+p205  = LV "p205"
+p206  = LV "p206"
+p207  = LV "p207"
+p208  = LV "p208"
+p209  = LV "p209"
+p210  = LV "p210"
+p211  = LV "p211"
+p212  = LV "p212"
+p213  = LV "p213"
+p214  = LV "p214"
+p215  = LV "p215"
+
+t20102 = toStatement v201 p201 v202
+t20203 = toStatement v202 p202 v203
+t20304 = toStatement v203 p203 v204
+t20405 = toStatement v204 p204 v205
+t20501 = toStatement v205 p205 v201
+t20601 = toStatement v206 p206 v201
+t20702 = toStatement v207 p207 v202
+t20803 = toStatement v208 p208 v203
+t20904 = toStatement v209 p209 v204
+t21005 = toStatement v210 p210 v205
+t20607 = toStatement v206 p211 v207
+t20708 = toStatement v207 p212 v208
+t20809 = toStatement v208 p213 v209
+t20910 = toStatement v209 p214 v210
+t21006 = toStatement v210 p215 v206
+
+--  Graph pattern 3:
+--  star-in-pentangle, corresponding vertices linked toward star
+--  Although this graph is similarly linked to patterns 1 and 2,
+--  it is topologically different as it contains circuits only of
+--  length 5, where the others have circuits of length 4 and 5
+--  (ignoring direction of arcs)
+
+v301  = LV "v301"
+v302  = LV "v302"
+v303  = LV "v303"
+v304  = LV "v304"
+v305  = LV "v305"
+v306  = LV "v306"
+v307  = LV "v307"
+v308  = LV "v308"
+v309  = LV "v309"
+v310  = LV "v310"
+
+p301  = LV "p301"
+p302  = LV "p302"
+p303  = LV "p303"
+p304  = LV "p304"
+p305  = LV "p305"
+p306  = LV "p306"
+p307  = LV "p307"
+p308  = LV "p308"
+p309  = LV "p309"
+p310  = LV "p310"
+p311  = LV "p311"
+p312  = LV "p312"
+p313  = LV "p313"
+p314  = LV "p314"
+p315  = LV "p315"
+
+t30102 = toStatement v301 p301 v302
+t30203 = toStatement v302 p302 v303
+t30304 = toStatement v303 p303 v304
+t30405 = toStatement v304 p304 v305
+t30501 = toStatement v305 p305 v301
+t30106 = toStatement v301 p306 v306
+t30207 = toStatement v302 p307 v307
+t30308 = toStatement v303 p308 v308
+t30409 = toStatement v304 p309 v309
+t30510 = toStatement v305 p310 v310
+t30608 = toStatement v306 p311 v308
+t30709 = toStatement v307 p312 v309
+t30810 = toStatement v308 p313 v310
+t30906 = toStatement v309 p314 v306
+t31007 = toStatement v310 p315 v307
+
+--  Graph pattern 4:
+--  pentangle-in-pentangle, corresponding vertices linked upward
+--  The vertices 6-10 are linked in reverse order to the
+--  corresponding vertices 1-5.
+
+v401  = LV "v401"
+v402  = LV "v402"
+v403  = LV "v403"
+v404  = LV "v404"
+v405  = LV "v405"
+v406  = LV "v406"
+v407  = LV "v407"
+v408  = LV "v408"
+v409  = LV "v409"
+v410  = LV "v410"
+
+p401  = LV "p401"
+p402  = LV "p402"
+p403  = LV "p403"
+p404  = LV "p404"
+p405  = LV "p405"
+p406  = LV "p406"
+p407  = LV "p407"
+p408  = LV "p408"
+p409  = LV "p409"
+p410  = LV "p410"
+p411  = LV "p411"
+p412  = LV "p412"
+p413  = LV "p413"
+p414  = LV "p414"
+p415  = LV "p415"
+
+t40102 = toStatement v401 p401 v402
+t40203 = toStatement v402 p402 v403
+t40304 = toStatement v403 p403 v404
+t40405 = toStatement v404 p404 v405
+t40501 = toStatement v405 p405 v401
+t40106 = toStatement v401 p406 v406
+t40207 = toStatement v402 p407 v407
+t40308 = toStatement v403 p408 v408
+t40409 = toStatement v404 p409 v409
+t40510 = toStatement v405 p410 v410
+t41009 = toStatement v410 p411 v409
+t40908 = toStatement v409 p412 v408
+t40807 = toStatement v408 p413 v407
+t40706 = toStatement v407 p414 v406
+t40610 = toStatement v406 p415 v410
+
+--  Graph pattern 5:
+--  Same as pattern 1, except same fixed property in all cases.
+
+p5    = LF "p5"
+
+t50102 = toStatement v101 p5 v102
+t50203 = toStatement v102 p5 v103
+t50304 = toStatement v103 p5 v104
+t50405 = toStatement v104 p5 v105
+t50501 = toStatement v105 p5 v101
+t50106 = toStatement v101 p5 v106
+t50207 = toStatement v102 p5 v107
+t50308 = toStatement v103 p5 v108
+t50409 = toStatement v104 p5 v109
+t50510 = toStatement v105 p5 v110
+t50607 = toStatement v106 p5 v107
+t50708 = toStatement v107 p5 v108
+t50809 = toStatement v108 p5 v109
+t50910 = toStatement v109 p5 v110
+t51006 = toStatement v110 p5 v106
+
+--  Graph pattern 6:
+--  Same as pattern 5, with different variables
+
+t60102 = toStatement v201 p5 v202
+t60203 = toStatement v202 p5 v203
+t60304 = toStatement v203 p5 v204
+t60405 = toStatement v204 p5 v205
+t60501 = toStatement v205 p5 v201
+t60106 = toStatement v201 p5 v206
+t60207 = toStatement v202 p5 v207
+t60308 = toStatement v203 p5 v208
+t60409 = toStatement v204 p5 v209
+t60510 = toStatement v205 p5 v210
+t60607 = toStatement v206 p5 v207
+t60708 = toStatement v207 p5 v208
+t60809 = toStatement v208 p5 v209
+t60910 = toStatement v209 p5 v210
+t61006 = toStatement v210 p5 v206
+
+--
+
+arcsToGraph as = GraphMem { arcs = as }
+
+-- Very simple case
+
+g100 = arcsToGraph
+       [ t10102, t10203, t10304, t10405, t10501,
+         t10607, t10708, t10809, t10910, t11006
+       ]
+
+g200 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20607, t20708, t20809, t20910, t21006
+       ]
+
+-- 10/3 node graph comparisons
+
+g101 = arcsToGraph
+       [ t10102, t10203, t10304, t10405, t10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g201 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20601, t20702, t20803, t20904, t21005,
+         t20607, t20708, t20809, t20910, t21006 ]
+
+g301 = arcsToGraph
+       [ t30102, t30203, t30304, t30405, t30501,
+         t30106, t30207, t30308, t30409, t30510,
+         t30608, t30709, t30810, t30906, t31007 ]
+
+g401 = arcsToGraph
+       [ t40102, t40203, t40304, t40405, t40501,
+         t40106, t40207, t40308, t40409, t40510,
+         t40610, t40706, t40807, t40908, t41009 ]
+
+g501 = arcsToGraph
+       [ t50102, t50203, t50304, t50405, t50501,
+         t50106, t50207, t50308, t50409, t50510,
+         t50607, t50708, t50809, t50910, t51006 ]
+
+g601 = arcsToGraph
+       [ t60102, t60203, t60304, t60405, t60501,
+         t60106, t60207, t60308, t60409, t60510,
+         t60607, t60708, t60809, t60910, t61006 ]
+
+-- Remove one arc from each
+
+g102 = arcsToGraph
+       [ t10102, t10203, t10304, t10405,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g202 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20601, t20702, t20803, t20904, t21005,
+                 t20708, t20809, t20910, t21006 ]
+
+g302 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20601, t20702, t20803, t20904,
+         t20607, t20708, t20809, t20910, t21006 ]
+
+-- Remove two adjacent arcs from each
+
+g103 = arcsToGraph
+       [ t10102, t10203, t10304,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g203 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20601, t20702, t20803, t20904, t21005,
+         t20607, t20708,                 t21006 ]
+
+g303 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20601, t20702, t20803, t20904,
+         t20607, t20708, t20809,         t21006 ]
+
+-- Remove two adjacent arcs from one, non-adjacent from another
+
+g104 = arcsToGraph
+       [ t10102, t10203, t10304,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g204 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20601, t20702, t20803,
+         t20607, t20708, t20809, t20910, t21006 ]
+
+-- Compare two rings of 5 with one ring of 10
+-- (each node double-connected, but different overall topology)
+
+t10901 = toStatement v109 p109 v101
+
+g105 = arcsToGraph
+       [ t10102, t10203, t10304, t10405,
+                                 t10901, t10510,
+         t10607, t10708, t10809,         t11006 ]
+
+g205 = arcsToGraph
+       [ t20102, t20203, t20304, t20405, t20501,
+         t20607, t20708, t20809, t20910, t21006 ]
+
+-- Reverse one arc from test 01
+-- (also, rearrange arcs to catch ordering artefacts)
+
+t20201 = toStatement v202 p201 v201
+
+g106 = arcsToGraph
+       [ t10102, t10203, t10304, t10405, t10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g206 = arcsToGraph
+       [ t20607, t20708, t20809, t20910, t21006,
+         t20601, t20702, t20803, t20904, t21005,
+         t20102, t20203, t20304, t20405, t20501 ]
+
+g306 = arcsToGraph
+       [ t20607, t20708, t20809, t20910, t21006,
+         t20601, t20702, t20803, t20904, t21005,
+         t20201, t20203, t20304, t20405, t20501 ]
+
+-- Similar tests to 02,03,04,
+-- but add identified property rather than removing arcs
+
+f01  = LF "f01"
+f02  = LF "f02"
+
+-- Fix one arc from each
+
+f10102 = toStatement v101 f01 v102
+f10501 = toStatement v105 f01 v101
+f21006 = toStatement v210 f01 v206
+f20510 = toStatement v205 f01 v210
+
+g107 = arcsToGraph
+       [ f10102, t10203, t10304, t10405, t10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g207 = arcsToGraph
+       [ t10102, t10203, t10304, t10405, f10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g307 = arcsToGraph
+       [ t20607, t20708, t20809, t20910, f21006,
+         t20601, t20702, t20803, t20904, t21005,
+         t20102, t20203, t20304, t20405, t20501 ]
+
+g407 = arcsToGraph
+       [ t20607, t20708, t20809, t20910, t21006,
+         t20601, t20702, t20803, t20904, t21005,
+         t20102, t20203, t20304, t20405, t20501 ]
+
+-- Fix two adjacent arcs from each
+
+f10203 = toStatement v102 f01 v103
+f10405 = toStatement v104 f01 v105
+f20910 = toStatement v209 f01 v210
+f20601 = toStatement v206 f01 v201
+
+g108 = arcsToGraph
+       [ f10102, f10203, t10304, t10405, t10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g208 = arcsToGraph
+       [ t10102, t10203, t10304, f10405, f10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g308 = arcsToGraph
+       [ t20607, t20708, t20809, f20910, f21006,
+         t20601, t20702, t20803, t20904, t21005,
+         t20102, t20203, t20304, t20405, t20501 ]
+
+g408 = arcsToGraph
+       [ t20607, t20708, t20809, t20910, f21006,
+         f20601, t20702, t20803, t20904, t21005,
+         t20102, t20203, t20304, t20405, t20501 ]
+
+-- Fix two adjacent arcs with different properties
+
+g10203 = toStatement v102 f02 v103
+g10102 = toStatement v101 f02 v102
+g10405 = toStatement v104 f02 v105
+
+g109 = arcsToGraph
+       [ f10102, g10203, t10304, t10405, t10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g209 = arcsToGraph
+       [ g10102, t10203, t10304, t10405, f10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+g309 = arcsToGraph
+       [ t10102, t10203, t10304, g10405, f10501,
+         t10106, t10207, t10308, t10409, t10510,
+         t10607, t10708, t10809, t10910, t11006 ]
+
+
+mgeq00 = testGraphEq "g100-g200" True  g100 g200
+
+mgeq0112 = testGraphEq "g101-g201" True  g101 g201
+mgeq0113 = testGraphEq "g101-g301" False g101 g301
+mgeq0114 = testGraphEq "g101-g401" False g101 g401
+mgeq0115 = testGraphEq "g101-g501" False g101 g501
+mgeq0116 = testGraphEq "g101-g601" False g101 g601
+mgeq0156 = testGraphEq "g501-g601" True  g501 g601
+
+mgeq0212 = testGraphEq "g102-g202" True  g102 g202
+mgeq0213 = testGraphEq "g102-g302" False g102 g302
+
+mgeq0312 = testGraphEq "g103-g203" True  g103 g203
+mgeq0313 = testGraphEq "g103-g303" False g103 g303
+
+mgeq04 = testGraphEq "g104-g204" False g104 g204
+mgeq05 = testGraphEq "g105-g205" False g105 g205
+
+mgeq0612 = testGraphEq "g106-g206" True  g106 g206
+mgeq0613 = testGraphEq "g106-g306" False g106 g306
+
+mgeq0712 = testGraphEq "g107-g207" True  g107 g207
+mgeq0713 = testGraphEq "g107-g307" True  g107 g307
+mgeq0714 = testGraphEq "g107-g407" False g107 g407
+
+mgeq0812 = testGraphEq "g108-g208" True  g108 g208
+mgeq0813 = testGraphEq "g108-g308" True  g108 g308
+mgeq0814 = testGraphEq "g108-g408" False g108 g408
+
+mgeq0912 = testGraphEq "g109-g209" True  g109 g209
+mgeq0913 = testGraphEq "g109-g309" False g109 g309
+
+testGraphEqSuiteMore = TestList
+  [ mgeq00
+  , mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156
+  , mgeq0212, mgeq0213
+  , mgeq0312, mgeq0313
+  , mgeq04
+  , mgeq05
+  , mgeq0612, mgeq0613
+  , mgeq0712, mgeq0713, mgeq0714
+  , mgeq0812, mgeq0813, mgeq0814
+  , mgeq0912, mgeq0913
+  ]
+
+------------------------------------------------------------
+-- All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ testSelectSuite
+  , testMapsetSuite
+  , testSubsetSuite
+  , testHashSuite
+  , testLabSuite
+  , testGraphSuite
+  , testLabelEqSuite
+  , testLabelOrdSuite
+  , testStmtEqSuite
+  , testLabelMapSuite
+  , testGraphMatchSupportSuite
+  , testGraphMatchStepSuite
+  , testGraphEqSuitePart
+  , testGraphEqSuite
+  , testGraphEqSuiteMore
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+geq    = testGraphEqSuite
+geq1   = testGraphEqSuiteMore
+ttmore = tt testGraphEqSuiteMore    -- this test may take a long time
+tfmore = tf testGraphEqSuiteMore
+ttstep = tt testGraphMatchStepSuite
+tfstep = tf testGraphMatchStepSuite
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/GraphTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.24 $
+-- $Log: GraphTest.hs,v $
+-- Revision 1.24  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.23  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.22  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.21  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.20  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.19  2003/05/29 01:50:56  graham
+-- More performance tuning, courtesy of GHC profiler.
+-- All modules showing reasonable performance now.
+--
+-- Revision 1.18  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.17  2003/05/23 16:29:20  graham
+-- Partial code cleanup:
+-- - Arc is an alebraic type
+-- - Arc is an instance of Functor
+-- - add gmap function to Graph interface
+-- - remove some duplicate functions from GraphMatch
+-- This in preparation for adding graph merge facility with
+-- blank node renaming.
+--
+-- Revision 1.16  2003/05/20 23:35:28  graham
+-- Modified code to compile with GHC hierarchical libraries
+--
+-- Revision 1.15  2003/05/14 11:13:15  graham
+-- Fixed bug in graph matching.
+-- (A graph-equivalence check is needed to weed out false matches
+-- caused by the "guessing" stage.)
+--
+-- Revision 1.14  2003/05/14 02:01:59  graham
+-- GraphMatch recoded and almost working, but
+-- there are a couple of
+-- obscure bugs that are proving rather stubborn to squash.
+--
+-- Revision 1.13  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.12  2003/05/07 19:26:32  graham
+-- Sync
+--
+-- Revision 1.11  2003/05/01 23:15:44  graham
+-- GraphTest passes all tests using refactored LookupMap
+-- Extensive changes to GraphMatch were required.
+--
+-- Revision 1.10  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.9  2003/04/11 18:12:10  graham
+-- Renamed GraphHelpers to ListHelpers
+-- LookupMapTest, GraphTest, RDFGraphTest all run OK
+--
+-- Revision 1.8  2003/04/11 18:04:49  graham
+-- Rename GraphLookupMap to LookupMap:
+-- GraphTest runs OK.
+--
+-- Revision 1.7  2003/04/10 13:41:22  graham
+-- More graph code tidying
+-- Graph test cases still run OK
+--
+-- Revision 1.6  2003/04/10 13:35:34  graham
+-- Separated GraphMatch logic from GraphMem
+--
+-- Revision 1.5  2003/04/10 08:36:06  graham
+-- Graph matching passes battery of new tests
+-- Started work on RDF graph
+--
+-- Revision 1.4  2003/03/31 22:18:08  graham
+-- Simple graph equality tests all pass
+--
+-- Revision 1.3  2003/03/31 20:52:23  graham
+-- Restructure graph matching to deal with same unbound node names in
+-- different graphs.  It shows signs that it might be working now.
+-- More testing is needed.
+--
+-- Revision 1.2  2003/03/28 21:50:22  graham
+-- Graph equality coded and nearly working
+--
+-- Revision 1.1  2003/03/12 23:00:43  graham
+-- Graph model coded and working, except for graph isomorphism test.
+--

+ Swish/HaskellRDF/MapXsdInteger.hs view
@@ -0,0 +1,96 @@+--------------------------------------------------------------------------------
+--  $Id: MapXsdInteger.hs,v 1.1 2003/11/14 15:59:51 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  MapXsdInteger
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + ????
+--
+--  This module defines the datatytpe mapping and relation values
+--  used for RDF dataype xsd:integer
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.MapXsdInteger
+    ( mapXsdInteger
+    )
+where
+
+import Swish.HaskellRDF.Datatype
+    ( DatatypeMap(..)
+    )
+
++import Swish.HaskellRDF.Dfa.Dfa
+    ( Re(..)
+    , matchRe
+    )
+
+------------------------------------------------------------
+--  Implementation of DatatypeMap for xsd:integer
+------------------------------------------------------------
+
+-- |mapXsdInteger contains functions that perform lexical-to-value
+--  and value-to-canonical-lexical mappings for xsd:integer values
+--
+mapXsdInteger :: DatatypeMap Integer
+mapXsdInteger = DatatypeMap
+    { -- mapL2V :: String -> Maybe Integer
+      mapL2V = \s -> case [ x
+                          | matchRe reInteger s
+                          , (x,t) <- reads $ skipPlus s
+                          , ("","") <- lex t
+                          ] of
+                    [] -> Nothing
+                    is -> Just $ head is
+      -- mapV2L :: Integer -> Maybe String
+    , mapV2L = Just . show
+    }
+
+skipPlus :: String -> String
+skipPlus ('+':s) = s
+skipPlus s       = s
+
+reInteger = ReCat [ReOpt (alt "+-"), digits1]
+    where
+        digits0 = ReStar digit
+        digits1 = RePlus digit
+        digit   = alt "0123456789"
+        alt cs  = ReOr $ map (\c -> ReTerm [c]) cs
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/MapXsdInteger.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: MapXsdInteger.hs,v $
+-- Revision 1.1  2003/11/14 15:59:51  graham
+-- Separate MapXsdInteger from RDFDatatypeXsdInteger.
+--

+ Swish/HaskellRDF/N3Formatter.hs view
@@ -0,0 +1,695 @@+--------------------------------------------------------------------------------
+--  $Id: N3Formatter.hs,v 1.23 2004/01/22 19:52:41 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  N3Formatter
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This Module implements a Notation 3 formatter (see [1], [2]),
+--  for an RDFGraph value.
+--
+--
+-- REFERENCES:
+--
+-- [1] http://www.w3.org/DesignIssues/Notation3.html
+--     Tim Berners-Lee's design issues series notes and description
+--
+-- [2] http://www.w3.org/2000/10/swap/Primer.html
+--     Notation 3 Primer by Sean Palmer
+--
+--
+--  [[[TODO:]]]
+--  (a) Initial prefix list to include nested formulae;
+--      then don't need to update prefix list for these.
+--  (b) blank nodes used just once, can be expanded inline using
+--      [...] syntax.
+--  (c) generate multi-line literals when appropriate
+--  (d) more flexible terminator generation for formatted formulae
+--      (for inline blank nodes.)
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.N3Formatter
+    ( formatGraphAsStringNl
+    , formatGraphAsString
+    , formatGraphAsShowS
+    , formatGraphIndent
+    , formatGraphDiag
+    )
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFGraph, RDFLabel(..)
+    , NamespaceMap, RevNamespaceMap
+    , emptyNamespaceMap
+    , FormulaMap, emptyFormulaMap
+    , getArcs, labels
+    , setNamespaces, getNamespaces
+    , getFormulae
+    , emptyRDFGraph
+    )
+
+import Swish.HaskellRDF.GraphClass
+    ( Arc(..)
+    , arc
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..)
+    , LookupMap, emptyLookupMap, reverseLookupMap
+    , listLookupMap
+    , mapFind, mapFindMaybe, mapAdd, mapDelete, mapMerge
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..)
+    , newQName, qnameFromPair, qnameFromURI
+    , getNamespace, getLocalName, getQNameURI
+    , splitURI
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..), getScopeURI )
+
+import Swish.HaskellUtils.ProcessURI
+    ( isAbsoluteURIRef )
+
+import Swish.HaskellRDF.Sort.QuickSort
+    ( stableQuickSort )
+
+import Data.Char
+    ( isDigit )
+
+import Data.List
+    ( groupBy )
+
+import Data.Maybe
+    ( Maybe(..), isJust, fromJust )
+
+----------------------------------------------------------------------
+--  Ouptut string concatenation
+----------------------------------------------------------------------
+--
+--  Function puts uses the shows mechanism to avoid the cost of
+--  quadratic string concatenation times.  (Use function composition to
+--  concatenate strings thus reprersented.)
+
+puts :: String -> ShowS
+puts = showString
+
+----------------------------------------------------------------------
+--  Graph formatting state monad
+----------------------------------------------------------------------
+--
+--  The graph to be formatted is carried as part of the formatting
+--  state, so that decisions about what needs to be formatted can
+--  themselves be based upon and reflected in the state (e.g. if a
+--  decision is made to include a blank node inline, it can be removed
+--  from the graph state that remains to be formatted).
+
+type SubjTree lb = [(lb,PredTree lb)]
+type PredTree lb = [(lb,[lb])]
+
+data Fgs = Fgs
+    { indent    :: String
+    , lineBreak :: Bool
+    , graph     :: RDFGraph
+    , subjs     :: SubjTree RDFLabel
+    , props     :: PredTree RDFLabel   -- for last subject selected
+    , objs      :: [RDFLabel]          -- for last property selected
+    , formAvail :: FormulaMap RDFLabel
+    , formQueue :: [(RDFLabel,RDFGraph)]
+    , nodeGenSt :: NodeGenState
+    , traceBuf  :: [String]
+    }
+
+emptyFgs :: NodeGenState -> Fgs
+emptyFgs ngs = Fgs
+    { indent    = "\n"
+    , lineBreak = False
+    , graph     = emptyRDFGraph
+    , subjs     = []
+    , props     = []
+    , objs      = []
+    , formAvail = emptyFormulaMap
+    , formQueue = []
+    , nodeGenSt = ngs
+    , traceBuf  = []
+    }
+
+--  Node name generation state information that carries through
+--  and is updated by nested formulae
+
+type NodeGenLookupMap = LookupMap (RDFLabel,Int)
+
+data NodeGenState = Ngs
+    { prefixes  :: NamespaceMap
+    , nodeMap   :: NodeGenLookupMap
+    , nodeGen   :: Int
+    }
+
+emptyNgs :: NodeGenState
+emptyNgs = Ngs
+    { prefixes  = emptyLookupMap
+    , nodeMap   = emptyLookupMap
+    , nodeGen   = 0
+    }
+
+--  monad definition adapted from Simon Thompson's book, p410
+--
+--  Fgsm a is a "state transformer" on a state of type "Fgs",
+--  which additionally returns a value of type 'a'.
+data Fgsm a = Fgsm ( Fgs -> (Fgs,a) )
+
+instance Monad Fgsm where
+    return res      = Fgsm (\fgs -> (fgs,res))
+    (Fgsm st) >>= f = Fgsm (\fgs ->
+        let (newfgs,res) = st fgs
+            (Fgsm st')   = f res
+        in
+            st' newfgs
+        )
+
+getFgs :: Fgsm Fgs
+getFgs = Fgsm (\fgs -> (fgs,fgs) )
+
+doTrace :: String -> Fgsm ()
+doTrace msg = Fgsm (\fgs -> (fgs {traceBuf=msg:(traceBuf fgs)},()) )
+
+getIndent :: Fgsm String
+getIndent = Fgsm (\fgs -> (fgs,indent fgs) )
+
+setIndent :: String -> Fgsm ()
+setIndent ind = Fgsm (\fgs -> (fgs {indent=ind},()) )
+
+getLineBreak :: Fgsm Bool
+getLineBreak = Fgsm (\fgs -> (fgs,lineBreak fgs) )
+
+setLineBreak :: Bool -> Fgsm ()
+setLineBreak brk = Fgsm (\fgs -> (fgs {lineBreak=brk},()) )
+
+getNgs :: Fgsm NodeGenState
+getNgs = Fgsm (\fgs -> (fgs,nodeGenSt fgs) )
+
+setNgs :: NodeGenState -> Fgsm ()
+setNgs ngs = Fgsm (\fgs -> (fgs { nodeGenSt = ngs },()) )
+
+getPrefixes :: Fgsm NamespaceMap
+getPrefixes = Fgsm (\fgs -> (fgs,prefixes (nodeGenSt fgs)) )
+
+queueFormula :: RDFLabel -> Fgsm ()
+queueFormula fn = Fgsm (\fgs ->
+    let fa = formAvail fgs
+        newState fv =
+            fgs { formAvail=mapDelete fa fn
+                , formQueue=(fn,fv):(formQueue fgs)
+                }
+    in
+        case (mapFindMaybe fn fa) of
+            Nothing -> (fgs,())
+            Just fv -> (newState fv,())
+    )
+
+moreFormulae :: Fgsm Bool
+moreFormulae =  Fgsm (\fgs -> (fgs,not $ null (formQueue fgs)) )
+
+nextFormula :: Fgsm (RDFLabel,RDFGraph)
+nextFormula =  Fgsm (\fgs ->
+    let (nf:fq) = (formQueue fgs) in (fgs {formQueue=fq},nf)
+    )
+
+----------------------------------------------------------------------
+--  Define a top-level formatter function:
+--  accepts a graph and returns a string
+----------------------------------------------------------------------
+
+formatGraphAsStringNl :: RDFGraph -> String
+formatGraphAsStringNl gr = formatGraphAsShowS gr "\n"
+
+formatGraphAsString :: RDFGraph -> String
+formatGraphAsString gr = formatGraphAsShowS gr ""
+
+formatGraphAsShowS :: RDFGraph -> ShowS
+formatGraphAsShowS gr = formatGraphIndent "\n" True gr
+{- old code:
+    where
+        (out,_,_,_) = formatGraphDiag gr
+-}
+
+formatGraphIndent :: String -> Bool -> RDFGraph -> ShowS
+formatGraphIndent ind dopref gr = out
+    where
+        (_,out) = formatGraphDiag1 ind dopref emptyLookupMap gr
+
+--  Format graph and return additional information
+formatGraphDiag ::
+    RDFGraph -> (ShowS,NodeGenLookupMap,Int,[String])
+formatGraphDiag gr = (out,nodeMap ngs,nodeGen ngs,traceBuf fgs)
+    where
+        (fgs,out) = formatGraphDiag1 "\n" True emptyLookupMap gr
+        ngs       = nodeGenSt fgs
+
+--  Internal function starts with supplied prefix table and indent string,
+--  and returns final state and formatted string.
+--  This is provided for diagnostic access to the final state
+formatGraphDiag1 :: String -> Bool -> NamespaceMap -> RDFGraph -> (Fgs,ShowS)
+formatGraphDiag1 ind dopref pref gr = res where
+    Fgsm fg = formatGraph ind " ." False dopref gr  -- construct monad
+    ngs     = emptyNgs                  -- construct initial state
+                { prefixes=pref
+                , nodeGen=findMaxBnode gr
+                }
+    (_,res) = fg (emptyFgs ngs)         -- apply monad to state, pick result
+
+----------------------------------------------------------------------
+--  Formatting as a monad-based computation
+----------------------------------------------------------------------
+
+-- ind      is indentation string
+-- end      is ending string to be placed after final statement
+-- dobreak  is True if a line break is to be inserted at the start
+-- dopref   is True if prefix strings are to be generated
+--
+formatGraph :: String -> String -> Bool -> Bool -> RDFGraph -> Fgsm (Fgs,ShowS)
+formatGraph ind end dobreak dopref gr =
+    do  { setIndent ind
+        ; setLineBreak dobreak
+        ; setGraph gr
+        ; fp <- if dopref then
+                    formatPrefixes (getNamespaces gr)
+                else
+                    return $ puts ""
+        ; more <- moreSubjects
+        ; res  <- if more then do
+            { fr <- formatSubjects
+            ; return $ fp . fr . (puts end)
+            }
+          else return $ fp
+        ; fgs <- getFgs
+        ; return (fgs,res)
+        }
+
+formatPrefixes :: NamespaceMap -> Fgsm ShowS
+formatPrefixes pmap =
+    do  { let mls = map (pref . keyVal) (listLookupMap pmap)
+        ; ls <- sequence mls
+        ; return $ puts $ concat ls
+        }
+    where
+        pref (p,u) = nextLine $ "@prefix "++p++": <"++u++"> ."
+
+--  The above function creates a list of 'Fgsm String' monads, then
+--  uses 'sequence' to turn that to a single 'Fgsm [String]' and finally
+--  concatenates them to a single string and uses 'puts' to return the
+--  result as a 'Fgsm ShowS'.  Phew!
+
+formatSubjects :: Fgsm ShowS
+formatSubjects =
+    do  { sb    <- nextSubject
+        ; sbstr <- formatLabel sb
+        ; prstr <- formatProperties sb sbstr
+        ; fmstr <- formatFormulae ""
+        ; more  <- moreSubjects
+        ; if more then do
+            { fr <- formatSubjects
+            ; return $ (puts $ prstr ++ fmstr ++ " .") . fr
+            }
+          else return $ puts $ prstr ++ fmstr
+        }
+
+formatProperties :: RDFLabel -> String -> Fgsm String
+formatProperties sb sbstr =
+    do  { pr    <- nextProperty sb
+        ; prstr <- formatLabel pr
+        ; obstr <- formatObjects sb pr (sbstr++" "++prstr)
+        ; more  <- moreProperties
+        ; let sbindent = replicate (length sbstr) ' '
+        ; if more then do
+            { fr <- formatProperties sb sbindent
+            ; nl <- nextLine $ obstr ++ " ;"
+            ; return $ nl ++ fr
+            }
+          else nextLine $ obstr
+        }
+
+formatObjects :: RDFLabel -> RDFLabel -> String -> Fgsm String
+formatObjects sb pr prstr =
+    do  { ob    <- nextObject sb pr
+        ; obstr <- formatLabel ob
+        ; more  <- moreObjects
+        ; if more then do
+            { let prindent = replicate (length prstr) ' '
+            ; fr <- formatObjects sb pr prindent
+            ; nl <- nextLine $ prstr ++ " " ++ obstr ++ ","
+            ; return $ nl ++ fr
+            }
+          else return $ prstr ++ " " ++ obstr
+        }
+
+formatFormulae :: String -> Fgsm String
+formatFormulae fp =
+    do  { more  <- moreFormulae
+        ; if more then do
+            { fnlgr <- nextFormula
+            ; fnstr <- formatFormula fnlgr
+            ; formatFormulae $ fp ++ " ." ++ fnstr
+            }
+          else return $ fp
+        }
+
+-- [[[TODO: use above pattern for subject/property/object loops?]]]
+
+formatFormula :: (RDFLabel,RDFGraph) -> Fgsm String
+formatFormula (fn,gr) =
+    do  { fnstr <- formatLabel fn
+        ; f1str <- nextLine $ fnstr ++ " :-"
+        ; f2str <- nextLine "    {"
+        ; ngs0  <- getNgs
+        ; ind   <- getIndent
+        ; let Fgsm grm = formatGraph (ind++"    ") "" True False
+                                     (setNamespaces emptyNamespaceMap gr)
+        ; let (fgs',(_,f3str)) = grm (emptyFgs ngs0)
+        ; setNgs (nodeGenSt fgs')
+        ; f4str <- nextLine "    }"
+        ; return $ f1str ++ f2str ++ (f3str f4str)
+        }
+
+----------------------------------------------------------------------
+--  Formatting helpers
+----------------------------------------------------------------------
+
+setGraph        :: RDFGraph -> Fgsm ()
+setGraph gr =
+    Fgsm (\fgs ->
+        let ngs0 = (nodeGenSt fgs)
+            pre' = mapMerge (prefixes ngs0) (getNamespaces gr)
+            ngs' = ngs0 { prefixes=pre' }
+            fgs' = fgs  { graph     = gr
+                        , subjs     = arcTree $ getArcs gr
+                        , props     = []
+                        , objs      = []
+                        , formAvail = getFormulae gr
+                        , nodeGenSt = ngs'
+                        }
+        in (fgs',()) )
+
+moreSubjects    :: Fgsm Bool
+moreSubjects    = Fgsm (\fgs -> (fgs,not $ null (subjs fgs)))
+
+nextSubject     :: Fgsm RDFLabel
+nextSubject     =
+    Fgsm (\fgs ->
+        let sb:sbs = subjs fgs
+            fgs' = fgs  { subjs = sbs
+                        , props = snd sb
+                        , objs  = []
+                        }
+        in (fgs',fst sb) )
+
+
+moreProperties  :: Fgsm Bool
+moreProperties  = Fgsm (\fgs -> (fgs,not $ null (props fgs)))
+
+nextProperty    :: RDFLabel -> Fgsm RDFLabel
+nextProperty sb =
+    Fgsm (\fgs ->
+        let pr:prs = props fgs
+            fgs' = fgs  { props = prs
+                        , objs  = snd pr
+                        }
+        in (fgs',fst pr) )
+
+
+moreObjects     :: Fgsm Bool
+moreObjects     = Fgsm (\fgs -> (fgs,not $ null (objs fgs)))
+
+nextObject      :: RDFLabel -> RDFLabel -> Fgsm RDFLabel
+nextObject sb pr =
+    Fgsm (\fgs ->
+        let ob:obs = objs fgs
+            fgs'   = fgs { objs = obs }
+        in (fgs',ob) )
+
+nextLine        :: String -> Fgsm String
+nextLine str =
+    do  { ind <- getIndent
+        ; brk <- getLineBreak
+        ; if brk then
+            return $ ind++str
+          else
+            --  After first line, always insert line break
+            do  { setLineBreak True
+                ; return str
+                }
+        }
+
+--  Format a label
+--  Most labels are simply displayed as provided, but there are a
+--  number of wrinkles to take care of here:
+--  (a) blank nodes automatically allocated on input, with node
+--      identifiers of the form of a digit string nnn.  These are
+--      not syntactically valid, and are reassigned node identifiers
+--      of the form _nnn, where nnn is chosen so that is does not
+--      clash with any other identifier in the graph.
+--  (b) URI nodes:  if possible, replace URI with qname,
+--      else display as <uri>
+--  (c) formula nodes (containing graphs).
+--
+--  [[[TODO:]]]
+--  (d) blank nodes used just once, can be expanded inline using
+--      [...] syntax.
+--  (e) generate multi-line literals when appropriate
+
+formatLabel :: RDFLabel -> Fgsm String
+formatLabel lab@(Blank nodeid@(lnc:_)) =
+    do  { name <- formatNodeId lab
+        ; queueFormula lab
+        ; return name
+        }
+formatLabel lab@(Res sn) =
+    do  { pr <- getPrefixes
+        ; let nsuri  = getScopeURI sn
+        ; let local  = snLocal sn
+        ; let premap = reverseLookupMap pr :: RevNamespaceMap
+        ; let prefix = mapFindMaybe nsuri premap
+        ; let name   = if (isJust prefix)
+                        then fromJust prefix++":"++local
+                        else "<"++nsuri++local++">"
+        ; queueFormula lab
+        ; return name
+        }
+{-
+formatLabel lab@(Lit str typ) =
+    do  { return $ show lab
+        }
+formatLabel lab@(Var vid) =
+    do  { return $ show lab
+        }
+-}
+formatLabel lab =
+    do  { return $ show lab
+        }
+
+formatNodeId :: RDFLabel -> Fgsm String
+formatNodeId lab@(Blank nodeid@(lnc:_)) =
+    if isDigit lnc then mapBlankNode lab else return $ show lab
+
+mapBlankNode :: RDFLabel -> Fgsm String
+mapBlankNode lab =
+    do  { ngs <- getNgs
+        ; let nmap = nodeMap ngs
+        ; let nnxt = (nodeGen ngs)
+        ; (nval,nnxt',nmap') <- case mapFind 0 lab nmap of
+            0 -> do { let nn = nnxt + 1
+                    ; let nm = mapAdd nmap (lab,nn)
+                    ; setNgs $ ngs { nodeGen=nn, nodeMap=nm }
+                    ; return (nn,nn,nm)
+                    }
+            n -> return $ (n,nnxt,nmap)
+        {- ; doTrace $ "Map node id: "++(show lab)
+                        ++", nval "++(show nval)
+                        ++", next "++(show nnxt')
+                        ++", nmap "++(show nmap') -}
+        ; return $ show $ Blank ('_':show nval)
+        }
+
+----------------------------------------------------------------------
+--  Graph-related helper functions
+----------------------------------------------------------------------
+
+--  Rearrange a list of arcs into a tree of pairs which group together
+--  all statements for a single subject, sind similarly for multiple
+--  objects of a common predicate.
+arcTree :: (Ord lb) => [Arc lb] -> SubjTree lb
+arcTree as = commonFstEq (commonFstEq id) $ map spopair $ stableQuickSort as
+    where
+        spopair (Arc s p o) = (s,(p,o))
+
+{-
+arcTree as = map spopair $ sort as
+    where
+        spopair (Arc s p o) = (s,[(p,[o])])
+-}
+
+--  Rearrange a list of pairs so that multiple occurrences of the first
+--  are commoned up, and the supplied function is applied to each sublist
+--  with common first elements to obtain the corresponding second value
+commonFstEq :: (Eq a) => ( [b] -> c ) -> [(a,b)] -> [(a,c)]
+commonFstEq f ps =
+    [ (fst $ head sps,f $ map snd sps) | sps <- groupBy fstEq ps ]
+    where
+        fstEq (f1,_) (f2,_) = f1 == f2
+
+{-+-- Diagnostic code for checking arcTree logic:
+testArcTree = (arcTree testArcTree1) == testArcTree2
+testArcTree1 =
+    [Arc "s1" "p11" "o111", Arc "s1" "p11" "o112"
+    ,Arc "s1" "p12" "o121", Arc "s1" "p12" "o122"
+    ,Arc "s2" "p21" "o211", Arc "s2" "p21" "o212"
+    ,Arc "s2" "p22" "o221", Arc "s2" "p22" "o222"
+    ]
+testArcTree2 =
+    [("s1",[("p11",["o111","o112"]),("p12",["o121","o122"])])
+    ,("s2",[("p21",["o211","o212"]),("p22",["o221","o222"])])
+    ]
+-}++
+findMaxBnode    :: RDFGraph -> Int
+findMaxBnode gr =
+    maximum $
+    map getAutoBnodeIndex $
+    labels gr
+
+getAutoBnodeIndex   :: RDFLabel -> Int
+getAutoBnodeIndex (Blank ('_':lns)) = res where
+    -- cf. prelude definition of read s ...
+    res = case [x | (x,t) <- reads lns, ("","") <- lex t] of
+            [x] -> x
+            _   -> 0
+getAutoBnodeIndex _                   = 0
+
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/N3Formatter.hs,v $
+-- $Author: graham $
+-- $Revision: 1.23 $
+-- $Log: N3Formatter.hs,v $
+-- Revision 1.23  2004/01/22 19:52:41  graham
+-- Rename module URI to avoid awkward clash with Haskell libraries
+--
+-- Revision 1.22  2004/01/09 12:57:08  graham
+-- Remove space between perfix and ':' in @prefix declaractions,
+-- for compatibility with new Notation 3 syntax (and Jena).
+--
+-- Revision 1.21  2004/01/09 12:49:39  graham
+-- Remove superfluous PutS class.
+--
+-- Revision 1.20  2004/01/09 12:44:52  graham
+-- Fix up N3Formatter to suppress final statement-terminating '.' in a formula,
+-- for compatibility with the current Notation3 syntax.
+--
+-- Revision 1.19  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.18  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.17  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.16  2003/11/24 15:46:04  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.15  2003/10/24 21:03:25  graham
+-- Changed kind-structure of LookupMap type classes.
+--
+-- Revision 1.14  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.13  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.12  2003/06/25 21:16:52  graham
+-- Reworked N3 formatting logic to support proof display.
+-- Basic proof display is working.
+--
+-- Revision 1.11  2003/06/12 00:47:55  graham
+-- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
+--
+-- Revision 1.10  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.9  2003/05/28 17:39:30  graham
+-- Trying to track down N3 formatter performance problem.
+--
+-- Revision 1.8  2003/05/23 00:02:42  graham
+-- Fixed blank node id generation bug in N3Formatter
+--
+-- Revision 1.7  2003/05/20 23:35:28  graham
+-- Modified code to compile with GHC hierarchical libraries
+--
+-- Revision 1.6  2003/05/14 22:39:23  graham
+-- Initial formatter tests all run OK.
+-- The formatter could still use so,me improvement,
+-- but it
+-- passes the minimal round-tripping tests.
+--
+-- Revision 1.5  2003/05/14 19:38:32  graham
+-- Simple formatter tests all working with reworked graph and lookup structures.
+-- More complex formatter tests still to be coded.
+--
+-- Revision 1.4  2003/04/29 22:09:43  graham
+-- Updated TODO notes
+--
+-- Revision 1.3  2003/04/29 22:07:10  graham
+-- Some refactoring of N3 formatter.
+-- N3 formatter now handles trivial cases.
+-- More complex formatter test cases still to be developed.
+--
+-- Revision 1.2  2003/04/25 11:40:06  graham
+-- Formatter compiles OK
+--
+-- Revision 1.1  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+ Swish/HaskellRDF/N3FormatterTest.hs view
@@ -0,0 +1,1470 @@+--------------------------------------------------------------------------------
+--  $Id: N3FormatterTest.hs,v 1.21 2004/01/09 12:57:08 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  N3FormatterTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This Module defines test cases for module Parse parsing functions.
+--
+--------------------------------------------------------------------------------
+
+-- WNH module Swish.HaskellRDF.N3FormatterTest where
+
+import Swish.HaskellRDF.N3Formatter
+    ( formatGraphAsStringNl
+    , formatGraphAsString
+    , formatGraphDiag )
+
+import Swish.HaskellRDF.N3Parser
+    ( ParseResult(..)
+    , parseN3fromString
+    , parseTextFromString, parseAltFromString
+    , parseNameFromString, parsePrefixFromString
+    , parseAbsURIrefFromString, parseLexURIrefFromString
+    , parseURIref2FromString )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)
+    , setArcs, getArcs, add, delete, extract, labels
+    , NamespaceMap, emptyNamespaceMap
+    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
+    , setNamespaces
+    , emptyRDFGraph, toRDFGraph
+      -- Export selected RDFLabel values
+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
+    , res_rdfs_member
+    , res_rdfd_GeneralRestriction
+    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality
+    , res_owl_sameAs
+    , res_operator_plus, res_operator_minus
+    , res_operator_slash, res_operator_star
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , makeNamespaceQName
+    , getQName, getScopedNameURI
+    , ScopedName(..)
+    , makeScopedName, makeQNameScopedName
+    , nullScopedName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceRDFC
+    , namespaceRDFO
+    , namespaceXSD
+    , namespaceXsdType
+    , namespaceOWL
+    , namespaceMATH
+    , namespaceLOG
+    , namespaceDAML
+    , rdf_type
+    , rdf_first, rdf_rest, rdf_nil
+    , rdfs_member
+    , rdfd_GeneralRestriction
+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
+    , owl_sameAs
+    , operator_plus, operator_minus, operator_slash, operator_star
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..)
+    , newQName, qnameFromPair, qnameFromURI
+    , getNamespace, getLocalName, getQNameURI
+    , splitURI
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..)
+    , emptyLookupMap, makeLookupMap, listLookupMap )
+
+import Swish.HaskellRDF.GraphClass
+    ( Arc, arcSubj, arcPred, arcObj, arc )
+
+import Swish.HaskellUtils.ErrorM
+    ( ErrorM(..) )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertEqual, runTestTT, runTestText, putTextToHandle )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn )
+
+------------------------------------------------------------
+--  Common test wrappers
+------------------------------------------------------------
+
+testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test
+testLabelEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
+
+testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test
+testGraphEq lab eq g1 g2 =
+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
+
+------------------------------------------------------------
+--  Define some common values
+------------------------------------------------------------
+
+base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"
+base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"
+base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
+base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+
+qb1s1 = ScopedName base1 "s1"
+qb2s2 = ScopedName base2 "s2"
+qb3s3 = ScopedName base3 "s3"
+
+s1 = Res qb1s1  :: RDFLabel
+s2 = Res qb2s2  :: RDFLabel
+s3 = Res qb3s3  :: RDFLabel
+
+b1 = Blank "b1" :: RDFLabel
+b2 = Blank "b2" :: RDFLabel
+b3 = Blank "b3" :: RDFLabel
+b4 = Blank "b4" :: RDFLabel
+b5 = Blank "b5" :: RDFLabel
+b6 = Blank "b6" :: RDFLabel
+b7 = Blank "b7" :: RDFLabel
+b8 = Blank "b8" :: RDFLabel
+
+c1 = Blank "c1" :: RDFLabel
+c2 = Blank "c2" :: RDFLabel
+c3 = Blank "c3" :: RDFLabel
+c4 = Blank "c4" :: RDFLabel
+c5 = Blank "c5" :: RDFLabel
+c6 = Blank "c6" :: RDFLabel
+
+qb1p1  = ScopedName base1 "p1"
+qb2p2  = ScopedName base2 "p2"
+qb3p3  = ScopedName base3 "p3"
+qb2p21 = ScopedName base2 "p21"
+qb2p22 = ScopedName base2 "p22"
+qb2p23 = ScopedName base2 "p23"
+qb2p24 = ScopedName base2 "p24"
+qb2p25 = ScopedName base2 "p25"
+qb2p26 = ScopedName base2 "p26"
+
+p1  = Res qb1p1  :: RDFLabel
+p2  = Res qb2p2  :: RDFLabel
+p3  = Res qb3p3  :: RDFLabel
+p21 = Res qb2p21 :: RDFLabel
+p22 = Res qb2p22 :: RDFLabel
+p23 = Res qb2p23 :: RDFLabel
+p24 = Res qb2p24 :: RDFLabel
+p25 = Res qb2p25 :: RDFLabel
+p26 = Res qb2p26 :: RDFLabel
+
+qb1o1 = ScopedName base1 "o1"
+qb2o2 = ScopedName base2 "o2"
+qb3o3 = ScopedName base3 "o3"
+
+o1 = Res qb1o1 :: RDFLabel
+o2 = Res qb2o2 :: RDFLabel
+o3 = Res qb3o3 :: RDFLabel
+
+l1txt = "l1"
+l2txt = "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'"
+l3txt = "l3--\r\"'\\--\x0020\&--\x00A0\&--"
+l11txt = "lx11"
+l12txt = "lx12"
+l13txt = "lx13"
+l14txt = "lx14"
+
+l1  = Lit l1txt  Nothing    :: RDFLabel
+l2  = Lit l2txt  Nothing    :: RDFLabel
+l3  = Lit l3txt  Nothing    :: RDFLabel
+l11 = Lit l11txt Nothing    :: RDFLabel
+l12 = Lit l12txt Nothing    :: RDFLabel
+l13 = Lit l13txt Nothing    :: RDFLabel
+l14 = Lit l14txt Nothing    :: RDFLabel
+
+qb1f1 = ScopedName base1 "f1"
+qb2f2 = ScopedName base2 "f2"
+
+f1 = Res qb1f1 :: RDFLabel
+f2 = Res qb2f2 :: RDFLabel
+
+v1 = Var "var1" :: RDFLabel
+v2 = Var "var2" :: RDFLabel
+v3 = Var "var3" :: RDFLabel
+v4 = Var "var4" :: RDFLabel
+
+------------------------------------------------------------
+--  Construct graphs for testing
+------------------------------------------------------------
+
+t01 = arc s1 p1 o1
+t02 = arc s2 p1 o2
+t03 = arc s3 p1 o3
+t04 = arc s1 p1 l1
+t05 = arc s2 p1 b1
+t06 = arc s3 p1 l2
+t07 = arc s3 p2 l3
+
+nslist = makeLookupMap
+    [ base1
+    , base2
+    , base3
+    , base4
+    ]
+
+g1np = NSGraph
+        { namespaces = emptyNamespaceMap
+        , formulae   = emptyFormulaMap
+        , statements = [t01]
+        }
+
+g1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01]
+        }
+
+g1b1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [b01]
+        }
+    where
+        b01 = arc b1 p1 o1
+
+g1b3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [b01]
+        }
+    where
+        b01 = arc b1 b2 b3
+
+g1a1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [a01]
+        }
+    where
+        a1  = Blank "1"  :: RDFLabel
+        a01 = arc a1 p1 o1
+
+g1l1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [l01]
+        }
+    where
+        l01 = arc s1 p1 l1
+
+g1l2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [l02]
+        }
+    where
+        l02 = arc s1 p1 l2
+
+
+g1f1 = NSGraph
+        { namespaces = nslist
+        , formulae   = formo1g1
+        , statements = [f01]
+        }
+    where
+        f01      = arc s1 p1 o1
+        formo1g1 = LookupMap [Formula o1 g1]
+
+
+g1f2 = NSGraph
+        { namespaces = nslist
+        , formulae   = formb2g1
+        , statements = [f02]
+        }
+    where
+        f02 = arc s1 p1 b2
+        formb2g1 = LookupMap [Formula b2 g1]
+
+g1f3 = NSGraph
+        { namespaces = nslist
+        , formulae   = formb3g1f2
+        , statements = [f02]
+        }
+    where
+        f02 = arc s1 p1 b3
+        formb3g1f2 = LookupMap [Formula b3 g1f2]
+
+----
+
+g2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03]
+        }
+
+g3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t04]
+        }
+
+g4 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t05]
+        }
+
+g5 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03,t04,t05]
+        }
+
+g6 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t06]
+        }
+
+g7 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t07]
+        }
+
+pref_rdf = nsURI namespaceRDF
+pref_op  = nsURI namespaceRDFO
+pref_owl = nsURI namespaceOWL
+
+t801 = arc s1 res_rdf_type       o1
+t802 = arc s2 res_owl_sameAs     o2
+t803 = arc s3 res_operator_plus  o3
+t804 = arc s3 res_operator_minus o3
+t805 = arc s3 res_operator_star  o3
+t806 = arc s3 res_operator_slash o3
+t807 = arc o1 p1 s1
+t808 = arc s2 p1 o2
+t809 = arc s1 p2 o1
+t810 = arc o2 p2 s2
+
+g8 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t801,t802,t803,t804,t805,t806,t807,t808,t809,t810]
+        }
+
+g81 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t801,t802]
+        }
+
+g82 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t803,t804,t805,t806]
+        }
+
+g83 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t807,t808,t809,t810]
+        }
+
+t911 = arc s1 p1 o1
+t912 = arc s1 p1 o2
+t913 = arc s1 p2 o2
+t914 = arc s1 p2 o3
+t921 = arc s2 p1 o1
+t922 = arc s2 p1 o2
+t923 = arc s2 p1 o3
+t924 = arc s2 p1 l1
+t925 = arc s2 p2 o1
+t926 = arc s2 p2 o2
+t927 = arc s2 p2 o3
+t928 = arc s2 p2 l1
+
+g9 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t911,t912,t913,t914,
+                        t921,t922,t923,t924,
+                        t925,t926,t927,t928]
+        }
+
+t1011 = arc s1 p1 o1
+t1012 = arc o2 p1 s1
+t1013 = arc s1 p2 o2
+t1014 = arc o3 p2 s1
+t1021 = arc s2 p1 o1
+t1022 = arc s2 p1 o2
+t1023 = arc s2 p1 o3
+t1024 = arc s2 p1 l1
+t1025 = arc o1 p2 s2
+t1026 = arc o2 p2 s2
+t1027 = arc o3 p2 s2
+-- t1028 = arc l1 p2 s2
+t1028 = arc s1 p2 s2
+
+g10 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t1011,t1012,t1013,t1014,
+                        t1021,t1022,t1023,t1024,
+                        t1025,t1026,t1027,t1028 ]
+        }
+
+t1111 = arc s1 p1 v1
+t1112 = arc v2 p1 o1
+t1113 = arc v3 p1 v4
+
+g11 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t1111,t1112,t1113]
+        }
+
+tx101 = arc b1 res_owl_sameAs s1
+tx102 = arc s2 res_owl_sameAs b2
+tx111 = arc b1 p1 o1
+tx112 = arc b1 p1 o2
+tx113 = arc b1 p2 o2
+tx114 = arc b1 p2 o3
+tx121 = arc b2 p1 o1
+tx122 = arc b2 p1 o2
+tx123 = arc b2 p1 o3
+tx124 = arc b2 p1 l1
+tx125 = arc b2 p2 o1
+tx126 = arc b2 p2 o2
+tx127 = arc b2 p2 o3
+tx128 = arc b2 p2 l1
+
+x1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx101,tx102,
+                        tx111,tx112,tx113,tx114,
+                        tx121,tx122,tx123,tx124,
+                        tx125,tx126,tx127,tx128]
+        }
+
+tx201 = arc b1 res_owl_sameAs s1
+tx202 = arc s2 res_owl_sameAs b2
+tx211 = arc b1 p1 o1
+tx212 = arc o2 p1 b1
+tx213 = arc b1 p2 o2
+tx214 = arc o3 p2 b1
+tx221 = arc b2 p1 o1
+tx222 = arc b2 p1 o2
+tx223 = arc b2 p1 o3
+tx224 = arc b2 p1 l1
+tx225 = arc o1 p2 b2
+tx226 = arc o2 p2 b2
+tx227 = arc o3 p2 b2
+-- tx228 = arc l1 p2 b2
+
+x2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx201,tx202,
+                        tx211,tx212,tx213,tx214,
+                        tx221,tx222,tx223,tx224,
+                        tx225,tx226,tx227]
+        }
+
+tx311 = arc s1 p1 o1
+tx312 = arc o2 p1 s1
+tx313 = arc s1 p2 o2
+tx314 = arc o3 p2 s1
+tx321 = arc s2 p1 o1
+tx322 = arc s2 p1 o2
+tx323 = arc s2 p1 o3
+tx324 = arc s2 p1 l1
+tx325 = arc o1 p2 s2
+tx326 = arc o2 p2 s2
+tx327 = arc o3 p2 s2
+-- tx328 = arc l1 p2 s2
+
+x3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx311,tx312,tx313,tx314,
+                        tx321,tx322,tx323,tx324,
+                        tx325,tx326,tx327]
+        }
+
+tx401 = arc s1 res_owl_sameAs b1
+tx402 = arc b1 res_rdf_first  o1
+tx403 = arc b1 res_rdf_rest   b2
+tx404 = arc b2 res_rdf_first  o2
+tx405 = arc b2 res_rdf_rest   b3
+tx406 = arc b3 res_rdf_first  o3
+tx407 = arc b3 res_rdf_rest   b4
+tx408 = arc b4 res_rdf_first  l1
+tx409 = arc b4 res_rdf_rest   res_rdf_nil
+
+x4 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx401,tx402,tx403,tx404,
+                        tx405,tx406,tx407,tx408,
+                        tx409]
+        }
+
+tx501 = arc b1 res_owl_sameAs s1
+tx502 = arc b1 res_rdf_first  o1
+tx503 = arc b1 res_rdf_rest   b2
+tx504 = arc b2 res_rdf_first  o2
+tx505 = arc b2 res_rdf_rest   b3
+tx506 = arc b3 res_rdf_first  o3
+tx507 = arc b3 res_rdf_rest   b4
+tx508 = arc b4 res_rdf_first  l1
+tx509 = arc b4 res_rdf_rest   res_rdf_nil
+
+x5 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx501,tx502,tx503,tx504,
+                        tx505,tx506,tx507,tx508,
+                        tx509]
+        }
+
+tx601 = arc s1 res_rdf_first o1
+tx602 = arc s1 res_rdf_rest  b2
+tx603 = arc b2 res_rdf_first o2
+tx604 = arc b2 res_rdf_rest  b3
+tx605 = arc b3 res_rdf_first o3
+tx606 = arc b3 res_rdf_rest  b4
+tx607 = arc b4 res_rdf_first l1
+tx608 = arc b4 res_rdf_rest  res_rdf_nil
+
+x6 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx601,tx602,tx603,tx604,
+                        tx605,tx606,tx607,tx608]
+        }
+
+formb1g2 = LookupMap [Formula b1 g2]
+tx701    = arc b1 p2 f2
+x7       = NSGraph
+        { namespaces = nslist
+        , formulae   = formb1g2
+        , statements = [tx701]
+        }
+
+formf1g2 = LookupMap [Formula f1 g2]
+tx801    = arc f1 p2 f2
+x8       = NSGraph
+        { namespaces = nslist
+        , formulae   = formf1g2
+        , statements = [tx801]
+        }
+
+formf1g1 = LookupMap [Formula f1 g1]
+tx901 = arc f1 p2 f2
+
+x9 = NSGraph
+        { namespaces = nslist
+        , formulae   = formf1g1
+        , statements = [tx801]
+        }
+
+--  Test allocation of bnodes carries over a nested formula
+tx1201 = arc s1 p1 b1
+tx1202 = arc b1 p1 o1
+tx1203 = arc b2 p2 f2
+tx1204 = arc s3 p3 b3
+tx1205 = arc b3 p3 o3
+tx1211 = arc s2 p2 b4
+tx1212 = arc b4 p2 o2
+x12fg  = NSGraph
+        { namespaces = emptyNamespaceMap
+        , formulae   = emptyFormulaMap
+        , statements = [tx1211,tx1212]
+        }
+x12f   = LookupMap [Formula b2 x12fg]
+x12    = NSGraph
+        { namespaces = nslist
+        , formulae   = x12f
+        , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]
+        }
+
+--  List of simple anon nodes
+tx1301 = arc s1 res_rdf_first b1
+tx1302 = arc s1 res_rdf_rest  c1
+tx1303 = arc c1 res_rdf_first b2
+tx1304 = arc c1 res_rdf_rest  c2
+tx1305 = arc c2 res_rdf_first b3
+tx1306 = arc c2 res_rdf_rest  res_rdf_nil
+tx1307 = arc b1 p1 o1
+tx1308 = arc b2 p1 o2
+tx1309 = arc b3 p1 o3
+
+x13    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,
+                        tx1307,tx1308,tx1309]
+        }
+
+--  List of simple anon nodes using autogenerated bnodes
+b_1 = Blank "1" :: RDFLabel
+b_2 = Blank "2" :: RDFLabel
+b_3 = Blank "3" :: RDFLabel
+c_1 = Blank "4" :: RDFLabel
+c_2 = Blank "5" :: RDFLabel
+
+tx1301a = arc s1  res_rdf_first b_1
+tx1302a = arc s1  res_rdf_rest  c_1
+tx1303a = arc c_1 res_rdf_first b_2
+tx1304a = arc c_1 res_rdf_rest  c_2
+tx1305a = arc c_2 res_rdf_first b_3
+tx1306a = arc c_2 res_rdf_rest  res_rdf_nil
+tx1307a = arc b_1 p1 o1
+tx1308a = arc b_2 p1 o2
+tx1309a = arc b_3 p1 o3
+
+x13a = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1301a,tx1302a,tx1303a,tx1304a,tx1305a,tx1306a,
+                        tx1307a,tx1308a,tx1309a]
+        }
+
+--  List of more complex anon nodes
+tx1401 = arc s1 res_rdf_first b1
+tx1402 = arc s1 res_rdf_rest  c1
+tx1403 = arc c1 res_rdf_first b2
+tx1404 = arc c1 res_rdf_rest  c2
+tx1405 = arc c2 res_rdf_first b3
+tx1406 = arc c2 res_rdf_rest  res_rdf_nil
+tx1407 = arc b1 p1 o1
+tx1408 = arc b1 p2 o1
+tx1409 = arc b2 p1 o2
+tx1410 = arc b2 p2 o2
+tx1411 = arc b3 p1 o3
+tx1412 = arc b3 p2 o3
+
+x14    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,
+                        tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]
+        }
+
+--  List with nested list
+tx1501 = arc s1 res_rdf_first b1
+tx1502 = arc s1 res_rdf_rest  c1
+tx1503 = arc c1 res_rdf_first b2
+tx1504 = arc c1 res_rdf_rest  c2
+tx1505 = arc c2 res_rdf_first b3
+tx1506 = arc c2 res_rdf_rest  res_rdf_nil
+tx1507 = arc b1 p1 o1
+tx1508 = arc b2 p2 c3
+tx1509 = arc b3 p1 o3
+
+tx1521 = arc c3 res_rdf_first b4
+tx1522 = arc c3 res_rdf_rest  c4
+tx1523 = arc c4 res_rdf_first b5
+tx1524 = arc c4 res_rdf_rest  c5
+tx1525 = arc c5 res_rdf_first b6
+tx1526 = arc c5 res_rdf_rest  res_rdf_nil
+tx1527 = arc b4 p1 o1
+tx1528 = arc b5 p1 o2
+tx1529 = arc b6 p1 o3
+
+x15    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,
+                        tx1507,tx1508,tx1509,
+                        tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,
+                        tx1527,tx1528,tx1529]
+        }
+
+
+
+--  More complex list with nested list
+tx1601 = arc s1 res_rdf_first b1
+tx1602 = arc s1 res_rdf_rest  c1
+tx1603 = arc c1 res_rdf_first b2
+tx1604 = arc c1 res_rdf_rest  c2
+tx1605 = arc c2 res_rdf_first b3
+tx1606 = arc c2 res_rdf_rest  res_rdf_nil
+tx1607 = arc b1 p1 o1
+tx1608 = arc b1 p2 o1
+tx1609 = arc b2 p2 c3
+tx1610 = arc b3 p1 o3
+tx1611 = arc b3 p2 o3
+
+tx1621 = arc c3 res_rdf_first b4
+tx1622 = arc c3 res_rdf_rest  c4
+tx1623 = arc c4 res_rdf_first b5
+tx1624 = arc c4 res_rdf_rest  c5
+tx1625 = arc c5 res_rdf_first b6
+tx1626 = arc c5 res_rdf_rest  res_rdf_nil
+tx1627 = arc b4 p1 o1
+tx1628 = arc b4 p2 o1
+tx1629 = arc b5 p1 o2
+tx1630 = arc b5 p2 o2
+tx1631 = arc b6 p1 o3
+tx1632 = arc b6 p2 o3
+
+x16    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,
+                        tx1607,tx1608,tx1609,tx1610,tx1611,
+                        tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,
+                        tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]
+        }
+
+--  Troublesome example
+tx1701 = arc s1 res_rdf_type  o1
+tx1702 = arc s1 res_rdf_first b1
+tx1703 = arc s1 res_rdf_rest  c1
+tx1704 = arc c1 res_rdf_first b2
+tx1705 = arc c1 res_rdf_rest  res_rdf_nil
+
+tx1706 = arc b1 p21 o2
+tx1707 = arc b1 p22 c2
+
+tx1708 = arc b2 p24 o3
+tx1709 = arc b2 p25 l13
+
+tx1710 = arc c2 res_rdf_first b3
+tx1711 = arc c2 res_rdf_rest  c3
+tx1712 = arc c3 res_rdf_first l12
+tx1713 = arc c3 res_rdf_rest  res_rdf_nil
+
+tx1714 = arc b3 p23 l11
+
+x17    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1701,tx1702,tx1703,tx1704,tx1705,tx1706,
+                        tx1707,tx1708,tx1709,
+                        tx1710,tx1711,tx1712,tx1713,tx1714]
+        }
+
+------------------------------------------------------------
+--  Trivial formatter tests
+------------------------------------------------------------
+--
+--  These are very basic tests that confirm that output for a
+--  simple graph corresponds exactly to some supplied string.
+
+formatTest :: String -> RDFGraph -> String -> Test
+formatTest lab gr out =
+    TestList
+      [ TestCase ( assertEqual ("formatTest:"++lab) out res )
+      ]
+    where
+      res = formatGraphAsStringNl gr
+
+diagTest :: String -> RDFGraph -> String -> Test
+diagTest lab gr out =
+    TestList
+      [ TestCase ( assertEqual ("diag:text:"++lab) out (res "") )
+      , TestCase ( assertEqual ("diag:map:"++lab) emptyLookupMap nmap )
+      , TestCase ( assertEqual ("diag:gen:"++lab) 0 ngen )
+      , TestCase ( assertEqual ("diag:trc:"++lab) [] trc )
+      ]
+    where
+      (res,nmap,ngen,trc) = formatGraphDiag gr
+
+commonPrefixes =
+    "@prefix base1: <" ++ nsURI base1 ++ "> .\n" ++
+    "@prefix base2: <" ++ nsURI base2 ++ "> .\n" ++
+    "@prefix base3: <" ++ nsURI base3 ++ "> .\n" ++
+    "@prefix base4: <" ++ nsURI base4 ++ "> .\n"
+
+--  Single statement using <uri> form
+simpleN3Graph_g1_01 =
+    "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> " ++
+    "<http://id.ninebynine.org/wip/2003/test/graph1/node#p1> " ++
+    "<http://id.ninebynine.org/wip/2003/test/graph1/node#o1> .\n"
+
+--  Single statement using prefix:name form
+simpleN3Graph_g1_02 =
+    commonPrefixes ++
+    "base1:s1 base1:p1 base1:o1 .\n"
+
+--  Single blank node
+simpleN3Graph_g1_03 =
+    commonPrefixes ++
+    "_:b1 base1:p1 base1:o1 .\n"
+
+--  Single auto-allocated blank node
+simpleN3Graph_g1_04 =
+    commonPrefixes ++
+    "_:_1 base1:p1 base1:o1 .\n"
+
+--  Single literal object
+simpleN3Graph_g1_05 =
+    commonPrefixes ++
+    "base1:s1 base1:p1 \"l1\" .\n"
+
+--  Single multiline literal object
+simpleN3Graph_g1_06 =
+    commonPrefixes ++
+    "base1:s1 base1:p1 \"l2-'\\\"line1\\\"'\\n\\nl2-'\\\"\\\"line2\\\"\\\"'\" .\n"
+
+--  Single statement with formula node
+simpleN3Graph_g1_07 =
+    commonPrefixes ++
+    "base1:s1 base1:p1 base1:o1 .\n"++
+    "base1:o1 :-\n"++
+    "    {\n"++
+    "    base1:s1 base1:p1 base1:o1\n"++
+    "    } .\n"
+
+--  Single statement with formula blank node
+simpleN3Graph_g1_08 =
+    commonPrefixes ++
+    "base1:s1 base1:p1 _:b2 .\n"++
+    "_:b2 :-\n"++
+    "    {\n"++
+    "    base1:s1 base1:p1 base1:o1\n"++
+    "    } .\n"
+
+--  Three blank nodes (or is that blind mice?)
+simpleN3Graph_g1_09 =
+    commonPrefixes ++
+    "_:b1 _:b2 _:b3 .\n"
+
+--  Simple nested foprmula case
+simpleN3Graph_g1_10 =
+    commonPrefixes ++
+    "base1:s1 base1:p1 _:b3 .\n"           ++
+    "_:b3 :-\n"                            ++
+    "    {\n"                              ++
+    "    base1:s1 base1:p1 _:b2 .\n"       ++
+    "    _:b2 :-\n"                        ++
+    "        {\n"                          ++
+    "        base1:s1 base1:p1 base1:o1\n" ++
+    "        }\n"                          ++
+    "    } .\n"
+
+--  Simple troublesome case
+simpleN3Graph_x13a =
+    commonPrefixes ++
+    "base1:s1 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> _:_1 ;\n"++
+    "         <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> _:_2 .\n"++
+    "_:_1 base1:p1 base1:o1 .\n"++
+    "_:_3 base1:p1 base2:o2 .\n"++
+    "_:_4 base1:p1 base3:o3 .\n"++
+    "_:_2 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> _:_3 ;\n"++
+    "     <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> _:_5 .\n"++
+    "_:_5 <http://www.w3.org/1999/02/22-rdf-syntax-ns#first> _:_4 ;\n"++
+    "     <http://www.w3.org/1999/02/22-rdf-syntax-ns#rest> <http://www.w3.org/1999/02/22-rdf-syntax-ns#nil> .\n"
+
+trivialTest01 = formatTest "trivialTest01" g1np simpleN3Graph_g1_01
+trivialTest02 = formatTest "trivialTest02" g1   simpleN3Graph_g1_02
+trivialTest03 = formatTest "trivialTest03" g1b1 simpleN3Graph_g1_03
+trivialTest04 = formatTest "trivialTest04" g1a1 simpleN3Graph_g1_04
+trivialTest05 = formatTest "trivialTest05" g1l1 simpleN3Graph_g1_05
+trivialTest06 = formatTest "trivialTest06" g1l2 simpleN3Graph_g1_06
+trivialTest07 = formatTest "trivialTest07" g1f1 simpleN3Graph_g1_07
+trivialTest08 = formatTest "trivialTest08" g1f2 simpleN3Graph_g1_08
+trivialTest09 = formatTest "trivialTest09" g1b3 simpleN3Graph_g1_09
+trivialTest10 = formatTest "trivialTest10" g1f3 simpleN3Graph_g1_10
+trivialTest13 = formatTest "trivialTest13" x13a simpleN3Graph_x13a
+
+diag13 = diagTest "trivialTest13" x13a simpleN3Graph_x13a
+
+trivialTestSuite = TestList
+  [ trivialTest01
+  , trivialTest02
+  , trivialTest03
+  , trivialTest04
+  , trivialTest05
+  , trivialTest06
+  , trivialTest07
+  , trivialTest08
+  , trivialTest09
+  , trivialTest10
+  , trivialTest13
+  ]
+
+------------------------------------------------------------
+--  Parser tests to cross-check round-trip testing
+------------------------------------------------------------
+
+parseTest :: String -> String -> RDFGraph -> String -> Test
+parseTest lab inp gr er =
+    TestList
+      [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )
+      , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )
+      ]
+    where
+        (pe,pg) = case parseN3fromString inp of
+            Result g -> ("",g)
+            Error  s -> (s,emptyRDFGraph)
+
+noError   = ""
+errorText = "*"
+
+parseTest01 = parseTest "01" simpleN3Graph_g1_01 g1np noError
+parseTest02 = parseTest "02" simpleN3Graph_g1_02 g1   noError
+parseTest03 = parseTest "03" simpleN3Graph_g1_03 g1b1 noError
+parseTest04 = parseTest "04" simpleN3Graph_g1_04 g1a1 noError
+parseTest05 = parseTest "05" simpleN3Graph_g1_05 g1l1 noError
+parseTest06 = parseTest "06" simpleN3Graph_g1_06 g1l2 noError
+parseTest07 = parseTest "07" simpleN3Graph_g1_07 g1f1 noError
+parseTest08 = parseTest "08" simpleN3Graph_g1_08 g1f2 noError
+
+parseTestSuite = TestList
+  [ parseTest01
+  , parseTest02
+  , parseTest03
+  , parseTest04
+  , parseTest05
+  , parseTest06
+  , parseTest07
+  , parseTest08
+  ]
+
+------------------------------------------------------------
+--  Repeat above tests using parser and graph-comparison
+------------------------------------------------------------
+--
+--  This establishes a framework that will be used for
+--  more complex tests that are less susceptible to trivial
+--  formatting differences.  The idea is to generate output
+--  that can be parsed to obtain an equivalent graph.
+
+roundTripTest :: String -> RDFGraph -> Test
+roundTripTest lab gr =
+    TestList
+      [ TestCase ( assertEqual ("RoundTrip:gr:"++lab) gr pg )
+      , TestCase ( assertEqual ("RoundTrip:er:"++lab) "" pe )
+      -- , TestCase ( assertEqual ("Formatted:"++lab) "" out )
+      ]
+    where
+        out     = formatGraphAsString gr
+        (pe,pg) = case parseN3fromString out of
+            Result g -> ("",g)
+            Error  s -> (s,emptyRDFGraph)
+
+--  Full round trip from graph source.  This test may pick up some errors
+--  the bnode generation logic that are not tested by hand-assembled graph
+--  data structures.
+fullRoundTripTest :: String -> String -> Test
+fullRoundTripTest lab grstr =
+    TestList
+      [ TestCase ( assertEqual ("FullRoundTrip:gr:"++lab) gr pg )
+      , TestCase ( assertEqual ("FullRoundTrip:er:"++lab) "" pe )
+      -- , TestCase ( assertEqual ("FullRoundTrip:"++lab) "" out )
+      ]
+    where
+        (ge,gr) = case parseN3fromString grstr of
+            Result g -> ("",g)
+            Error  s -> (s,emptyRDFGraph)
+        out     = formatGraphAsString gr
+        (pe,pg) = case parseN3fromString out of
+            Result g -> ("",g)
+            Error  s -> (s,emptyRDFGraph)
+
+roundTripTest01 = roundTripTest "01" g1np
+roundTripTest02 = roundTripTest "02" g1
+roundTripTest03 = roundTripTest "03" g1b1
+roundTripTest04 = roundTripTest "04" g1a1
+roundTripTest05 = roundTripTest "05" g1l1
+roundTripTest06 = roundTripTest "06" g1l2
+roundTripTest07 = roundTripTest "07" g1f1
+roundTripTest08 = roundTripTest "08" g1f2
+roundTripTest11 = fullRoundTripTest "11" simpleN3Graph_g1_01
+roundTripTest12 = fullRoundTripTest "12" simpleN3Graph_g1_02
+roundTripTest13 = fullRoundTripTest "13" simpleN3Graph_g1_03
+roundTripTest14 = fullRoundTripTest "14" simpleN3Graph_g1_04
+roundTripTest15 = fullRoundTripTest "15" simpleN3Graph_g1_05
+roundTripTest16 = fullRoundTripTest "16" simpleN3Graph_g1_06
+roundTripTest17 = fullRoundTripTest "17" simpleN3Graph_g1_07
+roundTripTest18 = fullRoundTripTest "18" simpleN3Graph_g1_08
+
+roundTripTestSuite = TestList
+  [ roundTripTest01
+  , roundTripTest02
+  , roundTripTest03
+  , roundTripTest04
+  , roundTripTest05
+  , roundTripTest06
+  , roundTripTest07
+  , roundTripTest08
+  , roundTripTest11
+  , roundTripTest12
+  , roundTripTest13
+  , roundTripTest14
+  , roundTripTest15
+  , roundTripTest16
+  , roundTripTest17
+  , roundTripTest18
+  ]
+
+------------------------------------------------------------
+--  Simple formatter tests
+------------------------------------------------------------
+--
+--  These are simple tests that format and re-parse a graph,
+--  and make sure that the result graph compares the same as
+--  the original.  Therefore, depends on a trusted parser and
+--  graph compare function.
+
+simpleTest :: String -> RDFGraph -> Test
+simpleTest lab = roundTripTest ("SimpleTest:"++lab)
+
+simpleTest01 = simpleTest "01" g2
+simpleTest02 = simpleTest "02" g3
+simpleTest03 = simpleTest "03" g4
+simpleTest04 = simpleTest "04" g5
+simpleTest05 = simpleTest "05" g6
+simpleTest06 = simpleTest "06" g7
+simpleTest07 = simpleTest "07" g8
+simpleTest08 = simpleTest "08" g81
+simpleTest09 = simpleTest "09" g82
+simpleTest10 = simpleTest "10" g83
+simpleTest11 = simpleTest "11" g9
+simpleTest12 = simpleTest "12" g10
+simpleTest13 = simpleTest "13" g11
+
+simpleTestSuite = TestList
+  [ simpleTest01
+  , simpleTest02
+  , simpleTest03
+  , simpleTest04
+  , simpleTest05
+  , simpleTest06
+  , simpleTest07
+  , simpleTest08
+  , simpleTest09
+  , simpleTest10
+  , simpleTest11
+  , simpleTest12
+  , simpleTest13
+  ]
+
+------------------------------------------------------------
+--  Exotic parser tests
+------------------------------------------------------------
+--
+--  These tests cover various forms of anonymous nodes
+--  [...], lists and formulae. together with uses of ':-'
+--
+
+-- does a round-trip test starting with the
+exoticTest :: String -> RDFGraph -> Test
+exoticTest lab gr =
+    TestList
+      [ TestCase ( assertEqual ("ExoticTest:gr:"++lab) gr pg )
+      , TestCase ( assertEqual ("ExoticTest:er:"++lab) "" pe )
+      -- , TestCase ( assertEqual ("ExoticTest:"++lab)    "" out )
+      ]
+    where
+        out     = formatGraphAsString gr
+        (pe,pg) = case parseN3fromString out of
+            Result g -> ("",g)
+            Error  s -> (s,emptyRDFGraph)
+
+--  Simple anon nodes, with semicolons and commas
+exoticN3Graph_x1 =
+    commonPrefixes ++
+    " [ base1:p1 base1:o1 ; \n" ++
+    "   base1:p1 base2:o2 ; \n" ++
+    "   base2:p2 base2:o2 ; \n" ++
+    "   base2:p2 base3:o3 ] = base1:s1 . \n" ++
+    " base2:s2 = \n" ++
+    " [ base1:p1 base1:o1 , \n" ++
+    "   base2:o2 , \n" ++
+    "   base3:o3 , \n" ++
+    "   \"l1\"   ; \n" ++
+    "   base2:p2 base1:o1 , \n" ++
+    "            base2:o2 , \n" ++
+    "            base3:o3 , \n" ++
+    "            \"l1\"   ] . \n"
+
+--  Simple anon nodes, with 'is ... of' and semicolons and commas
+exoticN3Graph_x2 =
+    commonPrefixes ++
+    " [ has base1:p1 of base1:o1 ; \n" ++
+    "   is  base1:p1 of base2:o2 ; \n" ++
+    "   has base2:p2 of base2:o2 ; \n" ++
+    "   is  base2:p2 of base3:o3 ] = base1:s1 . \n" ++
+    " base2:s2 = \n" ++
+    " [ has base1:p1 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ; \n" ++
+    "   is  base2:p2 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 ] . \n"
+    -- "                   \"l1\"   ] . \n"
+
+--  Simple anon nodes, attached to identified node
+exoticN3Graph_x3 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    " [ has base1:p1 of base1:o1 ; \n" ++
+    "   is  base1:p1 of base2:o2 ; \n" ++
+    "   has base2:p2 of base2:o2 ; \n" ++
+    "   is  base2:p2 of base3:o3 ] . \n" ++
+    " base2:s2 :- \n" ++
+    " [ has base1:p1 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ; \n" ++
+    "   is  base2:p2 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 ] . \n"
+    -- "                   \"l1\"   ] . \n"
+
+--  List nodes, with and without :-
+
+exoticN3Graph_x4 =
+    commonPrefixes ++
+    " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
+
+exoticN3Graph_x5 =
+    commonPrefixes ++
+    " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"
+
+exoticN3Graph_x6 =
+    commonPrefixes ++
+    " base1:s1 :- (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
+
+--  Formula nodes, with and without :-
+
+exoticN3Graph_x7 =
+    commonPrefixes ++
+    " { base1:s1 base1:p1 base1:o1 .   \n" ++
+    "   base2:s2 base1:p1 base2:o2 .   \n" ++
+    "   base3:s3 base1:p1 base3:o3 . } \n" ++
+    " base2:p2 base2:f2 . "
+
+exoticN3Graph_x8 =
+    commonPrefixes ++
+    " base1:f1 :- \n" ++
+    " { base1:s1 base1:p1 base1:o1 .     \n" ++
+    "   base2:s2 base1:p1 base2:o2 .     \n" ++
+    "   base3:s3 base1:p1 base3:o3 . } ; \n" ++
+    " base2:p2 base2:f2 . "
+
+exoticN3Graph_x9 =
+    commonPrefixes ++
+    " base1:f1 :- \n" ++
+    " { base1:s1 base1:p1 base1:o1 . } ; \n" ++
+    " base2:p2 base2:f2 . "
+
+--  Test allocation of bnodes over a nested formula
+exoticN3Graph_x12 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 [ base1:p1 base1:o1 ] .     \n" ++
+    " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" ++
+    "            base2:p2 base2:f2 .                \n" ++
+    " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."
+
+--  List of bnodes
+exoticN3Graph_x13 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1] \n" ++
+    "    [base1:p1 base2:o2] \n" ++
+    "    [base1:p1 base3:o3] ) .\n"
+
+--  List of more complex bnodes
+exoticN3Graph_x14 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
+    "    [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
+    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
+
+--  List with nested list
+exoticN3Graph_x15 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1] \n"++
+    "    [base2:p2 \n" ++
+    "       ( [base1:p1 base1:o1] \n" ++
+    "         [base1:p1 base2:o2] \n" ++
+    "         [base1:p1 base3:o3] ) ] \n"++
+    "    [base1:p1 base3:o3] ) .\n"
+
+--  More complex list with nested list
+exoticN3Graph_x16 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n"++
+    "    [base2:p2 \n" ++
+    "       ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
+    "         [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
+    "         [base1:p1 base3:o3; base2:p2 base3:o3] ) ] \n"++
+    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
+
+--  Troublesome example
+exoticN3Graph_x17 =
+    commonPrefixes ++
+    "base1:s1 a base1:o1 ; :- \n" ++
+    "  ( [ base2:p21 base2:o2  ;  \n" ++
+    "      base2:p22 ( [ base2:p23 \"lx11\" ] \"lx12\" ) ] \n" ++
+    "    [ base2:p24 base3:o3 ; base2:p25 \"lx13\" ] \n" ++
+    "  ) . \n"
+
+--  Null prefixes
+exoticN3Graph_x18 =
+    commonPrefixes ++
+    "@prefix : <#> . " ++
+    ":s1 a :o1 ; :- \n" ++
+    "  ( [ :p21 :o2  ;  \n" ++
+    "      :p22 ( [ :p23 \"lx11\" ] \"lx12\" ) ] \n" ++
+    "    [ :p24 :o3 ; :p25 \"lx13\" ] \n" ++
+    "  ) . \n"
+
+-- Check graph sources parse to expected values
+exoticParseTest01 = parseTest "exoticParseTest01" exoticN3Graph_x1 x1 noError
+exoticParseTest02 = parseTest "exoticParseTest02" exoticN3Graph_x2 x2 noError
+exoticParseTest03 = parseTest "exoticParseTest03" exoticN3Graph_x3 x3 noError
+exoticParseTest04 = parseTest "exoticParseTest04" exoticN3Graph_x4 x4 noError
+exoticParseTest05 = parseTest "exoticParseTest05" exoticN3Graph_x5 x5 noError
+exoticParseTest06 = parseTest "exoticParseTest06" exoticN3Graph_x6 x6 noError
+exoticParseTest07 = parseTest "exoticParseTest07" exoticN3Graph_x7 x7 noError
+exoticParseTest08 = parseTest "exoticParseTest08" exoticN3Graph_x8 x8 noError
+exoticParseTest09 = parseTest "exoticParseTest09" exoticN3Graph_x9 x9 noError
+exoticParseTest12 = parseTest "exoticParseTest12" exoticN3Graph_x12 x12 noError
+exoticParseTest13 = parseTest "exoticParseTest13" exoticN3Graph_x13 x13 noError
+exoticParseTest13a = parseTest "exoticParseTest13a" exoticN3Graph_x13 x13a noError
+exoticParseTest14 = parseTest "exoticParseTest14" exoticN3Graph_x14 x14 noError
+exoticParseTest15 = parseTest "exoticParseTest15" exoticN3Graph_x15 x15 noError
+exoticParseTest16 = parseTest "exoticParseTest16" exoticN3Graph_x16 x16 noError
+exoticParseTest17 = parseTest "exoticParseTest17" exoticN3Graph_x17 x17 noError
+
+exoticTest01 = exoticTest "01" x1
+exoticTest02 = exoticTest "02" x2
+exoticTest03 = exoticTest "03" x3
+exoticTest04 = exoticTest "04" x4
+exoticTest05 = exoticTest "05" x5
+exoticTest06 = exoticTest "06" x6
+exoticTest07 = exoticTest "07" x7
+exoticTest08 = exoticTest "08" x8
+exoticTest09 = exoticTest "09" x9
+exoticTest10 = testGraphEq  "exoticTest10" False x7 x8
+exoticTest11 = testGraphEq  "exoticTest11" False x8 x9
+exoticTest12 = exoticTest "12" x12
+exoticTest13 = exoticTest "13" x13
+exoticTest13a = exoticTest "13a" x13a
+exoticTest14 = exoticTest "14" x14
+exoticTest15 = exoticTest "15" x15
+exoticTest16 = exoticTest "16" x16
+exoticTest17 = exoticTest "17" x17
+
+exoticRoundTripTest01 = fullRoundTripTest "Exotic01" exoticN3Graph_x1
+exoticRoundTripTest02 = fullRoundTripTest "Exotic02" exoticN3Graph_x2
+exoticRoundTripTest03 = fullRoundTripTest "Exotic03" exoticN3Graph_x3
+exoticRoundTripTest04 = fullRoundTripTest "Exotic04" exoticN3Graph_x4
+exoticRoundTripTest05 = fullRoundTripTest "Exotic05" exoticN3Graph_x5
+exoticRoundTripTest06 = fullRoundTripTest "Exotic06" exoticN3Graph_x6
+exoticRoundTripTest07 = fullRoundTripTest "Exotic07" exoticN3Graph_x7
+exoticRoundTripTest08 = fullRoundTripTest "Exotic08" exoticN3Graph_x8
+exoticRoundTripTest09 = fullRoundTripTest "Exotic09" exoticN3Graph_x9
+exoticRoundTripTest12 = fullRoundTripTest "Exotic12" exoticN3Graph_x12
+exoticRoundTripTest13 = fullRoundTripTest "Exotic13" exoticN3Graph_x13
+exoticRoundTripTest14 = fullRoundTripTest "Exotic14" exoticN3Graph_x14
+exoticRoundTripTest15 = fullRoundTripTest "Exotic15" exoticN3Graph_x15
+exoticRoundTripTest16 = fullRoundTripTest "Exotic16" exoticN3Graph_x16
+exoticRoundTripTest17 = fullRoundTripTest "Exotic17" exoticN3Graph_x17
+exoticRoundTripTest18 = fullRoundTripTest "Exotic18" exoticN3Graph_x18
+
+exoticTestSuite = TestList
+  [ exoticParseTest01
+  , exoticParseTest02
+  , exoticParseTest03
+  , exoticParseTest04
+  , exoticParseTest05
+  , exoticParseTest06
+  , exoticParseTest07
+  , exoticParseTest08
+  , exoticParseTest09
+  , exoticParseTest12
+  , exoticParseTest13
+  , exoticParseTest13a
+  , exoticParseTest14
+  , exoticParseTest15
+  , exoticParseTest16
+  , exoticParseTest17
+  , exoticTest01
+  , exoticTest02
+  , exoticTest03
+  , exoticTest04
+  , exoticTest05
+  , exoticTest06
+  , exoticTest07
+  , exoticTest08
+  , exoticTest09
+  , exoticTest10
+  , exoticTest11
+  , exoticTest12
+  , exoticTest13
+  , exoticTest13a
+  , exoticTest14
+  , exoticTest15
+  , exoticTest16
+  , exoticTest17
+  , exoticRoundTripTest01
+  , exoticRoundTripTest02
+  , exoticRoundTripTest03
+  , exoticRoundTripTest04
+  , exoticRoundTripTest05
+  , exoticRoundTripTest06
+  , exoticRoundTripTest07
+  , exoticRoundTripTest08
+  , exoticRoundTripTest09
+  , exoticRoundTripTest12
+  , exoticRoundTripTest13
+  , exoticRoundTripTest14
+  , exoticRoundTripTest15
+  , exoticRoundTripTest16
+  , exoticRoundTripTest17
+  , exoticRoundTripTest18
+  ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ trivialTestSuite
+  , parseTestSuite
+  , roundTripTestSuite
+  , simpleTestSuite
+  , exoticTestSuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/N3FormatterTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.21 $
+-- $Log: N3FormatterTest.hs,v $
+-- Revision 1.21  2004/01/09 12:57:08  graham
+-- Remove space between perfix and ':' in @prefix declaractions,
+-- for compatibility with new Notation 3 syntax (and Jena).
+--
+-- Revision 1.20  2004/01/09 12:44:52  graham
+-- Fix up N3Formatter to suppress final statement-terminating '.' in a formula,
+-- for compatibility with the current Notation3 syntax.
+--
+-- Revision 1.19  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.18  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.17  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.16  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.15  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.14  2003/11/24 15:46:04  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.13  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.12  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.11  2003/07/01 14:18:57  graham
+-- Allow blank node in predicate position.
+-- Add parser and formatter test case for this.
+--
+-- Revision 1.10  2003/06/25 21:16:52  graham
+-- Reworked N3 formatting logic to support proof display.
+-- Basic proof display is working.
+--
+-- Revision 1.9  2003/06/12 00:47:55  graham
+-- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
+--
+-- Revision 1.8  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.7  2003/05/28 19:57:50  graham
+-- Adjusting code to compile with GHC
+--
+-- Revision 1.6  2003/05/28 17:39:30  graham
+-- Trying to track down N3 formatter performance problem.
+--
+-- Revision 1.5  2003/05/23 00:02:42  graham
+-- Fixed blank node id generation bug in N3Formatter
+--
+-- Revision 1.4  2003/05/14 22:39:23  graham
+-- Initial formatter tests all run OK.
+-- The formatter could still use so,me improvement,
+-- but it
+-- passes the minimal round-tripping tests.
+--
+-- Revision 1.3  2003/05/14 19:38:32  graham
+-- Simple formatter tests all working with reworked graph and lookup structures.
+-- More complex formatter tests still to be coded.
+--
+-- Revision 1.2  2003/05/07 23:58:09  graham
+-- More restructuring.
+-- RDFGraphTest runs OK.
+-- N3ParserTest needs to be updated to use new structure for formulae.
+--
+-- Revision 1.1  2003/04/30 12:14:08  graham
+-- Add formetter test to CVS
+-- Noted problem with RDFGraph structure: preparing to rework
+--
+--
+ Swish/HaskellRDF/N3Parser.hs view
@@ -0,0 +1,1104 @@+--------------------------------------------------------------------------------
+--  $Id: N3Parser.hs,v 1.36 2004/01/22 19:52:41 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  N3Parser
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This Module implements a Notation 3 parser (see [1], [2]), returning a
+--  new RDFGraph consisting of triples and namespace information parsed from
+--  the supplied N3 input string, or an error indication.
+--
+--  Uses the Parsec monadic parser library.
+--
+--
+-- REFERENCES:
+--
+-- [1] http://www.w3.org/DesignIssues/Notation3.html
+--     Tim Berners-Lee's design issues series notes and description
+--
+-- [2] http://www.w3.org/2000/10/swap/Primer.html
+--     Notation 3 Primer by Sean Palmer
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.N3Parser
+    ( ParseResult
+    , parseN3fromString
+    , parseAnyfromString
+    , parseTextFromString, parseAltFromString
+    , parseNameFromString, parsePrefixFromString
+    , parseAbsURIrefFromString, parseLexURIrefFromString, parseURIref2FromString
+    -- Exports for parsers that embed Notation3 in a bigger syntax
+    , N3Parser, N3State(..)
+    , whiteSpace, symbol, lexeme, eof, identStart, identLetter
+    , defaultPrefix, namedPrefix
+    , document, subgraph, uriRef2, varid, lexUriRef
+    , newBlankNode
+    )
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFGraph, RDFLabel(..)
+    , NamespaceMap
+    , LookupFormula(..) 
+    , addArc 
+    , setFormula
+    , setNamespaces
+    , emptyRDFGraph
+    )
+
+import Swish.HaskellRDF.GraphClass
+    ( arc )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..)
+    , mapFind, mapReplace, mapReplaceOrAdd )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getScopePrefix 
+    , getScopedNameURI
+    , makeScopedName, makeUriScopedName
+    , nullScopedName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceRDFO
+    , namespaceOWL
+    , langName
+    , rdf_type
+    , rdf_first, rdf_rest, rdf_nil
+    , owl_sameAs
+    , operator_plus, operator_minus, operator_slash, operator_star
+    , default_base
+    )
+
+import Swish.HaskellUtils.ProcessURI
+    ( isAbsoluteURIRef, isValidURIRef, absoluteUriPart )
+
+import Swish.HaskellUtils.ErrorM
+    ( ErrorM(Error,Result) )
++import Swish.HaskellRDF.ParsecLanguage
+    ( emptyDef )
+
+import Text.ParserCombinators.Parsec
+
+import qualified Text.ParserCombinators.Parsec.Token as P
+
+import Data.Char
+    ( chr, digitToInt )
+
+
+----------------------------------------------------------------------
+--  Set up token parsers
+----------------------------------------------------------------------
+
+pythonStyle =
+        emptyDef
+            { P.commentStart   = ""
+            , P.commentEnd     = ""
+            , P.commentLine    = "#"
+            , P.nestedComments = True
+            , P.identStart     = letter <|> char '_'      -- oneOf "_"
+            , P.identLetter    = alphaNum <|> char '_'
+            , P.reservedNames  = []
+            , P.reservedOpNames= []
+            , P.caseSensitive  = True
+            }
+
+lexer :: P.TokenParser N3State
+lexer = P.makeTokenParser pythonStyle
+
+whiteSpace = P.whiteSpace lexer
+symbol     = P.symbol     lexer
+lexeme     = P.lexeme     lexer
+
+identStart  = P.identStart  pythonStyle
+identLetter = P.identLetter pythonStyle
+
+----------------------------------------------------------------------
+-- Define parser state and helper functions
+----------------------------------------------------------------------
+
+--  N3 parser state
+data N3State = N3State
+        { graphState :: RDFGraph            -- Graph under construction
+        , thisNode   :: RDFLabel            -- current context node (aka 'this')
+        , prefixUris :: NamespaceMap        -- namespace prefix mapping table
+        , syntaxUris :: SpecialMap          -- special name mapping table
+        , nodeGen    :: Int                 -- blank node id generator
+        }
+
+--  Type for special name lookup table
+type SpecialMap = LookupMap (String,ScopedName)
+
+--  Functions to update N3State vector (use with Parsec updateState)
+setPrefix :: String -> String -> N3State -> N3State
+setPrefix pre uri st =  st { prefixUris=p' }
+    where
+        p'    = mapReplaceOrAdd (Namespace pre uri) (prefixUris st)
+
+--  Set name for special syntax element
+setSName :: String -> ScopedName -> N3State -> N3State
+setSName nam snam st =  st { syntaxUris=s' }
+    where
+        s' = mapReplaceOrAdd (nam,snam) (syntaxUris st)
+setSUri :: String -> String -> N3State -> N3State
+setSUri nam suri = setSName nam (makeScopedName "" suri "")
+
+--  Get name for special syntax element, default null
+getSName :: N3State -> String -> ScopedName
+getSName st nam =  mapFind nullScopedName nam (syntaxUris st)
+
+getSUri :: N3State -> String -> String
+getSUri st nam = getScopedNameURI $ getSName st nam
+
+--  Lookup prefix in table and return URI or 'prefix:'
+mapPrefix :: NamespaceMap -> String -> String
+mapPrefix ps pre = mapFind (pre++":") pre ps
+
+--  Functions to access state:
+--  Map prefix to namespace
+getPrefixNs :: N3State -> String -> Namespace
+getPrefixNs st pre = Namespace pre (mapPrefix (prefixUris st) pre)
+
+--  Map ScopedName using prefix table
+--  (Ignore URI in supplied ScopedName)
+getPrefixScopedName :: N3State -> ScopedName -> ScopedName
+getPrefixScopedName st snam = ScopedName (getPrefixNs st pre) loc
+    where
+        pre = getScopePrefix snam
+        loc = snLocal snam
+
+--  Return function to update graph in N3 parser state,
+--  using the supplied function of a graph
+--  (use returned function with Parsec updateState)
+updateGraph :: ( RDFGraph -> RDFGraph ) -> ( N3State -> N3State )
+updateGraph f s = s { graphState = f (graphState s) }
+
+--  Define default table of namespaces
+prefixTable =   [ namespaceRDF
+                , namespaceRDFS
+                , namespaceRDFD     -- datatypes
+                , namespaceRDFO     -- operators
+                , namespaceOWL
+                ]
+
+--  Define default special-URI table
+specialTable :: [(String,ScopedName)]
+specialTable =  [ ( "a",         rdf_type       ),
+                  ( "equals",    owl_sameAs     ),
+                  ( "listfirst", rdf_first      ),
+                  ( "listrest",  rdf_rest       ),
+                  ( "listnull",  rdf_nil        ),
+                  ( "plus",      operator_plus  ),
+                  ( "minus",     operator_minus ),
+                  ( "slash",     operator_slash ),
+                  ( "star",      operator_star  ),
+                  ( "base",      default_base   ) ]
+
+----------------------------------------------------------------------
+--  Define top-level parser function:
+--  accepts a string and returns a graph or error
+----------------------------------------------------------------------
+
+type N3Parser a = GenParser Char N3State a
+
+type ParseResult = ErrorM RDFGraph -- PResult RDFGraph | PError String
+
+parseN3fromString :: String -> ParseResult
+parseN3fromString input =
+        case parseAnyfromString document Nothing input of
+            Left  err -> Error err
+            Right gr  -> Result gr
+
+--  Function to supply initial context and parse supplied term
+--
+--  parser  is parser to apply
+--  base    is base URI of the input, or Nothing to use default base value
+--  input   is the input to be parsed
+--
+parseAnyfromString :: N3Parser a -> Maybe String -> String -> (Either String a)
+parseAnyfromString parser base input =
+        let
+            pmap   = LookupMap prefixTable
+            smap   = LookupMap specialTable
+            bmap   = case base of
+                Nothing -> smap
+                Just bs -> mapReplace smap ("base",makeUriScopedName bs)
+            pstate = N3State
+                    { graphState = emptyRDFGraph
+                    , thisNode   = NoNode
+                    , prefixUris = pmap
+                    , syntaxUris = bmap
+                    , nodeGen    = 0
+                    }
+            result = runParser parser pstate "" input
+        in
+            case result of
+                Left  err -> Left  (show err)
+                Right res -> Right res
+
+newBlankNode :: N3Parser RDFLabel
+newBlankNode =
+        do  { s <- getState
+            ; let n = (nodeGen s) + 1
+            ; setState ( s { nodeGen = n } )
+            ; return (Blank (show n))
+            }
+
+--  Test functions for selected element parsing
+
+parseTextFromString :: String -> String -> (Either String String)
+parseTextFromString s =
+    parseAnyfromString (string s) Nothing
+
+parseAltFromString :: String -> String -> String -> (Either String String)
+parseAltFromString s1 s2 =
+    parseAnyfromString ( (string s1) <|> (string s2) ) Nothing
+
+parseNameFromString :: String -> (Either String String)
+parseNameFromString =
+    parseAnyfromString name Nothing
+
+parsePrefixFromString :: String -> (Either String Namespace)
+parsePrefixFromString =
+    parseAnyfromString prefix Nothing
+
+parseAbsURIrefFromString :: String -> (Either String String)
+parseAbsURIrefFromString =
+    parseAnyfromString absUriRef Nothing
+
+parseLexURIrefFromString :: String -> (Either String String)
+parseLexURIrefFromString =
+    parseAnyfromString lexUriRef Nothing
+
+parseURIref2FromString :: String -> (Either String ScopedName)
+parseURIref2FromString =
+    parseAnyfromString uriRef2 Nothing
+
+----------------------------------------------------------------------
+--  Syntax productions
+----------------------------------------------------------------------
+
+--  document         = directive* statement-list
+
+document :: N3Parser RDFGraph
+document =
+        do  { whiteSpace
+            ; many directive
+            ; statements
+            ; eof
+            ; s <- getState
+            ; return $ setNamespaces (prefixUris s) (graphState s)
+            }
+
+
+--  directive        = "@prefix" prefix ":" uriRef2 "."   // Namespace declaration
+--                   | "@prefix" ":" uriRef2 "."          // Default namespace
+--                   | "@equivalence" uriRef2 "."         // Alternative to daml:equivalent
+--                   | "@listfirst" uriRef2 "."           // Alternative to n3:first
+--                   | "@listrest"  uriRef2 "."           // Alternative to n3:rest
+--                   | "@listnull"  uriRef2 "."           // Alternative to n3:null
+--                   | "@plus"  uriRef2 "."               // Alternative to operator:plus
+--                   | "@minus" uriRef2 "."               // Alternative to operator:minus
+--                   | "@slash" uriRef2 "."               // Alternative to operator:slash
+--                   | "@star"  uriRef2 "."               // Alternative to operator:star
+--                   | "@base"  uriRef2 "."               // Base URI for relative URIs.
+
+directive :: N3Parser ()
+directive =
+        do  { try $ symbol "@prefix"
+            ; ( defaultPrefix <|> namedPrefix )
+            }
+    <|>
+        do  { string "@"    -- not lexeme
+            ; syntaxUri
+            }
+    <?>
+        "directive"
+
+defaultPrefix :: N3Parser ()
+defaultPrefix =
+        do  { symbol ":"
+            ; u <- uriRef2
+            ; symbol "."
+            ; updateState $ setPrefix "" (getScopedNameURI u)
+            }
+
+namedPrefix :: N3Parser ()
+namedPrefix =
+        do  { n <- name
+            ; symbol ":"
+            ; u <- uriRef2
+            ; symbol "."
+            ; updateState $ setPrefix n (getScopedNameURI u)
+            }
+
+syntaxUri :: N3Parser ()
+syntaxUri =
+        do  { s <- uriName
+            ; u <- uriRef2
+            ; symbol "."
+            ; updateState $ setSUri s (getScopedNameURI u)
+            }
+
+uriName :: N3Parser String
+uriName =
+        (try $ symbol "equivalence")
+    <|> (try $ symbol "listfirst")
+    <|> (try $ symbol "listrest")
+    <|> (try $ symbol "listnull")
+    <|> (try $ symbol "plus")
+    <|> (try $ symbol "minus")
+    <|> (try $ symbol "slash")
+    <|> (try $ symbol "star")
+    <|> (try $ symbol "base")
+    <?> "special URI directive"
+
+
+--  statements       = [ statement ( "." statement )* ]
+--
+--  statement        = subject property-list
+--
+--  properties       = [ property ( ";" property )* ]
+--
+--  New statements are added to the user state graph
+
+statements :: N3Parser ()
+statements =
+        do  { sepEndBy1 statement (symbol ".")
+            ; return ()
+            }
+
+statement :: N3Parser ()
+statement =
+        do  { subj <- subject
+            ; optional $ properties subj
+            }
+
+properties :: RDFLabel -> N3Parser ()
+properties subj =
+        do  { sepBy1 (property subj) (symbol ";")
+            ; return ()
+            }
+
+
+--  property         = verb object-list
+--                   | ":-" anon-node           // Creates anon-node aongside the current node
+--  verb             = ">-" prop "->"           // has 'prop' of
+--                   | "<-" prop "<-"           // is  'prop' of
+--                   | operator                 // has operator:'operator' of (???)
+--                   | prop                     // has 'prop' of -- shorthand
+--                   | "has" prop "of"          // has 'prop' of
+--                   | "is" prop "of"           // is  'prop' of
+--                   | "a"                      // has rdf:type of
+--                   | "="                      // has daml:equivalent of
+--
+--  subj    is the subject node for these properties.
+--
+--  New statements are added to the graph in the parser's user state.
+
+property :: RDFLabel -> N3Parser ()
+property subj =
+    do  { (prop,swap) <- verb
+        ; objects subj prop swap
+        }
+    <|>
+    do  { symbol ":-"
+        ; anonNode subj
+        ; return ()
+        }
+
+verb :: N3Parser (RDFLabel,Bool)
+verb =  do  { p <- prop ;                              return (p,False) }
+    <|> do  { p <- operator ;                          return (p,False) }
+    <|> do  { symbol ">-"  ; p <- prop ; symbol "->" ; return (p,False) }
+    <|> do  { symbol "<-"  ; p <- prop ; symbol "<-" ; return (p,True) }
+    <|> do  { symbol "has" ; p <- prop ; symbol "of" ; return (p,False) }
+    <|> do  { symbol "is"  ; p <- prop ; symbol "of" ; return (p,True) }
+    <|> do  { symbol "a"
+            ; lab <- operatorLabel rdf_type
+            ; return (lab,False)
+            }
+    <|> do  { symbol "="
+            ; lab <- operatorLabel owl_sameAs
+            ; return (lab,False)
+            }
+    <?> "property"
+
+
+--  objects          = object
+--                   | object "," object-list
+--
+--  subj    is the subject node for the new statements,
+--  prop    is the property node for the new statements.
+--  swap    is true if the subject/object values in the resulting statement
+--          are to be swapped (for "is <prop> of", etc.)
+--
+--  New statements are added to the graph in the parser's user state
+
+objects :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()
+objects subj prop swap =
+        do  { sepBy1 (object subj prop swap) (symbol ",")
+            ; return ()
+            }
+
+--  anonNode         = "[" property-list "]"    // Something with given properties
+--                   | "{" statement-list "}"   // List of statements as resource
+--                   | "(" node-list ")"        // Construct list with
+--                                              //   rdf:first, rdf:rest, rdf:nil
+--
+--  subj    is the subject node with which the new anonymous node is equated,
+--
+--  The anonymous node value is returned by this parser (which is often the same
+--  as the supplied subject node, but not always).
+--
+--  New statements are added to the graph in the parser's user state
+--  (in the case of a formula, a new graph and parser are created, and
+--  the graph arcs are added to this new graph).
+
+anonNode :: RDFLabel -> N3Parser RDFLabel
+anonNode subj =
+        do  { symbol "[" ; properties subj ; symbol "]" ; return subj }
+    <|> do  { symbol "{" ; form <- formula  subj ; symbol "}" ; return form }
+    <|> do  { symbol "(" ; list <- nodeList subj ; symbol ")" ; return list }
+    <?> "anon node (\"[\", \"(\" or \"{\")"
+
+--  This method allows a statement list to be parsed as a subgraph
+--  whose value is associated with the supplied node of the current
+--  graph.
+
+formula :: RDFLabel -> N3Parser RDFLabel
+formula subj =
+        do  { subgr <- subgraph subj
+            ; updateState $ updateGraph
+                          $ setFormula (Formula subj subgr)
+            ; return subj
+            }
+
+subgraph :: RDFLabel -> N3Parser RDFGraph
+subgraph this =
+        do  { pstate <- getState
+            ; let fstate = pstate { graphState = emptyRDFGraph, thisNode = this }
+            ; setState fstate       -- switch new state into parser
+            ; statements            -- parse statements of formula
+            ; fstate' <- getState
+            ; let nstate = pstate { nodeGen = (nodeGen fstate') }
+            ; setState nstate       -- swap back state, with updated nodeGen
+            ; return (graphState fstate')
+            }
+
+--  prop             = uri-ref2
+--                   | varid
+--
+--  Returns URI value as a Node
+
+prop :: N3Parser RDFLabel
+prop = nodeid <|> varid <|> uriNode
+
+
+--  operator         = "+"                      // >- operator:plus ->
+--                   | "-"                      // >- operator:minus ->
+--                   | "/"                      // >- operator:slash ->
+--                   | "*"                      // >- operator:star->
+--
+--  If matched, the operator is returned as a node value.
+
+operator :: N3Parser RDFLabel
+operator =
+        do  { symbol "+" ; operatorLabel operator_plus  }
+    <|> do  { symbol "-" ; operatorLabel operator_minus }
+    <|> do  { symbol "*" ; operatorLabel operator_star  }
+    <|> do  { symbol "/" ; operatorLabel operator_slash }
+    <?> ""
+
+operatorLabel :: ScopedName -> N3Parser RDFLabel
+operatorLabel snam =
+        do  { s <- getState
+            ; return $ Res (getPrefixScopedName s snam)
+            }
+
+--  subject          = node
+
+subject :: N3Parser RDFLabel
+subject = node
+
+
+--  object           = litNode
+--
+--  This production adds a new triple to the graph state,
+--  using the supplied subject and propert values.
+--  If swap is True, the subject and object positions are
+--  swapped.
+
+object :: RDFLabel -> RDFLabel -> Bool -> N3Parser ()
+object subj prop swap =
+        do  { o <- litNode
+            ; if swap then (addStatement o prop subj)
+                      else (addStatement subj prop o)
+            }
+
+-- Add statement to graph in N3 parser state
+
+addStatement :: RDFLabel -> RDFLabel -> RDFLabel -> N3Parser ()
+addStatement s p o = updateState (updateGraph (addArc (arc s p o) ))
+
+
+--  nodeList         = litNode*
+--
+--  subj    is the node from which the list is linked.
+--
+--  Returns the supplied head of list or Nil node allocated.
+--
+--  Link first element of link to list head, scan rest of list,
+--  and return the list head;  otherwise return a node rdf_null.
+--
+--  This slightly convoluted pattern is to deal with two different
+--  occurrences of a list node:
+--    <node> :- ( l1, l2, ... )
+--      Here, <node> (the supplied subj) is the listhead.
+--    <node> prop ( l1, l2, ... )
+--      Here, the a new blank is supplied as subj to be the listhead.
+--  In either case, if the list is non-empty, the supplied subj
+--  is returned.  But if the list is empty, a rdf_null node is returned.
+--  In the second case, the invoking production must use the returned
+--  value.
+
+nodeList :: RDFLabel -> N3Parser RDFLabel
+nodeList subj =
+        do  { val   <- litNode
+            ; first <- operatorLabel rdf_first
+            ; addStatement subj first val
+            ; nodeList1 subj
+            ; return subj
+            }
+    <|> do  { nil   <- operatorLabel rdf_nil
+            ; return nil
+            }
+    <?> "Node or ')'"
+
+nodeList1 :: RDFLabel -> N3Parser ()
+nodeList1 prev =
+        do  { val   <- litNode
+            ; lnk   <- newBlankNode
+            ; first <- operatorLabel rdf_first
+            ; rest  <- operatorLabel rdf_rest
+            ; addStatement lnk  first val
+            ; addStatement prev rest  lnk
+            ; nodeList1 lnk
+            }
+    <|> do  { nil   <- operatorLabel rdf_nil
+            ; rest  <- operatorLabel rdf_rest
+            ; addStatement prev rest nil
+            }
+    <?> "Node or ')'"
+
+
+--  lit-node         = node
+--                   | str-node [ "@" lang ] [ "^^" uriRef2 ]
+--  str-node         = '"' constant-value '"'
+--                   | '"""' constant value '"""'   // Including single or double occurences of
+--                                                  //   quotes and/or newlines
+--
+--  Returns a new node value.
+
+litNode :: N3Parser RDFLabel
+litNode =
+        node
+    <|> do  { s <- strNode
+            ; t <- litTypeOrLang
+            ; return $ Lit s t
+            }
+    <?> "URI, blank node or literal"
+
+strNode :: N3Parser String
+strNode =
+        tripleQuoteString
+    <|> singleQuoteString
+
+
+litTypeOrLang :: N3Parser (Maybe ScopedName)
+litTypeOrLang =
+        langTag
+    <|> typeUri
+    <|> return Nothing
+    <?> "'@tag' (language tag) or '^^name' (datatype URI)"
+
+langTag :: N3Parser (Maybe ScopedName)
+langTag =
+        do  { string "@"
+            ; l <- name -- name1 letter
+            ; return $ Just (langName l)
+            }
+    <?> "'@tag' (language tag)"
+
+typeUri :: N3Parser (Maybe ScopedName)
+typeUri =
+        do  { string "^^"
+            ; u <- uriRef2
+            ; return $ Just u
+            }
+    <?> "'^^name' (datatype URI)"
+
+--  node             = nodeid
+--                   | varid
+--                   | uri-ref2
+--                   | anon-node
+--
+--  nodeid           = "_:" name
+--
+--  varid            = "?" name
+--
+--  Returns a new node value.
+
+node :: N3Parser RDFLabel
+node =  nodeid
+    <|> varid
+    <|> uriNode
+    <|> do  { n <- newBlankNode
+            ; anonNode n
+            }
+    <?> "URI or blank node"
+
+--  Identified blank node in input
+--
+--  Note that automatically generated blank node identifiers start with
+--  a digit, where input node identifiers start with a letter, so there
+--  can be no clash.  Care is needed when serializing a graph to ensure
+--  that future clashes are avoided.
+
+nodeid :: N3Parser RDFLabel
+-- nodeid = lexeme nodeid1
+nodeid =
+    do  { string "_:"
+        ; n <- name
+        ; return (Blank n)
+        }
+
+--  variable identifier
+
+varid :: N3Parser RDFLabel
+varid = do  { string "?"
+            ; n <- name
+            ; return (Var n)
+            }
+
+--  uriNode          = qname
+--                   | "<" URI-reference ">"
+--                   | "this"
+
+uriNode :: N3Parser RDFLabel
+uriNode =
+        do  { sn <- uriRef2 ;
+            ; return ( Res sn )
+            }
+    <|>
+        do  { string "this"
+            ; s <- getState
+            ; return ( thisNode s )
+            }
+    <?> "URI node"
+
+
+--  uriRef2          = qname
+--                   | ":" local-name
+--                   | "<" URI-reference ">"
+--  qname            = prefix ":" local-name
+--
+--  prefix           = name                         // Namespace prefix
+--
+--  local-name       = name                         // Local name (namespace qualified)
+--
+--  name             = alpha alphanumeric*
+--
+--  alpha            = "a"-"z"
+--                   | "A"-"Z"
+--                   | "_"
+--
+--  alphanumeric     = alpha
+--                   | "0"-"9"
+--
+--  URI-reference    = (conforming to syntax in RFC2396)
+--
+--  uriRef2 returns a ScopedName.
+
+uriRef2 :: N3Parser ScopedName
+uriRef2 = ( lexeme $ try uriRef2a )
+    <?> "URI or QName"
+
+uriRef2a =
+        do  { ns    <- prefix
+            ; string ":"
+            ; local <- localname
+            ; return $ ScopedName ns local
+            }
+    <|>
+        do  { string ":"
+            ; ns    <- defaultprefix
+            ; local <- localname
+            ; return $ ScopedName ns local
+            }
+    <|>
+        do  { u <- absUriRef
+            ; return $ makeUriScopedName u
+            }
+    <?> "URI or QName"
+
+prefix :: N3Parser Namespace
+prefix =
+        do  { pref <- prefixname
+            ; st   <- getState
+            ; return (getPrefixNs st pref)   -- map prefix to namespace
+            }
+
+defaultprefix :: N3Parser Namespace
+defaultprefix =
+        do  { st <- getState
+            ; return (getPrefixNs st "")
+            }
+
+name :: N3Parser String
+name =  lexeme $ name1 identStart
+
+prefixname :: N3Parser String
+prefixname =  name1 identStart
+
+localname :: N3Parser String
+localname =  lexeme $ name1 identLetter
+
+--  'name1' is a name without following whitespace
+--  initChar is a parser for the first character
+name1 :: N3Parser Char -> N3Parser String
+name1 initChar =
+    do  { c  <- initChar
+        ; cs <- many identLetter
+        ; return (c:cs)
+        }
+    <?> "identifier"
+
+
+----------------------------------------------------------------------
+-- Lexical support
+----------------------------------------------------------------------
+--
+-- The following code adapted from ParsecToken,
+-- modified to handle different escape conventions and triple-quoted strings
+--      \c
+--      \uhhhh
+--      \Uhhhhhhhh
+--
+-- Regular single-quoted string -- cannot be split over line breaks
+
+singleQuoteString :: N3Parser String
+singleQuoteString =
+    lexeme
+    (   between (char '"') (char '"' <?> "end of string (\")") anyStringChars
+    <?> "literal string" )
+
+anyStringChars =
+        do  { str <- many stringChar
+            ; return (foldr (maybe id (:)) "" str)
+            }
+
+-- Triple-quoted string -- may include line breaks, '"' or '""'.
+tripleQuoteString :: N3Parser String
+tripleQuoteString =
+    lexeme
+    (   do  { str <- between (try $ string "\"\"\"")
+                             (string "\"\"\"" <?> "end of string (\"\"\")")
+                             (many tripleQuoteSubstring)
+            ; return (foldr (++) "" str)
+            }
+    <?> "triple-quoted literal string" )
+
+-- Match non-quote substring or one or two quote characters
+tripleQuoteSubstring :: N3Parser String
+tripleQuoteSubstring =
+        tripleQuoteSubstring1
+    <|> try sqTripleQuoteSubstring1
+    <|> try dqTripleQuoteSubstring1
+
+dqTripleQuoteSubstring1 =
+        do  { string "\"\""
+            ; s <- tripleQuoteSubstring1
+            ; return $ "\"\""++s
+            }
+
+sqTripleQuoteSubstring1 =
+        do  { char '"'
+            ; s <- tripleQuoteSubstring1
+            ; return $ "\""++s
+            }
+
+-- match at least one non-quote character in a triple-quoted string
+tripleQuoteSubstring1 :: N3Parser String
+tripleQuoteSubstring1 =
+        do  { str <- many1 tripleQuoteStringChar
+            ; return $ foldr (maybe id (:)) "" str
+            }
+
+tripleQuoteStringChar :: CharParser st (Maybe Char)
+tripleQuoteStringChar =
+            stringChar
+    <|> do  { (string "\n")
+            ; return $ Just '\n'
+            }
+
+stringChar :: CharParser st (Maybe Char)
+stringChar      =
+        do  { c <- stringLetter
+            ; return $ Just c
+            }
+    <|> stringEscape
+    <?> "string character"
+
+stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c >= '\032'))
+
+stringEscape    =
+        do  { char '\\'
+            ; do { esc <- escapeCode; return (Just esc) }
+            }
+
+-- escape codes
+escapeCode      = charEsc <|> charUCS2 <|> charUCS4 <?> "escape code"
+
+-- \c
+charEsc         = choice (map parseEsc escMap)
+                where
+                    parseEsc (c,code) = do { char c; return code }
+                    escMap            = zip ("nrt\\\"\'") ("\n\r\t\\\"\'")
+
+-- \uhhhh
+charUCS2        =
+        do  { char 'u'
+            ; n <- numberFW 16 hexDigit 4 0
+            ; return $ chr n
+            }
+
+-- \Uhhhhhhhh
+charUCS4        =
+        do  { char 'U'
+            ; n <- numberFW 16 hexDigit 8 0
+            ; return $ chr n
+            }
+
+-- parse fixed-width number:
+numberFW :: Int -> CharParser st Char -> Int -> Int -> CharParser st Int
+numberFW base baseDigit 0     val = return val
+numberFW base baseDigit width val =
+        do  { d <- baseDigit
+            ; numberFW base baseDigit (width-1) ((val*base) + (digitToInt d))
+            }
+
+
+----------------------------------------------------------------------
+--  Parse a URI reference from the input
+--  The result returned has absolute form;  relative URIs are resolved
+--  relative to the current base prefix (set using "@base").
+--
+--  [[[TODO:  rework the URI parser to use the Parsec library]]]
+
+--  lexeme version
+lexUriRef :: N3Parser String
+lexUriRef = lexeme absUriRef
+
+absUriRef :: N3Parser String
+absUriRef =
+        do  { u <- between (char '<') (char '>' <?> "end of URI '>'") anyUriChars
+            ; if (isAbsoluteURIRef u)
+              then (return u)
+              else
+              if (isValidURIRef u)
+              then
+                do  { s <- getState
+                    ; (return $ absoluteUriPart (getSUri s "base") u)
+                    }
+              else (fail ("Invalid URI: <"++u++">"))
+            }
+
+anyUriChars :: N3Parser String
+anyUriChars = many uriChar
+
+uriChar :: N3Parser Char
+uriChar =
+        alphaNum
+    <|> oneOf "[];?:@&=+$,-_.!~*'()%//#"
+    <?> "URI character"
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/N3Parser.hs,v $
+-- $Author: graham $
+-- $Revision: 1.36 $
+-- $Log: N3Parser.hs,v $
+-- Revision 1.36  2004/01/22 19:52:41  graham
+-- Rename module URI to avoid awkward clash with Haskell libraries
+--
+-- Revision 1.35  2004/01/09 11:23:54  graham
+-- Fix up N3Parser so that the final statement-terminating '.' in a formula
+-- or file is optional.
+--
+-- Revision 1.34  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.33  2003/12/20 12:53:40  graham
+-- Fix up code to compile and test with GHC 5.04.3
+--
+-- Revision 1.32  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.31  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.30  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.29  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.28  2003/12/03 17:07:23  graham
+-- Replace occurrences of QName in N3Parser with ScopedName.
+--
+-- Revision 1.27  2003/12/03 15:57:00  graham
+-- Use common parser wrapper function for all parsing.
+-- (This will also be used for Swish script parsing.)
+--
+-- Revision 1.26  2003/12/03 15:42:09  graham
+-- Eliminate special return type in favour of ErrorM
+--
+-- Revision 1.25  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.24  2003/11/24 15:46:04  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.23  2003/10/24 21:02:42  graham
+-- Changed kind-structure of LookupMap type classes.
+--
+-- Revision 1.22  2003/10/09 16:26:31  graham
+-- Added parser support for literal language tags and datatypes.
+-- (Language tags are names, not strictly per RFC3066)
+--
+-- Revision 1.21  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.20  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.19  2003/07/01 14:18:57  graham
+-- Allow blank node in predicate position.
+-- Add parser and formatter test case for this.
+--
+-- Revision 1.18  2003/06/19 19:48:03  graham
+-- Allow variable id in predicate position
+--
+-- Revision 1.17  2003/06/12 00:47:56  graham
+-- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
+--
+-- Revision 1.16  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.15  2003/05/29 00:57:37  graham
+-- Resolved swish performance problem, which turned out to an inefficient
+-- method used by the parser to add arcs to a graph.
+--
+-- Revision 1.14  2003/05/22 15:16:39  graham
+-- Added additional parser test cases for lists
+--
+-- Revision 1.13  2003/05/21 13:55:13  graham
+-- N3 parser now handles relative URIs and default prefixes.
+-- (Still need to figure better default base URI handling; i.e. current document)
+--
+-- Revision 1.12  2003/05/21 13:34:13  graham
+-- Various N3 parser bug fixes.
+-- Need to fix handling of :name terms.
+--
+-- Revision 1.11  2003/05/20 23:35:28  graham
+-- Modified code to compile with GHC hierarchical libraries
+--
+-- Revision 1.10  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.9  2003/05/07 23:58:09  graham
+-- More restructuring.
+-- RDFGraphTest runs OK.
+-- N3ParserTest needs to be updated to use new structure for formulae.
+--
+-- Revision 1.8  2003/04/17 00:35:38  graham
+-- Added module N3ParserTest
+-- N3parser is mostly working
+-- Formulae remain to test
+--
+-- Revision 1.7  2003/04/15 21:40:54  graham
+-- N3Parser compiles
+-- Some small changes to RDFGraph
+-- Added some QName methods
+--
+-- Revision 1.6  2003/04/11 17:38:34  graham
+-- Rename GraphLookupMap to LookupMap
+--
+-- Revision 1.5  2003/04/10 20:08:39  graham
+-- Reorganized RDFGraph naming (RDFGraphTest OK)
+-- Progressing N3Parser
+--
+-- Revision 1.4  2003/03/12 23:00:43  graham
+-- Graph model coded and working, except for graph isomorphism test.
+--
+-- Revision 1.3  2003/03/12 13:41:59  graham
+-- N3 parser initial coding done.
+-- Graph not yet implemented.
+--
+-- Revision 1.2  2003/03/08 17:28:45  graham
+-- Added string literal parsing code
+--
+-- Revision 1.1  2003/03/07 22:53:38  graham
+-- Started on N3 parser in Haskell

+ Swish/HaskellRDF/N3ParserTest.hs view
@@ -0,0 +1,1373 @@+--------------------------------------------------------------------------------
+--  $Id: N3ParserTest.hs,v 1.25 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  N3ParserTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This Module contains test cases for module N3Parses.
+--
+--------------------------------------------------------------------------------
+
+--  WNH RIP OUT module Swish.HaskellRDF.N3ParserTest where
+
+import Swish.HaskellRDF.N3Parser
+    ( ParseResult(..)
+    , parseN3fromString
+    , parseTextFromString, parseAltFromString
+    , parseNameFromString, parsePrefixFromString
+    , parseAbsURIrefFromString, parseLexURIrefFromString
+    , parseURIref2FromString
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)
+    -- LookupNamespace(..), Namespace
+    , NamespaceMap, emptyNamespaceMap
+    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
+    , setArcs, getArcs, add, delete, extract, labels
+    , setNamespaces
+    , emptyRDFGraph, toRDFGraph
+      -- Export selected RDFLabel values
+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
+    , res_rdfs_member
+    , res_rdfd_GeneralRestriction
+    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality
+    , res_owl_sameAs
+    , res_operator_plus, res_operator_minus
+    , res_operator_slash, res_operator_star
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , makeNamespaceQName
+    , nullNamespace
+    , getQName, getScopedNameURI
+    , ScopedName(..)
+    , makeScopedName, makeQNameScopedName
+    , nullScopedName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceRDFC
+    , namespaceRDFO
+    , namespaceXSD
+    , namespaceXsdType
+    , namespaceOWL
+    , namespaceMATH
+    , namespaceLOG
+    , namespaceDAML
+    , namespaceLang, langName
+    , rdf_type
+    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
+    , rdfs_member
+    , rdfd_GeneralRestriction
+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
+    , owl_sameAs
+    , operator_plus, operator_minus, operator_slash, operator_star
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..)
+    , mapFind, mapFindMaybe )
+
+import Swish.HaskellRDF.GraphClass
+    ( Arc, arcSubj, arcPred, arcObj, arc )
+
+import Swish.HaskellUtils.QName
+    ( QName(..) )
+
+import Swish.HaskellUtils.ErrorM
+    ( ErrorM(..) )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertEqual, runTestTT, runTestText, putTextToHandle )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn )
+
+------------------------------------------------------------
+--  Common values
+------------------------------------------------------------
+
+pref_rdf = nsURI namespaceRDF
+pref_op  = nsURI namespaceRDFO
+pref_owl = nsURI namespaceOWL
+
+------------------------------------------------------------
+--  Generic item parsing test wrapper
+------------------------------------------------------------
+
+type ParseFromString a = String -> (Either String a)
+
+parseItemTest :: (Eq a, Show a) => ParseFromString a -> a
+                 -> String -> String -> a -> String -> Test
+parseItemTest ifroms def lab inp val err =
+    TestList
+      [ TestCase ( assertEqual ("parseItemError:"++lab) fixerr pe )
+      , TestCase ( assertEqual ("parseItemValue:"++lab) val pv )
+      ]
+    where
+        (pe,pv) = case ifroms inp of
+            Left  e -> (e,def)
+            Right v -> (noError,v)
+        fixerr = if err /= noError then pe else noError
+
+noError   = ""
+errorText = "*"
+
+------------------------------------------------------------
+--  Common test wrappers
+------------------------------------------------------------
+
+testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test
+testLabelEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
+
+testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test
+testGraphEq lab eq g1 g2 =
+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
+
+parseTest :: String -> String -> RDFGraph -> String -> Test
+parseTest lab inp gr er =
+    TestList
+      [ TestCase ( assertEqual ("parseTestError:"++lab) er pe )
+      , TestCase ( assertEqual ("parseTestGraph:"++lab) gr pg )
+      ]
+    where
+        (pe,pg) = case parseN3fromString inp of
+            Result g -> ("",g)
+            Error  s -> (s,emptyRDFGraph)
+
+------------------------------------------------------------
+--  Test simple character parsing
+------------------------------------------------------------
+
+parseCharTest :: String -> String
+                 -> String -> String -> String -> Test
+parseCharTest c = parseItemTest (parseTextFromString c) ""
+
+parseAltTest :: String -> String
+                -> String -> String -> String -> String -> Test
+parseAltTest c1 c2 = parseItemTest (parseAltFromString c1 c2) ""
+
+charInp01 = ":"
+char01    = ":"
+
+charInp02 = "<>"
+char02    = "<>"
+
+charInp03 = "<="
+
+parseCharTest01 = parseCharTest char01
+                    "parseCharTest01" charInp01 char01 noError
+parseCharTest02 = parseCharTest char02
+                    "parseCharTest02" charInp02 char02 noError
+parseCharTest03 = parseAltTest char01 char02
+                    "parseCharTest03" charInp01 char01 noError
+parseCharTest04 = parseAltTest char01 char02
+                    "parseCharTest04" charInp02 char02 noError
+parseCharTest05 = parseAltTest char01 char02
+                    "parseCharTest04" charInp03 "" errorText
+
+charTestSuite = TestList
+  [ parseCharTest01
+  , parseCharTest02
+  , parseCharTest03
+  , parseCharTest04
+  , parseCharTest05
+  ]
+
+------------------------------------------------------------
+--  Test simple name parsing
+------------------------------------------------------------
+
+parseNameTest :: String -> String -> String -> String -> Test
+parseNameTest = parseItemTest parseNameFromString ""
+
+nameInp01 = "name"
+name01    = "name"
+
+nameInp02 = "rdf"
+name02    = "rdf"
+
+parseNameTest01 = parseNameTest "parseNameTest01" nameInp01 name01 ""
+parseNameTest02 = parseNameTest "parseNameTest02" nameInp02 name02 ""
+
+nameTestSuite = TestList
+  [ parseNameTest01
+  , parseNameTest02
+  ]
+
+------------------------------------------------------------
+--  Test simple prefix parsing
+------------------------------------------------------------
+
+parsePrefixTest :: String -> String -> Namespace -> String -> Test
+parsePrefixTest = parseItemTest parsePrefixFromString nullNamespace
+
+prefixInp01 = "pref"
+prefix01    = Namespace "pref" "pref:"
+
+prefixInp02 = "rdf"
+prefix02    = Namespace "rdf" pref_rdf
+
+parsePrefixTest01 = parsePrefixTest "parsePrefixTest01" prefixInp01 prefix01 ""
+parsePrefixTest02 = parsePrefixTest "parsePrefixTest02" prefixInp02 prefix02 ""
+
+prefixTestSuite = TestList
+  [ parsePrefixTest01
+  , parsePrefixTest02
+  ]
+
+------------------------------------------------------------
+--  Test absolute URIref parsing
+------------------------------------------------------------
+
+parseAbsUriRefTest :: String -> String -> String -> String -> Test
+parseAbsUriRefTest = parseItemTest parseAbsURIrefFromString ""
+
+parseLexUriRefTest :: String -> String -> String -> String -> Test
+parseLexUriRefTest = parseItemTest parseLexURIrefFromString ""
+
+absUriRefInp01  = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type>"
+absUriRefInp01s = "<http://www.w3.org/1999/02/22-rdf-syntax-ns#type> "
+absUriRef01     = "http://www.w3.org/1999/02/22-rdf-syntax-ns#type"
+
+absUriRefInp02  = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"
+absUriRefInp02s = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "
+absUriRef02     = "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
+
+parseAbsUriRefTest01 = parseAbsUriRefTest "parseAbsUriRefTest01" absUriRefInp01 absUriRef01 ""
+parseAbsUriRefTest02 = parseAbsUriRefTest "parseAbsUriRefTest02" absUriRefInp02 absUriRef02 ""
+parseAbsUriRefTest03 = parseLexUriRefTest "parseAbsUriRefTest03" absUriRefInp01s absUriRef01 ""
+parseAbsUriRefTest04 = parseLexUriRefTest "parseAbsUriRefTest04" absUriRefInp02s absUriRef02 ""
+
+absUriRefTestSuite = TestList
+  [ parseAbsUriRefTest01
+  , parseAbsUriRefTest02
+  , parseAbsUriRefTest03
+  , parseAbsUriRefTest04
+  ]
+
+
+------------------------------------------------------------
+--  Test simple URIref parsing
+------------------------------------------------------------
+
+parseUriRef2Test :: String -> String -> ScopedName -> String -> Test
+parseUriRef2Test = parseItemTest parseURIref2FromString nullScopedName
+
+uriRef01 = "rdf:type "
+sname01  = ScopedName namespaceRDF "type"
+
+uriRef02 = "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1> "
+sname02  =
+    makeScopedName "" "http://id.ninebynine.org/wip/2003/test/graph1/node#" "s1"
+
+parseUriRef2Test01 = parseUriRef2Test "parseUriRef2Test01" uriRef01 sname01 ""
+parseUriRef2Test02 = parseUriRef2Test "parseUriRef2Test02" uriRef02 sname02 ""
+
+uriRef2TestSuite = TestList
+  [ parseUriRef2Test01
+  , parseUriRef2Test02
+  ]
+
+------------------------------------------------------------
+--  Define some common values
+------------------------------------------------------------
+
+base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node/"
+base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node#"
+base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
+base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+
+qb1s1 = ScopedName base1 "s1"
+qb2s2 = ScopedName base2 "s2"
+qb3s3 = ScopedName base3 "s3"
+
+s1 = Res qb1s1  :: RDFLabel
+s2 = Res qb2s2  :: RDFLabel
+s3 = Res qb3s3  :: RDFLabel
+
+b1 = Blank "b1" :: RDFLabel
+b2 = Blank "b2" :: RDFLabel
+b3 = Blank "b3" :: RDFLabel
+b4 = Blank "b4" :: RDFLabel
+b5 = Blank "b5" :: RDFLabel
+b6 = Blank "b6" :: RDFLabel
+b7 = Blank "b7" :: RDFLabel
+b8 = Blank "b8" :: RDFLabel
+
+c1 = Blank "c1" :: RDFLabel
+c2 = Blank "c2" :: RDFLabel
+c3 = Blank "c3" :: RDFLabel
+c4 = Blank "c4" :: RDFLabel
+c5 = Blank "c5" :: RDFLabel
+c6 = Blank "c6" :: RDFLabel
+
+qb1p1 = ScopedName base1 "p1"
+qb2p2 = ScopedName base2 "p2"
+qb3p3 = ScopedName base3 "p3"
+
+p1 = Res qb1p1  :: RDFLabel
+p2 = Res qb2p2  :: RDFLabel
+p3 = Res qb3p3  :: RDFLabel
+
+qb1o1 = ScopedName base1 "o1"
+qb2o2 = ScopedName base2 "o2"
+qb3o3 = ScopedName base3 "o3"
+
+o1 = Res qb1o1  :: RDFLabel
+o2 = Res qb2o2  :: RDFLabel
+o3 = Res qb3o3  :: RDFLabel
+
+l1 = Lit "l1"  Nothing :: RDFLabel
+l2 = Lit "l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'" Nothing :: RDFLabel
+l3 = Lit "l3--\r\"'\\--\x0020\&--\x00A0\&--" Nothing    :: RDFLabel
+
+lfr    = Lit "chat"          (Just $ langName "fr")     :: RDFLabel
+lxml   = Lit "<br/>"         (Just rdf_XMLLiteral )     :: RDFLabel
+lfrxml = Lit "<em>chat</em>" (Just rdf_XMLLiteral )     :: RDFLabel -- was: lang "fr"
+
+qb1f1 = ScopedName base1 "f1"
+qb2f2 = ScopedName base2 "f2"
+
+f1 = Res qb1f1  :: RDFLabel
+f2 = Res qb2f2  :: RDFLabel
+
+v1 = Var "var1" :: RDFLabel
+v2 = Var "var2" :: RDFLabel
+v3 = Var "var3" :: RDFLabel
+v4 = Var "var4" :: RDFLabel
+
+------------------------------------------------------------
+--  Construct graphs for testing
+------------------------------------------------------------
+
+t01  = arc s1 p1 o1
+t01b = arc b1 b2 b3
+t02  = arc s2 p1 o2
+t03  = arc s3 p1 o3
+t04  = arc s1 p1 l1
+t05  = arc s2 p1 b1
+t06  = arc s3 p1 l2
+t07  = arc s3 p2 l3
+
+makeNewPrefixNamespace :: (String,Namespace) -> Namespace
+makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)
+
+nslist = LookupMap $ map makeNewPrefixNamespace
+    [ ("base1",base1)
+    , ("base2",base2)
+    , ("base3",base3)
+    , ("base4",base4)
+    ]
+
+g1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01]
+        }
+
+g1b = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01b]
+        }
+
+g2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03]
+        }
+
+g3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t04]
+        }
+
+g4 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t05]
+        }
+
+g5 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03,t04,t05]
+        }
+
+g6 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t06]
+        }
+
+g7 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t07]
+        }
+
+t801 = arc s1 res_rdf_type       o1
+t802 = arc s2 res_owl_sameAs     o2
+t803 = arc s3 res_operator_plus  o3
+t804 = arc s3 res_operator_minus o3
+t805 = arc s3 res_operator_star  o3
+t806 = arc s3 res_operator_slash o3
+t807 = arc o1 p1 s1
+t808 = arc s2 p1 o2
+t809 = arc s1 p2 o1
+t810 = arc o2 p2 s2
+
+g8 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t801,t802,t803,t804,t805,t806,t807,t808,t809,t810]
+        }
+
+g81 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t801,t802]
+        }
+
+g82 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t803,t804,t805,t806]
+        }
+
+g83 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t807,t808,t809,t810]
+        }
+
+t911 = arc s1 p1 o1
+t912 = arc s1 p1 o2
+t913 = arc s1 p2 o2
+t914 = arc s1 p2 o3
+t921 = arc s2 p1 o1
+t922 = arc s2 p1 o2
+t923 = arc s2 p1 o3
+t924 = arc s2 p1 l1
+t925 = arc s2 p2 o1
+t926 = arc s2 p2 o2
+t927 = arc s2 p2 o3
+t928 = arc s2 p2 l1
+
+g9 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t911,t912,t913,t914,
+                        t921,t922,t923,t924,
+                        t925,t926,t927,t928]
+        }
+
+t1011 = arc s1 p1 o1
+t1012 = arc o2 p1 s1
+t1013 = arc s1 p2 o2
+t1014 = arc o3 p2 s1
+t1021 = arc s2 p1 o1
+t1022 = arc s2 p1 o2
+t1023 = arc s2 p1 o3
+t1024 = arc s2 p1 l1
+t1025 = arc o1 p2 s2
+t1026 = arc o2 p2 s2
+t1027 = arc o3 p2 s2
+t1028 = arc l1 p2 s2
+
+g10 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t1011,t1012,t1013,t1014,
+                        t1021,t1022,t1023,t1024,
+                        t1025,t1026,t1027,t1028]
+        }
+
+t1111 = arc s1 p1 v1
+t1112 = arc v2 p1 o1
+t1113 = arc v3 p1 v4
+
+g11 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t1111,t1112,t1113]
+        }
+
+t1211 = arc b1 p1 o1
+t1221 = arc b2 res_rdf_first v1
+t1222 = arc b2 res_rdf_rest  b3
+t1223 = arc b3 res_rdf_first v2
+t1224 = arc b3 res_rdf_rest  res_rdf_nil
+
+g12 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t1211,t1221,t1222,t1223,t1224]
+        }
+
+t1711 = arc s1 p1 lfr
+t1722 = arc s2 p2 lxml
+t1733 = arc s3 p3 lfrxml
+
+g17 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t1711,t1722,t1733]
+        }
+
+tx101 = arc b1 res_owl_sameAs s1
+tx102 = arc s2 res_owl_sameAs b2
+tx111 = arc b1 p1 o1
+tx112 = arc b1 p1 o2
+tx113 = arc b1 p2 o2
+tx114 = arc b1 p2 o3
+tx121 = arc b2 p1 o1
+tx122 = arc b2 p1 o2
+tx123 = arc b2 p1 o3
+tx124 = arc b2 p1 l1
+tx125 = arc b2 p2 o1
+tx126 = arc b2 p2 o2
+tx127 = arc b2 p2 o3
+tx128 = arc b2 p2 l1
+
+x1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx101,tx102,
+                        tx111,tx112,tx113,tx114,
+                        tx121,tx122,tx123,tx124,
+                        tx125,tx126,tx127,tx128]
+        }
+
+tx201 = arc b1 res_owl_sameAs s1
+tx202 = arc s2 res_owl_sameAs b2
+tx211 = arc b1 p1 o1
+tx212 = arc o2 p1 b1
+tx213 = arc b1 p2 o2
+tx214 = arc o3 p2 b1
+tx221 = arc b2 p1 o1
+tx222 = arc b2 p1 o2
+tx223 = arc b2 p1 o3
+tx224 = arc b2 p1 l1
+tx225 = arc o1 p2 b2
+tx226 = arc o2 p2 b2
+tx227 = arc o3 p2 b2
+tx228 = arc l1 p2 b2
+
+x2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx201,tx202,
+                        tx211,tx212,tx213,tx214,
+                        tx221,tx222,tx223,tx224,
+                        tx225,tx226,tx227,tx228]
+        }
+
+tx311 = arc s1 p1 o1
+tx312 = arc o2 p1 s1
+tx313 = arc s1 p2 o2
+tx314 = arc o3 p2 s1
+tx321 = arc s2 p1 o1
+tx322 = arc s2 p1 o2
+tx323 = arc s2 p1 o3
+tx324 = arc s2 p1 l1
+tx325 = arc o1 p2 s2
+tx326 = arc o2 p2 s2
+tx327 = arc o3 p2 s2
+tx328 = arc l1 p2 s2
+
+x3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx311,tx312,tx313,tx314,
+                        tx321,tx322,tx323,tx324,
+                        tx325,tx326,tx327,tx328]
+        }
+
+tx401 = arc s1 res_owl_sameAs b1
+tx402 = arc b1 res_rdf_first  o1
+tx403 = arc b1 res_rdf_rest   b2
+tx404 = arc b2 res_rdf_first  o2
+tx405 = arc b2 res_rdf_rest   b3
+tx406 = arc b3 res_rdf_first  o3
+tx407 = arc b3 res_rdf_rest   b4
+tx408 = arc b4 res_rdf_first  l1
+tx409 = arc b4 res_rdf_rest   res_rdf_nil
+
+x4 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx401,tx402,tx403,tx404,
+                        tx405,tx406,tx407,tx408,
+                        tx409]
+        }
+
+tx501 = arc b1 res_owl_sameAs s1
+tx502 = arc b1 res_rdf_first  o1
+tx503 = arc b1 res_rdf_rest   b2
+tx504 = arc b2 res_rdf_first  o2
+tx505 = arc b2 res_rdf_rest   b3
+tx506 = arc b3 res_rdf_first  o3
+tx507 = arc b3 res_rdf_rest   b4
+tx508 = arc b4 res_rdf_first  l1
+tx509 = arc b4 res_rdf_rest   res_rdf_nil
+
+x5 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx501,tx502,tx503,tx504,
+                        tx505,tx506,tx507,tx508,
+                        tx509]
+        }
+
+tx601 = arc s1 res_rdf_first o1
+tx602 = arc s1 res_rdf_rest  b2
+tx603 = arc b2 res_rdf_first o2
+tx604 = arc b2 res_rdf_rest  b3
+tx605 = arc b3 res_rdf_first o3
+tx606 = arc b3 res_rdf_rest  b4
+tx607 = arc b4 res_rdf_first l1
+tx608 = arc b4 res_rdf_rest  res_rdf_nil
+
+x6 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx601,tx602,tx603,tx604,
+                        tx605,tx606,tx607,tx608]
+        }
+
+tx701 = arc b1 p2 f2
+x7f   = LookupMap [Formula b1 g2]
+x7    = NSGraph
+        { namespaces = nslist
+        , formulae   = x7f
+        , statements = [tx701]
+        }
+
+tx801 = arc f1 p2 f2
+x8f   = LookupMap [Formula f1 g2]
+x8    = NSGraph
+        { namespaces = nslist
+        , formulae   = x8f
+        , statements = [tx801]
+        }
+
+tx901 = tx801
+x9f   = LookupMap [Formula f1 g1]
+x9    = NSGraph
+        { namespaces = nslist
+        , formulae   = x9f
+        , statements = [tx901]
+        }
+
+--  Test allocation of bnodes carries over a nested formula
+tx1201 = arc s1 p1 b1
+tx1202 = arc b1 p1 o1
+tx1203 = arc b2 p2 f2
+tx1204 = arc s3 p3 b3
+tx1205 = arc b3 p3 o3
+tx1211 = arc s2 p2 b4
+tx1212 = arc b4 p2 o2
+x12fg  = NSGraph
+        { namespaces = emptyNamespaceMap
+        , formulae   = emptyFormulaMap
+        , statements = [tx1211,tx1212]
+        }
+x12f   = LookupMap [Formula b2 x12fg]
+x12    = NSGraph
+        { namespaces = nslist
+        , formulae   = x12f
+        , statements = [tx1201,tx1202,tx1203,tx1204,tx1205]
+        }
+
+--  List of simple anon nodes
+tx1301 = arc s1 res_rdf_first b1
+tx1302 = arc s1 res_rdf_rest  c1
+tx1303 = arc c1 res_rdf_first b2
+tx1304 = arc c1 res_rdf_rest  c2
+tx1305 = arc c2 res_rdf_first b3
+tx1306 = arc c2 res_rdf_rest  res_rdf_nil
+tx1307 = arc b1 p1 o1
+tx1308 = arc b2 p1 o2
+tx1309 = arc b3 p1 o3
+
+x13    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1301,tx1302,tx1303,tx1304,tx1305,tx1306,
+                        tx1307,tx1308,tx1309]
+        }
+
+--  List of more complex anon nodes
+tx1401 = arc s1 res_rdf_first b1
+tx1402 = arc s1 res_rdf_rest  c1
+tx1403 = arc c1 res_rdf_first b2
+tx1404 = arc c1 res_rdf_rest  c2
+tx1405 = arc c2 res_rdf_first b3
+tx1406 = arc c2 res_rdf_rest  res_rdf_nil
+tx1407 = arc b1 p1 o1
+tx1408 = arc b1 p2 o1
+tx1409 = arc b2 p1 o2
+tx1410 = arc b2 p2 o2
+tx1411 = arc b3 p1 o3
+tx1412 = arc b3 p2 o3
+
+x14    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1401,tx1402,tx1403,tx1404,tx1405,tx1406,
+                        tx1407,tx1408,tx1409,tx1410,tx1411,tx1412]
+        }
+
+--  List with nested list
+tx1501 = arc s1 res_rdf_first b1
+tx1502 = arc s1 res_rdf_rest  c1
+tx1503 = arc c1 res_rdf_first b2
+tx1504 = arc c1 res_rdf_rest  c2
+tx1505 = arc c2 res_rdf_first b3
+tx1506 = arc c2 res_rdf_rest  res_rdf_nil
+tx1507 = arc b1 p1 o1
+tx1508 = arc b2 p2 c3
+tx1509 = arc b3 p1 o3
+
+tx1521 = arc c3 res_rdf_first b4
+tx1522 = arc c3 res_rdf_rest  c4
+tx1523 = arc c4 res_rdf_first b5
+tx1524 = arc c4 res_rdf_rest  c5
+tx1525 = arc c5 res_rdf_first b6
+tx1526 = arc c5 res_rdf_rest  res_rdf_nil
+tx1527 = arc b4 p1 o1
+tx1528 = arc b5 p1 o2
+tx1529 = arc b6 p1 o3
+
+x15    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1501,tx1502,tx1503,tx1504,tx1505,tx1506,
+                        tx1507,tx1508,tx1509,
+                        tx1521,tx1522,tx1523,tx1524,tx1525,tx1526,
+                        tx1527,tx1528,tx1529]
+        }
+
+--  More complex list with nested list
+tx1601 = arc s1 res_rdf_first b1
+tx1602 = arc s1 res_rdf_rest  c1
+tx1603 = arc c1 res_rdf_first b2
+tx1604 = arc c1 res_rdf_rest  c2
+tx1605 = arc c2 res_rdf_first b3
+tx1606 = arc c2 res_rdf_rest  res_rdf_nil
+tx1607 = arc b1 p1 o1
+tx1608 = arc b1 p2 o1
+tx1609 = arc b2 p2 c3
+tx1610 = arc b3 p1 o3
+tx1611 = arc b3 p2 o3
+
+tx1621 = arc c3 res_rdf_first b4
+tx1622 = arc c3 res_rdf_rest  c4
+tx1623 = arc c4 res_rdf_first b5
+tx1624 = arc c4 res_rdf_rest  c5
+tx1625 = arc c5 res_rdf_first b6
+tx1626 = arc c5 res_rdf_rest  res_rdf_nil
+tx1627 = arc b4 p1 o1
+tx1628 = arc b4 p2 o1
+tx1629 = arc b5 p1 o2
+tx1630 = arc b5 p2 o2
+tx1631 = arc b6 p1 o3
+tx1632 = arc b6 p2 o3
+
+x16    = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tx1601,tx1602,tx1603,tx1604,tx1605,tx1606,
+                        tx1607,tx1608,tx1609,tx1610,tx1611,
+                        tx1621,tx1622,tx1623,tx1624,tx1625,tx1626,
+                        tx1627,tx1628,tx1629,tx1630,tx1631,tx1632]
+        }
+
+------------------------------------------------------------
+--  Simple parser tests
+------------------------------------------------------------
+
+commonPrefixes =
+    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++
+    "@prefix base2 : <" ++ nsURI base2 ++ "> . \n" ++
+    "@prefix base3 : <" ++ nsURI base3 ++ "> . \n"
+
+--  Single statement using <uri> form
+simpleN3Graph_g1_01 =
+    " <http://id.ninebynine.org/wip/2003/test/graph1/node/s1> " ++
+    " <http://id.ninebynine.org/wip/2003/test/graph1/node/p1> " ++
+    " <http://id.ninebynine.org/wip/2003/test/graph1/node/o1> . "
+
+--  Single statement using prefix:name form
+simpleN3Graph_g1_02 =
+    "@prefix base1 : <" ++ nsURI base1 ++ "> ." ++
+    " base1:s1 base1:p1 base1:o1 . "
+
+--  Single statement using :name form
+simpleN3Graph_g1_03 =
+    "@prefix : <" ++ nsURI base1 ++ "> .\n" ++
+    " :s1 :p1 :o1 . "
+
+--  Single statement using relative URI form
+simpleN3Graph_g1_04 =
+    "@base <" ++ nsURI base1 ++ "> .\n" ++
+    " <s1> <p1> <o1> . "
+
+--  Single statement using blank nodes
+simpleN3Graph_g1_05 =
+    "@base <" ++ nsURI base1 ++ "> .\n" ++
+    " _:b1 _:b2 _:b3 . "
+
+--  Single statement with junk following
+simpleN3Graph_g1_06 =
+    "@prefix base1 : <" ++ nsURI base1 ++ "> ." ++
+    " base1:s1 base1:p1 base1:o1 . " ++
+    " **** "
+
+--  Multiple statements
+simpleN3Graph_g2 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 . \n" ++
+    " base2:s2 base1:p1 base2:o2 . \n" ++
+    " base3:s3 base1:p1 base3:o3 . \n"
+
+--  Graph with literal
+simpleN3Graph_g3 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 . \n" ++
+    " base1:s1 base1:p1 \"l1\" . \n"
+
+--  Graph with nodeid
+simpleN3Graph_g4 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 . \n" ++
+    " base2:s2 base1:p1 _:b1 . \n"
+
+--  Graph with literal and nodeid
+simpleN3Graph_g5 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 . \n" ++
+    " base2:s2 base1:p1 base2:o2 . \n" ++
+    " base3:s3 base1:p1 base3:o3 . \n" ++
+    " base1:s1 base1:p1 \"l1\" . \n"   ++
+    " base2:s2 base1:p1 _:b1 . \n"
+
+--  Triple-quoted literal
+simpleN3Graph_g6 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 . \n" ++
+    " base3:s3 base1:p1 \"\"\"l2-'\"line1\"'\n\nl2-'\"\"line2\"\"'\"\"\" . \n"
+
+--  String escapes
+simpleN3Graph_g7 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 . \n" ++
+    " base3:s3 base2:p2 " ++
+    " \"l3--\\r\\\"\\'\\\\--\\u0020--\\U000000A0--\" " ++
+    " . \n"
+
+--  Different verb forms
+simpleN3Graph_g8 =
+    commonPrefixes ++
+    " base1:s1 a base1:o1 . \n" ++
+    " base2:s2 = base2:o2 . \n" ++
+    " base3:s3 + base3:o3 . \n" ++
+    " base3:s3 - base3:o3 . \n" ++
+    " base3:s3 * base3:o3 . \n" ++
+    " base3:s3 / base3:o3 . \n" ++
+    " base1:s1 is  base1:p1 of base1:o1 . \n" ++
+    " base2:s2 has base1:p1 of base2:o2 . \n" ++
+    " base1:s1 >-  base2:p2 -> base1:o1 . \n" ++
+    " base2:s2 <-  base2:p2 <- base2:o2 . \n"
+
+simpleN3Graph_g81 =
+    commonPrefixes ++
+    " base1:s1 a base1:o1 . \n" ++
+    " base2:s2 = base2:o2 . \n"
+
+simpleN3Graph_g82 =
+    commonPrefixes ++
+    " base3:s3 + base3:o3 . \n" ++
+    " base3:s3 - base3:o3 . \n" ++
+    " base3:s3 * base3:o3 . \n" ++
+    " base3:s3 / base3:o3 . \n"
+
+simpleN3Graph_g83 =
+    commonPrefixes ++
+    " base1:s1 is  base1:p1 of base1:o1 . \n" ++
+    " base2:s2 has base1:p1 of base2:o2 . \n" ++
+    " base1:s1 >-  base2:p2 -> base1:o1 . \n" ++
+    " base2:s2 <-  base2:p2 <- base2:o2 . \n"
+
+--  Semicolons and commas
+simpleN3Graph_g9 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 base1:o1 ; \n" ++
+    "          base1:p1 base2:o2 ; \n" ++
+    "          base2:p2 base2:o2 ; \n" ++
+    "          base2:p2 base3:o3 . \n" ++
+    " base2:s2 base1:p1 base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ; \n" ++
+    "          base2:p2 base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   . \n"
+
+--  'is ... of' and semicolons and commas
+simpleN3Graph_g10 =
+    commonPrefixes ++
+    " base1:s1 has base1:p1 of base1:o1 ; \n" ++
+    "          is  base1:p1 of base2:o2 ; \n" ++
+    "          has base2:p2 of base2:o2 ; \n" ++
+    "          is  base2:p2 of base3:o3 . \n" ++
+    " base2:s2 has base1:p1 of base1:o1 , \n" ++
+    "                          base2:o2 , \n" ++
+    "                          base3:o3 , \n" ++
+    "                          \"l1\"   ; \n" ++
+    "          is  base2:p2 of base1:o1 , \n" ++
+    "                          base2:o2 , \n" ++
+    "                          base3:o3 , \n" ++
+    "                          \"l1\"   . \n"
+
+--  Simple statements using ?var form
+simpleN3Graph_g11 =
+    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++
+    " base1:s1 base1:p1 ?var1 . \n"          ++
+    " ?var2 base1:p1 base1:o1 . \n"          ++
+    " ?var3 base1:p1 ?var4 .    \n"
+
+--  Bare anonymous nodes
+simpleN3Graph_g12 =
+    "@prefix base1 : <" ++ nsURI base1 ++ "> . \n" ++
+    " [ base1:p1 base1:o1 ] .  \n"          ++
+    " ( ?var1 ?var2 ) .    \n"
+
+--  Literals with dataype and language
+simpleN3Graph_g17 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 \"chat\"@fr . \n "                          ++
+    " base2:s2 base2:p2 \"<br/>\"^^rdf:XMLLiteral . \n "            ++
+    " base3:s3 base3:p3 \"<em>chat</em>\"^^rdf:XMLLiteral . \n "
+
+simpleTest011 = parseTest "simpleTest011" simpleN3Graph_g1_01 g1  noError
+simpleTest012 = parseTest "simpleTest012" simpleN3Graph_g1_02 g1  noError
+simpleTest013 = parseTest "simpleTest013" simpleN3Graph_g1_03 g1  noError
+simpleTest014 = parseTest "simpleTest014" simpleN3Graph_g1_04 g1  noError
+simpleTest015 = parseTest "simpleTest015" simpleN3Graph_g1_05 g1b noError
+simpleTest016 = parseTest "simpleTest016" simpleN3Graph_g1_06 emptyRDFGraph
+                ( "(line 1, column 103):\n"++
+                  "unexpected \"*\"\n"++
+                  "expecting URI or blank node or end of input" )
+simpleTest03  = parseTest "simpleTest03"  simpleN3Graph_g2    g2  noError
+simpleTest04  = parseTest "simpleTest04"  simpleN3Graph_g3    g3  noError
+simpleTest05  = parseTest "simpleTest05"  simpleN3Graph_g4    g4  noError
+simpleTest06  = parseTest "simpleTest06"  simpleN3Graph_g5    g5  noError
+simpleTest07  = parseTest "simpleTest07"  simpleN3Graph_g6    g6  noError
+simpleTest08  = parseTest "simpleTest08"  simpleN3Graph_g7    g7  noError
+simpleTest09  = parseTest "simpleTest09"  simpleN3Graph_g8    g8  noError
+simpleTest10  = parseTest "simpleTest10"  simpleN3Graph_g81   g81 noError
+simpleTest11  = parseTest "simpleTest11"  simpleN3Graph_g82   g82 noError
+simpleTest12  = parseTest "simpleTest12"  simpleN3Graph_g83   g83 noError
+simpleTest13  = parseTest "simpleTest13"  simpleN3Graph_g9    g9  noError
+simpleTest14  = parseTest "simpleTest14"  simpleN3Graph_g10   g10 noError
+simpleTest15  = parseTest "simpleTest15"  simpleN3Graph_g11   g11 noError
+simpleTest16  = parseTest "simpleTest16"  simpleN3Graph_g12   g12 noError
+simpleTest17  = parseTest "simpleTest17"  simpleN3Graph_g17   g17 noError
+
+simpleTestSuite = TestList
+  [ simpleTest011
+  , simpleTest012
+  , simpleTest013
+  , simpleTest014
+  , simpleTest015
+  , simpleTest016
+  , simpleTest03
+  , simpleTest04
+  , simpleTest05
+  , simpleTest06
+  , simpleTest07
+  , simpleTest08
+  , simpleTest09
+  , simpleTest10
+  , simpleTest11
+  , simpleTest12
+  , simpleTest13
+  , simpleTest14
+  , simpleTest15
+  , simpleTest16
+  , simpleTest17
+  ]
+
+------------------------------------------------------------
+--  Exotic parser tests
+------------------------------------------------------------
+--
+--  These tests cover various forms of anonymous nodes
+--  [...], lists and formula. together with uses of ':-'
+--
+
+--  Simple anon nodes, with semicolons and commas
+exoticN3Graph_x1 =
+    commonPrefixes ++
+    " [ base1:p1 base1:o1 ; \n" ++
+    "   base1:p1 base2:o2 ; \n" ++
+    "   base2:p2 base2:o2 ; \n" ++
+    "   base2:p2 base3:o3 ] = base1:s1 . \n" ++
+    " base2:s2 = \n" ++
+    " [ base1:p1 base1:o1 , \n" ++
+    "   base2:o2 , \n" ++
+    "   base3:o3 , \n" ++
+    "   \"l1\"   ; \n" ++
+    "   base2:p2 base1:o1 , \n" ++
+    "            base2:o2 , \n" ++
+    "            base3:o3 , \n" ++
+    "            \"l1\"   ] . \n"
+
+--  Simple anon nodes, with 'is ... of' and semicolons and commas
+exoticN3Graph_x2 =
+    commonPrefixes ++
+    " [ has base1:p1 of base1:o1 ; \n" ++
+    "   is  base1:p1 of base2:o2 ; \n" ++
+    "   has base2:p2 of base2:o2 ; \n" ++
+    "   is  base2:p2 of base3:o3 ] = base1:s1 . \n" ++
+    " base2:s2 = \n" ++
+    " [ has base1:p1 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ; \n" ++
+    "   is  base2:p2 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ] . \n"
+
+
+--  Simple anon nodes, attached to identified node
+exoticN3Graph_x3 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    " [ has base1:p1 of base1:o1 ; \n" ++
+    "   is  base1:p1 of base2:o2 ; \n" ++
+    "   has base2:p2 of base2:o2 ; \n" ++
+    "   is  base2:p2 of base3:o3 ] . \n" ++
+    " base2:s2 :- \n" ++
+    " [ has base1:p1 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ; \n" ++
+    "   is  base2:p2 of base1:o1 , \n" ++
+    "                   base2:o2 , \n" ++
+    "                   base3:o3 , \n" ++
+    "                   \"l1\"   ] . \n"
+
+
+--  List nodes, with and without :-
+
+exoticN3Graph_x4 =
+    commonPrefixes ++
+    " base1:s1 = (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
+
+exoticN3Graph_x5 =
+    commonPrefixes ++
+    " (base1:o1 base2:o2 base3:o3 \"l1\") = base1:s1 .\n"
+
+exoticN3Graph_x6 =
+    commonPrefixes ++
+    " base1:s1 :- (base1:o1 base2:o2 base3:o3 \"l1\") .\n"
+
+--  Formula nodes, with and without :-
+
+exoticN3Graph_x7 =
+    commonPrefixes ++
+    " { base1:s1 base1:p1 base1:o1 .   \n" ++
+    "   base2:s2 base1:p1 base2:o2 .   \n" ++
+    "   base3:s3 base1:p1 base3:o3 . } \n" ++
+    " base2:p2 base2:f2 . "
+
+exoticN3Graph_x8 =
+    commonPrefixes ++
+    " base1:f1 :- \n" ++
+    " { base1:s1 base1:p1 base1:o1 .     \n" ++
+    "   base2:s2 base1:p1 base2:o2 .     \n" ++
+    "   base3:s3 base1:p1 base3:o3 . } ; \n" ++
+    " base2:p2 base2:f2 . "
+
+exoticN3Graph_x9 =
+    commonPrefixes ++
+    " base1:f1 :- \n" ++
+    "   { base1:s1 base1:p1 base1:o1 } ; \n" ++
+    "   base2:p2 base2:f2 "
+    -- (also omits final periods)
+
+exoticN3Graph_x8a =
+    commonPrefixes ++
+    " base1:f1 :- \n" ++
+    " { base1:s1 base1:p1 base1:o1 .     \n" ++
+    "   base2:s2 base1:p1 base2:o2 .     \n" ++
+    "   base3:s3 base1:p1 base3:o3 . } . \n" ++
+    " base1:f1 base2:p2 base2:f2 . "
+
+exoticN3Graph_x9a =
+    commonPrefixes ++
+    " base1:f1 :- \n" ++
+    " { base1:s1 base1:p1 base1:o1 . } . \n" ++
+    " base1:f1 base2:p2 base2:f2 . "
+
+--  Test allocation of bnodes carries over a nested formula
+exoticN3Graph_x12 =
+    commonPrefixes ++
+    " base1:s1 base1:p1 [ base1:p1 base1:o1 ] .     \n" ++
+    " { base2:s2 base2:p2 [ base2:p2 base2:o2 ] . } \n" ++
+    "            base2:p2 base2:f2 .                \n" ++
+    " base3:s3 base3:p3 [ base3:p3 base3:o3 ] ."
+
+--  List of bnodes
+exoticN3Graph_x13 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1] \n" ++
+    "    [base1:p1 base2:o2] \n" ++
+    "    [base1:p1 base3:o3] ) .\n"
+
+--  List of more complex bnodes
+exoticN3Graph_x14 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
+    "    [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
+    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
+
+--  List with nested list
+exoticN3Graph_x15 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1] \n"++
+    "    [base2:p2 \n" ++
+    "       ( [base1:p1 base1:o1] \n" ++
+    "         [base1:p1 base2:o2] \n" ++
+    "         [base1:p1 base3:o3] ) ] \n"++
+    "    [base1:p1 base3:o3] ) .\n"
+
+--  More complex list with nested list
+exoticN3Graph_x16 =
+    commonPrefixes ++
+    " base1:s1 :- \n" ++
+    "  ( [base1:p1 base1:o1; base2:p2 base1:o1] \n"++
+    "    [base2:p2 \n" ++
+    "       ( [base1:p1 base1:o1; base2:p2 base1:o1] \n" ++
+    "         [base1:p1 base2:o2; base2:p2 base2:o2] \n" ++
+    "         [base1:p1 base3:o3; base2:p2 base3:o3] ) ] \n"++
+    "    [base1:p1 base3:o3; base2:p2 base3:o3] ) .\n"
+
+exoticTest01 = parseTest "exoticTest01" exoticN3Graph_x1  x1  noError
+exoticTest02 = parseTest "exoticTest02" exoticN3Graph_x2  x2  noError
+exoticTest03 = parseTest "exoticTest03" exoticN3Graph_x3  x3  noError
+exoticTest04 = parseTest "exoticTest04" exoticN3Graph_x4  x4  noError
+exoticTest05 = parseTest "exoticTest05" exoticN3Graph_x5  x5  noError
+exoticTest06 = parseTest "exoticTest06" exoticN3Graph_x6  x6  noError
+exoticTest07 = parseTest "exoticTest07" exoticN3Graph_x7  x7  noError
+exoticTest08 = parseTest "exoticTest08" exoticN3Graph_x8  x8  noError
+exoticTest09 = parseTest "exoticTest09" exoticN3Graph_x9  x9  noError
+exoticTest10 = parseTest "exoticTest10" exoticN3Graph_x8a x8  noError
+exoticTest11 = parseTest "exoticTest11" exoticN3Graph_x9a x9  noError
+exoticTest12 = parseTest "exoticTest12" exoticN3Graph_x12 x12 noError
+exoticTest13 = parseTest "exoticTest13" exoticN3Graph_x13 x13 noError
+exoticTest14 = parseTest "exoticTest14" exoticN3Graph_x14 x14 noError
+exoticTest15 = parseTest "exoticTest15" exoticN3Graph_x15 x15 noError
+exoticTest16 = parseTest "exoticTest16" exoticN3Graph_x16 x16 noError
+exoticTest20 = testGraphEq "exoticTest20" False x7 x8
+exoticTest21 = testGraphEq "exoticTest21" False x8 x9
+
+exoticTestSuite = TestList
+  [ exoticTest01
+  , exoticTest02
+  , exoticTest03
+  , exoticTest04
+  , exoticTest05
+  , exoticTest06
+  , exoticTest07
+  , exoticTest08
+  , exoticTest09
+  , exoticTest10
+  , exoticTest11
+  , exoticTest12
+  , exoticTest13
+  , exoticTest14
+  , exoticTest15
+  , exoticTest16
+  , exoticTest20
+  , exoticTest21
+  ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ charTestSuite
+  , nameTestSuite
+  , prefixTestSuite
+  , absUriRefTestSuite
+  , uriRef2TestSuite
+  , simpleTestSuite
+  , exoticTestSuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/N3ParserTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.25 $
+-- $Log: N3ParserTest.hs,v $
+-- Revision 1.25  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.24  2004/01/09 11:23:54  graham
+-- Fix up N3Parser so that the final statement-terminating '.' in a formula
+-- or file is optional.
+--
+-- Revision 1.23  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.22  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.21  2003/12/03 17:07:23  graham
+-- Replace occurrences of QName in N3Parser with ScopedName.
+--
+-- Revision 1.20  2003/12/03 15:42:09  graham
+-- Eliminate special return type in favour of ErrorM
+--
+-- Revision 1.19  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.18  2003/11/24 15:46:04  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.17  2003/10/09 16:26:31  graham
+-- Added parser support for literal language tags and datatypes.
+-- (Language tags are names, not strictly per RFC3066)
+--
+-- Revision 1.16  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.15  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.14  2003/07/01 14:18:57  graham
+-- Allow blank node in predicate position.
+-- Add parser and formatter test case for this.
+--
+-- Revision 1.13  2003/06/12 00:47:56  graham
+-- Allowed variable node (?v) and bare anonymous nodes in N3 parser.
+--
+-- Revision 1.12  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.11  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.10  2003/05/23 00:02:42  graham
+-- Fixed blank node id generation bug in N3Formatter
+--
+-- Revision 1.9  2003/05/22 15:16:39  graham
+-- Added additional parser test cases for lists
+--
+-- Revision 1.8  2003/05/21 13:55:13  graham
+-- N3 parser now handles relative URIs and default prefixes.
+-- (Still need to figure better default base URI handling; i.e. current document)
+--
+-- Revision 1.7  2003/05/21 13:34:13  graham
+-- Various N3 parser bug fixes.
+-- Need to fix handling of :name terms.
+--
+-- Revision 1.6  2003/05/14 16:50:32  graham
+-- Graph matching seems solid now:
+-- RDFGraphTest and N3ParserTest pass all tests
+-- Updated TODO file with comments from code
+--
+-- Revision 1.5  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.4  2003/05/07 23:58:09  graham
+-- More restructuring.
+-- RDFGraphTest runs OK.
+-- N3ParserTest needs to be updated to use new structure for formulae.
+--
+-- Revision 1.3  2003/04/30 12:14:08  graham
+-- Add formetter test to CVS
+-- Noted problem with RDFGraph structure: preparing to rework
+--
+-- Revision 1.2  2003/04/17 12:28:05  graham
+-- Formula parsing seems OK.
+-- There remains a question about how to represent
+-- and compare graphs containing formulae.
+--
+-- Revision 1.1  2003/04/17 00:35:38  graham
+-- Added module N3ParserTest
+-- N3parser is mostly working
+-- Formulae remain to test
+--
+ Swish/HaskellRDF/ParsecLanguage.hs view
@@ -0,0 +1,115 @@++----------------------------------------------------------------+-- Daan Leijen (c) 1999-2001, daan@cs.uu.nl+-- +-- a helper module that defines some language definitions+-- that can be used to instantiate a token parser (see ParsecToken)+-- +-- $Revision: 1.3 $+-- $Author: daan $+-- $Date: 2001/10/03 09:21:38 $+----------------------------------------------------------------+module Swish.HaskellRDF.ParsecLanguage( haskellDef, haskell+                                       , mondrianDef, mondrian+                   +                                       , emptyDef+                                       , haskellStyle+                                       , javaStyle   +                                       , LanguageDef (..)                +                                       ) where++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Token ++           +-----------------------------------------------------------+-- Styles: haskellStyle, javaStyle+-----------------------------------------------------------               ++haskellStyle= emptyDef                      +                { commentStart   = "{-"+                , commentEnd     = "-}"+                , commentLine    = "--"+                , nestedComments = True+                , identStart     = letter+                , identLetter	 = alphaNum <|> oneOf "_'"+                , opStart	 = opLetter haskellStyle+                , opLetter	 = oneOf ":!#$%&*+./<=>?@\\^|-~"              +                , reservedOpNames= []+                , reservedNames  = []+                , caseSensitive  = True                                   +                }         +                           +javaStyle   = emptyDef+		{ commentStart	 = "/*"+		, commentEnd	 = "*/"+		, commentLine	 = "//"+		, nestedComments = True+		, identStart	 = letter+		, identLetter	 = alphaNum <|> oneOf "_'"		+		, reservedNames  = []+		, reservedOpNames= []	+                , caseSensitive  = False				  +		}++-----------------------------------------------------------+-- minimal language definition+-----------------------------------------------------------                +emptyDef    = LanguageDef +               { commentStart   = ""+               , commentEnd     = ""+               , commentLine    = ""+               , nestedComments = True+               , identStart     = letter <|> char '_'+               , identLetter    = alphaNum <|> oneOf "_'"+               , opStart        = opLetter emptyDef+               , opLetter       = oneOf ":!#$%&*+./<=>?@\\^|-~"+               , reservedOpNames= []+               , reservedNames  = []+               , caseSensitive  = True+               }+                +++-----------------------------------------------------------+-- Haskell+-----------------------------------------------------------               +haskell :: TokenParser st+haskell      = makeTokenParser haskellDef++haskellDef   = haskell98Def+	        { identLetter	 = identLetter haskell98Def <|> char '#'+	        , reservedNames	 = reservedNames haskell98Def ++ +    				   ["foreign","import","export","primitive"+    				   ,"_ccall_","_casm_"+    				   ,"forall"+    				   ]+                }+			    +haskell98Def = haskellStyle+                { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]+                , reservedNames  = ["let","in","case","of","if","then","else",+                                    "data","type",+                                    "class","default","deriving","do","import",+                                    "infix","infixl","infixr","instance","module",+                                    "newtype","where",+                                    "primitive"+                                    -- "as","qualified","hiding"+                                   ]+                }         +                +                +-----------------------------------------------------------+-- Mondrian+-----------------------------------------------------------               +mondrian :: TokenParser st+mondrian    = makeTokenParser mondrianDef++mondrianDef = javaStyle+		{ reservedNames = [ "case", "class", "default", "extends"+				  , "import", "in", "let", "new", "of", "package"+				  ]	+                , caseSensitive  = True				  +		}++				
+ Swish/HaskellRDF/Proof.hs view
@@ -0,0 +1,361 @@+--------------------------------------------------------------------------------
+--  $Id: Proof.hs,v 1.19 2004/01/07 19:49:12 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Proof
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a framework for constructing proofs
+--  over some expression form.  It is intended to be used
+--  with RDF graphs, but the structures aim to be quite
+--  generic with respect to the expression forms allowed.
+--
+--  It does not define any proof-finding strategy.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.Proof
+    ( Proof(..), Step(..)
+    , checkProof, explainProof, checkStep, showProof, showsProof, showsFormula )
+where
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..)
+    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..)
+    , fwdCheckInference
+    , showsFormula, showsFormulae, showsWidth )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getScopePrefix, getScopeURI
+    , getQName, getScopedNameURI )
+
+import Swish.HaskellUtils.ShowM
+    ( ShowM(..), showm )
+
+import Swish.HaskellUtils.ListHelpers
+    ( subset )
+
+import Data.List
+    ( union, intersect, intersperse )
+
+import Data.Maybe
+    ( isJust, fromJust, catMaybes )
+
+
+------------------------------------------------------------
+--  Proof framework
+------------------------------------------------------------
+
+-- |Step in proof chain
+--
+--  The display name for a proof step comes from the display name of its
+--  consequence formula.
+data Step ex = Step
+    { stepRule :: Rule ex           -- ^ Inference rule used
+    , stepAnt  :: [Formula ex]      -- ^ Antecedents of inference rule
+    , stepCon  :: Formula ex        -- ^ Named consequence of inference rule
+    } deriving Show
+
+-- |Proof is a structure that presents a chain of rule applications
+--  that yield a result expression from a given expression
+data Proof ex = Proof
+    { proofContext :: [Ruleset ex]  -- ^ Proof context:  list of rulesets,
+                                    --   each of which provides a number of
+                                    --   axioms and rules.
+    , proofInput   :: Formula ex    -- ^ Given expression
+    , proofResult  :: Formula ex    -- ^ Result expression
+    , proofChain   :: [Step ex]     -- ^ Chain of inference rule applications
+                                    --   progressing from input to result
+    }
+
+-- |Return a list of axioms from all the rulesets in a proof
+proofAxioms = concat . map rsAxioms . proofContext
+
+-- |Return a list of rules from all the rulesets in a proof
+proofRules = concat . map rsRules . proofContext
+
+-- |Return list of axioms actually referenced by a proof
+proofAxiomsUsed :: Proof ex -> [Formula ex]
+proofAxiomsUsed proof = foldl union [] $ map stepAxioms (proofChain proof)
+    where
+        stepAxioms st = stepAnt st `intersect` proofAxioms proof
+
+-- |Check consistency of given proof.
+--  The supplied rules and axioms are assumed to be correct.
+checkProof :: (Expression ex) => Proof ex -> Bool
+checkProof pr =
+    checkProof1 (proofRules pr) initExpr (proofChain pr) goalExpr
+    where
+        initExpr = (formExpr $ proofInput pr):(map formExpr $ proofAxioms pr)
+        goalExpr = (formExpr $ proofResult pr)
+
+checkProof1 :: (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
+checkProof1 _     prev []       res = res `elem` prev
+checkProof1 rules prev (st:steps) res =
+    checkStep rules prev st &&
+    checkProof1 rules ((formExpr $ stepCon st):prev) steps res
+
+--  A proof step is valid if rule is in list of rules
+--  and the antecedents are sufficient to obtain the conclusion
+--  and the antecedents are in the list of formulae already proven.
+--
+--  Note:  this function depends on the ruleName of any rule being
+--  unique among all rules.  In particular the name of the step rule
+--  being in correspondence with the name of one of the indicated
+--  valid rules of inference.
+checkStep :: (Expression ex) => [Rule ex] -> [ex] -> Step ex -> Bool
+checkStep rules prev step =
+    -- Rule name is one of supplied rules, and
+    (ruleName srul `elem` map ruleName rules) &&
+    -- Antecedent expressions are all previously accepted expressions
+    (sant `subset` prev)   &&
+    -- Inference rule yields concequence from antecendents
+    checkInference srul sant scon
+    where
+        --  Rule from proof step:
+        srul = stepRule step
+        --  Antecedent expressions from proof step:
+        sant = map formExpr $ stepAnt step
+        --  Consequentent expression from proof step:
+        scon = formExpr $ stepCon step
+
+
+{-
+    (formExpr (stepCon step) `elem` sfwd)
+    -- (or $ map (`subset` sant) sbwd)
+    where
+        --  Rule from proof step:
+        srul = stepRule step
+        --  Antecedent expressions from proof step:
+        sant = map formExpr $ stepAnt step
+        --  Forward chaining from antecedents of proof step
+        scon = map formExpr $ stepCon step
+        --  Forward chaining from antecedents of proof step
+
+        sfwd = fwdApply srul sant
+        --  Backward chaining from consequent of proof step
+        --  (Does not work because of introduction of existentials)
+        sbwd = bwdApply srul (formExpr $ stepCon step)
+-}
+
+-- |Check proof, and return identification of failing step.
+explainProof ::
+    (Expression ex) => Proof ex -> Maybe String
+explainProof pr =
+    explainProof1 (proofRules pr) initExpr (proofChain pr) goalExpr
+    where
+        initExpr = (formExpr $ proofInput pr):(map formExpr $ proofAxioms pr)
+        goalExpr = (formExpr $ proofResult pr)
+
+explainProof1 ::
+    (Expression ex) => [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
+explainProof1 _     prev []       res   =
+    if res `elem` prev then Nothing else Just "Result not demonstrated"
+explainProof1 rules prev (st:steps) res =
+    case explainStep rules prev st  of
+        Nothing -> explainProof1 rules ((formExpr $ stepCon st):prev) steps res
+        Just ex -> Just ("Invalid step: "++show (formName $ stepCon st)++": "++ex)
+
+--  A proof step is valid if rule is in list of rules
+--  and the antecedents are sufficient to obtain the conclusion
+--  and the antecedents are in the list of formulae already proven.
+--
+--  Note:  this function depends on the ruleName of any rule being
+--  unique among all rules.  In particular the name of the step rule
+--  being in correspondence with the name of one of the indicated
+--  valid rules of inference.
+--
+--  Return Nothing if step is OK, or Just string describing failure
+--
+explainStep :: (Expression ex) => [Rule ex] -> [ex] -> Step ex -> Maybe String
+explainStep rules prev step =
+        if null errors then Nothing else Just $ concat (intersperse ", " errors)
+    where
+        --  Rule from proof step:
+        srul = stepRule step
+        --  Antecedent expressions from proof step:
+        sant = map formExpr $ stepAnt step
+        --  Consequentent expression from proof step:
+        scon = formExpr $ stepCon step
+        --  Tests for step to be valid
+        errors = catMaybes
+            -- Rule name is one of supplied rules, and
+            [ require (ruleName srul `elem` map ruleName rules)
+                      ("rule "++show (ruleName srul)++" not present")
+            -- Antecedent expressions are all previously accepted expressions
+            , require (sant `subset` prev)
+                      ("antecedent not axiom or previous result")
+            -- Inference rule yields consequence from antecedents
+            , require (checkInference srul sant scon)
+                      ("rule does not deduce consequence from antecedents")
+            ]
+        require b s = if b then Nothing else Just s
+
+-- |showsProof
+--  Create a displayable form of a proof, returned as a ShowS value.
+--
+--  This function is intended to allow the calling function some control
+--  of multiline displays by providing:
+--  (1) the first line of the proof is not preceded by any text, so
+--      it may be appended to some preceding text on the same line,
+--  (2) the supplied newline string is used to separate lines of the
+--      formatted text, and may include any desired indentation, and
+--  (3) no newline is output following the final line of text.
+showsProof :: (ShowM ex) => String -> Proof ex -> ShowS
+showsProof newline proof =
+    if null axioms then shProof else shAxioms . shProof
+    where
+        axioms = proofAxiomsUsed proof
+        shAxioms =
+            showString    ("Axioms:" ++ newline) .
+            showsFormulae newline (proofAxiomsUsed proof) newline
+        shProof =
+            showString    ("Input:" ++ newline) .
+            showsFormula  newline (proofInput  proof) .
+            showString    (newline ++ "Proof:" ++ newline) .
+            showsSteps    newline (proofChain  proof)
+
+-- |showProof
+--  Returns a simple string representation of a proof.
+showProof :: (ShowM ex) => String -> Proof ex -> String
+showProof newline proof = showsProof newline proof ""
+
+-- |showsSteps
+--  Create a displayable form of a list of labelled proof steps
+showsSteps :: (ShowM ex) => String -> [Step ex] -> ShowS
+showsSteps _       []     = id
+showsSteps newline [s]    = showsStep  newline s
+showsSteps newline (s:ss) = showsStep  newline s .
+                            showString newline .
+                            showsSteps newline ss
+
+-- |showsStep
+--  Create a displayable form of a labelled proof step.
+showsStep :: (ShowM ex) => String -> Step ex -> ShowS
+showsStep newline s = showsFormula newline (stepCon s) .
+                      showString newline .
+                      showString ("  (by ["++rulename++"] from "++antnames++")")
+    where
+        rulename = show . ruleName $ stepRule s
+        antnames = showNames $ map (show . formName) (stepAnt s)
+
+-- |showNames
+--  Return a string containing a list of names.
+showNames :: [String] -> String
+showNames []      = "<nothing>"
+showNames [n]     = showName n
+showNames [n1,n2] = showName n1 ++ " and " ++ showName n2
+showNames (n1:ns) = showName n1 ++ ", " ++ showNames ns
+
+-- |showNames
+--  Return a string representing a single name.
+showName n = "["++n++"]"
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/Proof.hs,v $
+-- $Author: graham $
+-- $Revision: 1.19 $
+-- $Log: Proof.hs,v $
+-- Revision 1.19  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.18  2003/12/18 18:27:47  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.17  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.16  2003/09/30 20:02:39  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.15  2003/09/30 16:39:41  graham
+-- Refactor proof code to use new ruleset logic.
+-- Moved some support code from RDFProofCheck to RDFRuleset.
+--
+-- Revision 1.14  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.13  2003/07/02 13:51:14  graham
+-- Intermediate save:  partially coded RDFS rules.
+--
+-- Revision 1.12  2003/07/01 14:20:30  graham
+-- Added instance entailment to proof check module.
+--
+-- Revision 1.11  2003/06/27 20:46:00  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.10  2003/06/26 15:37:23  graham
+-- Added rdfQueryInstance, and tests, all works.
+--
+-- Revision 1.9  2003/06/25 21:16:53  graham
+-- Reworked N3 formatting logic to support proof display.
+-- Basic proof display is working.
+--
+-- Revision 1.8  2003/06/24 23:08:18  graham
+-- Replaced Rule class with algebraic data type
+--
+-- Revision 1.7  2003/06/24 19:56:31  graham
+-- Basic proof-check now works
+--
+-- Revision 1.6  2003/06/19 19:49:07  graham
+-- RDFProofCheck compiles, but test fails
+--
+-- Revision 1.5  2003/06/18 18:40:08  graham
+-- Basic proof backchaining tests OK.
+-- Next:  add filtering on variable bindings.
+--
+-- Revision 1.4  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.3  2003/06/10 01:04:46  graham
+-- Proof framework in progress;  compiles, incomplete
+--
+-- Revision 1.2  2003/06/04 00:49:53  graham
+-- Proof module compiles OK
+--
+-- Revision 1.1  2003/06/03 19:24:54  graham
+-- Started work on inference/proof module
+--

+ Swish/HaskellRDF/RDFDatatype.hs view
@@ -0,0 +1,290 @@+--------------------------------------------------------------------------------
+--  $Id: RDFDatatype.hs,v 1.14 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFDatatype
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + existential types
+--
+--  This module defines the structures used by Swish to represent and
+--  manipulate RDF datatypes.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype
+    , RDFDatatypeVal
+    , RDFDatatypeMod
+    , RDFModifierFn, RDFApplyModifier
+    , makeRdfDtOpenVarBindingModify, makeRdfDtOpenVarBindingModifiers
+    , applyRDFDatatypeMod
+    , RDFDatatypeSub
+    , fromRDFLabel, toRDFLabel, makeDatatypedLiteral
+    )
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..)
+    , isDatatyped
+    , getLiteralText
+    , RDFGraph
+    )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding, nullRDFVarBinding
+    , RDFVarBindingModify, RDFOpenVarBindingModify
+    )
+
+import Swish.HaskellRDF.Datatype
+    ( Datatype -- , typeName, typeRules
+    , DatatypeVal(..)
+    , getDTMod
+    , DatatypeMap(..)
+    , DatatypeMod(..), ModifierFn
+    , nullDatatypeMod
+    , ApplyModifier
+    , DatatypeSub(..)
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..)
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getQName
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    , boundVars, subBinding, makeVarBinding
+    , applyVarBinding, joinVarBindings, addVarBinding
+    , VarBindingModify(..)
+    )
+
+import Data.Maybe
+    ( Maybe(..), fromMaybe, isJust, fromJust )
+
+import Control.Monad
+    ( liftM )
+
+------------------------------------------------------------
+--  Specialize datatype framework types for use with RDF
+------------------------------------------------------------
+
+-- |RDF datatype wrapper used with RDF graph values
+--
+type RDFDatatype = Datatype RDFGraph RDFLabel RDFLabel
+
+-- |RDF datatype value used with RDF graph values
+--
+type RDFDatatypeVal vt = DatatypeVal RDFGraph vt RDFLabel RDFLabel
+
+-- |RDF datatype modifier used with RDF graph values
+--
+type RDFDatatypeMod vt = DatatypeMod vt RDFLabel RDFLabel
+
+-- |Describe a subtype/supertype relationship between a pair
+--  of RDF datatypes.
+--
+type RDFDatatypeSub supvt subvt = DatatypeSub RDFGraph RDFLabel RDFLabel supvt subvt
+
+-- |RDF value modifier function type
+--
+--  This indicates a modifier function that operates on RDFLabel values.
+--
+type RDFModifierFn = ModifierFn RDFLabel
+
+-- |RDF value modifier application function type
+--
+--  This indicates a function that applies RDFModifierFn functions.
+--
+type RDFApplyModifier = ApplyModifier RDFLabel RDFLabel
+
+--------------------------------------------------------------
+--  Functions for creating datatype variable binding modifiers
+--------------------------------------------------------------
+
+-- |Create an RDFOpenVarBindingModify value.
+--
+--  dtval   is an RDFDatatype value containing details of the datatype
+--          for which a variable binding modifier is created.
+--  dtmod   is the data value modifier value that defines the calculations
+--          that are used to implement a variable binding modifier.
+--
+--  The key purpose of this function is to "lift" the supplied
+--  variable constraint functions from operating on data values directly
+--  to a corresponding list of functions that operate on values contained
+--  in RDF graph labels (i.e. RDF literal nodes).  It also applies
+--  node type checking, such that if the actual RDF nodes supplied do
+--  not contain appropriate values then the variable binding is not
+--  accepted.
+--
+makeRdfDtOpenVarBindingModify ::
+    RDFDatatypeVal vt -> RDFDatatypeMod vt -> RDFOpenVarBindingModify
+makeRdfDtOpenVarBindingModify dtval dtmod =
+    dmAppf dtmod (dmName dtmod) $ map (makeRDFModifierFn dtval) (dmModf dtmod)
+
+-- |Create all RDFOpenVarBindingModify values for a given datatype value.
+--  See makeRdfDtOpenVarBindingModify abovr.
+--
+--  dtval   is an RDFDatatype value containing details of the datatype
+--          for which variable binding modifiers are created.
+--
+makeRdfDtOpenVarBindingModifiers ::
+    RDFDatatypeVal vt -> [RDFOpenVarBindingModify]
+makeRdfDtOpenVarBindingModifiers dtval =
+    map (makeRdfDtOpenVarBindingModify dtval) (tvalMod dtval)
+
+-- |Apply a datatype modifier using supplied RDF labels to a supplied
+--  RDF variable binding.
+--
+applyRDFDatatypeMod ::
+    RDFDatatypeVal vt -> RDFDatatypeMod vt -> [RDFLabel] -> [RDFVarBinding]
+    -> [RDFVarBinding]
+applyRDFDatatypeMod dtval dtmod lbs =
+    vbmApply (makeRdfDtOpenVarBindingModify dtval dtmod lbs)
+
+-- |Given details of a datatype and a single value constraint function,
+--  return a new constraint function that operates on RDFLabel values.
+--
+--  The returned constraint function incorporates checks for appropriately
+--  typed literal nodes, and returns similarly typed literal nodes.
+--
+makeRDFModifierFn ::
+    RDFDatatypeVal vt -> ModifierFn vt -> RDFModifierFn
+makeRDFModifierFn dtval fn ivs =
+    let
+        ivals = sequence $ map (rdfNodeExtract dtval) ivs
+        ovals | isJust ivals = fn (fromJust ivals)
+              | otherwise    = []
+    in
+        fromMaybe [] $ sequence $ map (rdfNodeInject dtval) ovals
+
+-- |Extract datatyped value from RDFLabel value, or return Nothing.
+--
+rdfNodeExtract :: RDFDatatypeVal vt -> RDFLabel -> Maybe vt
+rdfNodeExtract dtval node
+    | isDatatyped dtname node = mapL2V dtmap $ getLiteralText node
+    | otherwise               = Nothing
+    where
+        dtname = tvalName dtval
+        dtmap  = tvalMap  dtval
+
+-- |Return new RDF literal node with a representation of the supplied
+--  value, or Nothing.
+--
+rdfNodeInject :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel
+rdfNodeInject dtval val = maybeNode valstr
+    where
+        valstr = mapV2L (tvalMap  dtval) val
+        maybeNode Nothing    = Nothing
+        maybeNode (Just str) = Just $ Lit str (Just (tvalName dtval))
+
+------------------------------------------------------------
+--  Helpers to map between datatype values and RDFLabels
+------------------------------------------------------------
+
+fromRDFLabel ::
+    RDFDatatypeVal vt -> RDFLabel -> Maybe vt
+fromRDFLabel dtv lab
+    | isDatatyped dtnam lab = mapL2V dtmap $ getLiteralText lab
+    | otherwise             = Nothing
+    where
+        dtnam = tvalName dtv
+        dtmap = tvalMap dtv
+
+toRDFLabel :: RDFDatatypeVal vt -> vt -> Maybe RDFLabel
+toRDFLabel dtv =
+    liftM (makeDatatypedLiteral dtnam) . mapV2L dtmap
+    where
+        dtnam = tvalName dtv
+        dtmap = tvalMap dtv
+
+makeDatatypedLiteral :: ScopedName -> String -> RDFLabel
+makeDatatypedLiteral dtnam strval =
+    Lit strval (Just dtnam)
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFDatatype.hs,v $
+-- $Author: graham $
+-- $Revision: 1.14 $
+-- $Log: RDFDatatype.hs,v $
+-- Revision 1.14  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.13  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.12  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.11  2003/12/08 17:29:19  graham
+-- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
+--
+-- Revision 1.10  2003/11/28 00:17:55  graham
+-- Datatype constraint test cases all passed.
+--
+-- Revision 1.9  2003/11/25 23:02:17  graham
+-- Reworked datatype variable modifier logic.
+-- Limited range of test cases so far all pass.
+--
+-- Revision 1.8  2003/11/24 22:13:09  graham
+-- Working on reworking datatype variable modifiers to work with
+-- revised datatype framework.
+--
+-- Revision 1.7  2003/11/14 21:48:35  graham
+-- First cut cardinality-checked datatype-constraint rules to pass test cases.
+-- Backward chaining is still to do.
+--
+-- Revision 1.6  2003/11/13 01:14:32  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.4  2003/11/11 21:02:55  graham
+-- Working on datatype class-constraint inference rule.  Incomplete.
+--
+-- Revision 1.3  2003/11/07 21:45:47  graham
+-- Started rework of datatype to use new DatatypeRel structure.
+--
+-- Revision 1.2  2003/10/24 21:05:08  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.1  2003/10/22 15:46:38  graham
+-- Add RDFDatatype module.
+--

+ Swish/HaskellRDF/RDFDatatypeXsdInteger.hs view
@@ -0,0 +1,609 @@+--------------------------------------------------------------------------------
+--  $Id: RDFDatatypeXsdInteger.hs,v 1.15 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFDatatypeXsdInteger
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines the structures used by swish to represent and
+--  manipulate RDF datatypes.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFDatatypeXsdInteger
+    ( rdfDatatypeXsdInteger
+    , rdfDatatypeValXsdInteger
+    , typeNameXsdInteger, namespaceXsdInteger
+    , axiomsXsdInteger, rulesXsdInteger
+    , prefixXsdInteger
+    )
+where
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula 
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    )
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype
+    , RDFDatatypeVal
+    , RDFDatatypeMod
+    , makeRdfDtOpenVarBindingModifiers
+    )
+
+import Swish.HaskellRDF.ClassRestrictionRule
+    ( makeRDFDatatypeRestrictionRules
+    )
+
+import Swish.HaskellRDF.MapXsdInteger
+    ( mapXsdInteger
+    )
+
+import Swish.HaskellRDF.Datatype
+    ( Datatype(..)
+    , DatatypeVal(..)
+    , DatatypeRel(..), DatatypeRelPr
+    , altArgs
+    , UnaryFnTable,    unaryFnApp
+    , BinaryFnTable,   binaryFnApp
+    , BinMaybeFnTable, binMaybeFnApp
+    , DatatypeMod(..) 
+    , makeVmod_1_1_inv, makeVmod_1_1
+    , makeVmod_2_1_inv, makeVmod_2_1
+    , makeVmod_2_0
+    , makeVmod_2_2
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( makeRuleset
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceXSD
+    , namespaceMATH
+    , namespaceXsdType
+    )
+
+import Data.Maybe
+    ( Maybe (..), maybeToList )
+
+import Control.Monad
+    ( liftM )
+
+------------------------------------------------------------
+--  Misc values
+------------------------------------------------------------
+
+--  Local name for Integer datatype
+nameXsdInteger      = "integer"
+
+-- |Type name for xsd:integer datatype
+typeNameXsdInteger  = ScopedName namespaceXSD nameXsdInteger
+
+-- |Namespace for xsd:integer datatype functions
+namespaceXsdInteger = namespaceXsdType nameXsdInteger
+
+--  Helper to catenate strings with newline separator,
+--  used for making textual representations of graphs.
+--  (the newline makes N3 parser diagnostics easier to interpret)
+--
+infixr 5 +++
+(+++) :: String -> ShowS
+(+++) str = ((str++"\n")++)
+
+--  Compose with function of two arguments
+c2 = (.) . (.)
+
+--  Integer power (exponentiation) function
+--  returns Nothing if exponent is negative.
+--
+intPower :: Integer -> Integer -> Maybe Integer
+intPower a b = if b < 0 then Nothing else Just (intPower1 a b)
+    where
+        intPower1 a b
+            | q == 1           = atopsq*a
+            | p == 0           = 1
+            | otherwise        = atopsq
+            where
+                (p,q)  = b `divMod` 2
+                atop   = intPower1 a p
+                atopsq = atop*atop
+
+------------------------------------------------------------
+--  Declare exported RDFDatatype value for xsd:integer
+------------------------------------------------------------
+
+rdfDatatypeXsdInteger :: RDFDatatype
+rdfDatatypeXsdInteger = Datatype rdfDatatypeValXsdInteger
+
+------------------------------------------------------------
+--  Implmentation of RDFDatatypeVal for xsd:integer
+------------------------------------------------------------
+
+-- |Define Datatype value for xsd:integer
+--  Members of this datatype are positive or negative integer values.
+--
+--  The lexical form consists of an option '+' or '-'
+--  followed by a sequence of decimal digits.
+--
+--  The canonical lexical form has leading zeros and '+' sign removed.
+--
+rdfDatatypeValXsdInteger :: RDFDatatypeVal Integer
+rdfDatatypeValXsdInteger = DatatypeVal
+    { tvalName      = typeNameXsdInteger
+    , tvalRules     = rdfRulesetXsdInteger  -- Ruleset RDFGraph
+    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger
+                                            -- RDFGraph -> [RDFRules]
+    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdInteger
+    , tvalMap       = mapXsdInteger         -- DatatypeMap Integer
+    , tvalRel       = relXsdInteger         -- [DatatypeRel Integer]
+    , tvalMod       = modXsdInteger         -- [DatatypeMod Integer]
+    }
+
+-- |relXsdInteger contains arithmetic and other relations for xsd:Integer values.
+--
+--  The functions are inspired by those defined by CWM as math: properties.
+--  (cf. http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html)
+--
+
+relXsdInteger :: [DatatypeRel Integer]
+relXsdInteger =
+    [ relXsdIntegerAbs
+    , relXsdIntegerNeg
+    , relXsdIntegerSum
+    , relXsdIntegerDiff
+    , relXsdIntegerProd
+    , relXsdIntegerDivMod
+    , relXsdIntegerPower
+    , relXsdIntegerEq
+    , relXsdIntegerNe
+    , relXsdIntegerLt
+    , relXsdIntegerLe
+    , relXsdIntegerGt
+    , relXsdIntegerGe
+    ]
+
+mkIntRel2 ::
+    String -> DatatypeRelPr Integer -> UnaryFnTable Integer
+    -> DatatypeRel Integer
+mkIntRel2 nam pr fns = DatatypeRel
+    { dtRelName = ScopedName namespaceXsdInteger nam
+    , dtRelFunc = altArgs pr fns unaryFnApp
+    }
+
+mkIntRel3 ::
+    String -> DatatypeRelPr Integer -> BinaryFnTable Integer
+    -> DatatypeRel Integer
+mkIntRel3 nam pr fns = DatatypeRel
+    { dtRelName = ScopedName namespaceXsdInteger nam
+    , dtRelFunc = altArgs pr fns binaryFnApp
+    }
+
+mkIntRel3maybe ::
+    String -> DatatypeRelPr Integer -> BinMaybeFnTable Integer
+    -> DatatypeRel Integer
+mkIntRel3maybe nam pr fns = DatatypeRel
+    { dtRelName = ScopedName namespaceXsdInteger nam
+    , dtRelFunc = altArgs pr fns binMaybeFnApp
+    }
+
+relXsdIntegerAbs :: DatatypeRel Integer
+relXsdIntegerAbs = mkIntRel2 "abs" (const True)
+    [ ( (>=0),      [ (abs,1) ] )
+    , ( const True, [ (id,0), (negate,0) ] )
+    ]
+
+relXsdIntegerNeg :: DatatypeRel Integer
+relXsdIntegerNeg = mkIntRel2 "neg" (const True)
+    [ ( const True, [ (negate,1) ] )
+    , ( const True, [ (negate,0) ] )
+    ]
+
+relXsdIntegerSum :: DatatypeRel Integer
+relXsdIntegerSum = mkIntRel3 "sum" (const True)
+    [ ( const True, [ ((+),1,2) ] )
+    , ( const True, [ ((-),0,2) ] )
+    , ( const True, [ ((-),0,1) ] )
+    ]
+
+relXsdIntegerDiff :: DatatypeRel Integer
+relXsdIntegerDiff = mkIntRel3 "diff" (const True)
+    [ ( const True, [ ((-),1,2) ] )
+    , ( const True, [ ((+),0,2) ] )
+    , ( const True, [ ((-),1,0) ] )
+    ]
+
+relXsdIntegerProd :: DatatypeRel Integer
+relXsdIntegerProd = mkIntRel3 "prod" (const True)
+    [ ( const True, [ ((*),1,2) ] )
+    , ( const True, [ (div,0,2) ] )
+    , ( const True, [ (div,0,1) ] )
+    ]
+
+relXsdIntegerDivMod :: DatatypeRel Integer
+relXsdIntegerDivMod = mkIntRel3 "divmod" (const True)
+    [ ( const True, [ (div,2,3) ] )
+    , ( const True, [ (mod,2,3) ] )
+    , ( const True, [ ] )
+    , ( const True, [ ] )
+    ]
+
+relXsdIntegerPower :: DatatypeRel Integer
+relXsdIntegerPower = mkIntRel3maybe "power" (const True)
+    [ ( const True, [ (liftM (:[]) `c2` intPower,1,2) ] )
+    , ( const True, [ ] )
+    , ( (>=0),      [ ] )
+    ]
+
+liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool
+liftL2 p i1 i2 as = p (i1 as) (i2 as)
+
+lcomp :: (a->a->Bool) -> [a] -> Bool
+lcomp p = liftL2 p head (head . tail)
+
+-- eq
+
+relXsdIntegerEq :: DatatypeRel Integer
+relXsdIntegerEq = mkIntRel2 "eq" (lcomp (==))
+    ( repeat (const True, []) )
+
+-- ne
+
+relXsdIntegerNe :: DatatypeRel Integer
+relXsdIntegerNe = mkIntRel2 "ne" (lcomp (/=))
+    ( repeat (const True, []) )
+
+-- lt
+
+relXsdIntegerLt :: DatatypeRel Integer
+relXsdIntegerLt = mkIntRel2 "lt" (lcomp (<))
+    ( repeat (const True, []) )
+
+-- le
+
+relXsdIntegerLe :: DatatypeRel Integer
+relXsdIntegerLe = mkIntRel2 "le" (lcomp (<=))
+    ( repeat (const True, []) )
+
+-- gt
+
+relXsdIntegerGt :: DatatypeRel Integer
+relXsdIntegerGt = mkIntRel2 "gt" (lcomp (>))
+    ( repeat (const True, []) )
+
+-- ge
+
+relXsdIntegerGe :: DatatypeRel Integer
+relXsdIntegerGe = mkIntRel2 "ge" (lcomp (>=))
+    ( repeat (const True, []) )
+
+-- |modXsdInteger contains variable binding modifiers for xsd:Integer values.
+--
+--  The functions are selected from those defined by CWM as math:
+--  properties.
+--  (cf. http://www.w3.org/2000/10/swap/doc/CwmBuiltins.html)
+--
+modXsdInteger :: [RDFDatatypeMod Integer]
+modXsdInteger =
+    [ modXsdIntegerAbs
+    , modXsdIntegerNeg
+    , modXsdIntegerSum
+    , modXsdIntegerDiff
+    , modXsdIntegerProd
+    , modXsdIntegerDivMod
+    , modXsdIntegerPower
+    , modXsdIntegerEq
+    , modXsdIntegerNe
+    , modXsdIntegerLt
+    , modXsdIntegerLe
+    , modXsdIntegerGt
+    , modXsdIntegerGe
+    ]
+
+modXsdIntegerAbs :: RDFDatatypeMod Integer
+modXsdIntegerAbs = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "abs")
+    , dmModf = [ f0, f1 ]
+    , dmAppf = makeVmod_1_1
+    }
+    where
+        f0 vs@[v1,v2] = if v1 == abs v2 then vs else []
+        f0 _          = []
+        f1 [v2]       = [abs v2]
+        f1 _          = []
+
+modXsdIntegerNeg :: RDFDatatypeMod Integer
+modXsdIntegerNeg = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "neg")
+    , dmModf = [ f0, f1, f1 ]
+    , dmAppf = makeVmod_1_1_inv
+    }
+    where
+        f0 vs@[v1,v2] = if v1 == negate v2 then vs else []
+        f0 _          = []
+        f1 [vi]       = [-vi]
+        f1 _          = []
+
+modXsdIntegerSum :: RDFDatatypeMod Integer
+modXsdIntegerSum = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "sum")
+    , dmModf = [ f0, f1, f2, f2 ]
+    , dmAppf = makeVmod_2_1_inv
+    }
+    where
+        f0 vs@[v1,v2,v3] = if v1 == v2+v3 then vs else []
+        f0 _             = []
+        f1 [v2,v3]       = [v2+v3]
+        f1 _             = []
+        f2 [v1,vi]       = [v1-vi]
+        f2 _             = []
+
+modXsdIntegerDiff :: RDFDatatypeMod Integer
+modXsdIntegerDiff = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "diff")
+    , dmModf = [ f0, f1, f2, f3 ]
+    , dmAppf = makeVmod_2_1_inv
+    }
+    where
+        f0 vs@[v1,v2,v3] = if v1 == v2-v3 then vs else []
+        f0 _             = []
+        f1 [v2,v3]       = [v2-v3]
+        f1 _             = []
+        f2 [v1,v3]       = [v1+v3]
+        f2 _             = []
+        f3 [v1,v2]       = [v2-v1]
+        f3 _             = []
+
+modXsdIntegerProd :: RDFDatatypeMod Integer
+modXsdIntegerProd = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "prod")
+    , dmModf = [ f0, f1, f2, f2 ]
+    , dmAppf = makeVmod_2_1_inv
+    }
+    where
+        f0 vs@[v1,v2,v3] = if v1 == v2*v3 then vs else []
+        f0 _             = []
+        f1 [v2,v3]       = [v2*v3]
+        f1 _             = []
+        f2 [v1,vi]       = if r == 0 then [q] else []
+            where (q,r)  = quotRem v1 vi
+        f2 _             = []
+
+modXsdIntegerDivMod :: RDFDatatypeMod Integer
+modXsdIntegerDivMod = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "divmod")
+    , dmModf = [ f0, f1 ]
+    , dmAppf = makeVmod_2_2
+    }
+    where
+        f0 vs@[v1,v2,v3,v4] = if (v1,v2) == divMod v3 v4 then vs else []
+        f0 _                = []
+        f1 [v3,v4]          = [v1,v2] where (v1,v2) = divMod v3 v4
+        f1 _                = []
+
+modXsdIntegerPower :: RDFDatatypeMod Integer
+modXsdIntegerPower = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger "power")
+    , dmModf = [ f0, f1 ]
+    , dmAppf = makeVmod_2_1
+    }
+    where
+        f0 vs@[v1,v2,v3] = if Just v1 == intPower v2 v3 then vs else []
+        f0 _             = []
+        f1 [v2,v3]       = maybeToList (intPower v2 v3)
+        f1 _             = []
+
+modXsdIntegerEq = modXsdIntegerCompare "eq" (==)
+modXsdIntegerNe = modXsdIntegerCompare "ne" (/=)
+modXsdIntegerLt = modXsdIntegerCompare "lt" (<)
+modXsdIntegerLe = modXsdIntegerCompare "le" (<=)
+modXsdIntegerGt = modXsdIntegerCompare "gt" (>)
+modXsdIntegerGe = modXsdIntegerCompare "ge" (>=)
+
+modXsdIntegerCompare ::
+    String -> (Integer->Integer->Bool) -> RDFDatatypeMod Integer
+modXsdIntegerCompare nam rel = DatatypeMod
+    { dmName = (ScopedName namespaceXsdInteger nam)
+    , dmModf = [ f0 ]
+    , dmAppf = makeVmod_2_0
+    }
+    where
+        f0 vs@[v1,v2] = if rel v1 v2 then vs else []
+        f0 _          = []
+
+-- |rulesetXsdInteger contains rules and axioms that allow additional
+--  deductions when xsd:integer values appear in a graph.
+--
+--  The rules defined here are concerned with basic integer arithmetic
+--  operations: +, -, *, div, rem
+--
+--  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
+--
+rdfRulesetXsdInteger =
+    makeRuleset namespaceXsdInteger axiomsXsdInteger rulesXsdInteger
+
+mkPrefix ns =
+    "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"
+
+prefixXsdInteger =
+    mkPrefix namespaceRDF  ++
+    mkPrefix namespaceRDFS ++
+    mkPrefix namespaceRDFD ++
+    mkPrefix namespaceXSD  ++
+    mkPrefix namespaceXsdInteger ++
+    " \n"
+
+mkAxiom :: String -> String -> RDFFormula
+mkAxiom local gr =
+    makeRDFFormula namespaceXsdInteger local (prefixXsdInteger++gr)
+
+axiomsXsdInteger =
+    [ mkAxiom "dt"      "xsd:integer rdf:type rdfs:Datatype ."
+    ]
+
+rulesXsdInteger = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr
+    where
+        gr = makeRDFGraphFromN3String rulesXsdIntegerStr
+
+rulesXsdIntegerStr = prefixXsdInteger
+    +++ "xsd_integer:Abs a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:abs ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Neg a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:neg ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Sum a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
+    +++ "  rdfd:constraint xsd_integer:sum ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Diff a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
+    +++ "  rdfd:constraint xsd_integer:diff ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Prod a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
+    +++ "  rdfd:constraint xsd_integer:prod ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:DivMod a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3 rdf:_4) ; "
+    +++ "  rdfd:constraint xsd_integer:divmod ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Power a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2 rdf:_3) ; "
+    +++ "  rdfd:constraint xsd_integer:power ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Eq a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:eq ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Ne a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:ne ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Lt a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:lt ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Le a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:le ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Gt a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:gt ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_integer:Ge a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_integer:ge ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFDatatypeXsdInteger.hs,v $
+-- $Author: graham $
+-- $Revision: 1.15 $
+-- $Log: RDFDatatypeXsdInteger.hs,v $
+-- Revision 1.15  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.14  2003/12/18 18:27:47  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.13  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.12  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.11  2003/11/28 00:17:55  graham
+-- Datatype constraint test cases all passed.
+--
+-- Revision 1.10  2003/11/27 11:35:49  graham
+-- Variable modifier tests all run.
+-- Initial class constraint reasoning tests pass.
+-- Fixed bug in class constraint backward-chained reasoning that returned
+-- multiple instances of some statements, and did not filter out all occurrences
+-- of the original statements.
+--
+-- Revision 1.9  2003/11/25 23:02:17  graham
+-- Reworked datatype variable modifier logic.
+-- Limited range of test cases so far all pass.
+--
+-- Revision 1.8  2003/11/24 22:13:09  graham
+-- Working on reworking datatype variable modifiers to work with
+-- revised datatype framework.
+--
+-- Revision 1.7  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.6  2003/11/14 21:48:34  graham
+-- First cut cardinality-checked datatype-constraint rules to pass test cases.
+-- Backward chaining is still to do.
+--
+-- Revision 1.5  2003/11/14 15:59:51  graham
+-- Separate MapXsdInteger from RDFDatatypeXsdInteger.
+--
+-- Revision 1.4  2003/11/11 21:02:55  graham
+-- Working on datatype class-constraint inference rule.  Incomplete.
+--
+-- Revision 1.3  2003/11/07 21:45:47  graham
+-- Started rework of datatype to use new DatatypeRel structure.
+--
+-- Revision 1.2  2003/10/24 21:05:08  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.1  2003/10/22 16:19:34  graham
+-- DatatypeXsdInteger module renamed to RDFDatatypeXsdInteger.
+--
+-- Revision 1.2  2003/10/22 15:47:46  graham
+-- Working on datatype inference support.
+--
+-- Revision 1.1  2003/10/09 17:16:59  graham
+-- Add initial attempt at xsd:integer datatype module
+--

+ Swish/HaskellRDF/RDFDatatypeXsdIntegerTest.hs view
@@ -0,0 +1,1667 @@+--------------------------------------------------------------------------------
+--  $Id: RDFDatatypeXsdIntegerTest.hs,v 1.13 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFDatatypeXsdIntegerTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test cases for variable binding values and
+--  variable binding modifier values.
+--
+--------------------------------------------------------------------------------
+
+-- WNH RIP OUT module Swish.HaskellRDF.RDFDatatypeXsdIntegerTest where
+
+import Swish.HaskellRDF.RDFDatatypeXsdInteger
+    ( rdfDatatypeXsdInteger
+    , rdfDatatypeValXsdInteger
+    , typeNameXsdInteger, namespaceXsdInteger
+    , axiomsXsdInteger, rulesXsdInteger
+    , prefixXsdInteger
+    )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    )
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype
+    , RDFDatatypeVal
+    , RDFDatatypeMod
+    , applyRDFDatatypeMod
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..), RDFGraph
+    )
+
+import Swish.HaskellRDF.ClassRestrictionRule
+    ( ClassRestriction(..), ClassRestrictionFn
+    , makeDatatypeRestriction, makeDatatypeRestrictionFn
+    , makeRDFClassRestrictionRules
+    , makeRDFDatatypeRestrictionRules
+    , falseGraph, falseGraphStr
+    )
+
+import Swish.HaskellRDF.Datatype
+    ( Datatype(..)
+    , typeName, typeRules, typeMkRules
+    , getTypeAxiom, getTypeRule
+    , DatatypeVal(..)
+    , getDTMod
+    , DatatypeMap(..)
+    , DatatypeMod(..)
+    , nullDatatypeMod
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..)
+    , getRulesetAxiom, getRulesetRule
+    )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..)
+    , nullScope, nullFormula, nullRule
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    , makeVarBinding
+    , VarBindingModify(..)
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getScopePrefix, getScopeURI
+    , getQName, getScopedNameURI
+    , makeScopedName
+    , matchName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceNull
+    , namespaceRDF
+    , namespaceRDFS
+    , namespaceXSD
+    , namespaceMATH
+    , namespaceXsdType
+    , namespaceDefault
+    , scopeRDF
+    , scopeRDFS
+    , scopeRDFD
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..)
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , mapFind, mapFindMaybe
+    )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , Assertion
+    , assertBool, assertEqual, assertString, assertFailure
+    , runTestTT, runTestText, putTextToHandle
+    )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    )
+
+import Control.Monad ( unless )
+
+import Data.List
+    ( sort, union, intersect )
+
+import Data.Maybe
+    ( isJust, fromJust, fromMaybe )
+
+
+------------------------------------------------------------
+--  Test case helpers
+------------------------------------------------------------
+
+assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
+assertMember preface expected actual =
+  unless (expected `elem` actual ) (assertFailure msg)
+  where msg = (if null preface then "" else preface ++ "\n") ++
+             "expected: " ++ show expected ++ "\nbut got: " ++ show actual
+
+test :: String -> Bool -> Test
+test lab bv =
+    TestCase ( assertBool ("test:"++lab) bv )
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
+
+testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
+testElem lab a1 as =
+    TestCase ( assertMember ("testElem:"++lab) a1 as )
+
+testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
+testLe lab eq a1 a2 =
+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
+
+-- Test for Just x or Nothing
+
+testJust :: String -> Maybe a -> Test
+testJust lab av =
+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
+
+testNothing :: String -> Maybe a -> Test
+testNothing lab av =
+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
+
+-- Compare lists and lists of lists and Maybe lists for set equivalence:
+
+data ListTest a = ListTest [a]
+
+instance (Eq a) => Eq (ListTest a) where
+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
+
+instance (Show a) => Show (ListTest a) where
+    show (ListTest a) = show a
+
+data MaybeListTest a = MaybeListTest (Maybe [a])
+
+instance (Eq a) => Eq (MaybeListTest a) where
+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
+    MaybeListTest Nothing   == MaybeListTest Nothing   = True
+    _                       == _                       = False
+
+instance (Show a) => Show (MaybeListTest a) where
+    show (MaybeListTest a) = show a
+
+testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
+testEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
+
+testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
+testEqvEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest $ map ListTest a1
+        ma2 = ListTest $ map ListTest a2
+
+testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
+testHasEqv lab a1 a2 =
+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest a1
+        ma2 = map ListTest a2
+
+testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
+testMaybeEqv lab a1 a2 =
+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = (MaybeListTest a1)
+        ma2 = (MaybeListTest a2)
+
+------------------------------------------------------------
+--  Misc values
+------------------------------------------------------------
+
+xsd_int_name nam  = (ScopedName namespaceXsdInteger nam)
+
+axiomXsdIntegerDT       = xsd_int_name "dt"
+
+ruleXsdIntegerAbs       = xsd_int_name "Abs"
+ruleXsdIntegerNeg       = xsd_int_name "Neg"
+ruleXsdIntegerSum       = xsd_int_name "Sum"
+ruleXsdIntegerDiff      = xsd_int_name "Diff"
+ruleXsdIntegerProd      = xsd_int_name "Prod"
+ruleXsdIntegerDivMod    = xsd_int_name "DivMod"
+ruleXsdIntegerPower     = xsd_int_name "Power"
+ruleXsdIntegerEq        = xsd_int_name "Eq"
+ruleXsdIntegerNe        = xsd_int_name "Ne"
+ruleXsdIntegerLt        = xsd_int_name "Lt"
+ruleXsdIntegerLe        = xsd_int_name "Le"
+ruleXsdIntegerGt        = xsd_int_name "Gt"
+ruleXsdIntegerGe        = xsd_int_name "Ge"
+
+------------------------------------------------------------
+--  Basic rdfDatatypeXsdInteger tests
+------------------------------------------------------------
+
+getXsdIntegerAxiom scopnam =
+    fromMaybe nullFormula $ getTypeAxiom scopnam rdfDatatypeXsdInteger
+
+getXsdIntegerRule scopnam =
+    fromMaybe nullRule $ getTypeRule scopnam rdfDatatypeXsdInteger
+
+getXsdIntegerDTmod scopnam =
+    fromMaybe nullDatatypeMod $ getDTMod scopnam rdfDatatypeValXsdInteger
+
+testDatatype01 = testEq  "testDatatype01" typeNameXsdInteger $
+                    typeName rdfDatatypeXsdInteger
+testDatatype02 = testEq  "testDatatype02" namespaceXsdInteger $
+                    rsNamespace (typeRules rdfDatatypeXsdInteger)
+testDatatype03 = testEqv "testDatatype03" axiomsXsdInteger $
+                    rsAxioms (typeRules rdfDatatypeXsdInteger)
+testDatatype04 = testEqv "testDatatype04" rulesXsdInteger $
+                    rsRules (typeRules rdfDatatypeXsdInteger)
+testDatatype05 = testEq "testDatatype05" axiomXsdIntegerDT $
+                    formName (getXsdIntegerAxiom axiomXsdIntegerDT)
+testDatatype06 = testEq "testDatatype06" ruleXsdIntegerAbs $
+                    ruleName (getXsdIntegerRule ruleXsdIntegerAbs)
+
+testDatatypeSuite = TestList
+    [ testDatatype01, testDatatype02, testDatatype03, testDatatype04
+    , testDatatype05, testDatatype06
+    ]
+
+------------------------------------------------------------
+--  Basic rdfDatatypeValXsdInteger tests
+------------------------------------------------------------
+
+testDatatypeVal01 = testEq  "testDatatypeVal01" (Just 123) $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "123"
+testDatatypeVal02 = testEq  "testDatatypeVal02" (Just 0) $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "0"
+testDatatypeVal03 = testEq  "testDatatypeVal03" (Just 456) $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "+000456"
+testDatatypeVal04 = testEq  "testDatatypeVal04" (Just (-987)) $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "-0987"
+testDatatypeVal05 = testEq  "testDatatypeVal05" Nothing $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "11x2"
+testDatatypeVal06 = testEq  "testDatatypeVal06" Nothing $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) " 321"
+testDatatypeVal07 = testEq  "testDatatypeVal07" Nothing $
+                        mapL2V (tvalMap rdfDatatypeValXsdInteger) "321 "
+
+testDatatypeVal11 = testEq  "testDatatypeVal11" (Just "123") $
+                        mapV2L (tvalMap rdfDatatypeValXsdInteger) 123
+testDatatypeVal12 = testEq  "testDatatypeVal12" (Just "-987") $
+                        mapV2L (tvalMap rdfDatatypeValXsdInteger) (-987)
+
+testDatatypeVal21 = testElem "testDatatypeVal21" dmodXsdIntegerAbs $
+                    map dmName (tvalMod rdfDatatypeValXsdInteger)
+testDatatypeVal22 = testEq "testDatatypeVal22" dmodXsdIntegerAbs $
+                    dmName (getXsdIntegerDTmod dmodXsdIntegerAbs)
+
+testDatatypeValSuite = TestList
+    [ testDatatypeVal01, testDatatypeVal02, testDatatypeVal03, testDatatypeVal04
+    , testDatatypeVal05, testDatatypeVal06, testDatatypeVal07
+    , testDatatypeVal11, testDatatypeVal12
+    , testDatatypeVal21, testDatatypeVal22
+    ]
+
+------------------------------------------------------------
+--  Variable binding modifier tests
+------------------------------------------------------------
+
+dmodXsdIntegerAbs    = xsd_int_name "abs"
+dmodXsdIntegerNeg    = xsd_int_name "neg"
+dmodXsdIntegerSum    = xsd_int_name "sum"
+dmodXsdIntegerDiff   = xsd_int_name "diff"
+dmodXsdIntegerProd   = xsd_int_name "prod"
+dmodXsdIntegerDivMod = xsd_int_name "divmod"
+dmodXsdIntegerPower  = xsd_int_name "power"
+dmodXsdIntegerEq     = xsd_int_name "eq"
+dmodXsdIntegerNe     = xsd_int_name "ne"
+dmodXsdIntegerLt     = xsd_int_name "lt"
+dmodXsdIntegerLe     = xsd_int_name "le"
+dmodXsdIntegerGt     = xsd_int_name "gt"
+dmodXsdIntegerGe     = xsd_int_name "ge"
+
+testVmod2 = testVmodN [(Var "a"),(Var "b")]
+
+testVmod3 = testVmodN [(Var "a"),(Var "b"),(Var "c")]
+
+testVmod4 = testVmodN [(Var "a"),(Var "b"),(Var "c"),(Var "d")]
+
+testVmodN :: [RDFLabel]
+    -> String -> Maybe (RDFDatatypeMod Integer)
+    -> [RDFVarBinding] -> [RDFVarBinding]
+    -> Test
+testVmodN vars lab (Just dmod) ibinds obinds =
+    testEqv lab obinds $
+        applyRDFDatatypeMod rdfDatatypeValXsdInteger dmod vars ibinds
+testVmodN vars lab Nothing ibinds obinds = TestCase $
+    assertFailure $ "testVmodN:"++lab++", null variable binding modifier"
+
+--  make various kinds of RDF variable bindings
+rdfVR (v,u) = (Var v,Res u)                     -- (Variable,Resource)
+rdfVB (v,b) = (Var v,Blank b)                   -- (Variable,Blank)
+rdfVL (v,l) = (Var v,Lit l Nothing)             -- (Variable,Untyped literal)
+rdfVI (v,l) = (Var v,Lit l (Just typeNameXsdInteger))
+                                                -- (Variable,Integer literal)
+
+makeBVR :: [(String,ScopedName)] -> RDFVarBinding
+makeBVR nls = makeVarBinding $ map rdfVR nls
+
+makeBVB :: [(String,String)] -> RDFVarBinding
+makeBVB nls = makeVarBinding $ map rdfVB nls
+
+makeBVI :: [(String,String)] -> RDFVarBinding
+makeBVI nls = makeVarBinding $ map rdfVI nls
+
+makeBVL :: [(String,String)] -> RDFVarBinding
+makeBVL nls = makeVarBinding $ map rdfVL nls
+
+--  Test null modifier
+
+testVarModify00 = testVmod2  "testVarModify00"
+                    (Just nullDatatypeMod)
+                    [makeBVI [("a","123")]]
+                    [makeBVI [("a","123")]]
+
+--  Tests for xsd_integer:abs
+
+testVarModifyAbs01 = testVmod2  "testVarModifyAbs01"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","123")]]
+                    [makeBVI [("a","123"),("b","123")]]
+
+testVarModifyAbs02 = testVmod2  "testVarModifyAbs02"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","-123")]]
+                    [makeBVI [("a","123"),("b","-123")]]
+
+testVarModifyAbs03 = testVmod2  "testVarModifyAbs03"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","123"),("b","123")]]
+                    [makeBVI [("a","123"),("b","123")]]
+
+testVarModifyAbs04 = testVmod2  "testVarModifyAbs04"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","123"),("b","-123")]]
+                    [makeBVI [("a","123"),("b","-123")]]
+
+testVarModifyAbs05 = testVmod2  "testVarModifyAbs05"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-123"),("b","123")]]
+                    []
+
+testVarModifyAbs06 = testVmod2  "testVarModifyAbs06"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","123"),("b","456")]]
+                    []
+
+testVarModifyAbs07 = testVmod2  "testVarModifyAbs07"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVI [("c","123")]]
+                    []
+
+testVarModifyAbs08 = testVmod2  "testVarModifyAbs08"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVL [("b","123")]]
+                    []
+
+testVarModifyAbs09 = testVmod2  "testVarModifyAbs09"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVR [("b",makeScopedName "" "http://ex.org/" "123")]]
+                    []
+
+testVarModifyAbs10 = testVmod2  "testVarModifyAbs10"
+                    (getDTMod dmodXsdIntegerAbs rdfDatatypeValXsdInteger)
+                    [makeBVB [("b","123")]]
+                    []
+
+--  Tests for xsd_integer:neg
+
+testVarModifyNeg01 = testVmod2  "testVarModifyNeg01"
+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","123"),("b","-123")]]
+                    [makeBVI [("a","123"),("b","-123")]]
+
+testVarModifyNeg02 = testVmod2  "testVarModifyNeg02"
+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-123"),("b","123")]]
+                    [makeBVI [("a","-123"),("b","123")]]
+
+testVarModifyNeg03 = testVmod2  "testVarModifyNeg03"
+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","123"),("b","123")]]
+                    []
+
+testVarModifyNeg04 = testVmod2  "testVarModifyNeg04"
+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","123")]]
+                    [makeBVI [("a","-123"),("b","123")]]
+
+testVarModifyNeg05 = testVmod2  "testVarModifyNeg05"
+                    (getDTMod dmodXsdIntegerNeg rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-123")]]
+                    [makeBVI [("a","-123"),("b","123")]]
+
+--  Tests for xsd_integer:sum
+
+testVarModifySum01 = testVmod3  "testVarModifySum01"
+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","33"),("b","22"),("c","11")]]
+                    [makeBVI [("a","33"),("b","22"),("c","11")]]
+
+testVarModifySum02 = testVmod3  "testVarModifySum02"
+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","22"),("c","11")]]
+                    [makeBVI [("a","33"),("b","22"),("c","11")]]
+
+testVarModifySum03 = testVmod3  "testVarModifySum03"
+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","33"),("c","11")]]
+                    [makeBVI [("a","33"),("b","22"),("c","11")]]
+
+testVarModifySum04 = testVmod3  "testVarModifySum04"
+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","33"),("b","22")]]
+                    [makeBVI [("a","33"),("b","22"),("c","11")]]
+
+testVarModifySum05 = testVmod3  "testVarModifySum05"
+                    (getDTMod dmodXsdIntegerSum rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","44"),("b","22"),("c","11")]]
+                    []
+
+--  Tests for xsd_integer:diff
+
+testVarModifyDiff01 = testVmod3  "testVarModifyDiff01"
+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","11"),("b","33"),("c","22")]]
+                    [makeBVI [("a","11"),("b","33"),("c","22")]]
+
+testVarModifyDiff02 = testVmod3  "testVarModifyDiff02"
+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","33"),("c","22")]]
+                    [makeBVI [("a","11"),("b","33"),("c","22")]]
+
+testVarModifyDiff03 = testVmod3  "testVarModifyDiff03"
+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","11"),("c","22")]]
+                    [makeBVI [("a","11"),("b","33"),("c","22")]]
+
+testVarModifyDiff04 = testVmod3  "testVarModifyDiff04"
+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","11"),("b","33")]]
+                    [makeBVI [("a","11"),("b","33"),("c","22")]]
+
+testVarModifyDiff05 = testVmod3  "testVarModifyDiff05"
+                    (getDTMod dmodXsdIntegerDiff rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","11"),("b","44"),("c","22")]]
+                    []
+
+--  Tests for xsd_integer:prod
+--
+--  Note:   product can also be used to test if a value is
+--          an exact multiple of some other.
+
+testVarModifyProd01 = testVmod3  "testVarModifyProd01"
+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","6"),("b","2"),("c","3")]]
+                    [makeBVI [("a","6"),("b","2"),("c","3")]]
+
+testVarModifyProd02 = testVmod3  "testVarModifyProd02"
+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","2"),("c","3")]]
+                    [makeBVI [("a","6"),("b","2"),("c","3")]]
+
+testVarModifyProd03 = testVmod3  "testVarModifyProd03"
+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","6"),("c","3")]]
+                    [makeBVI [("a","6"),("b","2"),("c","3")]]
+
+testVarModifyProd04 = testVmod3  "testVarModifyProd04"
+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","6"),("c","3")]]
+                    [makeBVI [("a","6"),("b","2"),("c","3")]]
+
+testVarModifyProd05 = testVmod3  "testVarModifyProd05"
+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","7"),("b","2"),("c","3")]]
+                    []
+
+testVarModifyProd06 = testVmod3  "testVarModifyProd06"
+                    (getDTMod dmodXsdIntegerProd rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","7"),("b","2")]]
+                    []
+
+--  Tests for xsd_integer:divmod
+--
+--  Note:   truncates downwards, so remainder is same sign as divisor
+--          cf. Haskell divMod function.
+
+testVarModifyDivMod01 = testVmod4  "testVarModifyDivMod01"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]
+                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]
+
+testVarModifyDivMod02 = testVmod4  "testVarModifyDivMod02"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("c","7"),("d","3")]]
+                    [makeBVI [("a","2"),("b","1"),("c","7"),("d","3")]]
+
+testVarModifyDivMod03 = testVmod4  "testVarModifyDivMod03"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("c","-7"),("d","3")]]
+                    [makeBVI [("a","-3"),("b","2"),("c","-7"),("d","3")]]
+
+testVarModifyDivMod04 = testVmod4  "testVarModifyDivMod04"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("c","7"),("d","-3")]]
+                    [makeBVI [("a","-3"),("b","-2"),("c","7"),("d","-3")]]
+
+testVarModifyDivMod05 = testVmod4  "testVarModifyDivMod05"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("c","-7"),("d","-3")]]
+                    [makeBVI [("a","2"),("b","-1"),("c","-7"),("d","-3")]]
+
+testVarModifyDivMod06 = testVmod4  "testVarModifyDivMod06"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","2"),("b","5"),("c","7"),("d","3")]]
+                    []
+
+testVarModifyDivMod07 = testVmod4  "testVarModifyDivMod07"
+                    (getDTMod dmodXsdIntegerDivMod rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","2"),("b","1"),("d","3")]]
+                    []
+
+--  Tests for xsd_integer:power
+
+testVarModifyPower01 = testVmod3  "testVarModifyPower01"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","8"),("b","2"),("c","3")]]
+                    [makeBVI [("a","8"),("b","2"),("c","3")]]
+
+testVarModifyPower02 = testVmod3  "testVarModifyPower02"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","2"),("c","3")]]
+                    [makeBVI [("a","8"),("b","2"),("c","3")]]
+
+testVarModifyPower03 = testVmod3  "testVarModifyPower03"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","8"),("c","3")]]
+                    []
+
+testVarModifyPower04 = testVmod3  "testVarModifyPower04"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","8"),("b","2")]]
+                    []
+
+testVarModifyPower05 = testVmod3  "testVarModifyPower05"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","8"),("b","3"),("c","2")]]
+                    []
+
+testVarModifyPower06 = testVmod3  "testVarModifyPower06"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","55"),("c","0")]]
+                    [makeBVI [("a","1"),("b","55"),("c","0")]]
+
+testVarModifyPower07 = testVmod3  "testVarModifyPower07"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","-2"),("c","3")]]
+                    [makeBVI [("a","-8"),("b","-2"),("c","3")]]
+
+testVarModifyPower08 = testVmod3  "testVarModifyPower08"
+                    (getDTMod dmodXsdIntegerPower rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","55"),("c","-2")]]
+                    []
+
+--  Tests for xsd_integer:eq
+
+testVarModifyEq01 = testVmod2  "testVarModifyEq01"
+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100"),("b","100")]]
+                    [makeBVI [("a","100"),("b","100")]]
+
+testVarModifyEq02 = testVmod2  "testVarModifyEq02"
+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","99"),("b","100")]]
+                    []
+
+testVarModifyEq03 = testVmod2  "testVarModifyEq03"
+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-99"),("b","-100")]]
+                    []
+
+testVarModifyEq04 = testVmod2  "testVarModifyEq04"
+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","100")]]
+                    []
+
+testVarModifyEq05 = testVmod2  "testVarModifyEq05"
+                    (getDTMod dmodXsdIntegerEq rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100")]]
+                    []
+
+--  Tests for xsd_integer:ne
+
+testVarModifyNe01 = testVmod2  "testVarModifyNe01"
+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100"),("b","100")]]
+                    []
+
+testVarModifyNe02 = testVmod2  "testVarModifyNe02"
+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","99"),("b","100")]]
+                    [makeBVI [("a","99"),("b","100")]]
+
+testVarModifyNe03 = testVmod2  "testVarModifyNe03"
+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-99"),("b","-100")]]
+                    [makeBVI [("a","-99"),("b","-100")]]
+
+testVarModifyNe04 = testVmod2  "testVarModifyNe04"
+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","100")]]
+                    []
+
+testVarModifyNe05 = testVmod2  "testVarModifyNe05"
+                    (getDTMod dmodXsdIntegerNe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100")]]
+                    []
+
+--  Tests for xsd_integer:lt
+
+testVarModifyLt01 = testVmod2  "testVarModifyLt01"
+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100"),("b","100")]]
+                    []
+
+testVarModifyLt02 = testVmod2  "testVarModifyLt02"
+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","99"),("b","100")]]
+                    [makeBVI [("a","99"),("b","100")]]
+
+testVarModifyLt03 = testVmod2  "testVarModifyLt03"
+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-99"),("b","-100")]]
+                    []
+
+testVarModifyLt04 = testVmod2  "testVarModifyLt04"
+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","100")]]
+                    []
+
+testVarModifyLt05 = testVmod2  "testVarModifyLt05"
+                    (getDTMod dmodXsdIntegerLt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100")]]
+                    []
+
+--  Tests for xsd_integer:le
+
+testVarModifyLe01 = testVmod2  "testVarModifyLe01"
+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100"),("b","100")]]
+                    [makeBVI [("a","100"),("b","100")]]
+
+testVarModifyLe02 = testVmod2  "testVarModifyLe02"
+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","99"),("b","100")]]
+                    [makeBVI [("a","99"),("b","100")]]
+
+testVarModifyLe03 = testVmod2  "testVarModifyLe03"
+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-99"),("b","-100")]]
+                    []
+
+testVarModifyLe04 = testVmod2  "testVarModifyLe04"
+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","100")]]
+                    []
+
+testVarModifyLe05 = testVmod2  "testVarModifyLe05"
+                    (getDTMod dmodXsdIntegerLe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100")]]
+                    []
+
+--  Tests for xsd_integer:gt
+
+testVarModifyGt01 = testVmod2  "testVarModifyGt01"
+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100"),("b","100")]]
+                    []
+
+testVarModifyGt02 = testVmod2  "testVarModifyGt02"
+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","99"),("b","100")]]
+                    []
+
+testVarModifyGt03 = testVmod2  "testVarModifyGt03"
+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-99"),("b","-100")]]
+                    [makeBVI [("a","-99"),("b","-100")]]
+
+testVarModifyGt04 = testVmod2  "testVarModifyGt04"
+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","100")]]
+                    []
+
+testVarModifyGt05 = testVmod2  "testVarModifyGt05"
+                    (getDTMod dmodXsdIntegerGt rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100")]]
+                    []
+
+--  Tests for xsd_integer:ge
+
+testVarModifyGe01 = testVmod2  "testVarModifyGe01"
+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100"),("b","100")]]
+                    [makeBVI [("a","100"),("b","100")]]
+
+testVarModifyGe02 = testVmod2  "testVarModifyGe02"
+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","99"),("b","100")]]
+                    []
+
+testVarModifyGe03 = testVmod2  "testVarModifyGe03"
+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","-99"),("b","-100")]]
+                    [makeBVI [("a","-99"),("b","-100")]]
+
+testVarModifyGe04 = testVmod2  "testVarModifyGe04"
+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
+                    [makeBVI [("b","100")]]
+                    []
+
+testVarModifyGe05 = testVmod2  "testVarModifyGe05"
+                    (getDTMod dmodXsdIntegerGe rdfDatatypeValXsdInteger)
+                    [makeBVI [("a","100")]]
+                    []
+
+--  Full suite for variable binding modifier tests
+
+testVarModifySuite = TestList
+    [ testVarModify00
+    , testVarModifyAbs01,    testVarModifyAbs02,    testVarModifyAbs03
+    , testVarModifyAbs04,    testVarModifyAbs05,    testVarModifyAbs06
+    , testVarModifyAbs07,    testVarModifyAbs08,    testVarModifyAbs09
+    , testVarModifyAbs10
+    , testVarModifyNeg01,    testVarModifyNeg02,    testVarModifyNeg03
+    , testVarModifyNeg04,    testVarModifyNeg05
+    , testVarModifySum01,    testVarModifySum02,    testVarModifySum03
+    , testVarModifySum04,    testVarModifySum05
+    , testVarModifyDiff01,   testVarModifyDiff02,   testVarModifyDiff03
+    , testVarModifyDiff04,   testVarModifyDiff05
+    , testVarModifyProd01,   testVarModifyProd02,   testVarModifyProd03
+    , testVarModifyProd04,   testVarModifyProd05,   testVarModifyProd06
+    , testVarModifyDivMod01, testVarModifyDivMod02, testVarModifyDivMod03
+    , testVarModifyDivMod04, testVarModifyDivMod05, testVarModifyDivMod06
+    , testVarModifyDivMod07
+    , testVarModifyPower01,  testVarModifyPower02,  testVarModifyPower03
+    , testVarModifyPower04,  testVarModifyPower05,  testVarModifyPower06
+    , testVarModifyPower07,  testVarModifyPower08
+    , testVarModifyEq01,     testVarModifyEq02,     testVarModifyEq03
+    , testVarModifyEq04,     testVarModifyEq05
+    , testVarModifyNe01,     testVarModifyNe02,     testVarModifyNe03
+    , testVarModifyNe04,     testVarModifyNe05
+    , testVarModifyLt01,     testVarModifyLt02,     testVarModifyLt03
+    , testVarModifyLt04,     testVarModifyLt05
+    , testVarModifyLe01,     testVarModifyLe02,     testVarModifyLe03
+    , testVarModifyLe04,     testVarModifyLe05
+    , testVarModifyGt01,     testVarModifyGt02,     testVarModifyGt03
+    , testVarModifyGt04,     testVarModifyGt05
+    , testVarModifyGe01,     testVarModifyGe02,     testVarModifyGe03
+    , testVarModifyGe04,     testVarModifyGe05
+    ]
+
+------------------------------------------------------------
+--  Test rules defined for datatype
+------------------------------------------------------------
+
+mkGraph grstr = makeRDFGraphFromN3String (prefixXsdInteger++base++grstr)
+    where
+        base = "@prefix : <"++nsURI namespaceDefault++"> . \n"
+
+testRuleFwd lab (Just rule) antstr constrs =
+    let
+        antgr  = mkGraph antstr
+        congrs = map mkGraph constrs
+    in
+        testEqv lab congrs $ fwdApply rule [antgr]
+testRuleFwd lab Nothing _ _ = TestCase $
+    assertFailure $ "testRuleFwd:"++lab++", null rule supplied"
+
+testRuleBwd lab (Just rule) antstr prestrss =
+    let
+        antgr   = mkGraph antstr
+        pregrss = map (map mkGraph) prestrss
+    in
+        testEqvEqv lab pregrss $ bwdApply rule antgr
+testRuleBwd lab Nothing _ _ = TestCase $
+    assertFailure $ "testRuleBwd:"++lab++", null rule supplied"
+
+testRuleChk lab (Just rule) antstr constr =
+    let
+        antgr = mkGraph antstr
+        congr = mkGraph constr
+    in
+        test lab $ checkInference rule [antgr] congr
+testRuleChk lab Nothing _ _ = TestCase $
+    assertFailure $ "testRuleChk:"++lab++", null rule supplied"
+
+xsdIntRules = (typeRules rdfDatatypeXsdInteger)
+
+axdt        = getRulesetAxiom axiomXsdIntegerDT      xsdIntRules
+
+ruleabs     = getRulesetRule  ruleXsdIntegerAbs      xsdIntRules
+ruleneg     = getRulesetRule  ruleXsdIntegerNeg      xsdIntRules
+rulesum     = getRulesetRule  ruleXsdIntegerSum      xsdIntRules
+rulediff    = getRulesetRule  ruleXsdIntegerDiff     xsdIntRules
+ruleprod    = getRulesetRule  ruleXsdIntegerProd     xsdIntRules
+ruledivmod  = getRulesetRule  ruleXsdIntegerDivMod   xsdIntRules
+rulepower   = getRulesetRule  ruleXsdIntegerPower    xsdIntRules
+ruleeq      = getRulesetRule  ruleXsdIntegerEq       xsdIntRules
+rulene      = getRulesetRule  ruleXsdIntegerNe       xsdIntRules
+rulelt      = getRulesetRule  ruleXsdIntegerLt       xsdIntRules
+rulele      = getRulesetRule  ruleXsdIntegerLe       xsdIntRules
+rulegt      = getRulesetRule  ruleXsdIntegerGt       xsdIntRules
+rulege      = getRulesetRule  ruleXsdIntegerGe       xsdIntRules
+
+-- Test cases for the arithmetic functions
+
+-- abs
+
+abs01inp =
+        "_:a a xsd_integer:Abs ; "
+    +++ "  rdf:_2 \"1\"^^xsd:integer . "
+abs01fwd =
+    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]
+abs01bwd = []
+testRuleFwdAbs01 = testRuleFwd "testRuleFwdAbs01" ruleabs abs01inp abs01fwd
+testRuleBwdAbs01 = testRuleBwd "testRuleBwdAbs01" ruleabs abs01inp abs01bwd
+
+abs02inp =
+        "_:a a xsd_integer:Abs ; "
+    +++ "  rdf:_2 \"-1\"^^xsd:integer . "
+abs02fwd =
+    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]
+abs02bwd =
+    []
+testRuleFwdAbs02 = testRuleFwd "testRuleFwdAbs02" ruleabs abs02inp abs02fwd
+testRuleBwdAbs02 = testRuleBwd "testRuleBwdAbs02" ruleabs abs02inp abs02bwd
+
+abs03inp =
+        "_:a a xsd_integer:Abs ; "
+    +++ "  rdf:_1 \"1\"^^xsd:integer . "
+abs03fwd = []
+abs03bwd =
+    [ [ "_:a a xsd_integer:Abs . "
+      , "_:a rdf:_2 \"1\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Abs . "
+      , "_:a rdf:_2 \"-1\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdAbs03 = testRuleFwd "testRuleFwdAbs03" ruleabs abs03inp abs03fwd
+testRuleBwdAbs03 = testRuleBwd "testRuleBwdAbs03" ruleabs abs03inp abs03bwd
+
+abs04inp =
+        "_:a a xsd_integer:Abs ; "
+    +++ "  rdf:_1 \"-1\"^^xsd:integer . "
+abs04fwd =
+    [ falseGraphStr
+    ]
+abs04bwd =
+    [ [ falseGraphStr
+      ]
+    ]
+testRuleFwdAbs04 = testRuleFwd "testRuleFwdAbs04" ruleabs abs04inp abs04fwd
+testRuleBwdAbs04 = testRuleBwd "testRuleBwdAbs04" ruleabs abs04inp abs04bwd
+
+-- neg
+
+neg01inp =
+        "_:a a xsd_integer:Neg ; "
+    +++ "  rdf:_2 \"1\"^^xsd:integer . "
+neg01fwd =
+    [ "_:a rdf:_1 \"-1\"^^xsd:integer . " ]
+neg01bwd =
+    [ [ "_:a a xsd_integer:Neg . "
+      , "_:a rdf:_1 \"-1\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdNeg01 = testRuleFwd "testRuleFwdNeg01" ruleneg neg01inp neg01fwd
+testRuleBwdNeg01 = testRuleBwd "testRuleBwdNeg01" ruleneg neg01inp neg01bwd
+
+neg02inp =
+        "_:a a xsd_integer:Neg ; "
+    +++ "  rdf:_2 \"-2\"^^xsd:integer . "
+neg02fwd =
+    [ "_:a rdf:_1 \"2\"^^xsd:integer . " ]
+neg02bwd =
+    [ [ "_:a a xsd_integer:Neg . "
+      , "_:a rdf:_1 \"2\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdNeg02 = testRuleFwd "testRuleFwdNeg02" ruleneg neg02inp neg02fwd
+testRuleBwdNeg02 = testRuleBwd "testRuleBwdNeg02" ruleneg neg02inp neg02bwd
+
+-- sum
+
+sum01inp =
+        "_:a a xsd_integer:Sum ; "
+    +++ "  rdf:_2 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"20\"^^xsd:integer . "
+sum01fwd =
+    [ "_:a rdf:_1 \"51\"^^xsd:integer . " ]
+sum01bwd =
+    [ [ "_:a a xsd_integer:Sum . "
+      , "_:a rdf:_1 \"51\"^^xsd:integer . "
+      , "_:a rdf:_2 \"31\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Sum . "
+      , "_:a rdf:_1 \"51\"^^xsd:integer . "
+      , "_:a rdf:_3 \"20\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdSum01 = testRuleFwd "testRuleFwdSum01" rulesum sum01inp sum01fwd
+testRuleBwdSum01 = testRuleBwd "testRuleBwdSum01" rulesum sum01inp sum01bwd
+
+sum02inp =
+        "_:a a xsd_integer:Sum ; "
+    +++ "  rdf:_1 \"52\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"21\"^^xsd:integer . "
+sum02fwd =
+    [ "_:a rdf:_2 \"31\"^^xsd:integer . " ]
+sum02bwd =
+    [ [ "_:a a xsd_integer:Sum . "
+      , "_:a rdf:_1 \"52\"^^xsd:integer . "
+      , "_:a rdf:_2 \"31\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Sum . "
+      , "_:a rdf:_2 \"31\"^^xsd:integer . "
+      , "_:a rdf:_3 \"21\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdSum02 = testRuleFwd "testRuleFwdSum02" rulesum sum02inp sum02fwd
+testRuleBwdSum02 = testRuleBwd "testRuleBwdSum02" rulesum sum02inp sum02bwd
+
+sum03inp =
+        "_:a a xsd_integer:Sum ; "
+    +++ "  rdf:_1 \"53\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"32\"^^xsd:integer . "
+sum03fwd =
+    [ "_:a rdf:_3 \"21\"^^xsd:integer . " ]
+sum03bwd =
+    [ [ "_:a a xsd_integer:Sum . "
+      , "_:a rdf:_1 \"53\"^^xsd:integer . "
+      , "_:a rdf:_3 \"21\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Sum . "
+      , "_:a rdf:_2 \"32\"^^xsd:integer . "
+      , "_:a rdf:_3 \"21\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdSum03 = testRuleFwd "testRuleFwdSum03" rulesum sum03inp sum03fwd
+testRuleBwdSum03 = testRuleBwd "testRuleBwdSum03" rulesum sum03inp sum03bwd
+
+-- diff
+
+diff01inp =
+        "_:a a xsd_integer:Diff ; "
+    +++ "  rdf:_2 \"222\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"333\"^^xsd:integer . "
+diff01fwd =
+    [ "_:a rdf:_1 \"-111\"^^xsd:integer . " ]
+diff01bwd =
+    [ [ "_:a a xsd_integer:Diff . "
+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Diff . "
+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
+      , "_:a rdf:_3 \"333\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdDiff01 = testRuleFwd "testRuleFwdDiff01" rulediff diff01inp diff01fwd
+testRuleBwdDiff01 = testRuleBwd "testRuleBwdDiff01" rulediff diff01inp diff01bwd
+
+diff02inp =
+        "_:a a xsd_integer:Diff ; "
+    +++ "  rdf:_1 \"-111\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"333\"^^xsd:integer . "
+diff02fwd =
+    [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]
+diff02bwd =
+    [ [ "_:a a xsd_integer:Diff . "
+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Diff . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      , "_:a rdf:_3 \"333\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdDiff02 = testRuleFwd "testRuleFwdDiff02" rulediff diff02inp diff02fwd
+testRuleBwdDiff02 = testRuleBwd "testRuleBwdDiff02" rulediff diff02inp diff02bwd
+
+diff03inp =
+        "_:a a xsd_integer:Diff ; "
+    +++ "  rdf:_1 \"-111\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"222\"^^xsd:integer . "
+diff03fwd =
+    [ "_:a rdf:_3 \"333\"^^xsd:integer . " ]
+diff03bwd =
+    [ [ "_:a a xsd_integer:Diff . "
+      , "_:a rdf:_1 \"-111\"^^xsd:integer . "
+      , "_:a rdf:_3 \"333\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Diff . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      , "_:a rdf:_3 \"333\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdDiff03 = testRuleFwd "testRuleFwdDiff03" rulediff diff03inp diff03fwd
+testRuleBwdDiff03 = testRuleBwd "testRuleBwdDiff03" rulediff diff03inp diff03bwd
+
+-- prod
+
+prod01inp =
+        "_:a a xsd_integer:Prod ; "
+    +++ "  rdf:_2 \"222\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"3\"^^xsd:integer . "
+prod01fwd =
+    [ "_:a rdf:_1 \"666\"^^xsd:integer . " ]
+prod01bwd =
+    [ [ "_:a a xsd_integer:Prod . "
+      , "_:a rdf:_1 \"666\"^^xsd:integer . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Prod . "
+      , "_:a rdf:_1 \"666\"^^xsd:integer . "
+      , "_:a rdf:_3 \"3\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdProd01 = testRuleFwd "testRuleFwdProd01" ruleprod prod01inp prod01fwd
+testRuleBwdProd01 = testRuleBwd "testRuleBwdProd01" ruleprod prod01inp prod01bwd
+
+prod02inp =
+        "_:a a xsd_integer:Prod ; "
+    +++ "  rdf:_1 \"666\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"3\"^^xsd:integer . "
+prod02fwd =
+    [ "_:a rdf:_2 \"222\"^^xsd:integer . " ]
+prod02bwd =
+    [ [ "_:a a xsd_integer:Prod . "
+      , "_:a rdf:_1 \"666\"^^xsd:integer . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Prod . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      , "_:a rdf:_3 \"3\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdProd02 = testRuleFwd "testRuleFwdProd02" ruleprod prod02inp prod02fwd
+testRuleBwdProd02 = testRuleBwd "testRuleBwdProd02" ruleprod prod02inp prod02bwd
+
+prod03inp =
+        "_:a a xsd_integer:Prod ; "
+    +++ "  rdf:_1 \"666\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"222\"^^xsd:integer . "
+prod03fwd =
+    [ "_:a rdf:_3 \"3\"^^xsd:integer . " ]
+prod03bwd =
+    [ [ "_:a a xsd_integer:Prod . "
+      , "_:a rdf:_1 \"666\"^^xsd:integer . "
+      , "_:a rdf:_3 \"3\"^^xsd:integer . "
+      ]
+    , [ "_:a a xsd_integer:Prod . "
+      , "_:a rdf:_2 \"222\"^^xsd:integer . "
+      , "_:a rdf:_3 \"3\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdProd03 = testRuleFwd "testRuleFwdProd03" ruleprod prod03inp prod03fwd
+testRuleBwdProd03 = testRuleBwd "testRuleBwdProd03" ruleprod prod03inp prod03bwd
+
+-- divmod
+
+divmod01inp =
+        "_:a a xsd_integer:DivMod ; "
+    +++ "  rdf:_3 \"33\"^^xsd:integer ; "
+    +++ "  rdf:_4 \"5\"^^xsd:integer . "
+divmod01fwd =
+    [     "_:a rdf:_1 \"6\"^^xsd:integer . "
+      +++ "_:a rdf:_2 \"3\"^^xsd:integer . "
+    ]
+divmod01bwd =
+    [ {- "_:a a xsd_integer:DivMod . "
+      , "_:a rdf:_1 \"6\"^^xsd:integer . "
+      , "_:a rdf:_2 \"3\"^^xsd:integer . "
+      , "_:a rdf:_4 \"5\"^^xsd:integer . "
+      -}
+    ]
+testRuleFwdDivMod01 = testRuleFwd "testRuleFwdDivMod01" ruledivmod divmod01inp divmod01fwd
+testRuleBwdDivMod01 = testRuleBwd "testRuleBwdDivMod01" ruledivmod divmod01inp divmod01bwd
+
+divmod02inp =
+        "_:a a xsd_integer:DivMod ; "
+    +++ "  rdf:_1 \"6\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"3\"^^xsd:integer ; "
+    +++ "  rdf:_4 \"5\"^^xsd:integer . "
+divmod02fwd =
+    [ ]
+divmod02bwd =
+    [ {- "_:a a xsd_integer:DivMod . "
+      , "_:a rdf:_3 \"33\"^^xsd:integer . "
+      , "_:a rdf:_4 \"5\"^^xsd:integer . "
+      -}
+    ]
+testRuleFwdDivMod02 = testRuleFwd "testRuleFwdDivMod02" ruledivmod divmod02inp divmod02fwd
+testRuleBwdDivMod02 = testRuleBwd "testRuleBwdDivMod02" ruledivmod divmod02inp divmod02bwd
+
+divmod03inp =
+        "_:a a xsd_integer:DivMod ; "
+    +++ "  rdf:_3 \"-33\"^^xsd:integer ; "
+    +++ "  rdf:_4 \"5\"^^xsd:integer . "
+divmod03fwd =
+    [     "_:a rdf:_1 \"-7\"^^xsd:integer . "
+      +++ "_:a rdf:_2 \"2\"^^xsd:integer . "
+    ]
+divmod03bwd =
+    [ ]
+testRuleFwdDivMod03 = testRuleFwd "testRuleFwdDivMod03" ruledivmod divmod03inp divmod03fwd
+testRuleBwdDivMod03 = testRuleBwd "testRuleBwdDivMod03" ruledivmod divmod03inp divmod03bwd
+
+-- power
+
+power01inp =
+        "_:a a xsd_integer:Power ; "
+    +++ "  rdf:_2 \"2\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"5\"^^xsd:integer . "
+power01fwd =
+    [ "_:a rdf:_1 \"32\"^^xsd:integer . " ]
+power01bwd =
+    [ ]
+testRuleFwdPower01 = testRuleFwd "testRuleFwdPower01" rulepower power01inp power01fwd
+testRuleBwdPower01 = testRuleBwd "testRuleBwdPower01" rulepower power01inp power01bwd
+
+power02inp =
+        "_:a a xsd_integer:Power ; "
+    +++ "  rdf:_2 \"111\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"0\"^^xsd:integer . "
+power02fwd =
+    [ "_:a rdf:_1 \"1\"^^xsd:integer . " ]
+power02bwd =
+    [ ]
+testRuleFwdPower02 = testRuleFwd "testRuleFwdPower02" rulepower power02inp power02fwd
+testRuleBwdPower02 = testRuleBwd "testRuleBwdPower02" rulepower power02inp power02bwd
+
+power03inp =
+        "_:a a xsd_integer:Power ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer ; "
+    +++ "  rdf:_3 \"-33\"^^xsd:integer . "
+power03fwd =
+    [ falseGraphStr ]
+power03bwd =
+    [ [ falseGraphStr ]
+    ]
+testRuleFwdPower03 = testRuleFwd "testRuleFwdPower03" rulepower power03inp power03fwd
+testRuleBwdPower03 = testRuleBwd "testRuleBwdPower03" rulepower power03inp power03bwd
+
+-- eq
+
+eq01inp =
+        "_:a a xsd_integer:Eq ; "
+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"11\"^^xsd:integer . "
+eq01fwd = [ ]
+eq01bwd = [ ]
+testRuleFwdEq01 = testRuleFwd "testRuleFwdEq01" ruleeq eq01inp eq01fwd
+testRuleBwdEq01 = testRuleBwd "testRuleBwdEq01" ruleeq eq01inp eq01bwd
+
+eq02inp =
+        "_:a a xsd_integer:Eq ; "
+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer . "
+eq02fwd = [ falseGraphStr ]
+eq02bwd = [ [falseGraphStr] ]
+testRuleFwdEq02 = testRuleFwd "testRuleFwdEq02" ruleeq eq02inp eq02fwd
+testRuleBwdEq02 = testRuleBwd "testRuleBwdEq02" ruleeq eq02inp eq02bwd
+
+eq03inp =
+        "_:a a xsd_integer:Eq ; "
+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
+eq03fwd = [ falseGraphStr ]
+eq03bwd = [ [falseGraphStr] ]
+testRuleFwdEq03 = testRuleFwd "testRuleFwdEq03" ruleeq eq03inp eq03fwd
+testRuleBwdEq03 = testRuleBwd "testRuleBwdEq03" ruleeq eq03inp eq03bwd
+
+-- ne
+
+ne01inp =
+        "_:a a xsd_integer:Ne ; "
+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"11\"^^xsd:integer . "
+ne01fwd = [ falseGraphStr ]
+ne01bwd = [ [falseGraphStr] ]
+testRuleFwdNe01 = testRuleFwd "testRuleFwdNe01" rulene ne01inp ne01fwd
+testRuleBwdNe01 = testRuleBwd "testRuleBwdNe01" rulene ne01inp ne01bwd
+
+ne02inp =
+        "_:a a xsd_integer:Ne ; "
+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer . "
+ne02fwd = [ ]
+ne02bwd = [ ]
+testRuleFwdNe02 = testRuleFwd "testRuleFwdNe02" rulene ne02inp ne02fwd
+testRuleBwdNe02 = testRuleBwd "testRuleBwdNe02" rulene ne02inp ne02bwd
+
+ne03inp =
+        "_:a a xsd_integer:Ne ; "
+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
+ne03fwd = [ ]
+ne03bwd = [ ]
+testRuleFwdNe03 = testRuleFwd "testRuleFwdNe03" rulene ne03inp ne03fwd
+testRuleBwdNe03 = testRuleBwd "testRuleBwdNe03" rulene ne03inp ne03bwd
+
+-- lt
+
+lt01inp =
+        "_:a a xsd_integer:Lt ; "
+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"11\"^^xsd:integer . "
+lt01fwd = [ falseGraphStr ]
+lt01bwd = [ [falseGraphStr] ]
+testRuleFwdLt01 = testRuleFwd "testRuleFwdLt01" rulelt lt01inp lt01fwd
+testRuleBwdLt01 = testRuleBwd "testRuleBwdLt01" rulelt lt01inp lt01bwd
+
+lt02inp =
+        "_:a a xsd_integer:Lt ; "
+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer . "
+lt02fwd = [ ]
+lt02bwd = [ ]
+testRuleFwdLt02 = testRuleFwd "testRuleFwdLt02" rulelt lt02inp lt02fwd
+testRuleBwdLt02 = testRuleBwd "testRuleBwdLt02" rulelt lt02inp lt02bwd
+
+lt03inp =
+        "_:a a xsd_integer:Lt ; "
+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
+lt03fwd = [ falseGraphStr ]
+lt03bwd = [ [falseGraphStr] ]
+testRuleFwdLt03 = testRuleFwd "testRuleFwdLt03" rulelt lt03inp lt03fwd
+testRuleBwdLt03 = testRuleBwd "testRuleBwdLt03" rulelt lt03inp lt03bwd
+
+-- le
+
+le01inp =
+        "_:a a xsd_integer:Le ; "
+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"11\"^^xsd:integer . "
+le01fwd = [ ]
+le01bwd = [ ]
+testRuleFwdLe01 = testRuleFwd "testRuleFwdLe01" rulele le01inp le01fwd
+testRuleBwdLe01 = testRuleBwd "testRuleBwdLe01" rulele le01inp le01bwd
+
+le02inp =
+        "_:a a xsd_integer:Le ; "
+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer . "
+le02fwd = [ ]
+le02bwd = [ ]
+testRuleFwdLe02 = testRuleFwd "testRuleFwdLe02" rulele le02inp le02fwd
+testRuleBwdLe02 = testRuleBwd "testRuleBwdLe02" rulele le02inp le02bwd
+
+le03inp =
+        "_:a a xsd_integer:Le ; "
+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
+le03fwd = [ falseGraphStr ]
+le03bwd = [ [falseGraphStr] ]
+testRuleFwdLe03 = testRuleFwd "testRuleFwdLe03" rulele le03inp le03fwd
+testRuleBwdLe03 = testRuleBwd "testRuleBwdLe03" rulele le03inp le03bwd
+
+-- gt
+
+gt01inp =
+        "_:a a xsd_integer:Gt ; "
+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"11\"^^xsd:integer . "
+gt01fwd = [ falseGraphStr ]
+gt01bwd = [ [falseGraphStr] ]
+testRuleFwdGt01 = testRuleFwd "testRuleFwdGt01" rulegt gt01inp gt01fwd
+testRuleBwdGt01 = testRuleBwd "testRuleBwdGt01" rulegt gt01inp gt01bwd
+
+gt02inp =
+        "_:a a xsd_integer:Gt ; "
+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer . "
+gt02fwd = [ falseGraphStr ]
+gt02bwd = [ [falseGraphStr] ]
+testRuleFwdGt02 = testRuleFwd "testRuleFwdGt02" rulegt gt02inp gt02fwd
+testRuleBwdGt02 = testRuleBwd "testRuleBwdGt02" rulegt gt02inp gt02bwd
+
+gt03inp =
+        "_:a a xsd_integer:Gt ; "
+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
+gt03fwd = [ ]
+gt03bwd = [ ]
+testRuleFwdGt03 = testRuleFwd "testRuleFwdGt03" rulegt gt03inp gt03fwd
+testRuleBwdGt03 = testRuleBwd "testRuleBwdGt03" rulegt gt03inp gt03bwd
+
+-- ge
+
+ge01inp =
+        "_:a a xsd_integer:Ge ; "
+    +++ "  rdf:_1 \"11\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"11\"^^xsd:integer . "
+ge01fwd = [ ]
+ge01bwd = [ ]
+testRuleFwdGe01 = testRuleFwd "testRuleFwdGe01" rulege ge01inp ge01fwd
+testRuleBwdGe01 = testRuleBwd "testRuleBwdGe01" rulege ge01inp ge01bwd
+
+ge02inp =
+        "_:a a xsd_integer:Ge ; "
+    +++ "  rdf:_1 \"21\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"22\"^^xsd:integer . "
+ge02fwd = [ falseGraphStr ]
+ge02bwd = [ [falseGraphStr] ]
+testRuleFwdGe02 = testRuleFwd "testRuleFwdGe02" rulege ge02inp ge02fwd
+testRuleBwdGe02 = testRuleBwd "testRuleBwdGe02" rulege ge02inp ge02bwd
+
+ge03inp =
+        "_:a a xsd_integer:Ge ; "
+    +++ "  rdf:_1 \"31\"^^xsd:integer ; "
+    +++ "  rdf:_2 \"-32\"^^xsd:integer . "
+ge03fwd = [ ]
+ge03bwd = [ ]
+testRuleFwdGe03 = testRuleFwd "testRuleFwdGe03" rulege ge03inp ge03fwd
+testRuleBwdGe03 = testRuleBwd "testRuleBwdGe03" rulege ge03inp ge03bwd
+
+-- Test cases from design notes
+
+infixr 5 +++
+(+++) :: String -> ShowS
+(+++) str = ((str++"\n")++)
+
+-- Make a vector of rules using the graph string below
+
+pvRules :: [RDFRule]
+-- pvRules = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdInteger gr
+pvRules = typeMkRules rdfDatatypeXsdInteger gr
+    where
+        gr = (mkGraph pvRulesStr)
+
+pvRulesStr =
+        ":PassengerVehicle a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "
+    +++ "  rdfd:constraint xsd_integer:sum . "
+    +++ ":PassengerVehicle1 a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (:totalCapacity :seatedCapacity :standingCapacity) ; "
+    +++ "  rdfd:constraint xsd_integer:sum ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+
+--  Now the test cases that use the rules created above.
+
+pvRule0 = mapFindMaybe
+            (ScopedName namespaceDefault "PassengerVehicle")
+            (LookupMap pvRules)
+pvRule1 = mapFindMaybe
+            (ScopedName namespaceDefault "PassengerVehicle1")
+            (LookupMap pvRules)
+
+pv01inp =
+        "_:a a :PassengerVehicle ; "
+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
+    +++ "  :standingCapacity \"20\"^^xsd:integer . "
+pv01fwd =
+    [ "_:a :totalCapacity \"50\"^^xsd:integer . " ]
+pv01bwd =
+    [ [ "_:a a :PassengerVehicle . "
+      , "_:a :totalCapacity \"50\"^^xsd:integer . "
+      , "_:a :seatedCapacity \"30\"^^xsd:integer . "
+      ]
+    , [ "_:a a :PassengerVehicle . "
+      , "_:a :totalCapacity \"50\"^^xsd:integer . "
+      , "_:a :standingCapacity \"20\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdPv01 = testRuleFwd "testRuleFwdPv01" pvRule0 pv01inp pv01fwd
+testRuleBwdPv01 = testRuleBwd "testRuleBwdPv01" pvRule0 pv01inp pv01bwd
+
+pv02inp =
+        "_:a a :PassengerVehicle ; "
+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
+    +++ "  :totalCapacity \"51\"^^xsd:integer . "
+    +++ "_:b a :PassengerVehicle ; "
+    +++ "  :standingCapacity \"20\"^^xsd:integer ; "
+    +++ "  :totalCapacity \"52\"^^xsd:integer . "
+pv02fwd =
+    [ "_:a :standingCapacity \"21\"^^xsd:integer . "
+    , "_:b :seatedCapacity \"32\"^^xsd:integer . "
+    ]
+pv02bwd =
+    [ [ "_:a a :PassengerVehicle . "
+      , "_:a :standingCapacity \"21\"^^xsd:integer . "
+      , "_:a :totalCapacity \"51\"^^xsd:integer . "
+      , "_:b a :PassengerVehicle . "
+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
+      , "_:b :totalCapacity \"52\"^^xsd:integer . "
+      ]
+    , [ "_:a a :PassengerVehicle . "
+      , "_:a :seatedCapacity \"30\"^^xsd:integer . "
+      , "_:a :standingCapacity \"21\"^^xsd:integer . "
+      , "_:b a :PassengerVehicle . "
+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
+      , "_:b :totalCapacity \"52\"^^xsd:integer . "
+      ]
+    , [ "_:a a :PassengerVehicle . "
+      , "_:a :standingCapacity \"21\"^^xsd:integer . "
+      , "_:a :totalCapacity \"51\"^^xsd:integer . "
+      , "_:b a :PassengerVehicle . "
+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
+      , "_:b :standingCapacity \"20\"^^xsd:integer . "
+      ]
+    , [ "_:a a :PassengerVehicle . "
+      , "_:a :seatedCapacity \"30\"^^xsd:integer . "
+      , "_:a :standingCapacity \"21\"^^xsd:integer . "
+      , "_:b a :PassengerVehicle . "
+      , "_:b :seatedCapacity \"32\"^^xsd:integer . "
+      , "_:b :standingCapacity \"20\"^^xsd:integer . "
+      ]
+    ]
+testRuleFwdPv02 = testRuleFwd "testRuleFwdPv02" pvRule0 pv02inp pv02fwd
+testRuleBwdPv02 = testRuleBwd "testRuleBwdPv02" pvRule0 pv02inp pv02bwd
+
+pv03inp =
+        "_:a a :PassengerVehicle ; "
+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
+    +++ "  :standingCapacity \"23\"^^xsd:integer ; "
+    +++ "  :totalCapacity \"53\"^^xsd:integer . "
+pv03fwd = []
+testRuleFwdPv03 = testRuleFwd "testRuleFwdPv03" pvRule0 pv03inp pv03fwd
+
+pv04inp =
+        "_:a a :PassengerVehicle ; "
+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
+    +++ "  :standingCapacity \"20\"^^xsd:integer ; "
+    +++ "  :totalCapacity \"54\"^^xsd:integer . "
+pv04fwd =
+    [     "_:a :standingCapacity \"24\"^^xsd:integer . "
+      +++ "_:a :seatedCapacity \"34\"^^xsd:integer . "
+      +++ "_:a :totalCapacity \"50\"^^xsd:integer . "
+    ]
+testRuleFwdPv04 = testRuleFwd "testRuleFwdPv04" pvRule0 pv04inp pv04fwd
+
+pv05inp =
+        "_:a a :PassengerVehicle1 ; "
+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
+    +++ "  :standingCapacity \"25\"^^xsd:integer ; "
+    +++ "  :totalCapacity \"55\"^^xsd:integer . "
+pv05fwd = []
+testRuleFwdPv05 = testRuleFwd "testRuleFwdPv05" pvRule1 pv05inp pv05fwd
+
+pv06inp =
+        "_:a a :PassengerVehicle1 ; "
+    +++ "  :seatedCapacity \"30\"^^xsd:integer ; "
+    +++ "  :standingCapacity \"20\"^^xsd:integer ; "
+    +++ "  :totalCapacity \"56\"^^xsd:integer . "
+pv06fwd =
+    [ falseGraphStr
+    ]
+pv06bwd =
+    [ [ falseGraphStr
+      ]
+    ]
+testRuleFwdPv06 = testRuleFwd "testRuleFwdPv06" pvRule1 pv06inp pv06fwd
+testRuleBwdPv06 = testRuleBwd "testRuleBwdPv06" pvRule1 pv06inp pv06bwd
+
+pv07inp =
+        "_:a a :PassengerVehicle ; "
+    +++ "  :totalCapacity \"57\"^^xsd:integer . "
+pv07fwd = []
+pv07bwd = []
+testRuleFwdPv07 = testRuleFwd "testRuleFwdPv07" pvRule0 pv07inp pv07fwd
+testRuleBwdPv07 = testRuleFwd "testRuleBwdPv07" pvRule0 pv07inp pv07bwd
+
+--  Full suite for datatype rule tests
+
+testDatatypeRuleSuite = TestList
+    [ testRuleFwdAbs01, testRuleFwdAbs02, testRuleFwdAbs03, testRuleFwdAbs04
+    , testRuleFwdNeg01, testRuleFwdNeg02
+    , testRuleFwdSum01, testRuleFwdSum02, testRuleFwdSum03
+    , testRuleFwdDiff01, testRuleFwdDiff02, testRuleFwdDiff03
+    , testRuleFwdProd01, testRuleFwdProd02, testRuleFwdProd03
+    , testRuleFwdDivMod01, testRuleFwdDivMod02, testRuleFwdDivMod03
+    , testRuleFwdPower01, testRuleFwdPower02, testRuleFwdPower03
+    , testRuleFwdEq01, testRuleFwdEq02, testRuleFwdEq03
+    , testRuleFwdNe01, testRuleFwdNe02, testRuleFwdNe03
+    , testRuleFwdLt01, testRuleFwdLt02, testRuleFwdLt03
+    , testRuleFwdLe01, testRuleFwdLe02, testRuleFwdLe03
+    , testRuleFwdGt01, testRuleFwdGt02, testRuleFwdGt03
+    , testRuleFwdGe01, testRuleFwdGe02, testRuleFwdGe03
+    -- backard chaining tests
+    , testRuleBwdAbs01, testRuleBwdAbs02, testRuleBwdAbs03, testRuleBwdAbs04
+    , testRuleBwdNeg01, testRuleBwdNeg02
+    , testRuleBwdSum01, testRuleBwdSum02, testRuleBwdSum03
+    , testRuleBwdDiff01, testRuleBwdDiff02, testRuleBwdDiff03
+    , testRuleBwdProd01, testRuleBwdProd02, testRuleBwdProd03
+    , testRuleBwdDivMod01, testRuleBwdDivMod02, testRuleBwdDivMod03
+    , testRuleBwdPower01, testRuleBwdPower02, testRuleBwdPower03
+    , testRuleBwdEq01, testRuleBwdEq02, testRuleBwdEq03
+    , testRuleBwdNe01, testRuleBwdNe02, testRuleBwdNe03
+    , testRuleBwdLt01, testRuleBwdLt02, testRuleBwdLt03
+    , testRuleBwdLe01, testRuleBwdLe02, testRuleBwdLe03
+    , testRuleBwdGt01, testRuleBwdGt02, testRuleBwdGt03
+    , testRuleBwdGe01, testRuleBwdGe02, testRuleBwdGe03
+    -- test cases from design notes
+    , testRuleFwdPv01, testRuleFwdPv02, testRuleFwdPv03, testRuleFwdPv04
+    , testRuleFwdPv05, testRuleFwdPv06, testRuleFwdPv07
+    , testRuleBwdPv01, testRuleBwdPv02, testRuleBwdPv06, testRuleBwdPv07
+    ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+    [ testDatatypeSuite
+    , testDatatypeValSuite
+    , testVarModifySuite
+    , testDatatypeRuleSuite
+    ]
+
+main = runTestTT allTests
+trules = runTestTT testDatatypeRuleSuite
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFDatatypeXsdIntegerTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.13 $
+-- $Log: RDFDatatypeXsdIntegerTest.hs,v $
+-- Revision 1.13  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.12  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.11  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.10  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.9  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.8  2003/11/28 00:17:55  graham
+-- Datatype constraint test cases all passed.
+--
+-- Revision 1.7  2003/11/27 11:35:49  graham
+-- Variable modifier tests all run.
+-- Initial class constraint reasoning tests pass.
+-- Fixed bug in class constraint backward-chained reasoning that returned
+-- multiple instances of some statements, and did not filter out all occurrences
+-- of the original statements.
+--
+-- Revision 1.6  2003/11/25 23:02:17  graham
+-- Reworked datatype variable modifier logic.
+-- Limited range of test cases so far all pass.
+--
+-- Revision 1.5  2003/11/24 22:13:09  graham
+-- Working on reworking datatype variable modifiers to work with
+-- revised datatype framework.
+--
+-- Revision 1.4  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.3  2003/11/11 21:02:55  graham
+-- Working on datatype class-constraint inference rule.  Incomplete.
+--
+-- Revision 1.2  2003/11/07 21:45:47  graham
+-- Started rework of datatype to use new DatatypeRel structure.
+--
+-- Revision 1.1  2003/10/24 21:05:09  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--

+ Swish/HaskellRDF/RDFDatatypeXsdString.hs view
@@ -0,0 +1,362 @@+--------------------------------------------------------------------------------
+--  $Id: RDFDatatypeXsdString.hs,v 1.2 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFDatatypeXsdString
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines the structures used by swish to represent and
+--  manipulate RDF xsd:string datatyped literals.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFDatatypeXsdString
+    ( rdfDatatypeXsdString
+    , rdfDatatypeValXsdString
+    , typeNameXsdString, namespaceXsdString
+    , axiomsXsdString, rulesXsdString
+    , prefixXsdString
+    )
+where
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    , makeN3ClosureRule
+    )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBindingModify
+    )
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype
+    , RDFDatatypeVal
+    , RDFDatatypeMod
+    , makeRdfDtOpenVarBindingModifiers
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..) )
+
+import Swish.HaskellRDF.ClassRestrictionRule
+    ( makeRDFDatatypeRestrictionRules
+    )
+
+import Swish.HaskellRDF.Datatype
+    ( Datatype(..)
+    , DatatypeVal(..)
+    , DatatypeMap(..)
+    , DatatypeRel(..), DatatypeRelPr
+    , altArgs
+    , UnaryFnTable,  unaryFnApp
+    , BinaryFnTable, binaryFnApp 
+    , BinMaybeFnTable, binMaybeFnApp 
+    , DatatypeMod(..) 
+    , makeVmod_2_0
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( makeRuleset 
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceXSD
+    , namespaceXsdType
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    , addVarBinding
+    , VarBindingModify(..)
+    )
+
+{- in Prelude???+import Maybe
+    ( Maybe (..), maybeToList )
+
+import Monad
+    ( liftM )
+-}+
+------------------------------------------------------------
+--  Misc values
+------------------------------------------------------------
+
+--  Local name for Integer datatype
+nameXsdString      = "string"
+
+-- |Type name for xsd:integer datatype
+typeNameXsdString  = ScopedName namespaceXSD nameXsdString
+
+-- |Namespace for xsd:integer datatype functions
+namespaceXsdString = namespaceXsdType nameXsdString
+
+--  Helper to catenate strings with newline separator,
+--  used for making textual representations of graphs.
+--  (the newline makes N3 parser diagnostics easier to interpret)
+--
+infixr 5 +++
+(+++) :: String -> ShowS
+(+++) str = ((str++"\n")++)
+
+--  Compose with function of two arguments
+c2 = (.) . (.)
+
+------------------------------------------------------------
+--  Declare exported RDFDatatype value for xsd:integer
+------------------------------------------------------------
+
+rdfDatatypeXsdString :: RDFDatatype
+rdfDatatypeXsdString = Datatype rdfDatatypeValXsdString
+
+------------------------------------------------------------
+--  Implmentation of RDFDatatypeVal for xsd:integer
+------------------------------------------------------------
+
+-- |Define Datatype value for xsd:string
+--
+rdfDatatypeValXsdString :: RDFDatatypeVal String
+rdfDatatypeValXsdString = DatatypeVal
+    { tvalName      = typeNameXsdString
+    , tvalRules     = rdfRulesetXsdString  -- Ruleset RDFGraph
+    , tvalMkRules   = makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString
+                                           -- RDFGraph -> [RDFRules]
+    , tvalMkMods    = makeRdfDtOpenVarBindingModifiers rdfDatatypeValXsdString
+    , tvalMap       = mapXsdString         -- DatatypeMap Integer
+    , tvalRel       = relXsdString         -- [DatatypeRel Integer]
+    , tvalMod       = modXsdString         -- [DatatypeMod Integer]
+    }
+
+-- |mapXsdString contains functions that perform lexical-to-value
+--  and value-to-canonical-lexical mappings for xsd:string values
+--
+--  These are identity mappings.
+--
+mapXsdString :: DatatypeMap String
+mapXsdString = DatatypeMap
+    { -- mapL2V :: String -> Maybe String
+      mapL2V = Just
+      -- mapV2L :: String -> Maybe String
+    , mapV2L = Just
+    }
+
+-- |relXsdString contains useful relations for xsd:string values.
+--
+relXsdString :: [DatatypeRel String]
+relXsdString =
+    [ relXsdStringEq
+    , relXsdStringNe
+    ]
+
+mkStrRel2 ::
+    String -> DatatypeRelPr String -> UnaryFnTable String
+    -> DatatypeRel String
+mkStrRel2 nam pr fns = DatatypeRel
+    { dtRelName = ScopedName namespaceXsdString nam
+    , dtRelFunc = altArgs pr fns unaryFnApp
+    }
+
+mkStrRel3 ::
+    String -> DatatypeRelPr String -> BinaryFnTable String
+    -> DatatypeRel String
+mkStrRel3 nam pr fns = DatatypeRel
+    { dtRelName = ScopedName namespaceXsdString nam
+    , dtRelFunc = altArgs pr fns binaryFnApp
+    }
+
+mkStrRel3maybe ::
+    String -> DatatypeRelPr String -> BinMaybeFnTable String
+    -> DatatypeRel String
+mkStrRel3maybe nam pr fns = DatatypeRel
+    { dtRelName = ScopedName namespaceXsdString nam
+    , dtRelFunc = altArgs pr fns binMaybeFnApp
+    }
+
+liftL2 :: (a->a->Bool) -> ([a]->a) -> ([a]->a) -> [a] -> Bool
+liftL2 p i1 i2 as = p (i1 as) (i2 as)
+
+lcomp :: (a->a->Bool) -> [a] -> Bool
+lcomp p = liftL2 p head (head . tail)
+
+-- eq
+
+relXsdStringEq :: DatatypeRel String
+relXsdStringEq = mkStrRel2 "eq" (lcomp (==))
+    ( repeat (const True, []) )
+
+-- ne
+
+relXsdStringNe :: DatatypeRel String
+relXsdStringNe = mkStrRel2 "ne" (lcomp (/=))
+    ( repeat (const True, []) )
+
+-- |modXsdString contains variable binding modifiers for xsd:string values.
+--
+modXsdString :: [RDFDatatypeMod String]
+modXsdString =
+    [ modXsdStringEq
+    , modXsdStringNe
+    ]
+
+modXsdStringEq = modXsdStringCompare "eq" (==)
+modXsdStringNe = modXsdStringCompare "ne" (/=)
+
+modXsdStringCompare ::
+    String -> (String->String->Bool) -> RDFDatatypeMod String
+modXsdStringCompare nam rel = DatatypeMod
+    { dmName = (ScopedName namespaceXsdString nam)
+    , dmModf = [ f0 ]
+    , dmAppf = makeVmod_2_0
+    }
+    where
+        f0 vs@[v1,v2] = if rel v1 v2 then vs else []
+        f0 _          = []
+
+-- |rulesetXsdString contains rules and axioms that allow additional
+--  deductions when xsd:string values appear in a graph.
+--
+--  makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
+--
+rdfRulesetXsdString =
+    makeRuleset namespaceXsdString axiomsXsdString rulesXsdString
+
+mkPrefix ns =
+    "@prefix " ++ nsPrefix ns ++ ": <" ++ nsURI ns ++ "> . \n"
+
+prefixXsdString =
+    mkPrefix namespaceRDF  ++
+    mkPrefix namespaceRDFS ++
+    mkPrefix namespaceRDFD ++
+    mkPrefix namespaceXSD  ++
+    mkPrefix namespaceXsdString ++
+    " \n"
+
+mkAxiom :: String -> String -> RDFFormula
+mkAxiom local gr =
+    makeRDFFormula namespaceXsdString local (prefixXsdString++gr)
+
+axiomsXsdString =
+    [ mkAxiom "dt"      "xsd:string rdf:type rdfs:Datatype ."
+    ]
+
+rulesXsdString = rulesXsdStringClosure ++ rulesXsdStringRestriction
+
+rulesXsdStringRestriction =
+    makeRDFDatatypeRestrictionRules rdfDatatypeValXsdString gr
+    where
+        gr = makeRDFGraphFromN3String rulesXsdStringStr
+
+rulesXsdStringStr = prefixXsdString
+    +++ "xsd_string:Eq a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_string:eq ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+    +++ "xsd_string:Ne a rdfd:GeneralRestriction ; "
+    +++ "  rdfd:onProperties (rdf:_1 rdf:_2) ; "
+    +++ "  rdfd:constraint xsd_string:ne ; "
+    +++ "  rdfd:maxCardinality \"1\"^^xsd:nonNegativeInteger . "
+
+rulesXsdStringClosure =
+    [ xsdstrls
+    , xsdstrsl
+    ]
+
+--  Infer string from plain literal
+xsdstrls = makeN3ClosureRule namespaceXsdString "ls"
+            "?a ?p ?l ."
+            "?a ?p ?s ."
+            (stringPlain "?s" "?l")
+
+--  Infer plain literal from string
+xsdstrsl = makeN3ClosureRule namespaceXsdString "sl"
+            "?a ?p ?s ."
+            "?a ?p ?l ."
+            (stringPlain "?s" "?l")
+
+--  Map between string and plain literal values
+stringPlain :: String -> String -> RDFVarBindingModify
+stringPlain svar lvar =
+    stringPlainValue (vn svar) (vn lvar)
+    where
+            vn ('?':n) = Var n
+
+--  Variable binding modifier to create new binding to a canonical
+--  form of a datatyped literal.
+stringPlainValue ::
+    RDFLabel -> RDFLabel -> RDFVarBindingModify
+stringPlainValue svar lvar = VarBindingModify
+        { vbmName   = ScopedName namespaceRDFD "stringPlain"
+        , vbmApply  = concatMap app1
+        , vbmVocab  = [svar,lvar]
+        , vbmUsage  = [[svar],[lvar],[]]
+        }
+    where
+        app1 vbind = app2 (vbMap vbind svar) (vbMap vbind lvar) vbind
+        app2 (Just (Lit s (Just typeNameXsdString)))
+             (Just (Lit l (Nothing)))
+             vbind
+             | s == l
+             = [vbind]
+        app2 (Just (Lit s (Just typeNameXsdString)))
+             (Nothing)
+             vbind
+             = [addVarBinding lvar (Lit s (Nothing)) vbind]
+        app2 (Nothing)
+             (Just (Lit l (Nothing)))
+             vbind
+             = [addVarBinding svar (Lit l (Just typeNameXsdString)) vbind]
+        app2 _ _ _ = []
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFDatatypeXsdString.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: RDFDatatypeXsdString.hs,v $
+-- Revision 1.2  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.1  2003/12/18 20:46:24  graham
+-- Added xsd:string module to capture equivalence of xsd:string
+-- and plain literals without a language tag
+--

+ Swish/HaskellRDF/RDFGraph.hs view
@@ -0,0 +1,864 @@+{-# OPTIONS -XFlexibleInstances #-}+{-# OPTIONS -XMultiParamTypeClasses #-}+{-# OPTIONS -XTypeSynonymInstances #-}++--------------------------------------------------------------------------------
+--  $Id: RDFGraph.hs,v 1.48 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFGraph
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a memory-based RDF graph instance.
+--
+--------------------------------------------------------------------------------
+
+------------------------------------------------------------
+-- Simple labelled directed graph value
+------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..)
+    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
+    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
+    , getLiteralText, getScopedName, makeBlank
+    , RDFTriple
+    , NSGraph(..), RDFGraph
+    , NamespaceMap, RevNamespaceMap
+    , emptyNamespaceMap
+    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
+    , addArc, merge
+    , allLabels, allNodes, remapLabels, remapLabelList
+    , newNode, newNodes
+    , setNamespaces, getNamespaces
+    , setFormulae, getFormulae, setFormula, getFormula
+    , toRDFGraph, emptyRDFGraph {-, updateRDFGraph-}
+      -- Re-export from GraphClass
+    , LDGraph(..), Label (..), Arc(..)
+    , arc, arcSubj, arcPred, arcObj, Selector
+      -- Export selected RDFLabel values
+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
+    , res_rdfs_member
+    , res_rdfd_GeneralRestriction
+    , res_rdfd_onProperties, res_rdfd_constraint, res_rdfd_maxCardinality
+    , res_owl_sameAs
+    , res_operator_plus, res_operator_minus
+    , res_operator_slash, res_operator_star
+      -- Exported for testing:
+    , grMatchMap, grEq
+    , mapnode, maplist
+    )
+where
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , makeNamespaceQName
+    , getQName, getScopedNameURI
+    , ScopedName(..)
+    , makeScopedName, makeQNameScopedName
+    , nullScopedName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceRDFC
+    , namespaceRDFO
+    , namespaceXSD
+    , namespaceXsdType
+    , namespaceOWL
+    , namespaceMATH
+    , namespaceLOG
+    , namespaceDAML
+    , namespaceLang, langTag, isLang
+    , rdf_type
+    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
+    , rdfs_member
+    , rdfd_GeneralRestriction
+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
+    , owl_sameAs
+    , operator_plus, operator_minus, operator_slash, operator_star
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..)
+    , newQName, qnameFromPair, qnameFromURI
+    , getNamespace, getLocalName, getQNameURI
+    , splitURI
+    )
+
+import Swish.HaskellRDF.GraphClass
+    ( LDGraph(..), Label (..)
+    , Arc(..), arc, arcSubj, arcPred, arcObj
+    , Selector )
+
+import Swish.HaskellRDF.GraphMatch
+    ( graphMatch, LabelMap(..), ScopedLabel(..) )
+
+import Swish.HaskellUtils.MiscHelpers
+    ( hash, lower, quote )
+
+import Swish.HaskellUtils.ListHelpers
+    ( addSetElem )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..), LookupEntryClass(..)
+    , mapFind, mapFindMaybe, mapReplaceOrAdd, mapEq, mapVals, mapKeys
+    , mapTranslateKeys, mapTranslateVals
+    , mapTranslateEntries, mapTranslateEntriesM )
+
+import Swish.HaskellUtils.FunctorM
+    ( FunctorM(..) )
+
+import Data.Char
+    ( isDigit )
+
+import Data.Maybe
+    ( isJust )
+
+import Data.List
+    ( nub, intersect, union, findIndices )
+
+-----------------------------------------------------------
+--  RDF graph node values
+------------------------------------------------------------
+--
+--  cf. http://www.w3.org/TR/rdf-concepts/#section-Graph-syntax
+--
+--  This is extended from the RDF abstract graph syntax in the
+--  following ways:
+--  (a) a graph can be part of a resource node or blank node
+--      (cf. Notation3 formulae)
+--  (b) a "variable" node option is distinguished from a
+--      blank node.
+--      I have found this useful for encoding and handling
+--      queries, even though query variables can be expressed
+--      as blank nodes.
+--  (c) a "NoNode" option is defined.
+--      This might otherwise be handled by Maybe (RDFLabel g)
+
+data RDFLabel =
+      Res ScopedName                    -- resource
+    | Lit String (Maybe ScopedName)     -- literal [type/language]
+    | Blank String                      -- blank node
+    | Var String                        -- variable (not used in ordinary graphs)
+    | NoNode                            -- no node  (not used in ordinary graphs)
+
+instance Eq RDFLabel where
+    (==) = labelEq
+
+instance Show RDFLabel where
+    show (Res sn)           = show sn
+    show (Lit st Nothing)   = quote st
+    show (Lit st (Just nam))
+        | isLang nam = quote st ++ "@"  ++ (langTag nam)
+        | otherwise  = quote st ++ "^^" ++ (show nam)
+    show (Blank ln)         = "_:"++ln
+    show (Var ln)           = "?"++ln
+    show NoNode             = "<NoNode>"
+
+instance Ord RDFLabel where
+    -- Optimize some common cases..
+    compare (Res sn1)      (Res sn2)      = compare sn1 sn2
+    compare (Blank ln1)    (Blank ln2)    = compare ln1 ln2
+    compare (Res _)        (Blank _)      = LT
+    compare (Blank _)      (Res _)        = GT
+    -- .. else use show string comparison
+    compare l1 l2 = compare (show l1) (show l2)
+    -- Similarly for <=
+    (Res qn1)   <= (Res qn2)      = qn1 <= qn2
+    (Blank ln1) <= (Blank ln2)    = ln1 <= ln2
+    (Res _)     <= (Blank _)      = True
+    (Blank _)   <= (Res _)        = False
+    l1 <= l2                      = (show l1) <= (show l2)
+
+instance Label RDFLabel where
+    labelIsVar (Blank _)    = True
+    labelIsVar (Var _)      = True
+    labelIsVar _            = False
+    getLocal   (Blank loc)  = loc
+    getLocal   (Var   loc)  = '?':loc
+    getLocal   (Res   sn)   = "Res_"++snLocal sn
+    getLocal   (NoNode)     = "None"
+    getLocal   _            = "Lit_"
+    makeLabel  ('?':loc)    = Var loc
+    makeLabel  loc          = Blank loc
+    labelHash seed lb       = hash seed (showCanon lb)
+
+--  Get canonical string for RDF label.
+--  Used for hashing, so that equivalent labels always return
+--  the same hash value.
+showCanon :: RDFLabel -> String
+showCanon (Res sn)           = "<"++getScopedNameURI sn++">"
+showCanon (Lit st (Just nam))
+        | isLang nam = quote st ++ "@"  ++ (langTag nam)
+        | otherwise  = quote st ++ "^^" ++ (getScopedNameURI nam)
+showCanon lb                 = show lb
+
+
+-- Define equality of nodes possibly based on different graph types.
+--
+-- The version of equality defined here is not strictly RDF abstract syntax
+-- equality, but my interpretation of equivalence for the purposes of
+-- entailment, in the absence of any specific datatype knowledge other
+-- than XML literals.
+--
+labelEq :: RDFLabel -> RDFLabel -> Bool
+labelEq (Res q1)            (Res q2)        = (q1 == q2)
+labelEq (Blank s1)          (Blank s2)      = (s1 == s2)
+labelEq (Var v1)            (Var v2)        = (v1 == v2)
+labelEq (Lit s1 t1)         (Lit s2 t2)     = (s1 == s2) && (t1 == t2)
+labelEq _                   _               = False
+
+---------------------------------------------------------
+--  Selected RDFLabel values
+---------------------------------------------------------
+
+res_rdf_type                = Res rdf_type
+res_rdf_first               = Res rdf_first
+res_rdf_rest                = Res rdf_rest
+res_rdf_nil                 = Res rdf_nil
+res_rdfs_member             = Res rdfs_member
+res_rdfd_GeneralRestriction = Res rdfd_GeneralRestriction
+res_rdfd_onProperties       = Res rdfd_onProperties
+res_rdfd_constraint         = Res rdfd_constraint
+res_rdfd_maxCardinality     = Res rdfd_maxCardinality
+res_owl_sameAs              = Res owl_sameAs
+res_operator_plus           = Res operator_plus
+res_operator_minus          = Res operator_minus
+res_operator_slash          = Res operator_slash
+res_operator_star           = Res operator_star
+
+---------------------------------------------------------
+--  Additional functions on RDFLabel values
+---------------------------------------------------------
+
+-- |Test if supplied labal is a URI resource node
+isUri :: RDFLabel -> Bool
+isUri (Res _) = True
+isUri  _      = False
+
+-- |Test if supplied labal is a literal node
+isLiteral :: RDFLabel -> Bool
+isLiteral (Lit _ _) = True
+isLiteral  _        = False
+
+-- |Test if supplied labal is an untyped literal node
+isUntypedLiteral :: RDFLabel -> Bool
+isUntypedLiteral (Lit _ Nothing  ) = True
+isUntypedLiteral (Lit _ (Just tn)) = isLang tn
+isUntypedLiteral  _                = False
+
+-- |Test if supplied labal is an untyped literal node
+isTypedLiteral :: RDFLabel -> Bool
+isTypedLiteral (Lit _ (Just tn)) = not (isLang tn)
+isTypedLiteral  _                = False
+
+-- |Test if supplied labal is an XML literal node
+isXMLLiteral :: RDFLabel -> Bool
+isXMLLiteral = isDatatyped rdf_XMLLiteral
+
+-- |Test if supplied label is an typed literal node of a given datatype
+isDatatyped :: ScopedName -> RDFLabel -> Bool
+isDatatyped d  (Lit _ (Just n)) = (n == d)
+isDatatyped _  _                = False
+
+-- |Test if supplied label is a container membership property
+--
+--  Check for namespace is RDF namespace and
+--  first character of local name is '_' and
+--  remaining characters of local name are all digits
+isMemberProp :: RDFLabel -> Bool
+isMemberProp (Res sn) = ( snScope sn == namespaceRDF  ) &&
+                        ( head loc   == '_'   ) &&
+                        ( and . map isDigit . tail $ loc )
+                        where
+                            loc = snLocal sn
+isMemberProp _        = False
+
+-- |Test if supplied labal is a blank node
+isBlank :: RDFLabel -> Bool
+isBlank (Blank _) = True
+isBlank  _        = False
+
+-- |Test if supplied labal is a query variable
+isQueryVar :: RDFLabel -> Bool
+isQueryVar (Var _) = True
+isQueryVar  _      = False
+
+-- |Extract text value from a literal node
+getLiteralText :: RDFLabel -> String
+getLiteralText (Lit s _) = s
+getLiteralText  _        = ""
+
+-- |Extract ScopedName value from a resource node
+getScopedName :: RDFLabel -> ScopedName
+getScopedName (Res sn) = sn
+getScopedName  _       = nullScopedName
+
+-- |Make a blank node from a supplied query variable,
+--  or return the supplied label unchanged.
+--  (Use this in when substituting an existential for an
+--  unsubstituted query variable.)
+makeBlank :: RDFLabel -> RDFLabel
+makeBlank  (Var loc)    = Blank loc
+makeBlank  lb           = lb
+
+---------------------------------------------------------
+--  RDF Triple (statement)
+---------------------------------------------------------
+
+type RDFTriple = Arc RDFLabel
+
+---------------------------------------------------------
+--  Namespace prefix list entry
+---------------------------------------------------------
+
+type NamespaceMap = LookupMap Namespace
+
+data RevNamespace = RevNamespace Namespace
+
+instance LookupEntryClass RevNamespace String String where
+    keyVal   (RevNamespace (Namespace pre uri)) = (uri,pre)
+    newEntry (uri,pre) = (RevNamespace (Namespace pre uri))
+
+type RevNamespaceMap = LookupMap RevNamespace
+
+emptyNamespaceMap = LookupMap [] :: NamespaceMap
+
+---------------------------------------------------------
+--  Graph formula entry
+---------------------------------------------------------
+
+data LookupFormula lb gr = Formula
+    { formLabel :: lb
+    , formGraph :: gr
+    }
+
+instance ( Eq lb, Eq gr ) => Eq (LookupFormula lb gr) where
+    f1 == f2 = ( formLabel f1 == formLabel f2 ) &&
+               ( formGraph f1 == formGraph f2 )
+
+instance (Label lb)
+    => LookupEntryClass (LookupFormula lb (NSGraph lb)) lb (NSGraph lb)
+    where
+        keyVal fe      = (formLabel fe, formGraph fe)
+        newEntry (k,v) = Formula { formLabel=k, formGraph=v }
+
+instance (Label lb) => Show (LookupFormula lb (NSGraph lb))
+    where
+        show (Formula l g) = (show l) ++ " :- { " ++ (showArcs "    " g) ++ " }"
+
+type Formula lb = LookupFormula lb (NSGraph lb)
+
+type FormulaMap lb = LookupMap (LookupFormula lb (NSGraph lb))
+
+emptyFormulaMap = LookupMap [] :: FormulaMap RDFLabel
+
+{-  given up on trying to do Functor for formulae...
+instance Functor (LookupFormula (NSGraph lb)) where
+    fmap f fm = mapTranslateEntries (mapFormulaEntry f) fm
+-}
+
+formulaeMap :: (lb -> l2) -> FormulaMap lb -> FormulaMap l2
+formulaeMap f fm = mapTranslateEntries (formulaEntryMap f) fm
+
+formulaEntryMap ::
+    (lb -> l2)
+    -> LookupFormula lb (NSGraph lb)
+    -> LookupFormula l2 (NSGraph l2)
+formulaEntryMap f (Formula k gr) = Formula (f k) (fmap f gr)
+
+--  What follows is a monadic variant of formulaeMap, used to
+--  apply a transformation and collect some result in a single
+--  pass.
+
+formulaeMapM ::
+    (Monad m) => (lb -> m l2) -> FormulaMap lb -> m (FormulaMap l2)
+formulaeMapM f fm = mapTranslateEntriesM (formulaEntryMapM f) fm
+
+formulaEntryMapM ::
+    (Monad m)
+    => (lb -> m l2)
+    -> LookupFormula lb (NSGraph lb)
+    -> m (LookupFormula l2 (NSGraph l2))
+formulaEntryMapM f (Formula k gr) =
+    do  { f2 <- f k
+        ; g2 <- (fmapM f gr)
+        ; return $ Formula f2 g2
+        }
+
+---------------------------------------------------------
+--  Memory-based graph with namespaces and subgraphs
+---------------------------------------------------------
+
+data NSGraph lb = NSGraph
+    { namespaces :: NamespaceMap
+    , formulae   :: FormulaMap lb
+    , statements :: [Arc lb]
+    }
+
+getNamespaces   :: NSGraph lb -> NamespaceMap
+getNamespaces g = namespaces g
+
+setNamespaces      :: NamespaceMap -> NSGraph lb -> NSGraph lb
+setNamespaces ns g = g { namespaces=ns }
+
+getFormulae   :: NSGraph lb -> FormulaMap lb
+getFormulae g = formulae g
+
+setFormulae      :: FormulaMap lb -> NSGraph lb -> NSGraph lb
+setFormulae fs g = g { formulae=fs }
+
+getFormula     :: (Label lb) => NSGraph lb -> lb -> Maybe (NSGraph lb)
+getFormula g l = mapFindMaybe l (formulae g)
+
+setFormula     :: (Label lb) => Formula lb -> NSGraph lb -> NSGraph lb
+setFormula f g = g { formulae=(mapReplaceOrAdd f (formulae g)) }
+
+instance (Label lb) => LDGraph NSGraph lb where
+    getArcs g    = statements g
+    setArcs as g = g { statements=as }
+
+-- Optimized method to add arc .. don't check for duplicates.
+addArc :: (Label lb) => Arc lb -> NSGraph lb -> NSGraph lb
+addArc ar gr = gr { statements=(addSetElem ar (statements gr)) }
+
+instance Functor NSGraph where
+    fmap f g = g { statements = (map $ fmap f) (statements g)
+                 , formulae   = formulaeMap f (formulae g)
+                 }
+
+instance FunctorM NSGraph where
+    fmapM f g =
+        do  { s2 <- (mapM $ fmapM f) (statements g)
+            ; f2 <- formulaeMapM f (formulae g)
+            ; return $ g { statements = s2, formulae = f2 }
+            }
+
+instance (Label lb) => Eq (NSGraph lb) where
+    (==) = grEq
+
+instance (Label lb) => Show (NSGraph lb) where
+    show      gr = grShow "" gr
+    showList grs = grShowList "" grs
+
+grShowList _ []     = showString "[no graphs]"
+grShowList p (g:gs) = showChar '[' . showString (grShow pp g) . showl gs
+    where
+        showl []     = showChar ']' -- showString $ "\n" ++ p ++ "]"
+        showl (g:gs) = showString (",\n "++p++grShow pp g) . showl gs
+        pp           = ' ':p
+
+grShow   :: (Label lb) => String -> NSGraph lb -> String
+grShow p g =
+    "Graph, formulae: " ++ (showForm p g) ++ "\n" ++
+    p ++ "arcs: " ++ (showArcs p g)
+    where
+        showForm p g = (foldr (++) "" (map ( (pp++) . show ) formulae ))
+        (LookupMap formulae) = getFormulae g
+        pp = "\n    " ++ p
+
+showArcs :: (Label lb) => String -> NSGraph lb -> String
+showArcs p g = (foldr (++) "" (map ( (pp++) . show ) (getArcs g) ))
+    where
+        pp = "\n    " ++ p
+
+grEq :: (Label lb) => NSGraph lb -> NSGraph lb -> Bool
+grEq g1 g2 = fst ( grMatchMap g1 g2 )
+
+grMatchMap :: (Label lb) =>
+    NSGraph lb -> NSGraph lb -> (Bool, LabelMap (ScopedLabel lb))
+grMatchMap g1 g2 =
+    graphMatch matchable (getArcs g1) (getArcs g2)
+    where
+        matchable l1 l2 = (mapFormula g1 l1) == (mapFormula g2 l2)
+        mapFormula g l  = mapFindMaybe l (getFormulae g)
+
+toNSGraph :: (Eq lb, Show lb) => [Arc lb] -> NSGraph lb
+toNSGraph arcs =
+    NSGraph
+        { statements = arcs
+        , namespaces = emptyNamespaceMap
+        , formulae   = LookupMap []
+        }
+
+---------------------------------------------------------
+--  Merge RDF graphs, renaming bnodes in the second graph
+--  as necessary
+---------------------------------------------------------
+
+-- |Merge RDF graphs, renaming blank and query variable nodes as
+--  needed to neep variable nodes from the two graphs distinct in
+--  the resulting graph.
+merge :: (Label lb) => NSGraph lb -> NSGraph lb -> NSGraph lb
+merge gr1 gr2 =
+    let
+        bn1   = allLabels labelIsVar gr1
+        bn2   = allLabels labelIsVar gr2
+        dupbn = intersect bn1 bn2
+        allbn = union bn1 bn2
+    in
+        add gr1 (remapLabels dupbn allbn id gr2)
+
+-- |Return list of all labels (including properties) in the graph
+--  satisfying a supplied filter predicate.
+allLabels :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]
+allLabels p gr = filter p (unionNodes p (formulaNodes p gr) (labels gr) )
+
+-- |Return list of all subjects and objects in the graph
+--  satisfying a supplied filter predicate.
+allNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]
+allNodes p gr = unionNodes p [] (nodes gr)
+
+--  List all nodes in graph formulae satisfying a supplied predicate
+formulaNodes :: (Label lb) => (lb -> Bool) -> NSGraph lb -> [lb]
+formulaNodes p gr = foldl (unionNodes p) fkeys (map (allLabels p) fvals)
+    where
+        -- fm :: (Label lb) => FormulaMap lb
+        --                     LookupMap LookupFormula (NSGraph lb) lb
+        fm    = formulae gr
+        -- fvals :: (Label lb) => [NSGraph lb]
+        fvals = mapVals fm
+        -- fkeys :: (Label lb) => [lb]
+        fkeys = filter p $ mapKeys fm
+
+--  Helper to filter variable nodes and merge with those found so far
+unionNodes :: (Label lb) => (lb -> Bool) -> [lb] -> [lb] -> [lb]
+unionNodes p ls1 ls2 = ls1 `union` (filter p ls2)
+
+---------------------------------------------------------
+--  Remap selected nodes in a graph
+---------------------------------------------------------
+
+-- |Remap selected nodes in graph:
+--
+--  dupbn is list of variable nodes to be renamed
+--  allbn is list of variable nodes used that must be avoided
+--  cnvbn is a node conversion function that is applied to nodes
+--        from 'dupbn' in the graph that are to be replaced by
+--        new blank nodes.  If no such conversion is required,
+--        supply 'id'.  Function 'makeBlank' can be used to convert
+--        RDF query nodes into RDF blank nodes.
+--  gr    is graph in which nodes are to be renamed
+--
+--  This is the node renaming operation that prevents graph-scoped
+--  variable nodes from being merged when two graphs are merged.
+remapLabels ::
+    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> NSGraph lb -> NSGraph lb
+remapLabels dupbn allbn cnvbn gr = fmap (mapnode dupbn allbn cnvbn) gr
+
+-- |Externally callable function to construct a list of (old,new)
+--  values to be used for graph label remapping.  The supplied arguments
+--  are (a) a list of labels to be remaped, and (b) a list of labels
+--  to be avoided by the remapping:  the latter should be a list of
+--  all the variable nodes in the graph to which the remapping will be
+--  applied.
+remapLabelList ::
+    (Label lb) => [lb] -> [lb] -> [(lb,lb)]
+remapLabelList remap avoid = maplist remap avoid id []
+
+--  Remap a single graph node.
+--  If the node is not one of those to be remapped,
+--  the supplied value is returned unchanged.
+mapnode ::
+    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> lb -> lb
+mapnode dupbn allbn cnvbn nv =
+    mapFind nv nv (LookupMap (maplist dupbn allbn cnvbn []))
+
+--  Construct a list of (oldnode,newnode) values to be used for
+--  graph label remapping.  The function operates recursiovely, adding
+--  new nodes generated to the mapping list (mapbn') and also to the
+--  list of nodes to be avoided (allbn').
+maplist ::
+    (Label lb) => [lb] -> [lb] -> (lb -> lb) -> [(lb,lb)] -> [(lb,lb)]
+maplist []         _     _     mapbn = mapbn
+maplist (dn:dupbn) allbn cnvbn mapbn = maplist dupbn allbn' cnvbn mapbn'
+    where
+        dnmap  = newNode (cnvbn dn) allbn
+        mapbn' = (dn,dnmap):mapbn
+        allbn' = dnmap:allbn
+
+-- |Given a node and a list of existing nodes, find a new node for
+--  the supplied node that does not clash with any existing node.
+--  (Generates an non-terminating list of possible replacements, and
+--  picks the first one that isn't already in use.)
+--
+--  [[[TODO: optimize this for common case nnn and _nnn:
+--    always generate _nnn and keep track of last allocated]]]
+newNode :: (Label lb) => lb -> [lb] -> lb
+newNode dn existnodes =
+    head $ newNodes dn existnodes
+
+-- |Given a node and a list of existing nodes, generate a list of new
+--  nodes for the supplied node that do not clash with any existing node.
+newNodes :: (Label lb) => lb -> [lb] -> [lb]
+newNodes dn existnodes =
+    filter (not . (flip elem existnodes)) $ trynodes (noderootindex dn)
+
+noderootindex :: (Label lb) => lb -> (String,Int)
+noderootindex dn = (nh,nx) where
+    (nh,nt) = splitnodeid $ getLocal dn
+    nx      = if null nt then 0 else read nt
+
+splitnodeid :: String -> (String,String)
+splitnodeid dn = splitAt (tx+1) dn where
+    tx = last $ (-1):findIndices (not . isDigit) dn
+
+trynodes :: (Label lb) => (String,Int) -> [lb]
+trynodes (nr,nx) = [ makeLabel (nr++(show n)) | n <- iterate (+1) nx ]
+
+trybnodes :: (Label lb) => (String,Int) -> [lb]
+trybnodes (nr,nx) = [ makeLabel (nr++(show n)) | n <- iterate (+1) nx ]
+
+---------------------------------------------------------
+--  Memory-based RDF graph type and graph class functions
+---------------------------------------------------------
+
+type RDFGraph = NSGraph RDFLabel
+
+-- |Create a new RDF graph from a supplied list of arcs
+toRDFGraph :: [Arc RDFLabel] -> RDFGraph
+toRDFGraph arcs = toNSGraph arcs
+
+-- |Create a new, empty RDF graph.
+emptyRDFGraph :: RDFGraph
+emptyRDFGraph = toRDFGraph []
+
+{-
+-- |Update an RDF graph using a supplied list of arcs, keeping
+--  prefix definitions and formula definitions from the original.
+--
+--  [[[TODO:  I think this may be redundant - the default graph
+--  class has an update method which accepts a function to update
+--  the arcs, not touching other parts of the graph value.]]]
+updateRDFGraph :: RDFGraph -> [Arc RDFLabel] -> RDFGraph
+updateRDFGraph gr as = gr { statements=as }
+-}
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFGraph.hs,v $
+-- $Author: graham $
+-- $Revision: 1.48 $
+-- $Log: RDFGraph.hs,v $
+-- Revision 1.48  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.47  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.46  2004/01/06 16:29:56  graham
+-- Fix up module exports to avoid GHC warnings
+--
+-- Revision 1.45  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.44  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.43  2003/11/24 15:46:03  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.42  2003/11/14 21:48:35  graham
+-- First cut cardinality-checked datatype-constraint rules to pass test cases.
+-- Backward chaining is still to do.
+--
+-- Revision 1.41  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.40  2003/10/24 21:02:42  graham
+-- Changed kind-structure of LookupMap type classes.
+--
+-- Revision 1.39  2003/10/22 15:47:46  graham
+-- Working on datatype inference support.
+--
+-- Revision 1.38  2003/10/01 00:36:25  graham
+-- Added RDFGraph method to test for container membership property label.
+-- Added RDFQuery filter function to select container membership properties.
+--
+-- Revision 1.37  2003/09/30 16:39:41  graham
+-- Refactor proof code to use new ruleset logic.
+-- Moved some support code from RDFProofCheck to RDFRuleset.
+--
+-- Revision 1.36  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.35  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.34  2003/07/03 20:31:07  graham
+-- Add initial draft of datatype framework.
+--
+-- Revision 1.33  2003/07/02 21:27:30  graham
+-- Graph closure with instance rule tested.
+-- About to change ProofTest for graph forward chaining to return
+-- a single result graph.
+--
+-- Revision 1.32  2003/06/30 19:07:00  graham
+-- Instance entailment, subgraph entailment and simple entailment
+-- tests now working.
+--
+-- Revision 1.31  2003/06/27 21:02:59  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.30  2003/06/25 21:16:52  graham
+-- Reworked N3 formatting logic to support proof display.
+-- Basic proof display is working.
+--
+-- Revision 1.29  2003/06/19 19:49:07  graham
+-- RDFProofCheck compiles, but test fails
+--
+-- Revision 1.28  2003/06/17 15:43:35  graham
+-- remapNodes now accepts a node-mapping function rather than just
+-- a Boolean to control conversion of query variable nodes to blank
+-- nodes, and who knows what else.
+--
+-- Revision 1.27  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.26  2003/06/12 00:49:05  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--
+-- Revision 1.25  2003/06/10 17:38:34  graham
+-- Remove some unneeded calss constraints from data type declarations
+-- Reworked NSGraph to be an instance of Functor, replacing function
+-- gmap with fmap.  Graph formulae are still not handled well:  the data types
+-- will need re-working so that a "Formula lb" type constructor can be
+-- introduced having the correct (* -> *) kind to be a Functor.
+--
+-- Revision 1.24  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.23  2003/05/30 15:04:56  graham
+-- Fix references to defunct GraphHelpers module
+--
+-- Revision 1.22  2003/05/29 00:57:37  graham
+-- Resolved swish performance problem, which turned out to an inefficient
+-- method used by the parser to add arcs to a graph.
+--
+-- Revision 1.21  2003/05/28 19:57:50  graham
+-- Adjusting code to compile with GHC
+--
+-- Revision 1.20  2003/05/28 17:39:30  graham
+-- Trying to track down N3 formatter performance problem.
+--
+-- Revision 1.19  2003/05/27 19:15:50  graham
+-- Graph merge (with blank node renaming) complete and passes tests.
+--
+-- Revision 1.18  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.17  2003/05/23 19:33:36  graham
+-- Added and tested RDF graph label translation functions
+--
+-- Revision 1.16  2003/05/23 00:02:42  graham
+-- Fixed blank node id generation bug in N3Formatter
+--
+-- Revision 1.15  2003/05/14 22:39:23  graham
+-- Initial formatter tests all run OK.
+-- The formatter could still use so,me improvement,
+-- but it
+-- passes the minimal round-tripping tests.
+--
+-- Revision 1.14  2003/05/14 16:50:32  graham
+-- Graph matching seems solid now:
+-- RDFGraphTest and N3ParserTest pass all tests
+-- Updated TODO file with comments from code
+--
+-- Revision 1.13  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.12  2003/05/07 23:58:09  graham
+-- More restructuring.
+-- RDFGraphTest runs OK.
+-- N3ParserTest needs to be updated to use new structure for formulae.
+--
+-- Revision 1.11  2003/05/07 19:25:00  graham
+-- Restructured formula handling in RDF graph
+--
+-- Revision 1.10  2003/05/01 00:21:41  graham
+-- Started refactoring LookupMap.
+-- Revised module compiles OK.
+-- Working on test module.
+--
+-- Revision 1.9  2003/04/29 22:07:10  graham
+-- Some refactoring of N3 formatter.
+-- N3 formatter now handles trivial cases.
+-- More complex formatter test cases still to be developed.
+--
+-- Revision 1.8  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.7  2003/04/15 21:40:54  graham
+-- N3Parser compiles
+-- Some small changes to RDFGraph
+-- Added some QName methods
+--
+-- Revision 1.6  2003/04/11 17:38:34  graham
+-- Rename GraphLookupMap to LookupMap
+--
+-- Revision 1.5  2003/04/10 20:08:39  graham
+-- Reorganized RDFGraph naming (RDFGraphTest OK)
+-- Progressing N3Parser
+--
+-- Revision 1.4  2003/04/10 15:06:30  graham
+-- RDFGraph now passes all test cases
+--
+-- Revision 1.3  2003/04/10 13:36:45  graham
+-- Renamed GraphRDF to RDFGraph
+--
+-- Revision 1.1  2003/04/10 08:36:06  graham
+-- Graph matching passes battery of new tests
+-- Started work on RDF graph
+--

+ Swish/HaskellRDF/RDFGraphShowM.hs view
@@ -0,0 +1,81 @@+{-# OPTIONS -XTypeSynonymInstances #-}
+
+--------------------------------------------------------------------------------
+--  $Id: RDFGraphShowM.hs,v 1.2 2003/09/24 18:50:52 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFGraphShowM
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + ????
+--
+--  This module defines a ShowM class instance for RDFGraph, to be
+--  used when displaying RDF Graph values as part of a proof sequence,
+--  etc.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFGraphShowM()
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..)
+    , isUri, isLiteral, isXMLLiteral, isBlank, isQueryVar, makeBlank
+    , RDFTriple
+    , NSGraph(..), RDFGraph )
+
+import Swish.HaskellRDF.N3Formatter
+    ( formatGraphIndent )
+
+import Swish.HaskellUtils.ShowM
+    ( ShowM(..), showm )
+
+
+------------------------------------------------------------
+--  ShowM instance for RDFGraph
+------------------------------------------------------------
+
+instance ShowM RDFGraph where
+    showms linebreak graph = formatGraphIndent linebreak False graph
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFGraphShowM.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: RDFGraphShowM.hs,v $
+-- Revision 1.2  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.1  2003/06/25 21:20:12  graham
+-- Add ShowM class and RDF graph instance to CVS.
+-- This is part of reworking N3 formatting logic to support proof display,
+-- and other multiline display requirements.
+--

+ Swish/HaskellRDF/RDFGraphTest.hs view
@@ -0,0 +1,1575 @@+--------------------------------------------------------------------------------
+--  $Id: RDFGraphTest.hs,v 1.32 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFGraphTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test cases for module RDFGraph.
+--
+--------------------------------------------------------------------------------
+
+--  WNH RIP OUT module Swish.HaskellRDF.RDFGraphTest where
+
+import Swish.HaskellUtils.FunctorM
+    ( FunctorM(..) )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..)
+    , mapFind, mapFindMaybe, mapContains )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Swish.HaskellRDF.GraphClass
+    ( Label(..), Arc, arcSubj, arcPred, arcObj, arc )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , makeQNameScopedName
+    , nullScopedName
+    , makeUriScopedName
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..)
+    , newQName, qnameFromPair, qnameFromURI
+    , getNamespace, getLocalName, getQNameURI
+    , splitURI
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFTriple, RDFGraph, RDFLabel(..), NSGraph(..)
+    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
+    , isDatatyped, isMemberProp
+    , isUri, isBlank, isQueryVar, makeBlank
+    , getScopedName
+    -- , LookupNamespace(..), Namespace
+    , NamespaceMap, emptyNamespaceMap
+    , LookupFormula(..), Formula, FormulaMap, emptyFormulaMap
+    , setArcs, getArcs, addArc, add, delete, extract, labels, merge
+    , allLabels, remapLabels, remapLabelList
+    , setNamespaces, getNamespaces
+    , setFormulae, getFormulae, setFormula, getFormula
+    , emptyRDFGraph, toRDFGraph
+    , newNode, newNodes
+    , grMatchMap, grEq )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+{-
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceRDFC
+    , namespaceRDFO
+    , namespaceXSD
+    , namespaceXsdType
+    , namespaceOWL
+    , namespaceMATH
+    , namespaceLOG
+    , namespaceDAML
+-}
+    , namespaceLang, langName, langTag, isLang
+    , rdf_type
+    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
+    , rdfs_member
+    , rdfd_GeneralRestriction
+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
+    , owl_sameAs
+    , operator_plus, operator_minus, operator_slash, operator_star
+    )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn )
+
+import Data.List
+    ( elemIndex )
+
+import Data.Maybe
+    ( fromJust )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertBool, assertEqual, assertString
+    , runTestTT, runTestText, putTextToHandle )
+
+------------------------------------------------------------
+--  Common definitions
+------------------------------------------------------------
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
+
+------------------------------------------------------------
+--  Test language tag comparisons
+------------------------------------------------------------
+
+type Lang = Maybe ScopedName
+
+lt0 = Nothing
+lt1 = Just (langName "en")
+lt2 = Just (langName "EN")
+lt3 = Just (langName "fr")
+lt4 = Just (langName "FR")
+lt5 = Just (langName "en-us")
+lt6 = Just (langName "en-US")
+lt7 = Just (langName "EN-us")
+lt8 = Just (langName "EN-US")
+
+langlist =
+  [ ("lt0",lt0),
+    ("lt1",lt1), ("lt2",lt2), ("lt3",lt3), ("lt4",lt4),
+    ("lt5",lt5), ("lt6",lt6), ("lt7",lt7), ("lt8",lt8) ]
+
+langeqlist =
+  [
+    ("lt1","lt2"),
+    ("lt3","lt4"),
+    ("lt5","lt6"),
+    ("lt5","lt7"),
+    ("lt5","lt8"),
+    ("lt6","lt7"),
+    ("lt6","lt8"),
+    ("lt7","lt8")
+  ]
+
+testLangEq :: String -> Bool -> Lang -> Lang -> Test
+testLangEq lab eq l1 l2 =
+    TestCase ( assertEqual ("testLangEq:"++lab) eq (l1==l2) )
+
+testLangEqSuite = TestList
+  [ testLangEq (testLab l1 l2) (testEq  l1 l2) t1 t2
+      | (l1,t1) <- langlist , (l2,t2) <- langlist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` langeqlist ||
+            (l2,l1) `elem` langeqlist
+
+------------------------------------------------------------
+--  Define some common values
+------------------------------------------------------------
+
+base1 = Namespace "base1" "http://id.ninebynine.org/wip/2003/test/graph1/node#"
+base2 = Namespace "base2" "http://id.ninebynine.org/wip/2003/test/graph2/node/"
+base3 = Namespace "base3" "http://id.ninebynine.org/wip/2003/test/graph3/node"
+base4 = Namespace "base4" "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+
+qb1s1 = ScopedName base1 "s1"
+qb2s2 = ScopedName base2 "s2"
+qb3s3 = ScopedName base3 "s3"
+qb3   = ScopedName base3 ""
+qb3bm = ScopedName base3 "basemore"
+qb4m  = ScopedName base4 "more"
+
+s1 = Res qb1s1  :: RDFLabel
+s2 = Res qb2s2  :: RDFLabel
+s3 = Res qb3s3  :: RDFLabel
+s4 = Res qb3    :: RDFLabel
+s5 = Blank "s5" :: RDFLabel
+s6 = Res qb3bm  :: RDFLabel
+s7 = Res qb4m   :: RDFLabel
+s8 = Blank "s8" :: RDFLabel
+
+qb1st1 = ScopedName base1 "st1"
+qb2st2 = ScopedName base2 "st2"
+qb3st3 = ScopedName base3 "st3"
+
+st1 = Res qb1st1  :: RDFLabel
+st2 = Res qb2st2  :: RDFLabel
+st3 = Res qb3st3  :: RDFLabel
+
+bb  = Blank "bb"  :: RDFLabel
+bb0 = Blank "bb0" :: RDFLabel
+b1  = Blank "b1"  :: RDFLabel
+b2  = Blank "b2"  :: RDFLabel
+b3  = Blank "b3"  :: RDFLabel
+b4  = Blank "b4"  :: RDFLabel
+b5  = Blank "b5"  :: RDFLabel
+b6  = Blank "b6"  :: RDFLabel
+b7  = Blank "b7"  :: RDFLabel
+b8  = Blank "b8"  :: RDFLabel
+b9  = Blank "b9"  :: RDFLabel
+b10 = Blank "b10" :: RDFLabel
+
+c1 = Blank "c1" :: RDFLabel
+c2 = Blank "c2" :: RDFLabel
+c3 = Blank "c3" :: RDFLabel
+c4 = Blank "c4" :: RDFLabel
+
+ba1 = Blank "_1" :: RDFLabel
+ba2 = Blank "_2" :: RDFLabel
+ba3 = Blank "_3" :: RDFLabel
+ba4 = Blank "_4" :: RDFLabel
+
+bn3 = Blank "3" :: RDFLabel
+bn4 = Blank "4" :: RDFLabel
+bn5 = Blank "5" :: RDFLabel
+bn6 = Blank "6" :: RDFLabel
+
+qb1p1 = ScopedName base1 "p1"
+qb2p2 = ScopedName base2 "p2"
+qb3p3 = ScopedName base3 "p3"
+qb4p4 = ScopedName base3 "p4"
+qb1o1 = ScopedName base1 "o1"
+qb2o2 = ScopedName base2 "o2"
+qb3o3 = ScopedName base3 "o3"
+
+p1 = Res qb1p1  :: RDFLabel
+p2 = Res qb2p2  :: RDFLabel
+p3 = Res qb3p3  :: RDFLabel
+p4 = Res qb4p4  :: RDFLabel
+
+o1 = Res qb1o1  :: RDFLabel
+o2 = Res qb2o2  :: RDFLabel
+o3 = Res qb3o3  :: RDFLabel
+o4 = Res qb3    :: RDFLabel
+o5 = Blank "o5" :: RDFLabel
+o6 = Blank "s5" :: RDFLabel
+
+qb1t1 = ScopedName base1 "type1"
+qb1t2 = ScopedName base1 "type2"
+
+l1  = Lit "l1"  Nothing                 :: RDFLabel
+l2  = Lit "l2"  (Just (langName "en"))  :: RDFLabel
+l3  = Lit "l2"  (Just (langName "fr"))  :: RDFLabel
+l4  = Lit "l4"  (Just qb1t1)            :: RDFLabel
+l5  = Lit "l4"  (Just qb1t1)            :: RDFLabel -- (Lang "en")
+l6  = Lit "l4"  (Just qb1t1)            :: RDFLabel -- (Lang "fr")
+l7  = Lit "l4"  (Just qb1t2)            :: RDFLabel
+l8  = Lit "l4"  (Just qb1t2)            :: RDFLabel -- (Lang "en")
+l9  = Lit "l4"  (Just qb1t2)            :: RDFLabel -- (Lang "fr")
+l10 = Lit "l10" (Just rdf_XMLLiteral)   :: RDFLabel
+l11 = Lit "l10" (Just rdf_XMLLiteral)   :: RDFLabel -- (Lang "en")
+l12 = Lit "l10" (Just rdf_XMLLiteral)   :: RDFLabel -- (Lang "fr")
+
+v1  = Var "v1"   :: RDFLabel
+v2  = Var "v2"   :: RDFLabel
+v3  = Var "v3"   :: RDFLabel
+v4  = Var "v4"   :: RDFLabel
+vb3 = Blank "v3" :: RDFLabel
+vb4 = Blank "v4" :: RDFLabel
+
+-- Test cases for isMemberProp
+qcm1 = ScopedName namespaceRDF "_1"
+qcm2 = ScopedName namespaceRDF "_234567"
+qnm1 = ScopedName namespaceRDF "987"
+qnm2 = ScopedName namespaceRDF "_987a65"
+
+cm1  = Res qcm1  :: RDFLabel
+cm2  = Res qcm2  :: RDFLabel
+nm1  = Res qnm1  :: RDFLabel
+nm2  = Res qnm2  :: RDFLabel
+
+------------------------------------------------------------
+--  RDFLabel construction and equality tests
+------------------------------------------------------------
+
+testLabelEq :: String -> Bool -> RDFLabel -> RDFLabel -> Test
+testLabelEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) )
+
+nodelist =
+  [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5)
+  , ("s6",s6), ("s7",s7), ("s8",s8)
+  , ("b1",b1), ("b2",b2), ("b3",b3), ("b4",b4)
+  , ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4)
+  , ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4), ("o5",o5)
+  , ("l1",l1), ("l2",l2), ("l3",l3)
+  , ("l4",l4), ("l5",l5), ("l6",l6)
+  , ("l7",l7), ("l8",l8), ("l9",l9)
+  , ("l10",l10), ("l11",l11), ("l12",l12)
+  , ("v1",v1), ("v2",v2)
+  ]
+
+nodeeqlist =
+  [ ("s4","o4")
+  , ("s5","o6")
+  , ("s6","s7")
+  , ("l4","l5")
+  , ("l4","l6")
+  , ("l5","l6")
+  , ("l7","l8")
+  , ("l7","l9")
+  , ("l8","l9")
+  , ("l10","l11")
+  , ("l10","l12")
+  , ("l11","l12")
+  ]
+
+testNodeEqSuite = TestList
+  [ testLabelEq (testLab l1 l2) (testEq  l1 l2) n1 n2
+      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` nodeeqlist ||
+            (l2,l1) `elem` nodeeqlist
+
+------------------------------------------------------------
+--  RDFLabel classification tests
+------------------------------------------------------------
+
+testClass :: String -> (RDFLabel -> Bool) -> RDFLabel -> Bool -> Test
+testClass lab clsf nod eq =
+    TestCase ( assertEqual ("testClass:"++lab) eq (clsf nod) )
+
+testClass01 = testClass "testClass01" isUri            s1  True
+testClass02 = testClass "testClass02" isUri            s5  False
+testClass03 = testClass "testClass03" isUri            ba1 False
+testClass04 = testClass "testClass04" isUri            l1  False
+testClass05 = testClass "testClass05" isUri            l10 False
+testClass06 = testClass "testClass06" isUri            cm1 True
+testClass07 = testClass "testClass07" isUri            nm1 True
+testClass08 = testClass "testClass08" isUri            v1  False
+
+testClass10 = testClass "testClass10" isLiteral        s1  False
+testClass11 = testClass "testClass11" isLiteral        s5  False
+testClass12 = testClass "testClass12" isLiteral        ba1 False
+testClass13 = testClass "testClass13" isLiteral        l1  True
+testClass14 = testClass "testClass14" isLiteral        l4  True
+testClass15 = testClass "testClass15" isLiteral        l5  True
+testClass16 = testClass "testClass16" isLiteral        l10 True
+testClass17 = testClass "testClass17" isLiteral        l11 True
+testClass18 = testClass "testClass18" isLiteral        cm1 False
+testClass19 = testClass "testClass19" isLiteral        v1  False
+
+testClass20 = testClass "testClass20" isTypedLiteral   s1  False
+testClass21 = testClass "testClass21" isTypedLiteral   s5  False
+testClass22 = testClass "testClass22" isTypedLiteral   ba1 False
+testClass23 = testClass "testClass23" isTypedLiteral   l1  False
+testClass24 = testClass "testClass24" isTypedLiteral   l2  False
+testClass25 = testClass "testClass25" isTypedLiteral   l4  True
+testClass26 = testClass "testClass26" isTypedLiteral   l5  True
+testClass27 = testClass "testClass27" isTypedLiteral   l10 True
+testClass28 = testClass "testClass28" isTypedLiteral   l11 True
+testClass29 = testClass "testClass29" isTypedLiteral   v1  False
+
+testClass30 = testClass "testClass30" isUntypedLiteral s1  False
+testClass31 = testClass "testClass31" isUntypedLiteral s5  False
+testClass32 = testClass "testClass32" isUntypedLiteral ba1 False
+testClass33 = testClass "testClass33" isUntypedLiteral l1  True
+testClass34 = testClass "testClass34" isUntypedLiteral l2  True
+testClass35 = testClass "testClass35" isUntypedLiteral l4  False
+testClass36 = testClass "testClass36" isUntypedLiteral l5  False
+testClass37 = testClass "testClass37" isUntypedLiteral l10 False
+testClass38 = testClass "testClass38" isUntypedLiteral l11 False
+testClass39 = testClass "testClass39" isUntypedLiteral v1  False
+
+testClass40 = testClass "testClass40" isXMLLiteral     s1  False
+testClass41 = testClass "testClass41" isXMLLiteral     s5  False
+testClass42 = testClass "testClass42" isXMLLiteral     ba1 False
+testClass43 = testClass "testClass43" isXMLLiteral     l1  False
+testClass44 = testClass "testClass44" isXMLLiteral     l2  False
+testClass45 = testClass "testClass45" isXMLLiteral     l4  False
+testClass46 = testClass "testClass46" isXMLLiteral     l5  False
+testClass47 = testClass "testClass47" isXMLLiteral     l10 True
+testClass48 = testClass "testClass48" isXMLLiteral     l11 True
+testClass49 = testClass "testClass49" isXMLLiteral     v1  False
+
+altIsXmlLit = isDatatyped rdf_XMLLiteral
+testClass50 = testClass "testClass50" altIsXmlLit      s1  False
+testClass51 = testClass "testClass51" altIsXmlLit      s5  False
+testClass52 = testClass "testClass52" altIsXmlLit      ba1 False
+testClass53 = testClass "testClass53" altIsXmlLit      l1  False
+testClass54 = testClass "testClass54" altIsXmlLit      l2  False
+testClass55 = testClass "testClass55" altIsXmlLit      l4  False
+testClass56 = testClass "testClass56" altIsXmlLit      l5  False
+testClass57 = testClass "testClass57" altIsXmlLit      l10 True
+testClass58 = testClass "testClass58" altIsXmlLit      l11 True
+
+testClass60 = testClass "testClass60" isMemberProp     s1  False
+testClass61 = testClass "testClass61" isMemberProp     s5  False
+testClass62 = testClass "testClass62" isMemberProp     ba1 False
+testClass63 = testClass "testClass63" isMemberProp     l1  False
+testClass64 = testClass "testClass64" isMemberProp     l10 False
+testClass65 = testClass "testClass65" isMemberProp     cm1 True
+testClass66 = testClass "testClass66" isMemberProp     cm2 True
+testClass67 = testClass "testClass67" isMemberProp     nm1 False
+testClass68 = testClass "testClass68" isMemberProp     nm2 False
+
+testClass70 = testClass "testClass70" isBlank          s7  False
+testClass71 = testClass "testClass71" isBlank          s5  True
+testClass72 = testClass "testClass72" isBlank          ba1 True
+testClass73 = testClass "testClass73" isBlank          l1  False
+testClass74 = testClass "testClass74" isBlank          l4  False
+testClass75 = testClass "testClass75" isBlank          l5  False
+testClass76 = testClass "testClass76" isBlank          l10 False
+testClass77 = testClass "testClass77" isBlank          l11 False
+testClass78 = testClass "testClass78" isBlank          cm1 False
+testClass79 = testClass "testClass79" isBlank          v1  False
+
+testClass80 = testClass "testClass80" isQueryVar       s8  False
+testClass81 = testClass "testClass81" isQueryVar       s5  False
+testClass82 = testClass "testClass82" isQueryVar       ba1 False
+testClass83 = testClass "testClass83" isQueryVar       l1  False
+testClass84 = testClass "testClass84" isQueryVar       l4  False
+testClass85 = testClass "testClass85" isQueryVar       l5  False
+testClass86 = testClass "testClass86" isQueryVar       l10 False
+testClass87 = testClass "testClass87" isQueryVar       l11 False
+testClass88 = testClass "testClass88" isQueryVar       cm1 False
+testClass89 = testClass "testClass89" isQueryVar       v1  True
+
+testNodeClassSuite = TestList
+  [              testClass01, testClass02, testClass03, testClass04
+  , testClass05, testClass06, testClass07, testClass08
+  , testClass10, testClass11, testClass12, testClass13, testClass14
+  , testClass15, testClass16, testClass17, testClass18, testClass19
+  , testClass20, testClass21, testClass22, testClass23, testClass24
+  , testClass25, testClass26, testClass27, testClass28, testClass29
+  , testClass30, testClass31, testClass32, testClass33, testClass34
+  , testClass35, testClass36, testClass37, testClass38, testClass39
+  , testClass40, testClass41, testClass42, testClass43, testClass44
+  , testClass45, testClass46, testClass47, testClass48, testClass49
+  , testClass50, testClass51, testClass52, testClass53, testClass54
+  , testClass55, testClass56, testClass57, testClass58
+  , testClass60, testClass61, testClass62, testClass63, testClass64
+  , testClass65, testClass66, testClass67, testClass68
+  , testClass70, testClass71, testClass72, testClass73, testClass74
+  , testClass75, testClass76, testClass77, testClass78, testClass79
+  , testClass80, testClass81, testClass82, testClass83, testClass84
+  , testClass85, testClass86, testClass87, testClass88, testClass89
+  ]
+
+------------------------------------------------------------
+--  RDFLabel local part separation and recombination tests
+------------------------------------------------------------
+
+testLocalEq :: String -> String -> String -> Test
+testLocalEq lab l1 l2 =
+    TestCase ( assertEqual ("testLocalEq:"++lab) l1 l2 )
+
+testLocalLabEq :: String -> RDFLabel -> RDFLabel -> Test
+testLocalLabEq lab l1 l2 =
+    TestCase ( assertEqual ("testLocalEq:"++lab) l1 l2 )
+
+testNodeLocal01 = testLocalEq    "01" "b1"  (getLocal b1)
+testNodeLocal02 = testLocalEq    "02" "b2"  (getLocal b2)
+testNodeLocal03 = testLocalEq    "03" "?v1" (getLocal v1)
+testNodeLocal04 = testLocalEq    "04" "?v2" (getLocal v2)
+testNodeLocal05 = testLocalLabEq "05" b1    (makeLabel "b1")
+testNodeLocal06 = testLocalLabEq "06" b2    (makeLabel "b2")
+testNodeLocal07 = testLocalLabEq "07" v1    (makeLabel "?v1")
+testNodeLocal08 = testLocalLabEq "08" v2    (makeLabel "?v2")
+
+testNodeLocalSuite = TestList
+  [ testNodeLocal01
+  , testNodeLocal02
+  , testNodeLocal03
+  , testNodeLocal04
+  , testNodeLocal05
+  , testNodeLocal06
+  , testNodeLocal07
+  , testNodeLocal08
+  ]
+
+------------------------------------------------------------
+--  Node generation tests
+------------------------------------------------------------
+
+testNodeEq :: String -> RDFLabel -> RDFLabel -> Test
+testNodeEq lab l1 l2 =
+    TestCase ( assertEqual ("testNodeEq:"++lab) l1 l2 )
+
+tnn01 = (newNode  v1 [b1,b3,v1,v2])
+tnn02 = (newNode  b1 [b1,b3,v1,v2])
+tnn03 = (newNodes b1 [b1,b3,v1,v2])!!0
+tnn04 = (newNodes b1 [b1,b3,v1,v2])!!1
+tnn05 = (newNodes b1 [b1,b3,v1,v2])!!2
+tnn06 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!0
+tnn07 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!1
+tnn08 = (newNodes s1 [b1,b3,v1,v2,tnns3])!!2
+tnn09 = (newNodes l1 [b1,b3,v1,v2,tnns3])!!2
+
+tnns1 = Blank "Res_s1"
+tnns2 = Blank "Res_s2"
+tnns3 = Blank "Res_s3"
+tnns4 = Blank "Res_s4"
+tnnl1 = Blank "Lit_2"
+
+testNewNode01 = testNodeEq "testNewNode01" v3    tnn01
+testNewNode02 = testNodeEq "testNewNode02" b2    tnn02
+testNewNode03 = testNodeEq "testNewNode03" b2    tnn03
+testNewNode04 = testNodeEq "testNewNode04" b4    tnn04
+testNewNode05 = testNodeEq "testNewNode05" b5    tnn05
+testNewNode06 = testNodeEq "testNewNode06" tnns1 tnn06
+testNewNode07 = testNodeEq "testNewNode07" tnns2 tnn07
+testNewNode08 = testNodeEq "testNewNode08" tnns4 tnn08
+testNewNode09 = testNodeEq "testNewNode09" tnnl1 tnn09
+
+testNewNodeSuite = TestList
+  [ testNewNode01
+  , testNewNode02
+  , testNewNode03
+  , testNewNode04
+  , testNewNode05
+  , testNewNode06
+  , testNewNode07
+  , testNewNode08
+  , testNewNode09
+  ]
+
+------------------------------------------------------------
+--  RDFLabel ordering tests
+------------------------------------------------------------
+
+testLabelOrd :: String -> Ordering -> RDFLabel -> RDFLabel -> Test
+testLabelOrd lab order n1 n2 =
+    TestCase ( assertEqual
+               ("testLabelOrd:"++lab++"["++(show n1)++","++(show n2)++"]")
+               order (compare n1 n2) )
+
+nodeorder =
+  -- literals
+  [ "l1"
+  , "l11", "l12", "l10"
+  , "l2", "l3"
+  , "l5", "l6", "l4", "l8", "l9", "l7"
+  -- variables
+  , "v1", "v2"
+  -- URIs
+  , "o1", "p1", "s1"
+  , "o2", "p2", "s2"
+  , "s4", "o4", "s6", "s7"
+  , "o3", "p3", "p4", "s3"
+  -- blank nodes
+  , "b1", "b2", "b3", "b4"
+  , "o5", "s5", "s8"
+  ]
+
+testNodeOrdSuite = TestList
+  [ testLabelOrd (testLab l1 l2) (testOrd l1 l2) n1 n2
+      | (l1,n1) <- nodelist , (l2,n2) <- nodelist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testOrd l1 l2
+      | testEq l1 l2  = EQ
+      | otherwise     = compare (fromJust $ elemIndex l1 nodeorder)
+                                (fromJust $ elemIndex l2 nodeorder)
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` nodeeqlist ||
+            (l2,l1) `elem` nodeeqlist
+
+------------------------------------------------------------
+--  Other RDFLabel tests
+------------------------------------------------------------
+
+testLabelName01 = testEq "testLabelName01" (getScopedName s1) qb1s1
+testLabelName02 = testEq "testLabelName02" (getScopedName b1) nullScopedName
+testLabelName03 = testEq "testLabelName03" (getScopedName l1) nullScopedName
+testLabelName04 = testEq "testLabelName04" (getScopedName v1) nullScopedName
+
+testLabelOtherSuite = TestList
+    [ testLabelName01, testLabelName02, testLabelName03, testLabelName04
+    ]
+
+------------------------------------------------------------
+--  Statement construction and equality tests
+------------------------------------------------------------
+
+testStmtEq :: String -> Bool -> RDFTriple -> RDFTriple -> Test
+testStmtEq lab eq t1 t2 =
+    TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) )
+
+slist =
+  [
+    ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7)
+  ]
+
+plist =
+  [
+    ("p1",p1)
+  ]
+
+olist =
+  [ ("o1",o1), ("o4",o4), ("o5",o5),
+    ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10)
+  ]
+
+tlist =
+  [ (lab s p o,trp s p o) | s <- slist, p <- plist, o <- olist ]
+    where
+    lab (s,_) (p,_) (o,_) = s++"."++p++"."++o
+    trp (_,s) (_,p) (_,o) = arc s p o
+
+stmteqlist =
+  [
+    ("s6.p1.l1", "s7.p1.l1"),
+    ("s6.p1.l4", "s7.p1.l4"),
+    ("s6.p1.l7", "s7.p1.l7"),
+    ("s6.p1.l7", "s7.p1.l8"),
+    ("s6.p1.l8", "s7.p1.l7"),
+    ("s6.p1.l8", "s7.p1.l8"),
+    ("s6.p1.l10","s7.p1.l10"),
+    ("s6.p1.o1", "s7.p1.o1"),
+    ("s6.p1.o4", "s7.p1.o4"),
+    ("s6.p1.o5", "s7.p1.o5"),
+    ("s1.p1.l7", "s1.p1.l8"),
+    ("s4.p1.l7", "s4.p1.l8"),
+    ("s5.p1.l7", "s5.p1.l8"),
+    ("s6.p1.l7", "s6.p1.l8"),
+    ("s7.p1.l7", "s7.p1.l8")
+  ]
+
+testStmtEqSuite = TestList
+  [ testStmtEq (testLab l1 l2) (testEq  l1 l2) t1 t2
+      | (l1,t1) <- tlist , (l2,t2) <- tlist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` stmteqlist ||
+            (l2,l1) `elem` stmteqlist
+
+------------------------------------------------------------
+--  Graph construction and equality tests
+------------------------------------------------------------
+
+testGraphEq :: String -> Bool -> RDFGraph -> RDFGraph -> Test
+testGraphEq lab eq g1 g2 =
+    --  Set test False to get extra trace info about graph differences
+    --  Some tests will fail with this setting, so revert to True to
+    --  get test result.
+    if True then
+        TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
+    else
+        TestList
+            [ TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
+            , TestCase ( assertEqual ("testGraphEq:"++lab) g1 g2 )
+            ]
+
+testGraphEqM :: String -> Bool -> Maybe RDFGraph -> Maybe RDFGraph -> Test
+testGraphEqM lab eq g1 g2 =
+    TestCase ( assertEqual ("testGraphEq:"++lab) eq (g1==g2) )
+
+t01 = arc s1 p1 o1
+t02 = arc s2 p1 o2
+t03 = arc s3 p1 o3
+t04 = arc s1 p1 l1
+t05 = arc s2 p1 l4
+t06 = arc s3 p1 l10
+
+t10 = arc s1 p1 b1
+t11 = arc b1 p2 b2
+t12 = arc b2 p3 o1
+
+t20 = arc s1 p1 b3
+t21 = arc b3 p2 b4
+t22 = arc b4 p3 o1
+
+tt01 = arc st1 p1 o1
+tt02 = arc st2 p1 o2
+tt03 = arc st3 p1 o3
+tt04 = arc st1 p1 l1
+tt05 = arc st2 p1 l4
+tt06 = arc st3 p1 l10
+
+makeNewPrefixNamespace :: (String,Namespace) -> Namespace
+makeNewPrefixNamespace (pre,ns) = Namespace pre (nsURI ns)
+
+nslist = LookupMap $ map makeNewPrefixNamespace
+    [ ("base1",base1)
+    , ("base2",base2)
+    , ("base3",base3)
+    , ("base4",base4)
+    ]
+
+nslistalt = LookupMap $ map makeNewPrefixNamespace
+    [ ("altbase1",base1)
+    , ("altbase2",base2)
+    , ("altbase3",base3)
+    ]
+
+g1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01]
+        }
+
+gt1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tt01]
+        }
+
+-- Check for nonsensitivety of graph equility to namespace differences:
+g1alt = NSGraph
+        { namespaces = nslistalt
+        , formulae   = emptyFormulaMap
+        , statements = [t01]
+        }
+
+--  Construct version of g1 using just URIs
+uris1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
+urip1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#p1"
+urio1 = makeUriScopedName "http://id.ninebynine.org/wip/2003/test/graph1/node#o1"
+tu01  = arc (Res uris1) (Res urip1) (Res urio1)
+g1uri = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tu01]
+        }
+
+g2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03,t04,t05,t06]
+        }
+
+gt2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tt01,tt02,tt03,tt04,tt05,tt06]
+        }
+
+g3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t06,t05,t04,t03,t02,t01]
+        }
+
+gt3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tt06,tt05,tt04,tt03,tt02,tt01]
+        }
+
+g4 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03,t04,t05,t06,t10,t11,t12]
+        }
+
+g5 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03,t04,t05,t06,t20,t21,t22]
+        }
+
+g6 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22]
+        }
+
+g7 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t01,t02]
+        }
+
+g8 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t02,t01]
+        }
+
+g9 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t03,t02,t01]
+        }
+
+g9a = addArc t03 g8
+
+g10 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [t02,t02,t01]
+        }
+
+g10a = addArc t02 g8
+
+glist =
+  [ ("g1",g1), ("g1alt",g1alt), ("g1uri",g1uri)
+  , ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6)
+  , ("g7",g7), ("g8",g8), ("g9",g9), ("g10",g10)
+  , ("g9a",g9a), ("g10a",g10a)
+  ]
+
+grapheqlist =
+  [ ("g1","g1alt")
+  , ("g1","g1uri")
+  , ("g1alt","g1uri")
+  , ("g2","g3")
+  , ("g4","g5")
+  , ("g7","g8")
+  , ("g7","g10")
+  , ("g7","g10a")
+  , ("g8","g10")
+  , ("g8","g10a")
+  , ("g9","g9a")
+  , ("g10","g10a")
+  ]
+
+testGraphEqSuite = TestList
+  [ testGraphEq (testLab l1 l2) (testEq l1 l2) g1 g2
+      | (l1,g1) <- glist , (l2,g2) <- glist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` grapheqlist ||
+            (l2,l1) `elem` grapheqlist
+
+-- Selected tests for debugging
+geq12 = testGraphEq "g1-g2" False g1 g2
+geq21 = testGraphEq "g2-g1" False g2 g1
+geq22 = testGraphEq "g2-g2" True  g2 g2
+geq23 = testGraphEq "g2-g3" True  g2 g3
+geq14 = testGraphEq "g1-g4" False g1 g4
+geq24 = testGraphEq "g2-g4" False g2 g4
+geq77 = testGraphEq "g7-g7" True  g7 g7
+geq78 = testGraphEq "g7-g8" True  g7 g8
+geq87 = testGraphEq "g8-g7" True  g8 g7
+geq99a   = testGraphEq "g9-g9a"   True g9 g9a
+geq1010a = testGraphEq "g10-g10a" True g10 g10a
+
+testGraphEqSelSuite = TestList
+  [ geq12
+  , geq21
+  , geq22
+  , geq23
+  , geq14
+  , geq24
+  , geq77
+  , geq78
+  , geq87
+  , geq99a
+  , geq1010a
+  ]
+
+
+------------------------------------------------------------
+--  Test updating formulae
+------------------------------------------------------------
+
+testFormulaLookup ::
+    String -> FormulaMap RDFLabel -> RDFLabel -> Maybe RDFGraph -> Test
+testFormulaLookup lab fs fl gr =
+    TestCase ( assertEqual ("testFormulaLookup:"++lab) gr jfg )
+    where
+        jfg  = mapFindMaybe fl fs
+
+testMaybeEq :: (Eq a, Show a) => String -> Maybe a -> Maybe a -> Test
+testMaybeEq lab m1 m2 =
+    TestCase ( assertEqual ("testMaybeEq:"++lab) m1 m2 )
+
+g1f1 = g1
+f1   = getFormulae g1f1
+testGraphFormula01a = testFormulaLookup "01a" f1 s1 Nothing
+testGraphFormula01b = testFormulaLookup "01b" f1 s2 Nothing
+testGraphFormula01c = testFormulaLookup "01c" f1 s3 Nothing
+
+fm2  = LookupMap [Formula s2 g2]
+g1f2 = setFormulae fm2 g1f1
+f2   = getFormulae g1f2
+testGraphFormula02a = testFormulaLookup "02a" f2 s1 Nothing
+testGraphFormula02b = testFormulaLookup "02b" f2 s2 (Just g2)
+testGraphFormula02c = testFormulaLookup "02c" f2 s3 Nothing
+
+fm3  = LookupMap [Formula s1 g1,Formula s2 g2,Formula s3 g3]
+g1f3 = setFormulae fm3 g1f1
+f3   = getFormulae g1f3
+testGraphFormula03a = testFormulaLookup "03a" f3 s1 (Just g1)
+testGraphFormula03b = testFormulaLookup "03b" f3 s2 (Just g2)
+testGraphFormula03c = testFormulaLookup "03c" f3 s3 (Just g3)
+
+fm4  = LookupMap [Formula s1 g1,Formula s2 g3,Formula s3 g3]
+g1f4 = setFormulae fm4 g1f1
+f4   = getFormulae g1f4
+testGraphFormula04a = testFormulaLookup "04a" f4 s1 (Just g1)
+testGraphFormula04b = testFormulaLookup "04b" f4 s2 (Just g3)
+testGraphFormula04c = testFormulaLookup "04c" f4 s3 (Just g3)
+
+fm5  = LookupMap [Formula s1 g1,Formula s2 g4,Formula s3 g6]
+g1f5 = setFormulae fm5 g1f1
+f5   = getFormulae g1f5
+testGraphFormula05a = testFormulaLookup "05a" f5 s1 (Just g1)
+testGraphFormula05b = testFormulaLookup "05b" f5 s2 (Just g4)
+testGraphFormula05c = testFormulaLookup "05c" f5 s3 (Just g6)
+
+fm6  = LookupMap [Formula s1 g1,Formula s2 g5,Formula s3 g6]
+g1f6 = setFormulae fm6 g1f1
+f6   = getFormulae g1f6
+testGraphFormula06a = testFormulaLookup "06a" f6 s1 (Just g1)
+testGraphFormula06b = testFormulaLookup "06b" f6 s2 (Just g5)
+testGraphFormula06c = testFormulaLookup "06c" f6 s3 (Just g6)
+
+fm7  = LookupMap [Formula s1 g1,Formula s2 g7,Formula s3 g6]
+g1f7 = setFormulae fm7 g1f1
+f7   = getFormulae g1f7
+testGraphFormula07a = testFormulaLookup "07a" f7 s1 (Just g1)
+testGraphFormula07b = testFormulaLookup "07b" f7 s2 (Just g7)
+testGraphFormula07c = testFormulaLookup "07c" f7 s3 (Just g6)
+
+--  Same pattern as 1-3, but using base graph with more nodes used:
+--  The graph comparison results are expected to be different,
+--  because of formulae associated with nodes actually used in the
+--  graph
+g2f1 = g2
+f8   = getFormulae g2f1
+testGraphFormula08a = testFormulaLookup "08a" f8 s1 Nothing
+testGraphFormula08b = testFormulaLookup "08b" f8 s2 Nothing
+testGraphFormula08c = testFormulaLookup "08c" f8 s3 Nothing
+
+g2f2 = setFormulae fm2 g2f1
+f9   = getFormulae g2f2
+testGraphFormula09a = testFormulaLookup "09a" f9 s1 Nothing
+testGraphFormula09b = testFormulaLookup "09b" f9 s2 (Just g2)
+testGraphFormula09c = testFormulaLookup "09c" f9 s3 Nothing
+
+g2f3 = setFormulae fm3 g2f1
+f10   = getFormulae g2f3
+testGraphFormula10a = testFormulaLookup "10a" f10 s1 (Just g1)
+testGraphFormula10b = testFormulaLookup "10b" f10 s2 (Just g2)
+testGraphFormula10c = testFormulaLookup "10c" f10 s3 (Just g3)
+
+--  Comparison of graphs containing formulae.
+--  The intent is that graphs are matched if there is a bijection,
+--  where the matched nodes are associated with matching formulae.
+--  Definitions of formulae not used in the graphs don't affect the
+--  match result.
+testGraphFormula11a = testGraphEq "g1f1-g1f1" True  g1f1 g1f1
+testGraphFormula11b = testGraphEq "g1f1-g1f2" True  g1f1 g1f2
+testGraphFormula11c = testGraphEq "g1f1-g1f3" False g1f1 g1f3
+
+testGraphFormula12a = testGraphEq "g1f2-g1f1" True  g1f2 g1f1
+testGraphFormula12b = testGraphEq "g1f2-g1f2" True  g1f2 g1f2
+testGraphFormula12c = testGraphEq "g1f2-g1f3" False g1f2 g1f3
+
+testGraphFormula13a = testGraphEq "g1f3-g1f1" False g1f3 g1f1
+testGraphFormula13b = testGraphEq "g1f3-g1f2" False g1f3 g1f2
+testGraphFormula13c = testGraphEq "g1f3-g1f3" True  g1f3 g1f3
+
+testGraphFormula14a = testGraphEq "g1f4-g1f3" True  g1f4 g1f3
+testGraphFormula14b = testGraphEq "g1f4-g1f4" True  g1f4 g1f4
+testGraphFormula14c = testGraphEq "g1f4-g1f5" True  g1f4 g1f5
+
+testGraphFormula15a = testGraphEq "g1f5-g1f5" True  g1f5 g1f5
+testGraphFormula15b = testGraphEq "g1f5-g1f6" True  g1f5 g1f6
+testGraphFormula15c = testGraphEq "g1f5-g1f7" True  g1f5 g1f7
+
+testGraphFormula16a = testGraphEq "g1f6-g1f5" True  g1f6 g1f5
+testGraphFormula16b = testGraphEq "g1f6-g1f6" True  g1f6 g1f6
+testGraphFormula16c = testGraphEq "g1f6-g1f7" True  g1f6 g1f7
+
+testGraphFormula17a = testGraphEq "g1f7-g1f5" True  g1f7 g1f5
+testGraphFormula17b = testGraphEq "g1f7-g1f6" True  g1f7 g1f6
+testGraphFormula17c = testGraphEq "g1f7-g1f7" True  g1f7 g1f7
+
+testGraphFormula18a = testGraphEq "g2f1-g2f1" True  g2f1 g2f1
+testGraphFormula18b = testGraphEq "g2f1-g2f2" False g2f1 g2f2
+testGraphFormula18c = testGraphEq "g2f1-g2f3" False g2f1 g2f3
+
+testGraphFormula19a = testGraphEq "g2f2-g2f1" False g2f2 g2f1
+testGraphFormula19b = testGraphEq "g2f2-g2f2" True  g2f2 g2f2
+testGraphFormula19c = testGraphEq "g2f2-g2f3" False g2f2 g2f3
+
+testGraphFormula20a = testGraphEq "g2f3-g2f1" False g2f3 g2f1
+testGraphFormula20b = testGraphEq "g2f3-g2f2" False g2f3 g2f2
+testGraphFormula20c = testGraphEq "g2f3-g2f3" True  g2f3 g2f3
+
+--  Test methods to set/access an individual formula in a graph
+g1f21 = setFormula  (Formula s1 g7) g1f2
+f21   = getFormulae g1f21
+testGraphFormula21a = testFormulaLookup "21a" f21 s1 (Just g7)
+testGraphFormula21b = testFormulaLookup "21b" f21 s2 (Just g2)
+testGraphFormula21c = testFormulaLookup "21c" f21 s3 Nothing
+
+g1f22 = setFormula  (Formula s1 g1) g1f21
+f22   = getFormulae g1f22
+testGraphFormula22a = testFormulaLookup "22a" f22 s1 (Just g1)
+testGraphFormula22b = testFormulaLookup "22b" f22 s2 (Just g2)
+testGraphFormula22c = testFormulaLookup "22c" f22 s3 Nothing
+
+f23a = getFormula g1f22 s1
+f23b = getFormula g1f22 s2
+f23c = getFormula g1f22 s3
+testGraphFormula23a = testMaybeEq "23a" f23a (Just g1)
+testGraphFormula23b = testMaybeEq "23b" f23b (Just g2)
+testGraphFormula23c = testMaybeEq "23c" f23c Nothing
+
+
+testGraphFormulaSuite = TestLabel "TestFormulae" $ TestList
+  [ testGraphFormula01a, testGraphFormula01b, testGraphFormula01c
+  , testGraphFormula02a, testGraphFormula02b, testGraphFormula02c
+  , testGraphFormula03a, testGraphFormula03b, testGraphFormula03c
+  , testGraphFormula04a, testGraphFormula04b, testGraphFormula04c
+  , testGraphFormula05a, testGraphFormula05b, testGraphFormula05c
+  , testGraphFormula06a, testGraphFormula06b, testGraphFormula06c
+  , testGraphFormula07a, testGraphFormula07b, testGraphFormula07c
+  , testGraphFormula08a, testGraphFormula08b, testGraphFormula08c
+  , testGraphFormula09a, testGraphFormula09b, testGraphFormula09c
+  , testGraphFormula10a, testGraphFormula10b, testGraphFormula10c
+  , testGraphFormula11a, testGraphFormula11b, testGraphFormula11c
+  , testGraphFormula12a, testGraphFormula12b, testGraphFormula12c
+  , testGraphFormula13a, testGraphFormula13b, testGraphFormula13c
+  , testGraphFormula14a, testGraphFormula14b, testGraphFormula14c
+  , testGraphFormula15a, testGraphFormula15b, testGraphFormula15c
+  , testGraphFormula16a, testGraphFormula16b, testGraphFormula16c
+  , testGraphFormula17a, testGraphFormula17b, testGraphFormula17c
+  , testGraphFormula18a, testGraphFormula18b, testGraphFormula18c
+  , testGraphFormula19a, testGraphFormula19b, testGraphFormula19c
+  , testGraphFormula20a, testGraphFormula20b, testGraphFormula20c
+  , testGraphFormula21a, testGraphFormula21b, testGraphFormula21c
+  , testGraphFormula22a, testGraphFormula22b, testGraphFormula22c
+  , testGraphFormula23a, testGraphFormula23b, testGraphFormula23c
+  ]
+
+------------------------------------------------------------
+--  Test fmap translations of graphs, including formulae
+------------------------------------------------------------
+
+translate lab
+    | lab == s1 = st1
+    | lab == s2 = st2
+    | lab == s3 = st3
+    | otherwise = lab
+
+translateM lab
+    | lab == s1   = Just st1
+    | lab == s2   = Just st2
+    | lab == s3   = Just st3
+    | isBlank lab = Nothing
+    | otherwise   = Just lab
+
+gt1f1a = gt1
+gt1f1b = fmap translate g1f1
+ft1    = getFormulae gt1f1b
+testGraphTranslate01a = testGraphEq "gt1f1a-gt1f1b" True gt1f1a gt1f1b
+testGraphTranslate01b = testFormulaLookup "GraphTranslate01b" ft1 st1 Nothing
+testGraphTranslate01c = testFormulaLookup "GraphTranslate01c" ft1 st2 Nothing
+testGraphTranslate01d = testFormulaLookup "GraphTranslate01d" ft1 st3 Nothing
+testGraphTranslate01e = testEq "gt1f1a-gt1f1b" gt1f1a gt1f1b
+
+ftm2   = LookupMap [Formula st2 gt2]
+gt1f2a = setFormulae ftm2 gt1
+gt1f2b = fmap translate g1f2
+ft2    = getFormulae gt1f2b
+testGraphTranslate02a = testGraphEq "gt1f2a-gt1f2b" True gt1f2a gt1f2b
+testGraphTranslate02b = testFormulaLookup "GraphTranslate02b" ft2 st1 Nothing
+testGraphTranslate02c = testFormulaLookup "GraphTranslate02c" ft2 st2 (Just gt2)
+testGraphTranslate02d = testFormulaLookup "GraphTranslate02d" ft2 st3 Nothing
+
+ftm3   = LookupMap [Formula st1 gt1,Formula st2 gt2,Formula st3 gt3]
+gt1f3a = setFormulae ftm3 gt1
+gt1f3b = fmap translate g1f3
+ft3    = getFormulae gt1f3b
+testGraphTranslate03a = testGraphEq "gt1f3a-gt1f3b" True gt1f3a gt1f3b
+testGraphTranslate03b = testFormulaLookup "GraphTranslate03b" ft3 st1 (Just gt1)
+testGraphTranslate03c = testFormulaLookup "GraphTranslate03c" ft3 st2 (Just gt2)
+testGraphTranslate03d = testFormulaLookup "GraphTranslate03d" ft3 st3 (Just gt3)
+
+gt2f1a = gt2
+gt2f1b = fmap translate g2f1
+ft4    = getFormulae gt2f1b
+testGraphTranslate04a = testGraphEq "gt2f1a-gt2f1b" True gt2f1a gt2f1b
+testGraphTranslate04b = testFormulaLookup "GraphTranslate04b" ft4 st1 Nothing
+testGraphTranslate04c = testFormulaLookup "GraphTranslate04c" ft4 st2 Nothing
+testGraphTranslate04d = testFormulaLookup "GraphTranslate04d" ft4 st3 Nothing
+
+gt2f2a = setFormulae ftm2 gt2
+gt2f2b = fmap translate g2f2
+ft5    = getFormulae gt2f2b
+testGraphTranslate05a = testGraphEq "gt2f2a-gt2f2b" True gt2f2a gt2f2b
+testGraphTranslate05b = testFormulaLookup "GraphTranslate05b" ft5 st1 Nothing
+testGraphTranslate05c = testFormulaLookup "GraphTranslate05c" ft5 st2 (Just gt2)
+testGraphTranslate05d = testFormulaLookup "GraphTranslate05d" ft5 st3 Nothing
+
+gt2f3a = setFormulae ftm3 gt2
+gt2f3b = fmap translate g2f3
+ft6    = getFormulae gt2f3b
+testGraphTranslate06a = testGraphEq "gt2f3a-gt2f3b" True gt2f3a gt2f3b
+testGraphTranslate06b = testFormulaLookup "GraphTranslate06b" ft6 st1 (Just gt1)
+testGraphTranslate06c = testFormulaLookup "GraphTranslate06c" ft6 st2 (Just gt2)
+testGraphTranslate06d = testFormulaLookup "GraphTranslate06d" ft6 st3 (Just gt3)
+
+-- Monadic translate tests, using Maybe Monad
+gt1f1aM = Just gt1
+gt1f1bM = fmapM translateM g1f1
+ft1M    = getFormulae $ fromJust gt1f1bM
+testGraphTranslate07a = testGraphEqM "gt1f1aM-gt1f1bM" True gt1f1aM gt1f1bM
+testGraphTranslate07b = testFormulaLookup "GraphTranslate07b" ft1M st1 Nothing
+testGraphTranslate07c = testFormulaLookup "GraphTranslate07c" ft1M st2 Nothing
+testGraphTranslate07d = testFormulaLookup "GraphTranslate07d" ft1M st3 Nothing
+testGraphTranslate07e = testEq "gt1f1aM-gt1f1bM" gt1f1aM gt1f1bM
+
+gt1f2aM = Just gt1f2a
+gt1f2bM = fmapM translateM g1f2
+ft2M    = getFormulae $ fromJust gt1f2bM
+testGraphTranslate08a = testGraphEqM "gt1f2aM-gt1f2bM" True gt1f2aM gt1f2bM
+testGraphTranslate08b = testFormulaLookup "GraphTranslate08b" ft2M st1 Nothing
+testGraphTranslate08c = testFormulaLookup "GraphTranslate08c" ft2M st2 (Just gt2)
+testGraphTranslate08d = testFormulaLookup "GraphTranslate08d" ft2M st3 Nothing
+testGraphTranslate08e = testEq "gt1f2aM-gt1f2bM" gt1f2aM gt1f1bM
+
+gt1f5M = fmapM translateM g1f5
+testGraphTranslate09a = testEq "GraphTranslate09a" Nothing gt1f5M
+
+testGraphTranslateSuite = TestLabel "TestTranslate" $ TestList
+  [ testGraphTranslate01a
+  , testGraphTranslate01b, testGraphTranslate01c, testGraphTranslate01d
+  , testGraphTranslate01e
+  , testGraphTranslate02a
+  , testGraphTranslate02b, testGraphTranslate02c, testGraphTranslate02d
+  , testGraphTranslate03a
+  , testGraphTranslate03b, testGraphTranslate03c, testGraphTranslate03d
+  , testGraphTranslate04a
+  , testGraphTranslate04b, testGraphTranslate04c, testGraphTranslate04d
+  , testGraphTranslate05a
+  , testGraphTranslate05b, testGraphTranslate05c, testGraphTranslate05d
+  , testGraphTranslate06a
+  , testGraphTranslate06b, testGraphTranslate06c, testGraphTranslate06d
+  , testGraphTranslate07a
+  , testGraphTranslate07b, testGraphTranslate07c, testGraphTranslate07d
+  , testGraphTranslate07e
+  , testGraphTranslate08a
+  , testGraphTranslate08b, testGraphTranslate08c, testGraphTranslate08d
+  , testGraphTranslate08e
+  , testGraphTranslate09a
+  ]
+
+------------------------------------------------------------
+--  Test merge with conflicting bnodes, including formulae
+------------------------------------------------------------
+
+testMerge :: String -> RDFGraph -> RDFGraph -> RDFGraph -> Test
+testMerge lab g1 g2 gr =
+    TestCase ( assertEquiv ("testMerge:"++lab) gr (merge g1 g2) )
+        where
+            grequiv g1 g2 = (getArcs g1) `equiv` (getArcs g2)
+            assertEquiv lab g1 g2 = assertString $
+                if grequiv g1 g2 then ""
+                else lab++"\nExpected: "++(show g1)++"\nObtained: "++(show g2)
+
+
+testEquiv :: (Eq a) => String -> [a] -> [a] -> Test
+testEquiv lab l1 l2 = TestCase $ assertBool lab (l1 `equiv` l2)
+
+tm01 = arc s1  p1 b1
+tm02 = arc b1  p1 o2
+tm03 = arc b1  p1 o3
+tm04 = arc b2  p2 b3
+tm05 = arc b3  p2 b4
+tm06 = arc bb  p2 b5
+tm07 = arc s2  p3 v1
+tm08 = arc s3  p3 v2
+tm09 = arc s4  p1 c1
+tm10 = arc c2  p1 o4
+tm11 = arc s4  p2 ba1
+tm12 = arc ba2 p2 o4
+tm13 = arc s4  p2 bn3
+tm14 = arc bn4 p2 o4
+
+tm21 = arc s1  p1 b6
+tm22 = arc b6  p1 o2
+tm23 = arc b6  p1 o3
+tm24 = arc b7  p2 b8
+tm25 = arc b8  p2 b9
+tm26 = arc bb0 p2 b10
+tm27 = arc s2  p3 v3
+tm28 = arc s3  p3 v4
+tm29 = arc s4  p1 c3
+tm30 = arc c4  p1 o4
+tm31 = arc s4  p2 ba3
+tm32 = arc ba4 p2 o4
+tm33 = arc s4  p2 bn5
+tm34 = arc bn6 p2 o4
+
+tm41  = arc s1  p1 b2
+tm42  = arc b2  p1 o2
+tm43  = arc b2  p1 o3
+tm44  = arc b4  p2 b5
+
+tm41a = arc s1  p1 b4
+tm44a = arc b5  p2 b6
+
+tm67 = arc s2  p3 v3
+tm68 = arc s3  p3 v4
+tm69 = arc s4  p1 c3
+tm70 = arc c4  p1 o4
+tm71 = arc s4  p2 ba3
+tm72 = arc ba4 p2 o4
+tm73 = arc s4  p2 bn5
+tm74 = arc bn6 p2 o4
+
+gm1 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08
+                       ,tm09,tm10,tm11,tm12,tm13,tm14
+                       ]
+        }
+
+gm11  = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm01,tm02,tm03,tm04,tm05,tm06,tm07,tm08
+                       ,tm09,tm10,tm11,tm12,tm13,tm14
+                       ,tm21,tm22,tm23,tm24,tm25,tm26,tm27,tm28
+                       ,tm29,tm30,tm31,tm32,tm33,tm34
+                       ]
+        }
+
+gm2 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm01]
+        }
+
+gm2f = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm41]
+        }
+
+gm22 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm01,tm41]
+        }
+
+gm3 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm04]
+        }
+
+gm3f = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm44]
+        }
+
+gm33 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm04,tm44]
+        }
+
+gm4 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm01,tm04]
+        }
+
+gm44 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm01,tm04,tm41a,tm44a]
+        }
+
+gm5 = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap [Formula b1 gm2]
+        , statements = [tm01,tm02,tm03]
+        }
+
+gm55 = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap [Formula b1 gm2,Formula b2 gm2f]
+        , statements = [tm01,tm02,tm03,tm41,tm42,tm43]
+        }
+
+gm6 = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap [Formula ba1 gm2,Formula bn3 gm3]
+        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14]
+        }
+
+gm66 = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap
+                       [Formula ba1 gm2,Formula bn3 gm3
+                       ,Formula ba3 gm2f,Formula bn5 gm3f
+                       ]
+        , statements = [tm07,tm08,tm09,tm10,tm11,tm12,tm13,tm14
+                       ,tm67,tm68,tm69,tm70,tm71,tm72,tm73,tm74
+                       ]
+        }
+
+
+tm81  = arc b1 p1 v1
+tm82  = arc b2 p2 v2
+tm811 = arc b1 p1 v3
+tm821 = arc b2 p2 v4
+tm812 = arc b1 p1 vb3
+tm822 = arc b2 p2 vb4
+
+gm81 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm81,tm82]
+        }
+
+gm82 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm811,tm821]
+        }
+gm82a = remapLabels [v1,v2] [v1,v2,b1,b2] id gm81
+gm82b1 = remapLabelList [v1,v2] [v1,v2,b1,b2]
+gm82b2 = [(v1,v3),(v2,v4)]
+
+gm83 = NSGraph
+        { namespaces = nslist
+        , formulae   = emptyFormulaMap
+        , statements = [tm811,tm821]
+        }
+gm83a = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm81
+
+gm84  = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap [Formula b1 gm81,Formula v2 gm81]
+        , statements = [tm81,tm82]
+        }
+
+gm85 = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap [Formula b1 gm82,Formula v4 gm82]
+        , statements = [tm811,tm821]
+        }
+gm85a = remapLabels [v1,v2] [v1,v2,b1,b2] id gm84
+
+gm86 = NSGraph
+        { namespaces = nslist
+        , formulae   = LookupMap [Formula b1 gm82,Formula vb4 gm82]
+        , statements = [tm812,tm822]
+        }
+gm86a = remapLabels [v1,v2] [v1,v2,b1,b2] makeBlank gm84
+
+testMerge01 = testMerge "01" gm1 gm1 gm11
+testMerge02 = testMerge "02" gm2 gm2 gm22
+testMerge03 = testMerge "03" gm3 gm3 gm33
+testMerge04 = testMerge "04" gm4 gm4 gm44
+testMerge05 = testMerge "05" gm5 gm5 gm55
+testMerge06 = testMerge "06" gm6 gm6 gm66
+
+testRemap07 = testGraphEq "Remap07" True gm82 gm82a
+testRemapList07 = testEquiv "testRemapList07" gm82b2 gm82b1
+testRemap08 = testGraphEq "Remap08" True gm83 gm83a
+testRemap09 = testGraphEq "Remap09" True gm85 gm85a
+testRemap10 = testGraphEq "Remap10" True gm86 gm86a
+
+testMergeSuite = TestList
+  [ testMerge01
+  , testMerge02
+  , testMerge03
+  , testMerge04
+  , testMerge05
+  , testMerge06
+  , testRemap07
+  , testRemapList07
+  , testRemap08
+  , testRemap09
+  , testRemap10
+  ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ testLangEqSuite
+  , testNodeEqSuite
+  , testNodeClassSuite
+  , testNodeLocalSuite
+  , testNewNodeSuite
+  , testNodeOrdSuite
+  , testLabelOtherSuite
+  , testStmtEqSuite
+  , testGraphEqSuite
+  , testGraphEqSelSuite
+  , testGraphFormulaSuite
+  , testGraphTranslateSuite
+  , testMergeSuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+geq  = testGraphEqSuite
+nord = testNodeOrdSuite
+gtr  = testGraphTranslateSuite
+
+gmm g1 g2 = grMatchMap g1 g2
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFGraphTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.32 $
+-- $Log: RDFGraphTest.hs,v $
+-- Revision 1.32  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.31  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.30  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.29  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.28  2003/11/24 15:46:04  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.27  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.26  2003/10/01 00:36:25  graham
+-- Added RDFGraph method to test for container membership property label.
+-- Added RDFQuery filter function to select container membership properties.
+--
+-- Revision 1.25  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.24  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.23  2003/07/02 21:27:30  graham
+-- Graph closure with instance rule tested.
+-- About to change ProofTest for graph forward chaining to return
+-- a single result graph.
+--
+-- Revision 1.22  2003/07/01 14:20:30  graham
+-- Added instance entailment to proof check module.
+--
+-- Revision 1.21  2003/06/30 19:07:00  graham
+-- Instance entailment, subgraph entailment and simple entailment
+-- tests now working.
+--
+-- Revision 1.20  2003/06/17 15:43:35  graham
+-- remapNodes now accepts a node-mapping function rather than just
+-- a Boolean to control conversion of query variable nodes to blank
+-- nodes, and who knows what else.
+--
+-- Revision 1.19  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.18  2003/06/12 00:49:05  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--
+-- Revision 1.17  2003/06/10 17:38:34  graham
+-- Remove some unneeded calss constraints from data type declarations
+-- Reworked NSGraph to be an instance of Functor, replacing function
+-- gmap with fmap.  Graph formulae are still not handled well:  the data types
+-- will need re-working so that a "Formula lb" type constructor can be
+-- introduced having the correct (* -> *) kind to be a Functor.
+--
+-- Revision 1.16  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.15  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.14  2003/05/29 00:57:37  graham
+-- Resolved swish performance problem, which turned out to an inefficient
+-- method used by the parser to add arcs to a graph.
+--
+-- Revision 1.13  2003/05/27 19:15:50  graham
+-- Graph merge (with blank node renaming) complete and passes tests.
+--
+-- Revision 1.12  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.11  2003/05/23 19:33:36  graham
+-- Added and tested RDF graph label translation functions
+--
+-- Revision 1.10  2003/05/14 16:50:32  graham
+-- Graph matching seems solid now:
+-- RDFGraphTest and N3ParserTest pass all tests
+-- Updated TODO file with comments from code
+--
+-- Revision 1.9  2003/05/08 18:55:36  graham
+-- Updated graph matching module to deal consistently
+-- with graphs containing formulae.  All graph tests now
+-- run OK, but the GraphMatch module is a mess and
+-- desperately needs restructuring.  Also, graph matching
+-- performance needs to be improved.
+--
+-- Revision 1.8  2003/05/07 23:58:09  graham
+-- More restructuring.
+-- RDFGraphTest runs OK.
+-- N3ParserTest needs to be updated to use new structure for formulae.
+--
+-- Revision 1.7  2003/05/07 19:25:00  graham
+-- Restructured formula handling in RDF graph
+--
+-- Revision 1.6  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.5  2003/04/17 00:35:39  graham
+-- Added module N3ParserTest
+-- N3parser is mostly working
+-- Formulae remain to test
+--
+-- Revision 1.4  2003/04/15 21:40:54  graham
+-- N3Parser compiles
+-- Some small changes to RDFGraph
+-- Added some QName methods
+--
+-- Revision 1.3  2003/04/10 20:08:39  graham
+-- Reorganized RDFGraph naming (RDFGraphTest OK)
+-- Progressing N3Parser
+--
+-- Revision 1.2  2003/04/10 15:06:30  graham
+-- RDFGraph now passes all test cases
+--
+-- Revision 1.1  2003/03/28 21:50:22  graham
+-- Graph equality coded and nearly working
+--
+-- Revision 1.1  2003/03/12 23:00:43  graham
+-- Graph model coded and working, except for graph isomorphism test.
+--

+ Swish/HaskellRDF/RDFProof.hs view
@@ -0,0 +1,481 @@+{-# OPTIONS -XFlexibleInstances #-}
+{-# OPTIONS -XUndecidableInstances #-}
+--------------------------------------------------------------------------------
+--  $Id: RDFProof.hs,v 1.22 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFProof
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + multi-parameter classes
+--
+--  This module instantiates the 'Proof' framework for
+--  constructing proofs over RDFGraph expressions.
+--  The intent is that this can be used to test some
+--  correspondences between the RDF Model theory and
+--  corresponding proof theory based on closure rules
+--  applied to the graph, per <http://www.w3.org/TR/rdf-mt/>.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFProof
+    ( RDFProof, RDFProofStep
+    , makeRDFProof, makeRDFProofStep
+    , makeRdfInstanceEntailmentRule
+    , makeRdfSubgraphEntailmentRule
+    , makeRdfSimpleEntailmentRule )
+where
+
+import Swish.HaskellRDF.RDFQuery
+    (  rdfQueryInstance
+    , rdfQuerySubs 
+    )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFRuleset )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..), RDFGraph
+    --, makeBlank
+    , merge , allLabels , remapLabelList
+    {-, newNode, newNodes
+    , toRDFGraph -}, emptyRDFGraph
+    )
+
+import Swish.HaskellRDF.VarBinding
+    (  makeVarBinding
+    )
+
+import Swish.HaskellRDF.Proof
+    ( Proof(..), Step(..) )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Rule(..) )++import Swish.HaskellUtils.Namespace+    ( ScopedName(..)+    )+
+import Swish.HaskellRDF.GraphClass
+    ( Label(..), LDGraph(..), replaceArcs )
+
+import Swish.HaskellUtils.LookupMap
+    ( makeLookupMap, mapFind )
+
+import Swish.HaskellUtils.ListHelpers
+    ( subset
+    , powerSet
+    , powerSequences_len
+    , flist
+    )
+
+------------------------------------------------------------
+--  Type instantiation of Proof framework for RDFGraph data
+------------------------------------------------------------
+--
+--  This is a partial instantiation of the proof framework.
+--  Details for applying inference rules are specific to the
+--  graph instance type.
+
+------------------------------------------------------------
+--  Proof datatypes for graph values
+------------------------------------------------------------
+
+-- |Instances of LDGraph are also instance of the
+--  Expression class, for which proofs can be constructed.
+--  The empty RDF graph is always True (other enduring
+--  truths are asserted as axioms.
+instance (Label lb, LDGraph lg lb) => Expression (lg lb) where
+    isValid gr = null $ getArcs gr
+
+------------------------------------------------------------
+--  Define RDF-specific types for proof framework
+------------------------------------------------------------
+
+type RDFProof     = Proof RDFGraph
+
+type RDFProofStep = Step RDFGraph
+
+------------------------------------------------------------
+--  Helper functions for constructing proofs on RDF graphs
+------------------------------------------------------------
+
+-- |Make an RDF graph proof step
+--
+--  rul     is a rule to use for this step
+--  ants    is a list of antecedent RDF formulae for this step
+--  con     is an RDF formula that is the consequent for this step
+--
+makeRDFProofStep ::
+    RDFRule -> [RDFFormula] -> RDFFormula
+    -> RDFProofStep
+makeRDFProofStep rul ants con = Step
+    { stepRule = rul
+    , stepAnt  = ants
+    , stepCon  = con
+    }
+
+-- |Make an RDF proof
+--
+--  rsets   is a list of RDF rulesets that constitute a proof context
+--          for this proof.
+--  base    is an initial statement from which the goal is claimed
+--          to be proven.
+--  goal    is a statement that is claimed to be proven.
+--
+makeRDFProof ::
+    [RDFRuleset] -> RDFFormula -> RDFFormula
+    -> [RDFProofStep]
+    -> RDFProof
+makeRDFProof rsets base goal steps = Proof
+    { proofContext = rsets
+    , proofInput   = base
+    , proofResult  = goal
+    , proofChain   = steps
+    }
+
+------------------------------------------------------------
+--  RDF instance entailment inference rule
+------------------------------------------------------------
+
+-- |Make an inference rule dealing with RDF instance entailment;
+--  i.e. entailments that are due to replacement of a URI or literal
+--  node with a blank node.
+--
+--  The part of this rule expected to be useful is 'checkInference'.
+--  The 'fwdApply' and 'bwdApply' functions defined here may return
+--  rather large results if applied to graphs with many variables or
+--  a large vocabulary, and are defined for experimentation.
+--
+--  Forward and backward chaining is performed with respect to a
+--  specified vocabulary.  In the case of backward chaining, it would
+--  otherwise be impossible to bound the options thus generated.
+--  In the case of forward chaining, it is often not desirable to
+--  have the properties generalized.  If forward or backward backward
+--  chaining will not be used, supply an empty vocabulary.
+--  Note:  graph method 'allNodes' can be used to obtain a list of all
+--  the subjects and objuects used ina  graph, not counting nested
+--  formulae;  use a call of the form:
+--    allNodes (not . labelIsVar) graph
+makeRdfInstanceEntailmentRule :: ScopedName -> [RDFLabel] -> RDFRule
+makeRdfInstanceEntailmentRule name vocab = newrule
+    where
+        newrule = Rule
+            { ruleName = name
+            , fwdApply = rdfInstanceEntailFwdApply vocab
+            , bwdApply = rdfInstanceEntailBwdApply vocab
+            , checkInference = rdfInstanceEntailCheckInference
+            }
+
+--  Instance entailment forward chaining
+--
+--  Note:  unless the initial graph is small, the total result
+--  here could be very large.  The existential generalizations are
+--  sequenced in increasing number of substitutions applied.
+--  This sequencing is determined by the powerset function used,
+--  which generates subsets in increasing order of size
+--  (see module 'ListHelpers').
+--
+--  The instances generated are all copies of the merge of the
+--  supplied graphs, with some or all of the non-variable nodes
+--  replaced by blank nodes.
+rdfInstanceEntailFwdApply :: [RDFLabel] -> [RDFGraph] -> [RDFGraph]
+rdfInstanceEntailFwdApply vocab ante =
+    let
+        --  Merge antecedents to single graph, renaming bnodes if needed.
+        --  (Null test and using 'foldl1' to avoid merging if possible.)
+        mergeGraph  = if null ante then emptyRDFGraph
+                        else (foldl1 merge ante)
+        --  Obtain lists of variable and non-variable nodes
+        --  (was: nonvarNodes = allLabels (not . labelIsVar) mergeGraph)
+        nonvarNodes = vocab
+        varNodes    = allLabels (labelIsVar) mergeGraph
+        --  Obtain list of possible remappings for non-variable nodes
+        mapList     = remapLabelList nonvarNodes varNodes
+        mapSubLists = powerSet mapList
+        mapGr ls gr = fmap (\l -> mapFind l l (makeLookupMap ls)) gr
+    in
+        --  Return all remappings of the original merged graph
+        flist (map mapGr mapSubLists) mergeGraph
+
+--  Instance entailment backward chaining (for specified vocabulary)
+--
+--  [[[TODO:  this is an incomplete implementation, there being no
+--  provision for instantiating some variables and leaving others
+--  alone.  This can be overcome in many cases by combining instance
+--  and subgraph chaining.
+--  Also, there is no provision for instantiating some variables in
+--  a triple and leaving others alone.  This may be fixed later if
+--  this function is really needed to be completely faithful to the
+--  precise notion of instance entailment.]]]
+rdfInstanceEntailBwdApply :: [RDFLabel] -> RDFGraph -> [[RDFGraph]]
+rdfInstanceEntailBwdApply vocab cons =
+    let
+        --  Obtain list of variable nodes
+        varNodes     = allLabels (labelIsVar) cons
+        --  Generate a substitution for each combination of variable
+        --  and vocabulary node.
+        varBindings  = map (makeVarBinding . zip varNodes) vocSequences
+        vocSequences = powerSequences_len (length varNodes) vocab
+    in
+        --  Generate a substitution for each combination of variable
+        --  and vocabulary:
+        [ rdfQuerySubs [v] cons | v <- varBindings ]
+
+--  Instance entailment inference checker
+rdfInstanceEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
+rdfInstanceEntailCheckInference ante cons =
+    let
+        mante = if null ante then emptyRDFGraph -- merged antecedents
+                    else (foldl1 merge ante)
+        qvars = rdfQueryInstance cons mante     -- all query matches
+        bsubs = rdfQuerySubs qvars cons         -- all back substitutions
+    in
+        --  Return True if any back-substitution matches the original
+        --  merged antecendent graph.
+        or (map (mante ==) bsubs)
+
+--  Instance entailment notes.
+--
+--  Relation to simple entailment (s-entails):
+--
+--  (1) back-substitution yields original graph
+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o1  by [_:o1/ex:o1]
+--
+--  (2) back-substitution yields original graph
+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o2  by [_:o2/ex:o1]
+--  ex:s1 ex:p1  _:o1             ex:s1 ex:p1 _:o3     [_:o3/_:o1]
+--
+--  (3) back-substitution does not yield original graph
+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 _:o2  by [_:o2/ex:o1]
+--  ex:s1 ex:p1  _:o1             ex:s1 ex:p1 _:o3     [_:o3/ex:o1]
+--
+--  (4) consider
+--  ex:s1 ex:p1 ex:o1  s-entails  ex:s1 ex:p1 ex:o1
+--  ex:s1 ex:p1 ex:o2             ex:s1 ex:p1 ex:o2
+--  ex:s1 ex:p1 ex:o3             ex:s1 ex:p1 _:o1
+--                                ex:s1 ex:p1 _:o2
+--  where [_:o1/ex:o1,_:o2/ex:o2] yields a simple entailment but not
+--  an instance entailment, but [_:o1/ex:o3,_:o2/ex:o3] is also
+--  (arguably) an instance entailment.  Therefore, it is not sufficient
+--  to look only at the "largest" substitutions to determine instance
+--  entailment.
+--
+--  All this means that when checking for instance entailment by
+--  back substitution, all of the query results must be checked.
+--  This seems clumsy.  If this function is heavily used with
+--  multiple query matches, a modified query that uses each
+--  triple of the target graph exactly once may be required.
+
+------------------------------------------------------------
+--  RDF subgraph entailment inference rule
+------------------------------------------------------------
+
+-- |Make an inference rule dealing with RDF subgraph entailment.
+--  The part of this rule expected to be useful is 'checkInference'.
+--  The 'fwdApply' function defined here may return rather large
+--  results.  But in the name of completeness and experimentation
+--  with the possibilities of lazy evaluation, it has been defined.
+--
+--  Backward chaining is not performed, as there is no reasonable way
+--  to choose a meaningful supergraph of that supplied.
+makeRdfSubgraphEntailmentRule :: ScopedName -> RDFRule
+makeRdfSubgraphEntailmentRule name = newrule
+    where
+        newrule = Rule
+            { ruleName = name
+            , fwdApply = rdfSubgraphEntailFwdApply
+            , bwdApply = const []
+            , checkInference = rdfSubgraphEntailCheckInference
+            }
+
+--  Subgraph entailment forward chaining
+--
+--  Note:  unless the initial graph is small, the total result
+--  here could be very large.  The subgraphs are sequenced in
+--  increasing size of the sub graph.  This sequencing is determined
+--  by the 'powerSet' function used which generates subsets in
+--  increasing order of size (see module 'ListHelpers').
+rdfSubgraphEntailFwdApply :: [RDFGraph] -> [RDFGraph]
+rdfSubgraphEntailFwdApply ante =
+    let
+        --  Merge antecedents to single graph, renaming bnodes if needed.
+        --  (Null test and using 'foldl1' to avoid merging if possible.)
+        mergeGraph  = if null ante then emptyRDFGraph
+                        else (foldl1 merge ante)
+    in
+        --  Return all subgraphs of the full graph constructed above
+        map (replaceArcs mergeGraph) (init $ powerSet $ getArcs mergeGraph)
+
+--  Subgraph entailment inference checker
+--
+--  This is of dubious utiltiy, as it doesn't allow for node renaming.
+--  The simple entailment inference rule is probably more useful here.
+rdfSubgraphEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
+rdfSubgraphEntailCheckInference ante cons =
+    let
+        --  Combine antecedents to single graph, renaming bnodes if needed.
+        --  (Null test and using 'foldl1' to avoid merging if possible.)
+        fullGraph  = if null ante then emptyRDFGraph
+                        else (foldl1 add ante)
+    in
+        --  Check each consequent graph arc is in the antecedent graph
+        getArcs cons `subset` getArcs fullGraph
+
+------------------------------------------------------------
+--  RDF simple entailment inference rule
+------------------------------------------------------------
+
+-- |Make an inference rule dealing with RDF simple entailment.
+--  The part of this rule expected to be useful is 'checkInference'.
+--  The 'fwdApply' and 'bwdApply' functions defined return null
+--  results, indicating that they are not useful for the purposes
+--  of proof discovery.
+makeRdfSimpleEntailmentRule :: ScopedName -> RDFRule
+makeRdfSimpleEntailmentRule name = newrule
+    where
+        newrule = Rule
+            { ruleName = name
+            , fwdApply = const []
+            , bwdApply = const []
+            , checkInference = rdfSimpleEntailCheckInference
+            }
+
+--  Simple entailment inference checker
+--
+--  Note:  antecedents here are presumed to share bnodes.
+--         (Use 'merge' instead of 'add' for non-shared bnodes)
+--
+rdfSimpleEntailCheckInference :: [RDFGraph] -> RDFGraph -> Bool
+rdfSimpleEntailCheckInference ante cons =
+    let agr = if null ante then emptyRDFGraph else foldl1 add ante
+    in
+        not $ null $ rdfQueryInstance cons agr
+
+{- original..
+        not $ null $ rdfQueryInstance cons (foldl1 merge ante)
+-}
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFProof.hs,v $
+-- $Author: graham $
+-- $Revision: 1.22 $
+-- $Log: RDFProof.hs,v $
+-- Revision 1.22  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.21  2003/12/16 07:05:37  graham
+-- Working on updated RDFProofContext
+--
+-- Revision 1.20  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.19  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.18  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.17  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.16  2003/09/30 20:02:39  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.15  2003/09/30 16:39:41  graham
+-- Refactor proof code to use new ruleset logic.
+-- Moved some support code from RDFProofCheck to RDFRuleset.
+--
+-- Revision 1.14  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.13  2003/07/02 21:27:30  graham
+-- Graph closure with instance rule tested.
+-- About to change ProofTest for graph forward chaining to return
+-- a single result graph.
+--
+-- Revision 1.12  2003/07/01 14:20:30  graham
+-- Added instance entailment to proof check module.
+--
+-- Revision 1.11  2003/06/30 19:07:00  graham
+-- Instance entailment, subgraph entailment and simple entailment
+-- tests now working.
+--
+-- Revision 1.10  2003/06/27 20:46:00  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.9  2003/06/25 21:16:53  graham
+-- Reworked N3 formatting logic to support proof display.
+-- Basic proof display is working.
+--
+-- Revision 1.8  2003/06/25 09:52:25  graham
+-- Replaced Rule class with algebraic data type
+--
+-- Revision 1.7  2003/06/24 23:08:18  graham
+-- Replaced Rule class with algebraic data type
+--
+-- Revision 1.6  2003/06/24 19:56:31  graham
+-- Basic proof-check now works
+--
+-- Revision 1.5  2003/06/19 19:49:07  graham
+-- RDFProofCheck compiles, but test fails
+--
+-- Revision 1.4  2003/06/18 18:40:08  graham
+-- Basic proof backchaining tests OK.
+-- Next:  add filtering on variable bindings.
+--
+-- Revision 1.3  2003/06/18 01:29:29  graham
+-- Fixed up some problems with backward chaining queries.
+-- Query test cases still to complete.
+-- Proof incomplete.
+--
+-- Revision 1.2  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.1  2003/06/12 00:49:06  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--

+ Swish/HaskellRDF/RDFProofContext.hs view
@@ -0,0 +1,890 @@+--------------------------------------------------------------------------------
+--  $Id: RDFProofContext.hs,v 1.13 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFProofContext
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains proof-context declarations based on
+--  the RDF, RDFS and RDF datatyping semantics specifications.
+--  These definitions consist of namespaces (for identification
+--  in proofs), axioms and inference rules.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFProofContext
+    ( rulesetRDF
+    , rulesetRDFS
+    , rulesetRDFD )
+where
+
+import Swish.HaskellRDF.BuiltInDatatypes
+    ( findRDFDatatype )
+
+import Swish.HaskellRDF.RDFProof
+    ( makeRdfSubgraphEntailmentRule
+    , makeRdfSimpleEntailmentRule )
+
+import Swish.HaskellRDF.RDFRuleset 
+    ( RDFFormula 
+    , makeRDFFormula
+    , makeN3ClosureRule
+    , makeN3ClosureSimpleRule
+    , makeN3ClosureModifyRule
+    , makeN3ClosureAllocatorRule
+    , makeNodeAllocTo )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding
+    , RDFVarBindingModify
+    , RDFVarBindingFilter
+    , rdfVarBindingUriRef, rdfVarBindingBlank
+    , rdfVarBindingLiteral
+    , rdfVarBindingUntypedLiteral 
+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
+    , rdfVarBindingMemberProp
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..)
+    , isUri, isDatatyped
+    , getLiteralText )
+
+import Swish.HaskellRDF.VarBinding
+    ( applyVarBinding
+    , addVarBinding
+    , VarBindingModify(..)
+    , makeVarFilterModify
+    , varFilterDisjunction+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( makeRuleset )
+
+import Swish.HaskellRDF.Datatype
+    ( typeMkCanonicalForm )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..), ScopedName(..)
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , scopeRDF
+    , scopeRDFS
+    , scopeRDFD
+    )
+
+import Data.Maybe
+    ( isJust, fromJust )
+
+import Control.Monad
+    ( liftM )
+
+------------------------------------------------------------
+--  Define query binding filter auxiliaries
+------------------------------------------------------------
+
+makeFormula :: Namespace -> String -> String -> RDFFormula
+makeFormula scope local gr =
+    makeRDFFormula scope local (prefixRDF++gr)
+
+requireAny :: [RDFVarBindingFilter] -> RDFVarBindingFilter
+requireAny rs = varFilterDisjunction rs
+
+isLiteralV            :: String -> RDFVarBindingFilter+isLiteralV    ('?':l) = rdfVarBindingLiteral        (Var l)
++isUntypedLitV         :: String -> RDFVarBindingFilter+isUntypedLitV ('?':l) = rdfVarBindingUntypedLiteral (Var l)
++isXMLLitV             :: String -> RDFVarBindingFilter+isXMLLitV     ('?':x) = rdfVarBindingXMLLiteral     (Var x)
++isUriRefV             :: String -> RDFVarBindingFilter+isUriRefV     ('?':u) = rdfVarBindingUriRef         (Var u)
++isBlankV              :: String -> RDFVarBindingFilter+isBlankV      ('?':b) = rdfVarBindingBlank          (Var b)
++isDatatypedV                  :: String -> String -> RDFVarBindingFilter+isDatatypedV  ('?':d) ('?':l) = rdfVarBindingDatatyped (Var d) (Var l)
++isMemberPropV         :: String -> RDFVarBindingFilter+isMemberPropV ('?':l) = rdfVarBindingMemberProp     (Var l)
+
++allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify
+allocateTo bv av = makeNodeAllocTo (vn bv) (vn av)
+    where
+        vn ('?':n) = Var n
+
+--  Create new binding for datatype
+valueSame :: String -> String -> String -> String -> RDFVarBindingModify
+valueSame val1 typ1 val2 typ2 =
+    sameDatatypedValue (vn val1) (vn typ1) (vn val2) (vn typ2)
+    where
+            vn ('?':n) = Var n
+
+--  Variable binding modifier to create new binding to a canonical
+--  form of a datatyped literal.
+sameDatatypedValue ::
+    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel -> RDFVarBindingModify
+sameDatatypedValue val1 typ1 val2 typ2 = VarBindingModify
+        { vbmName   = ScopedName namespaceRDFD "sameValue"
+        , vbmApply  = sameDatatypedValueApplyAll val1 typ1 val2 typ2
+        , vbmVocab  = [val1,typ1,val2,typ2]
+        , vbmUsage  = [[val2]]
+        }
+
+sameDatatypedValueApplyAll ::
+    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel
+    -> [RDFVarBinding]
+    -> [RDFVarBinding]
+sameDatatypedValueApplyAll val1 typ1 val2 typ2 vbinds =
+    {-
+    trace "\nsameDatatypedValueApplyAll:" $
+    seq (traceShow "\nval1:" val1) $
+    seq (traceShow "\ntyp1:" typ1) $
+    seq (traceShow "\nval2:" val2) $
+    seq (traceShow "\ntyp2:" typ2) $
+    seq (traceShow "\nvbinds:" vbinds) $
+    trace "\n" $
+    -}
+    concatMap (sameDatatypedValueApply val1 typ1 val2 typ2) vbinds
+
+--  Auxiliary function that handles variable binding updates
+--  for sameDatatypedValue
+sameDatatypedValueApply ::
+    RDFLabel -> RDFLabel -> RDFLabel -> RDFLabel
+    -> RDFVarBinding
+    -> [RDFVarBinding]
+sameDatatypedValueApply val1 typ1 val2 typ2 vbind =
+    {-
+    trace "\nsameDatatypedValueApply:" $
+    seq (traceShow "\nval1:"   val1) $
+    seq (traceShow "\ntyp1:"   typ1) $
+    seq (traceShow "\nval2:"   val2) $
+    seq (traceShow "\ntyp2:"   typ2) $
+    seq (traceShow "\nvbind:"  vbind) $
+    seq (traceShow "\nresult:" result) $
+    trace "\n" $
+    -}
+    result
+    where
+        v1    = applyVarBinding vbind val1
+        t1    = applyVarBinding vbind typ1
+        t2    = applyVarBinding vbind typ2
+        sametype = getCanonical v1 t1 t2
+        result   =
+            if (isUri t1) && (isUri t2) then
+                if (t1 == t2) then
+                    if isJust sametype then
+                        [addVarBinding val2 (fromJust $ sametype) vbind]
+                    else
+                        []
+                else
+                    error "subtype conversions not yet defined"
+            else
+                []
+
+getCanonical :: RDFLabel -> RDFLabel -> RDFLabel -> Maybe RDFLabel
+getCanonical v1 t1 t2 =
+    if (isDatatyped dqn1 v1) && (isJust mdt1) then
+        liftM mkLit $ typeMkCanonicalForm dt1 (getLiteralText v1)
+    else
+        Nothing
+    where
+        dqn1  = case t1 of { (Res dqnam) -> dqnam }
+        dqn2  = case t2 of { (Res dqnam) -> dqnam }
+        mdt1  = findRDFDatatype dqn1
+        dt1   = fromJust mdt1
+        mkLit st = Lit st (Just dqn2)
+
+{- -- Test data
+qnamint = ScopedName namespaceXSD "integer"
+xsdint  = Res qnamint
+lab010  = Lit "010" (Just qnamint)
+can010  = getCanonical lab010 xsdint xsdint
+nsex    = Namespace "ex" "http://example.org/"
+resexp  = Res (ScopedName nsex "p")
+resexs  = Res (ScopedName nsex "s")
+
+vara = Var "a"
+varb = Var "b"
+varc = Var "c"
+vard = Var "d"
+varp = Var "p"
+vars = Var "s"
+vart = Var "t"
+
+vb1  = makeVarBinding [(vara,lab010),(varb,xsdint),(vard,xsdint)]
+vb2  = sameDatatypedValueApply vara varb varc vard vb1
+vb3  = vbmApply (sameDatatypedValue vara varb varc vard) [vb1]
+vb3t = vb3 == vb2
+vb4  = vbmApply (valueSame "?a" "?b" "?c" "?d") [vb1]
+vb4t = vb4 == vb2
+vb5  = vbmApply (valueSame "?a" "?b" "?c" "?b") [vb1]
+vb5t = vb5 == vb2
+
+vb6  = makeVarBinding [(vars,lab010),(varp,resexp),(vara,resexs),(vard,xsdint)]
+vb7  = vbmApply (valueSame "?s" "?d" "?t" "?d") [vb6]
+vb8  = makeVarBinding [(vars,lab010),(varp,resexp),(vara,resexs),(vard,xsdint)
+                      ,(vart,fromJust can010)]
+vb8t = vb7 == [vb8]
+-- -}
+
+------------------------------------------------------------
+--  Common definitions
+------------------------------------------------------------
+
+prefixRDF :: String+prefixRDF =
+    "@prefix rdf:  <" ++ nsURI namespaceRDF  ++ "> . \n" ++
+    "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++
+    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
+    " \n"
+
+------------------------------------------------------------
+--  Define RDF axioms
+------------------------------------------------------------
+
+-- scopeRDF  = Namespace "rs-rdf"  "http://id.ninebynine.org/2003/Ruleset/rdf#"
+
+--  RDF axioms (from RDF semantics document, section 3.1)
+--
+--  (See also, container property rules below)
+--
+rdfa1 :: RDFFormula+rdfa1 = makeFormula scopeRDF "a1" "rdf:type      rdf:type rdf:Property ."
++rdfa2 :: RDFFormula+rdfa2 = makeFormula scopeRDF "a2" "rdf:subject   rdf:type rdf:Property ."
++rdfa3 :: RDFFormula+rdfa3 = makeFormula scopeRDF "a3" "rdf:predicate rdf:type rdf:Property ."
++rdfa4 :: RDFFormula+rdfa4 = makeFormula scopeRDF "a4" "rdf:object    rdf:type rdf:Property ."
++rdfa5 :: RDFFormula+rdfa5 = makeFormula scopeRDF "a5" "rdf:first     rdf:type rdf:Property ."
++rdfa6 :: RDFFormula+rdfa6 = makeFormula scopeRDF "a6" "rdf:rest      rdf:type rdf:Property ."
++rdfa7 :: RDFFormula+rdfa7 = makeFormula scopeRDF "a7" "rdf:value     rdf:type rdf:Property ."
++rdfa8 :: RDFFormula+rdfa8 = makeFormula scopeRDF "a8" "rdf:nil       rdf:type rdf:List ."
+
+axiomsRDF :: [RDFFormula]+axiomsRDF =
+    [ rdfa1,  rdfa2,  rdfa3,  rdfa4,  rdfa5
+    , rdfa6,  rdfa7,  rdfa8
+    ]
+
+------------------------------------------------------------
+--  Define RDF rules
+------------------------------------------------------------
+
+--  RDF subgraph entailment (from RDF semantics document section 2)
+--
+-- rdfsub :: Swish.HaskellRDF.RDFRuleset.RDFRule 
+rdfsub = makeRdfSubgraphEntailmentRule (ScopedName scopeRDF "sub")
+
+--  RDF simple entailment (from RDF semantics document section 7.1)
+--  (Note: rules se1 and se2 are combined here, because the scope of
+--  the "allocatedTo" modifier is the application of a single rule.)
+--
+rdfse = makeRdfSimpleEntailmentRule (ScopedName scopeRDF "se")
+
+--  RDF bnode-for-literal assignments (from RDF semantics document section 7.1)
+--
+rdflg = makeN3ClosureAllocatorRule scopeRDF "lg"
+            "?x  ?a ?l . "
+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l ."
+            (makeVarFilterModify $ isLiteralV "?l")
+            (allocateTo "?b" "?l")
+
+--  RDF bnode-for-literal back-tracking (from RDF semantics document section 7.1)
+--
+rdfgl = makeN3ClosureSimpleRule scopeRDF "gl"
+            "?x  ?a ?l . ?b rdf:_allocatedTo ?l . "
+            "?x  ?a ?b ."
+
+--  RDF entailment rules (from RDF semantics document section 7.2)
+--
+--  (Note, statements with property rdf:_allocatedTo are introduced to
+--  track bnodes introduced according to rule rdflf.)
+--
+rdfr1 = makeN3ClosureSimpleRule scopeRDF "r1"
+            "?x ?a ?y ."
+            "?a rdf:type rdf:Property ."
+
+rdfr2 = makeN3ClosureRule scopeRDF "r2"
+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "
+            "?b rdf:type rdf:XMLLiteral ."
+            (makeVarFilterModify $ isXMLLitV "?l")
+
+--  Container property axioms (from RDF semantics document section 3.1)
+--
+--  (Using here an inference rule with a filter in place of an axiom schema)
+--
+--  This is a restricted form of the given axioms, in that the axioms
+--  are asserted only for container membership terms that appear in
+--  the graph.
+--
+--  (This may be very inefficient for forward chaining when dealing with
+--  large graphs:  may need to look at query logic to see if the search for
+--  container membership properties can be optimized.  This may call for a
+--  custom inference rule.)
+--
+rdfcp1 = makeN3ClosureRule scopeRDF "cp1"
+            "?x  ?c ?y . "
+            "?c rdf:type rdf:Property ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfcp2 = makeN3ClosureRule scopeRDF "cp2"
+            "?c  ?p ?y . "
+            "?c rdf:type rdf:Property ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfcp3 = makeN3ClosureRule scopeRDF "cp3"
+            "?x  ?p ?c . "
+            "?c rdf:type rdf:Property ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+--  Collect RDF rules
+--
+rulesRDF =
+    [ rdfsub,     rdfse
+    , rdflg,      rdfgl
+    , rdfr1,      rdfr2
+    , rdfcp1,     rdfcp2,     rdfcp3
+    ]
+
+--  Define ruleset for RDF inference
+
+rulesetRDF = makeRuleset scopeRDF axiomsRDF rulesRDF
+
+------------------------------------------------------------
+--  Define RDFS axioms
+------------------------------------------------------------
+
+-- scopeRDFS = Namespace "rdfs" "http://id.ninebynine.org/2003/Ruleset/rdfs#"
+
+--  RDFS axioms (from RDF semantics document, section 4.1)
+--
+--  (See also, container property rules below)
+--
+
+rdfsa01 :: RDFFormula+rdfsa01 = makeFormula scopeRDFS "a01"
+    "rdf:type           rdfs:domain rdfs:Resource ."
+
+rdfsa02 :: RDFFormula+rdfsa02 = makeFormula scopeRDFS "a02"
+    "rdf:type           rdfs:range  rdfs:Class ."
+
+rdfsa03 :: RDFFormula+rdfsa03 = makeFormula scopeRDFS "a03"
+    "rdfs:domain        rdfs:domain rdf:Property ."
+
+rdfsa04 :: RDFFormula+rdfsa04 = makeFormula scopeRDFS "a04"
+    "rdfs:domain        rdfs:range  rdfs:Class ."
+
+rdfsa05 :: RDFFormula+rdfsa05 = makeFormula scopeRDFS "a05"
+    "rdfs:range         rdfs:domain rdf:Property ."
+
+rdfsa06 :: RDFFormula+rdfsa06 = makeFormula scopeRDFS "a06"
+    "rdfs:range         rdfs:range  rdfs:Class ."
+
+rdfsa07 :: RDFFormula+rdfsa07 = makeFormula scopeRDFS "a07"
+    "rdfs:subPropertyOf rdfs:domain rdf:Property ."
+
+rdfsa08 :: RDFFormula+rdfsa08 = makeFormula scopeRDFS "a08"
+    "rdfs:subPropertyOf rdfs:range  rdf:Property ."
+
+rdfsa09 :: RDFFormula+rdfsa09 = makeFormula scopeRDFS "a09"
+    "rdfs:subClassOf    rdfs:domain rdfs:Class ."
+
+rdfsa10 :: RDFFormula+rdfsa10 = makeFormula scopeRDFS "a10"
+    "rdfs:subClassOf    rdfs:range  rdfs:Class ."
+
+rdfsa11 :: RDFFormula+rdfsa11 = makeFormula scopeRDFS "a11"
+    "rdf:subject        rdfs:domain rdf:Statement ."
+
+rdfsa12 :: RDFFormula+rdfsa12 = makeFormula scopeRDFS "a12"
+    "rdf:subject        rdfs:range  rdfs:Resource ."
+
+rdfsa13 :: RDFFormula+rdfsa13 = makeFormula scopeRDFS "a13"
+    "rdf:predicate      rdfs:domain rdf:Statement ."
+
+rdfsa14 :: RDFFormula+rdfsa14 = makeFormula scopeRDFS "a14"
+    "rdf:predicate      rdfs:range  rdfs:Resource ."
+
+rdfsa15 :: RDFFormula+rdfsa15 = makeFormula scopeRDFS "a15"
+    "rdf:object         rdfs:domain rdf:Statement ."
+
+rdfsa16 :: RDFFormula+rdfsa16 = makeFormula scopeRDFS "a16"
+    "rdf:object         rdfs:range  rdfs:Resource ."
+
+rdfsa17 :: RDFFormula+rdfsa17 = makeFormula scopeRDFS "a17"
+    "rdfs:member        rdfs:domain rdfs:Resource ."
+
+rdfsa18 :: RDFFormula+rdfsa18 = makeFormula scopeRDFS "a18"
+    "rdfs:member        rdfs:range  rdfs:Resource ."
+
+rdfsa19 :: RDFFormula+rdfsa19 = makeFormula scopeRDFS "a19"
+    "rdf:first          rdfs:domain rdf:List ."
+
+rdfsa20 :: RDFFormula+rdfsa20 = makeFormula scopeRDFS "a20"
+    "rdf:first          rdfs:range  rdfs:Resource ."
+
+rdfsa21 :: RDFFormula+rdfsa21 = makeFormula scopeRDFS "a21"
+    "rdf:rest           rdfs:domain rdf:List ."
+
+rdfsa22 :: RDFFormula+rdfsa22 = makeFormula scopeRDFS "a22"
+    "rdf:rest           rdfs:range  rdf:List ."
+
+rdfsa23 :: RDFFormula+rdfsa23 = makeFormula scopeRDFS "a23"
+    "rdfs:seeAlso       rdfs:domain rdfs:Resource ."
+
+rdfsa24 :: RDFFormula+rdfsa24 = makeFormula scopeRDFS "a24"
+    "rdfs:seeAlso       rdfs:range  rdfs:Resource ."
+
+rdfsa25 :: RDFFormula+rdfsa25 = makeFormula scopeRDFS "a25"
+    "rdfs:isDefinedBy   rdfs:domain rdfs:Resource ."
+
+rdfsa26 :: RDFFormula+rdfsa26 = makeFormula scopeRDFS "a26"
+    "rdfs:isDefinedBy   rdfs:range  rdfs:Resource ."
+
+rdfsa27 :: RDFFormula+rdfsa27 = makeFormula scopeRDFS "a27"
+    "rdfs:isDefinedBy   rdfs:subPropertyOf rdfs:seeAlso ."
+
+rdfsa28 :: RDFFormula+rdfsa28 = makeFormula scopeRDFS "a28"
+    "rdfs:comment       rdfs:domain rdfs:Resource ."
+
+rdfsa29 :: RDFFormula+rdfsa29 = makeFormula scopeRDFS "a29"
+    "rdfs:comment       rdfs:range  rdfs:Literal ."
+
+rdfsa30 :: RDFFormula+rdfsa30 = makeFormula scopeRDFS "a30"
+    "rdfs:label         rdfs:domain rdfs:Resource ."
+
+rdfsa31 :: RDFFormula+rdfsa31 = makeFormula scopeRDFS "a31"
+    "rdfs:label         rdfs:range  rdfs:Literal ."
+
+rdfsa32 :: RDFFormula+rdfsa32 = makeFormula scopeRDFS "a32"
+    "rdf:value          rdfs:domain rdfs:Resource ."
+
+rdfsa33 :: RDFFormula+rdfsa33 = makeFormula scopeRDFS "a33"
+    "rdf:value          rdfs:range  rdfs:Resource ."
+
+rdfsa34 :: RDFFormula+rdfsa34 = makeFormula scopeRDFS "a34"
+    "rdf:Alt            rdfs:subClassOf    rdfs:Container ."
+
+rdfsa35 :: RDFFormula+rdfsa35 = makeFormula scopeRDFS "a35"
+    "rdf:Bag            rdfs:subClassOf    rdfs:Container ."
+
+rdfsa36 :: RDFFormula+rdfsa36 = makeFormula scopeRDFS "a36"
+    "rdf:Seq            rdfs:subClassOf    rdfs:Container ."
+
+rdfsa37 :: RDFFormula+rdfsa37 = makeFormula scopeRDFS "a37"
+    "rdfs:ContainerMembershipProperty rdfs:subClassOf rdf:Property ."
+
+rdfsa38 :: RDFFormula+rdfsa38 = makeFormula scopeRDFS "a38"
+    "rdf:XMLLiteral     rdf:type           rdfs:Datatype ."
+
+rdfsa39 :: RDFFormula+rdfsa39 = makeFormula scopeRDFS "a39"
+    "rdf:XMLLiteral     rdfs:subClassOf    rdfs:Literal ."
+
+rdfsa40 :: RDFFormula+rdfsa40 = makeFormula scopeRDFS "a40"
+    "rdfs:Datatype      rdfs:subClassOf    rdfs:Class ."
+
+axiomsRDFS :: [RDFFormula]+axiomsRDFS =
+    [          rdfsa01, rdfsa02, rdfsa03, rdfsa04
+    , rdfsa05, rdfsa06, rdfsa07, rdfsa08, rdfsa09
+    , rdfsa10, rdfsa11, rdfsa12, rdfsa13, rdfsa14
+    , rdfsa15, rdfsa16, rdfsa17, rdfsa18, rdfsa19
+    , rdfsa20, rdfsa21, rdfsa22, rdfsa23, rdfsa24
+    , rdfsa25, rdfsa26, rdfsa27, rdfsa28, rdfsa29
+    , rdfsa30, rdfsa31, rdfsa32, rdfsa33, rdfsa34
+    , rdfsa35, rdfsa36, rdfsa37, rdfsa38, rdfsa39
+    , rdfsa40
+    ]
+
+------------------------------------------------------------
+--  Define RDFS rules
+------------------------------------------------------------
+
+{-
+rdfr2 = makeN3ClosureRule scopeRDF "r2"
+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "
+            "?b rdf:type rdf:XMLLiteral ."
+            (makeVarFilterModify $ isXMLLit "?l")
+-}
+
+--  RDFS entailment rules (from RDF semantics document section 7.2)
+--
+--  (Note, statements with property rdf:_allocatedTo are introduced to
+--  track bnodes introduced according to rule rdflf.)
+--
+rdfsr1 = makeN3ClosureRule scopeRDFS "r1"
+            "?x  ?a ?b . ?b rdf:_allocatedTo ?l . "
+            "?b rdf:type rdfs:Literal ."
+            (makeVarFilterModify $ isUntypedLitV "?l" )
+
+rdfsr2 = makeN3ClosureSimpleRule scopeRDFS "r2"
+            "?x ?a ?y . ?a rdfs:domain ?z ."
+            "?x rdf:type ?z ."
+
+rdfsr3 = makeN3ClosureRule scopeRDFS "r3"
+            "?u ?a ?v . ?a rdfs:range ?z ."
+            "?v rdf:type ?z ."
+            (makeVarFilterModify $ requireAny [isUriRefV "?v",isBlankV "?v"])
+
+rdfsr4a = makeN3ClosureSimpleRule scopeRDFS "r4a"
+            "?x ?a ?y ."
+            "?x rdf:type rdfs:Resource ."
+
+rdfsr4b = makeN3ClosureRule scopeRDFS "r4b"
+            "?x ?a ?u ."
+            "?u rdf:type rdfs:Resource ."
+            (makeVarFilterModify $ requireAny [isUriRefV "?u",isBlankV "?u"])
+
+rdfsr5  = makeN3ClosureSimpleRule scopeRDFS "r5"
+            "?a rdfs:subPropertyOf ?b . ?b rdfs:subPropertyOf ?c ."
+            "?a rdfs:subPropertyOf ?c ."
+
+rdfsr6  = makeN3ClosureSimpleRule scopeRDFS "r6"
+            "?x rdf:type rdf:Property ."
+            "?x rdfs:subPropertyOf ?x ."
+
+rdfsr7  = makeN3ClosureSimpleRule scopeRDFS "r7"
+            "?x ?a ?y . ?a rdfs:subPropertyOf ?b ."
+            "?x ?b ?y ."
+
+rdfsr8  = makeN3ClosureSimpleRule scopeRDFS "r8"
+            "?x rdf:type rdfs:Class ."
+            "?x rdfs:subClassOf rdfs:Resource ."
+
+rdfsr9  = makeN3ClosureSimpleRule scopeRDFS "r9"
+            "?x rdfs:subClassOf ?y . ?a rdf:type ?x ."
+            "?a rdf:type ?y ."
+
+rdfsr10 = makeN3ClosureSimpleRule scopeRDFS "r10"
+            "?x rdf:type rdfs:Class ."
+            "?x rdfs:subClassOf ?x ."
+
+rdfsr11 = makeN3ClosureSimpleRule scopeRDFS "r11"
+            "?x rdfs:subClassOf ?y . ?y rdfs:subClassOf ?z ."
+            "?x rdfs:subClassOf ?z ."
+
+rdfsr12 = makeN3ClosureSimpleRule scopeRDFS "r12"
+            "?x rdf:type rdfs:ContainerMembershipProperty ."
+            "?x rdfs:subPropertyOf rdfs:member ."
+
+rdfsr13 = makeN3ClosureSimpleRule scopeRDFS "r13"
+            "?x rdf:type rdfs:Datatype ."
+            "?x rdfs:subClassOf rdfs:Literal ."
+
+--  These are valid only under an extensional strengthening of RDFS,
+--  discussed in section 7.3.1 of the RDF semantics specification:
+
+rdfsrext1 = makeN3ClosureSimpleRule scopeRDFS "ext1"
+            "?x rdfs:domain ?y . ?y rdfs:subClassOf ?z ."
+            "?x rdfs:domain ?z ."
+
+rdfsrext2 = makeN3ClosureSimpleRule scopeRDFS "ext2"
+            "?x rdfs:range ?y . ?y rdfs:subClassOf ?z ."
+            "?x rdfs:range ?z ."
+
+rdfsrext3 = makeN3ClosureSimpleRule scopeRDFS "ext3"
+            "?x rdfs:domain ?y . ?z rdfs:subPropertyOf ?x ."
+            "?z rdfs:domain ?y ."
+
+rdfsrext4 = makeN3ClosureSimpleRule scopeRDFS "ext4"
+            "?x rdfs:range ?y . ?z rdfs:subPropertyOf ?x ."
+            "?z rdfs:range ?y ."
+
+rdfsrext5 = makeN3ClosureSimpleRule scopeRDFS "ext5"
+            "rdf:type rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."
+            "rdfs:Resource rdfs:subClassOf ?y ."
+
+rdfsrext6 = makeN3ClosureSimpleRule scopeRDFS "rext6"
+            "rdfs:subClassOf rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."
+            "rdfs:Class rdfs:subClassOf ?y ."
+
+rdfsrext7 = makeN3ClosureSimpleRule scopeRDFS "rext7"
+            "rdfs:subPropertyOf rdfs:subPropertyOf ?z . ?z rdfs:domain ?y ."
+            "rdfs:Property rdfs:subClassOf ?y ."
+
+rdfsrext8 = makeN3ClosureSimpleRule scopeRDFS "rext8"
+            "rdfs:subClassOf rdfs:subPropertyOf ?z . ?z rdfs:range ?y ."
+            "rdfs:Class rdfs:subClassOf ?y ."
+
+rdfsrext9 = makeN3ClosureSimpleRule scopeRDFS "rext9"
+            "rdfs:subPropertyOf rdfs:subPropertyOf ?z . ?z rdfs:range ?y ."
+            "rdfs:Property rdfs:subClassOf ?y ."
+
+
+--  Container property axioms (from RDF semantics document section 4.1)
+--
+--  (Using here an inference rule with a filter in place of an axiom schema)
+--
+--  This is a restricted form of the given axioms, in that the axioms
+--  are asserted only for container membership terms that appear in
+--  the graph.
+--
+--  (This may be very inefficient for forward chaining when dealing with
+--  large graphs:  may need to look at query logic to see if the search for
+--  container membership properties can be optimized.  This may call for a
+--  custom inference rule.)
+--
+rdfscp11 = makeN3ClosureRule scopeRDFS "cp1"
+            "?x  ?c ?y . "
+            "?c rdf:type rdfs:ContainerMembershipProperty ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp12 = makeN3ClosureRule scopeRDFS "cp1"
+            "?c  ?p ?y . "
+            "?c rdf:type rdfs:ContainerMembershipProperty ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp13 = makeN3ClosureRule scopeRDFS "cp1"
+            "?x  ?p ?c . "
+            "?c rdf:type rdfs:ContainerMembershipProperty ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp21 = makeN3ClosureRule scopeRDFS "cp1"
+            "?x  ?c ?y . "
+            "?c rdfs:domain rdfs:Resource ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp22 = makeN3ClosureRule scopeRDFS "cp1"
+            "?c  ?p ?y . "
+            "?c rdfs:domain rdfs:Resource ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp23 = makeN3ClosureRule scopeRDFS "cp1"
+            "?x  ?p ?c . "
+            "?c rdfs:domain rdfs:Resource ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp31 = makeN3ClosureRule scopeRDFS "cp1"
+            "?x  ?c ?y . "
+            "?c rdfs:range rdfs:Resource ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp32 = makeN3ClosureRule scopeRDFS "cp1"
+            "?c  ?p ?y . "
+            "?c rdfs:range rdfs:Resource ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+rdfscp33 = makeN3ClosureRule scopeRDFS "cp1"
+            "?x  ?p ?c . "
+            "?c rdfs:range rdfs:Resource ."
+            (makeVarFilterModify $ isMemberPropV "?c")
+
+--  Collect RDFS rules
+--
+rulesRDFS =
+    [ rdfsr1,    rdfsr2,    rdfsr3,    rdfsr4a,   rdfsr4b
+    , rdfsr5,    rdfsr6,    rdfsr7,    rdfsr8,    rdfsr9
+    , rdfsr10,   rdfsr11,   rdfsr12,   rdfsr13
+    , rdfscp11,   rdfscp12,   rdfscp13
+    , rdfscp21,   rdfscp22,   rdfscp23
+    , rdfscp31,   rdfscp32,   rdfscp33
+    ]
+
+--  Define ruleset for RDFS inference
+
+rulesetRDFS = makeRuleset scopeRDFS axiomsRDFS rulesRDFS
+
+------------------------------------------------------------
+--  Define RDFD (datatyping) axioms
+------------------------------------------------------------
+
+-- scopeRDFD = Namespace "rdfd" "http://id.ninebynine.org/2003/Ruleset/rdfd#"
+
+axiomsRDFD =
+    [
+    ]
+
+------------------------------------------------------------
+--  Define RDFD (datatyping) axioms
+------------------------------------------------------------
+
+--  RDFD closure rules from semantics document, section 7.4
+
+--  Infer type of datatyped literal
+--
+rdfdr1 = makeN3ClosureRule scopeRDFD "r1"
+            "?d rdf:type rdfs:Datatype . ?a ?p ?l . ?b rdf:_allocatedTo ?l . "
+            "?b rdf:type ?d ."
+            (makeVarFilterModify $ isDatatypedV "?d" "?l")
+
+--  Equivalent literals with same datatype:
+--  (generate canonical form, or operate in proof mode only)
+--
+rdfdr2 = makeN3ClosureRule scopeRDFD "r2"
+            "?d rdf:type rdfs:Datatype . ?a ?p ?s ."
+            "?a ?p ?t ."
+            (valueSame "?s" "?d" "?t" "?d")
+
+{- Note that valueSame does datatype check.  Otherwise use:
+rdfdr2 = makeN3ClosureModifyRule scopeRDFD "r2"
+            "?d rdf:type rdfs:Datatype . ?a ?p ?s ."
+            "?a ?p ?t ."
+            (makeVarFilterModify $ isDatatypedV "?d" "?s")
+            (valueSame "?s" "?d" "?t" "?d")
+-}
+
+--  Equivalent literals with different datatypes:
+--  (generate canonical form, or operate in proof mode only)
+--
+rdfdr3 = makeN3ClosureModifyRule scopeRDFD "r3"
+            ( "?d rdf:type rdfs:Datatype . ?e rdf:type rdfs:Datatype . " ++
+              "?a ?p ?s ." )
+            "?a ?p ?t ."
+            (makeVarFilterModify $ isDatatypedV "?s" "?d")
+            (valueSame "?s" "?d" "?t" "?e")
+
+--  Collect RDFD rules
+--
+rulesRDFD =
+    [ rdfdr1, rdfdr2, rdfdr3
+    ]
+
+--  Define ruleset for RDFD inference
+--
+rulesetRDFD = makeRuleset scopeRDFD axiomsRDFD rulesRDFD
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFProofContext.hs,v $
+-- $Author: graham $
+-- $Revision: 1.13 $
+-- $Log: RDFProofContext.hs,v $
+-- Revision 1.13  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.12  2003/12/20 12:00:14  graham
+-- Introduced new TraceHelpers module for Hugs-2003 compatibility.
+--
+-- Revision 1.11  2003/12/19 21:01:25  graham
+-- Change Debug.Trace import (from Hugs.Trace)
+--
+-- Revision 1.10  2003/12/18 18:27:47  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.9  2003/12/16 07:05:37  graham
+-- Working on updated RDFProofContext
+--
+-- Revision 1.8  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.7  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.6  2003/12/01 18:51:38  graham
+-- Described syntax for Swish script.
+-- Created Swish scripting test data.
+-- Edited export/import lists in Swish main program modules.
+--
+-- Revision 1.5  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.4  2003/10/22 16:18:37  graham
+-- Move common namespace definitions into Namespace module
+-- (May later move these into separate modules.)
+--
+-- Revision 1.3  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.2  2003/10/09 13:58:59  graham
+-- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
+-- of using just QueryBindingModifier.
+--
+-- Revision 1.1  2003/10/02 13:39:41  graham
+-- RDF axioms and rules defined as Rulesets, and moved out of module
+-- RDFProofCheck into RDFProorfContext, with corresponding test cases
+-- moved to module RDFProorfContextTest.
+--

+ Swish/HaskellRDF/RDFProofContextTest.hs view
@@ -0,0 +1,672 @@+--------------------------------------------------------------------------------
+--  $Id: RDFProofContextTest.hs,v 1.14 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFProofContextTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains RDF proof-checking test cases based on the RDF
+--  semantics specifications, as capured in module RDFProofContext.
+--
+--------------------------------------------------------------------------------
+
+-- WNH RIP OUTmodule Swish.HaskellRDF.RDFProofContextTest
 where
+
+import Swish.HaskellRDF.BuiltInMap
+    ( rdfRulesetMap, allRulesets )
+
+import Swish.HaskellRDF.RDFProofContext
+    ( rulesetRDF
+    , rulesetRDFS
+    , rulesetRDFD )
+
+import Swish.HaskellRDF.RDFProof
+    ( RDFProof, RDFProofStep
+    , makeRDFProof, makeRDFProofStep
+    , makeRdfInstanceEntailmentRule
+    , makeRdfSubgraphEntailmentRule
+    , makeRdfSimpleEntailmentRule )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
+    , nullRDFFormula
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    , makeNodeAllocTo )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFGraph )
+
+import Swish.HaskellRDF.RDFGraphShowM()
+
+import Swish.HaskellRDF.Proof
+    ( Proof(..), Step(..)
+    , checkProof, checkStep, showProof, showsProof, showsFormula
+    , explainProof)
+
+import Swish.HaskellRDF.Ruleset
+    ( getContextAxiom, getContextRule )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..)
+    , nullScope, nullFormula, nullRule )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..), ScopedName(..) )
+
+import Swish.HaskellUtils.LookupMap
+    ( mapFindMaybe )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceXSD
+    , namespaceXsdType
+    , scopeRDF
+    , scopeRDFS
+    , scopeRDFD
+    )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertBool, assertEqual, assertString
+    , runTestTT, runTestText, putTextToHandle )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    , putStr )
+
+import Data.Maybe
+    ( isJust, isNothing, fromJust, fromMaybe )
+
+--  misc helpers
+
+test :: String -> Bool -> Test
+test lab tst = TestCase $ assertBool lab tst
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab e a = TestCase $ assertEqual lab e a
+
+testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test
+testJe lab e a = TestList
+    [ TestCase $ assertBool  lab (isJust a)
+    , TestCase $ assertEqual lab e (fromJust a)
+    ]
+
+testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test
+testJl lab e a = TestList
+    [ TestCase $ assertBool  lab   (isJust a)
+    , TestCase $ assertEqual lab e (length (fromJust a))
+    ]
+
+testNo :: (Eq a, Show a) => String -> [[a]] -> Test
+testNo lab a =
+    TestCase $ assertBool  lab   (null a)
+
+testGr :: String -> RDFGraph -> [RDFGraph] -> Test
+testGr lab eg a = TestCase $ assertBool lab (eg `elem` a)
+
+-- testProof "rdfProof01" True rdfProof01
+testProof :: String -> Bool -> RDFProof -> Test
+testProof lab valid proof = TestList
+    [ TestCase $ assertEqual lab valid (checkProof proof)
+    , TestCase $ assertBool  (lab++": "++ex) (valid == (isNothing $ expl))
+    ]
+    where
+        expl = explainProof proof
+        ex   = fromMaybe "(Proof OK)" expl
+
+-- testProofStep "rdfStep01" True [rules] [antes] rdfStep01
+testProofStep ::
+    String -> Bool -> [RDFRule] -> [RDFGraph] -> Step RDFGraph
+    -> Test
+testProofStep lab valid rules antes step =
+    TestCase $ assertEqual lab valid (checkStep rules antes step)
+
+--  Various support methods
+
+makeFormula :: Namespace -> String -> String -> RDFFormula
+makeFormula scope local gr =
+    makeRDFFormula scope local (prefix++gr)
+
+getRule :: String -> RDFRule
+getRule nam = getContextRule (makeSName nam) nullRule $
+    rdfdContext++[rulesetXsdInt,rulesetXsdStr]
+
+getAxiom :: String -> RDFFormula
+getAxiom nam = getContextAxiom (makeSName nam) nullRDFFormula rdfdContext
+
+makeSName :: String -> ScopedName
+makeSName nam = ScopedName ns loc
+    where
+        (pre,_:loc) = break (==':') nam
+        ns = case pre of
+            "rs_rdf"  -> scopeRDF
+            "rs_rdfs" -> scopeRDFS
+            "rs_rdfd" -> scopeRDFD
+            "xsd_integer" -> (namespaceXsdType "integer")
+            "xsd_string"  -> (namespaceXsdType "string")
+            otherwise -> error ("makeSName: Unrecognized prefix in rule name: "++nam)
+
+--  Common definitions
+
+prefix =
+    "@prefix rdf:  <" ++ nsURI namespaceRDF  ++ "> . \n" ++
+    "@prefix rdfs: <" ++ nsURI namespaceRDFS ++ "> . \n" ++
+    "@prefix rdfd: <" ++ nsURI namespaceRDFD ++ "> . \n" ++
+    "@prefix xsd:  <" ++ nsURI namespaceXSD  ++ "> . \n" ++
+    "@prefix ex:   <http://example.org/> . \n" ++
+    " \n"
+
+scopeex   = Namespace "ex"   "http://id.ninebynine.org/wip/2003/RDFProofCheck#"
+
+rdfContext  = [ rulesetRDF ]
+
+rdfsContext = [ rulesetRDF, rulesetRDFS ]
+
+rdfdContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD ]
+
+xsdintContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD, rulesetXsdInt ]
+
+xsdstrContext = [ rulesetRDF, rulesetRDFS, rulesetRDFD, rulesetXsdStr ]
+
+Just rulesetXsdInt = mapFindMaybe (namespaceXsdType "integer") rdfRulesetMap
+
+Just rulesetXsdStr = mapFindMaybe (namespaceXsdType "string") rdfRulesetMap
+
+------------------------
+--  RDF/S rule tests
+------------------------
+--
+--  These tests aim to exercise the specific closure rule constructs
+--  that are used by the RDF/S rules.  They have been prepared as a
+--  regression test for a refactoring of the variable binding
+--  filtering and modification logic.
+
+--  Simple rule test - forward and backward chaining
+--
+--  rdfr1 = "?x ?a ?y ." => "?a rdf:type rdf:Property ."
+--
+rdfr1  = getRule "rs_rdf:r1"
+ant01  = formExpr $ makeFormula scopeex "ant01" $
+    "ex:s ex:p1 ex:o1 ; ex:p2 ex:o2 ."
+con01  = formExpr $ makeFormula scopeex "con01" $
+    "ex:p1 rdf:type rdf:Property ." ++
+    "ex:p2 rdf:type rdf:Property ."
+bwd01  = formExpr $ makeFormula scopeex "bwd01a" $
+    "_:s1 ex:p1 _:o1 . " ++
+    "_:s2 ex:p2 _:o2 . "
+testRule01a = testEq "testRule01a" "rs_rdf:r1" (show $ ruleName rdfr1)
+testRule01b = testEq "testRule01b" [con01]     (fwdApply rdfr1 [ant01])
+testRule01c = testEq "testRule01c" [[bwd01]]   (bwdApply rdfr1 con01)
+testRule01d = test   "testRule01d" (checkInference rdfr1 [ant01] con01)
+testRule01e = test   "testRule01e" (checkInference rdfr1 [bwd01] con01)
+
+--  Simple rule test - no match forward or backward
+--
+--  rdfsr2 = "?x ?a ?y . ?a rdfs:domain ?z ." => "?x rdf:type ?z ."
+--
+rdfsr2 = getRule "rs_rdfs:r2"
+ant02  = formExpr $ makeFormula scopeex "ant02" $
+    "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ."
+con02  = formExpr $ makeFormula scopeex "con02" $
+    "ex:s ex:p1 ex:o1 . ex:p2 rdfs:domain ex:d2 ."
+testRule02a = testEq "testRule02a" "rs_rdfs:r2" (show $ ruleName rdfsr2)
+testRule02b = testEq "testRule02b" []           (fwdApply rdfsr2 [ant02])
+testRule02c = testEq "testRule02c" []           (bwdApply rdfsr2 con02)
+testRule02d = testEq "testRule02d" False (checkInference rdfsr2 [ant02] con02)
+
+--  Rule with literal test and "allocateTo":
+--  match forward, but not backward
+--
+--  This is a two-part rule: (a) apply rdflg, (b) apply rdfr2
+--
+--  rdflg = "?x ?a ?l . " => "?x  ?a ?b . ?b rdf:_allocatedTo ?l ."
+--  where:
+--          (isLiteral "?l")
+--          (allocateTo "?b" "?l")
+--
+--  rdfr2 = "?x ?a ?l . ?b rdf:_allocatedTo ?l . "
+--          => "?b rdf:type rdf:XMLLiteral ."
+--  where:
+--          (isXMLLit "?l")
+--
+rdflg  = getRule "rs_rdf:lg"
+rdfr2  = getRule "rs_rdf:r2"
+ant03  = formExpr $ makeFormula scopeex "ant03" $
+    "ex:s ex:p1  \"lit1\"^^rdf:XMLLiteral ; " ++
+    "     ex:p2a \"lit2\"^^rdf:XMLLiteral ; " ++
+    "     ex:p2b \"lit2\"^^rdf:XMLLiteral ."
+con03lg  = formExpr $ makeFormula scopeex "con03" $
+    "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." ++
+    "_:l1 rdf:_allocatedTo \"lit1\"^^rdf:XMLLiteral ." ++
+    "_:l2 rdf:_allocatedTo \"lit2\"^^rdf:XMLLiteral ."
+con03r2  = formExpr $ makeFormula scopeex "con03" $
+    "_:l1 rdf:type rdf:XMLLiteral ." ++
+    "_:l2 rdf:type rdf:XMLLiteral ."
+
+testRule03a = testEq "testRule03a" "rs_rdf:lg" (show $ ruleName rdflg)
+testRule03b = testEq "testRule03b" "rs_rdf:r2" (show $ ruleName rdfr2)
+testRule03c = testEq "testRule03c" [con03lg]   (fwdApply rdflg [ant03])
+testRule03d = testEq "testRule03d" []          (bwdApply rdflg con03lg)
+testRule03e = test   "testRule03e" (checkInference rdflg [ant03] con03lg)
+testRule03f = testEq "testRule03f" [con03r2]   (fwdApply rdfr2 [con03lg])
+testRule03g = testEq "testRule03g" []          (bwdApply rdfr2 con03r2)
+testRule03h = test   "testRule03h" (checkInference rdfr2 [con03lg] con03r2)
+
+--  Rule with member property test, match forwards and backwards
+--  rdfcp1 = "?x  ?c ?y . " => "?c rdf:type rdf:Property ."
+--  where:
+--          (isMemberProp "?c")
+--
+rdfcp  = getRule "rs_rdf:cp1"
+ant04  = formExpr $ makeFormula scopeex "ant04" $
+    "ex:s rdf:_123 ex:o1 ; " ++
+    "     rdf:_2   ex:o2 . "
+con04  = formExpr $ makeFormula scopeex "con04" $
+    "rdf:_123 rdf:type rdf:Property ." ++
+    "rdf:_2   rdf:type rdf:Property ."
+bwd04  = formExpr $ makeFormula scopeex "bwd04a" $
+    "_:s1 rdf:_123 _:o1 . " ++
+    "_:s2 rdf:_2   _:o2 . "
+testRule04a = testEq "testRule04a" "rs_rdf:cp1" (show $ ruleName rdfcp)
+testRule04b = testEq "testRule04b" [con04]      (fwdApply rdfcp [ant04])
+testRule04c = testEq "testRule04c" [[bwd04]]    (bwdApply rdfcp con04)
+testRule04d = test   "testRule04d" (checkInference rdfcp [ant04] con04)
+testRule04e = test   "testRule01e" (checkInference rdfcp [bwd04] con04)
+
+--  Rule with disjunction test, match forwards and backwards
+--
+--  rdfsr3 = "?x ?a ?u . ?a rdfs:range ?z ." => "?u rdf:type ?z ."
+--  where:
+--          (requireAny [isUriRef "?u",isBlank "?u"])
+--
+rdfsr3 = getRule "rs_rdfs:r3"
+ant05  = formExpr $ makeFormula scopeex "ant05" $
+    "ex:s ex:p1 ex:o1 ; "        ++
+    "     ex:p2 _:o2  . "        ++
+    "ex:p1 rdfs:range ex:pr1 . " ++
+    "ex:p2 rdfs:range ex:pr2 . "
+con05  = formExpr $ makeFormula scopeex "con05" $
+    "ex:o1 rdf:type ex:pr1 ." ++
+    "_:o2  rdf:type ex:pr2 ."
+bwd05  = formExpr $ makeFormula scopeex "bwd05a" $
+    "_:s1 _:p1 ex:o1 . "        ++
+    "_:s2 _:p2 _:o2  . "        ++
+    "_:p1 rdfs:range ex:pr1 . " ++
+    "_:p2 rdfs:range ex:pr2 . "
+testRule05a = testEq "testRule05a" "rs_rdfs:r3" (show $ ruleName rdfsr3)
+testRule05b = testEq "testRule05b" [con05]      (fwdApply rdfsr3 [ant05])
+testRule05c = testEq "testRule05c" [[bwd05]]    (bwdApply rdfsr3 con05)
+testRule05d = test   "testRule05d" (checkInference rdfsr3 [ant05] con05)
+testRule05e = test   "testRule01e" (checkInference rdfsr3 [bwd05] con05)
+
+--  Rule with disjunction test, fail forwards
+--
+--  rdfsr3 = "?x ?a ?u . ?a rdfs:range ?z ." => "?u rdf:type ?z ."
+--  where:
+--          (requireAny [isUriRef "?u",isBlank "?u"])
+--
+ant06  = formExpr $ makeFormula scopeex "ant06" $
+    "ex:s ex:p1 \"lit1\" . "     ++
+    "ex:p1 rdfs:range ex:pr1 . "
+con06  = formExpr $ makeFormula scopeex "con06" $
+    "_:o1  rdf:type ex:pr1 ."
+bwd06  = formExpr $ makeFormula scopeex "bwd06a" $
+    "_:s1 _:p1 _:o1 . "      ++
+    "_:p1 rdfs:range ex:pr1 . "
+chk06  = formExpr $ makeFormula scopeex "bwd06a" $
+    "_:s1 _:p1 \"lit1\" . "      ++
+    "_:p1 rdfs:range ex:pr1 . "
+testRule06a = testEq "testRule06a" "rs_rdfs:r3" (show $ ruleName rdfsr3)
+testRule06b = testEq "testRule06b" []           (fwdApply rdfsr3 [ant06])
+testRule06c = testEq "testRule06c" [[bwd06]]    (bwdApply rdfsr3 con06)
+testRule06d = testEq "testRule06d" False (checkInference rdfsr3 [ant06] con06)
+testRule06e = testEq "testRule06e" True  (checkInference rdfsr3 [bwd06] con06)
+testRule06f = testEq "testRule06e" False (checkInference rdfsr3 [chk06] con06)
+
+--  Collected rule tests
+
+testRules = TestList
+    [ testRule01a, testRule01b, testRule01c, testRule01d, testRule01e
+    , testRule02a, testRule02b, testRule02c, testRule02d
+    , testRule03a, testRule03b, testRule03c, testRule03d, testRule03e
+    , testRule03f, testRule03g, testRule03h
+    , testRule04a, testRule04b, testRule04c, testRule04d, testRule04e
+    , testRule05a, testRule05b, testRule05c, testRule05d, testRule05e
+    , testRule06a, testRule06b, testRule06c, testRule06d, testRule06e
+    , testRule06f
+    ]
+
+------------------------
+--  Complete proof tests
+------------------------
+--
+--  These are a few tests of complete RDF proof chains based on the
+--  RDF semantic rules.
+
+
+--  RDF entailment proof checks
+
+rdfBase01  = makeFormula scopeex "rdfBase01" "ex:s ex:p ex:o ."
+rdfGoal01  = makeFormula scopeex "rdfGoal01" "ex:p rdf:type rdf:Property ."
+rdfStep01a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase01] rdfGoal01
+rdfProof01 = makeRDFProof rdfsContext rdfBase01 rdfGoal01
+                [ rdfStep01a ]
+
+rdfBase02  = makeFormula scopeex "rdfBase02" $
+                "ex:s ex:p \"l1\"^^rdf:XMLLiteral ."
+rdfCon02a  = makeFormula scopeex "rdfStep02a" $
+                "ex:s ex:p _:lll . "             ++
+                "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . "
+rdfGoal02  = makeFormula scopeex "rdfGoal02" $
+                "_:lll rdf:type rdf:XMLLiteral . "
+rdfStep02a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase02] rdfCon02a
+rdfStep02b = makeRDFProofStep (getRule "rs_rdf:r2") [rdfCon02a] rdfGoal02
+rdfProof02 = makeRDFProof rdfsContext rdfBase02 rdfGoal02
+                [ rdfStep02a, rdfStep02b ]
+
+rdfBase03  = makeFormula scopeex "rdfBase03" $
+                "ex:s ex:p ex:o ."
+rdfCon03a  = makeFormula scopeex "rdfStep03a" $
+                "ex:s ex:p _:lll . "             ++
+                "_:lll rdf:_allocatedTo \"l1\"^^rdf:XMLLiteral . "
+rdfGoal03  = makeFormula scopeex "rdfGoal03" $
+                "_:lll rdf:type rdf:XMLLiteral . "
+rdfStep03a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase03] rdfCon03a
+rdfStep03b = makeRDFProofStep (getRule "rs_rdf:r2") [rdfCon03a] rdfGoal03
+rdfProof03 = makeRDFProof rdfsContext rdfBase03 rdfGoal03
+                [ rdfStep03a, rdfStep03b ]
+
+rdfBase04  = makeFormula scopeex "rdfBase04" "ex:s ex:p ex:o ."
+rdfGoal04  = makeFormula scopeex "rdfGoal04" "_:s  ex:p _:o ."
+rdfStep04a = makeRDFProofStep (getRule "rs_rdf:se") [rdfBase04] rdfGoal04
+rdfProof04 = makeRDFProof rdfsContext rdfBase04 rdfGoal04
+                [ rdfStep04a ]
+
+rdfBase05  = makeFormula scopeex "rdfBase05" $
+                "ex:s ex:p rdf:nil ."
+rdfStep05a = makeRDFProofStep (getRule "rs_rdf:r1") [rdfBase05]  rdfCons05a
+rdfCons05a = makeFormula scopeex "rdfCons05a" $
+                "ex:p  rdf:type rdf:Property ."
+rdfStep05b = makeRDFProofStep (getRule "rs_rdf:se")
+                [rdfBase05,rdfCons05a,(getAxiom "rs_rdf:a8")] rdfGoal05
+rdfGoal05  = makeFormula scopeex "rdfGoal05" $
+                "ex:s _:p _:n ."               ++
+                "_:p  rdf:type rdf:Property ." ++
+                "_:n  rdf:type rdf:List ."
+rdfProof05 = makeRDFProof rdfsContext rdfBase05 rdfGoal05
+                [ rdfStep05a, rdfStep05b ]
+
+--  Swap rdfProof05 proof steps:
+rdfProof06 = makeRDFProof rdfsContext rdfBase05 rdfGoal05
+                [ rdfStep05b, rdfStep05a ]
+
+--  Proof using rdfsr1 and rdfsub
+--
+--    ex:s1 ex:p1 "lll"
+--    ex:s2 ex:p2 "lll"
+--  =>
+--    ex:s1 ex:p1 _:l
+--    ex:s2 ex:p2 _:l
+--    _:l   rdf:type rdfs:Literal
+
+rdfBase07  = makeFormula scopeex "rdfBase07" $
+                "ex:s1 ex:p1 \"lll\" ." ++
+                "ex:s2 ex:p2 \"lll\" ." ++
+                "ex:s3 ex:p3 \"mmm\" ."
+rdfStep07a = makeRDFProofStep (getRule "rs_rdf:lg") [rdfBase07]  rdfCons07a
+rdfCons07a = makeFormula scopeex "rdfCons07a" $
+                "ex:s1 ex:p1 _:l ."              ++
+                "ex:s2 ex:p2 _:l ."              ++
+                "_:l rdf:_allocatedTo \"lll\" ." ++
+                "ex:s3 ex:p3 _:m ."              ++
+                "_:m rdf:_allocatedTo \"mmm\" ."
+rdfStep07b = makeRDFProofStep (getRule "rs_rdfs:r1") [rdfCons07a]  rdfCons07b
+rdfCons07b = makeFormula scopeex "rdfCons07a" $
+                "_:l rdf:type rdfs:Literal ." ++
+                "_:m rdf:type rdfs:Literal ."
+rdfStep07c = makeRDFProofStep (getRule "rs_rdf:sub")
+                [rdfCons07a,rdfCons07b] rdfGoal07
+rdfGoal07  = makeFormula scopeex "rdfGoal07" $
+                "ex:s1 ex:p1 _:l ."           ++
+                "ex:s2 ex:p2 _:l ."           ++
+                "_:l rdf:type rdfs:Literal ."
+rdfProof07 = makeRDFProof rdfsContext rdfBase07 rdfGoal07
+                [ rdfStep07a, rdfStep07b, rdfStep07c ]
+
+--  Proof of:
+--    rdf:_123 rdfs:supPropertyOf rdfs:member
+
+rdfBase08  = makeFormula scopeex "rdfBase08" $
+                "ex:s1 rdf:_123 ex:o ."
+rdfStep08a = makeRDFProofStep (getRule "rs_rdfs:cp1") [rdfBase08]  rdfCons08a
+rdfCons08a = makeFormula scopeex "rdfCons08a" $
+                "rdf:_123 rdf:type rdfs:ContainerMembershipProperty ."
+rdfStep08b = makeRDFProofStep (getRule "rs_rdfs:r12")  [rdfCons08a]  rdfGoal08
+rdfGoal08  = makeFormula scopeex "rdfCons08b" $
+                "rdf:_123 rdfs:subPropertyOf rdfs:member ."
+rdfProof08 = makeRDFProof rdfsContext rdfBase08 rdfGoal08
+                [ rdfStep08a, rdfStep08b ]
+
+
+--  Proof of:
+--    ex:s ex:p "010"^^xsd:Integer .
+--  =>
+--    ex:s ex:p "10"^^xsd:Integer .
+--    ex:s ex:p _:b
+--    _:b rdf:type xsd:integer .
+
+rdfAxiomIntDt = getContextAxiom
+                    (ScopedName (namespaceXsdType "integer") "dt")
+                    nullFormula
+                    allRulesets
+
+rdfAxiom09 = testEq "rdfAxiom09" "xsd_integer:dt" $
+                show (formName rdfAxiomIntDt)
+
+rdfBase09  = makeFormula scopeex "rdfBase09" $
+                "ex:s ex:p \"010\"^^xsd:integer ."
+rdfStep09a = makeRDFProofStep (getRule "rs_rdfd:r2")
+                [rdfAxiomIntDt,rdfBase09]  rdfCons09a
+rdfCons09a = makeFormula scopeex "rdfCons09a" $
+                "ex:s ex:p \"10\"^^xsd:integer ."
+rdfStep09b = makeRDFProofStep (getRule "rs_rdf:lg")
+                [rdfCons09a]  rdfCons09b
+rdfCons09b = makeFormula scopeex "rdfCons09b" $
+                "ex:s ex:p _:l ." ++
+                "_:l rdf:_allocatedTo \"10\"^^xsd:integer ."
+rdfStep09c = makeRDFProofStep (getRule "rs_rdfd:r1")
+                [rdfAxiomIntDt,rdfCons09a,rdfCons09b]  rdfCons09c
+rdfCons09c = makeFormula scopeex "rdfCons09c" $
+                "_:l rdf:type xsd:integer ."
+rdfStep09d = makeRDFProofStep (getRule "rs_rdf:sub")
+                [rdfCons09a,rdfCons09b,rdfCons09c]  rdfGoal09
+rdfGoal09  = makeFormula scopeex "rdfGoal09" $
+                "ex:s ex:p  \"10\"^^xsd:integer ."           ++
+                "_:l rdf:_allocatedTo \"10\"^^xsd:integer ." ++
+                "_:l rdf:type xsd:integer ."
+rdfProof09 = makeRDFProof xsdintContext rdfBase09 rdfGoal09
+                [ rdfStep09a, rdfStep09b, rdfStep09c, rdfStep09d ]
+
+-- {- test data
+p09t1 = fwdApply (getRule "rs_rdfd:r2")
+    [(formExpr rdfAxiomIntDt),(formExpr rdfBase09)]
+p09sh = putStrLn ("\n"++showProof "\n" rdfProof09++"\n")
+-- -}
+
+
+--  Proof of:
+--    ex:s ex:p "abc" .
+--    ex:s ex:p "def"^^xsd:string .
+--  =>
+--    ex:s ex:p "abc"^^xsd:string .
+--    ex:s ex:p "def" .
+--    xsd:string rdf:type rdfs:Datatype .
+
+rdfAxiomStrDt = getContextAxiom
+                    (ScopedName (namespaceXsdType "string") "dt")
+                    nullFormula
+                    allRulesets
+
+rdfAxiom10 = testEq "rdfAxiom10" "xsd_string:dt" $
+                show (formName rdfAxiomStrDt)
+
+rdfRule10 = testEq "rdfRule10" "xsd_string:ls" $
+                show (ruleName (getRule "xsd_string:ls"))
+
+rdfBase10  = makeFormula scopeex "rdfBase10" $
+                "ex:s ex:p \"abc\" . " ++
+                "ex:s ex:p \"def\"^^xsd:string . "
+rdfStep10a = makeRDFProofStep (getRule "xsd_string:ls")
+                [rdfBase10]  rdfCons10a
+rdfCons10a = makeFormula scopeex "rdfCons10a" $
+                "ex:s ex:p \"abc\"^^xsd:string . "
+rdfStep10b = makeRDFProofStep (getRule "xsd_string:sl")
+                [rdfBase10]  rdfCons10b
+rdfCons10b = makeFormula scopeex "rdfCons10b" $
+                "ex:s ex:p \"def\" . "
+rdfStep10c = makeRDFProofStep (getRule "rs_rdf:sub")
+                [rdfCons10a,rdfCons10b,rdfAxiomStrDt] rdfGoal10
+rdfGoal10  = makeFormula scopeex "rdfGoal10" $
+                "ex:s ex:p \"abc\"^^xsd:string . " ++
+                "ex:s ex:p \"def\" . "             ++
+                "xsd:string rdf:type rdfs:Datatype . "
+rdfProof10 = makeRDFProof xsdstrContext rdfBase10 rdfGoal10
+                [ rdfStep10a, rdfStep10b, rdfStep10c ]
+
+testRdf = TestList
+    [ testProofStep "rdfStep01a" True  [(getRule "rs_rdf:r1")] [formExpr rdfBase01] rdfStep01a
+    , testProof     "rdfProof01" True  rdfProof01
+    --   Really should have support for scoped bnodes
+    , testProof     "rdfProof02" True  rdfProof02
+    , testProof     "rdfProof03" False rdfProof03
+    , testProof     "rdfProof04" True  rdfProof04
+    , testProof     "rdfProof05" True  rdfProof05
+    , testProof     "rdfProof06" False rdfProof06
+    , testProof     "rdfProof07" True  rdfProof07
+    , testProof     "rdfProof08" True  rdfProof08
+    , rdfAxiom09
+    , testProof     "rdfProof09" True  rdfProof09
+    , rdfAxiom10, rdfRule10
+    , testProof     "rdfProof10" True  rdfProof10
+    {-
+    , TestCase $ putStrLn ("\n"++showProof "\n" rdfProof01)
+    , TestCase $ putStrLn ("\n"++showProof "\n" rdfProof05)
+    -}
+    ]
+
+------------------------------------------------------------
+--  Full test suite, main program,
+--  and useful expressions for interactive use
+------------------------------------------------------------
+
+allTests = TestList
+  [ testRules
+  , testRdf
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+p10 = runTestTT $ TestList
+    [ rdfAxiom10
+    , rdfRule10
+    , testProof     "rdfProof10" True  rdfProof10
+    ]
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFProofContextTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.14 $
+-- $Log: RDFProofContextTest.hs,v $
+-- Revision 1.14  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.13  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.12  2003/12/20 12:53:40  graham
+-- Fix up code to compile and test with GHC 5.04.3
+--
+-- Revision 1.11  2003/12/18 20:46:24  graham
+-- Added xsd:string module to capture equivalence of xsd:string
+-- and plain literals without a language tag
+--
+-- Revision 1.10  2003/12/18 18:27:47  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.9  2003/12/16 07:05:37  graham
+-- Working on updated RDFProofContext
+--
+-- Revision 1.8  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.7  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.6  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.5  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.4  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.3  2003/10/09 17:16:13  graham
+-- Added test cases to exercise features of rules used to capture
+-- RDF semantics.  Also added proof test case using XML literal.
+--
+-- Revision 1.2  2003/10/09 13:58:59  graham
+-- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
+-- of using just QueryBindingModifier.
+--
+-- Revision 1.1  2003/10/02 13:39:41  graham
+-- RDF axioms and rules defined as Rulesets, and moved out of module
+-- RDFProofCheck into RDFProorfContext, with corresponding test cases
+-- moved to module RDFProorfContextTest.
+--

+ Swish/HaskellRDF/RDFProofTest.hs view
@@ -0,0 +1,1080 @@+--------------------------------------------------------------------------------
+--  $Id: RDFProofTest.hs,v 1.21 2004/01/06 13:53:10 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFProofTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module tests the RDFproof module, which instantiates the proof
+--  rule class over RDF graphs.
+--
+--------------------------------------------------------------------------------
+
+--  WNH RIP OUTmodule Swish.HaskellRDF.RDFProofTest
 where
+
+import Swish.HaskellRDF.RDFProof
+    ( RDFProof, RDFProofStep
+    , makeRDFProof, makeRDFProofStep
+    , makeRdfInstanceEntailmentRule
+    , makeRdfSubgraphEntailmentRule
+    , makeRdfSimpleEntailmentRule
+    )
+
+import Swish.HaskellRDF.RDFQuery
+    ( rdfQueryFind, rdfQuerySubs )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBindingFilter, RDFVarBindingModify )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
+    , GraphClosure(..), makeGraphClosureRule
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    , makeN3ClosureAllocatorRule
+    , makeN3ClosureRule
+    , makeN3ClosureSimpleRule
+    , makeNodeAllocTo
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( Label(..), RDFLabel(..), NSGraph(..), RDFGraph
+    , getArcs, add, allLabels, allNodes )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..), nullVarBinding
+    , VarBindingModify(..)
+    , makeVarFilterModify
+    , varBindingId -- , varFilterDisjunction, varFilterConjunction
+    , varFilterEQ, varFilterNE
+    )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..) )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..), ScopedName(..) )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertBool, assertEqual, assertString
+    , runTestTT, runTestText, putTextToHandle )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn )
+
+import Data.Maybe
+    ( isJust, fromJust )
+
+--  misc helpers
+
+test :: String -> Bool -> Test
+test lab tst = TestCase $ assertBool lab tst
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab e a = TestCase $ assertEqual lab e a
+
+testJe :: (Eq a, Show a) => String -> a -> Maybe a -> Test
+testJe lab e a = TestList
+    [ TestCase $ assertBool  lab (isJust a)
+    , TestCase $ assertEqual lab e (fromJust a)
+    ]
+
+testJl :: (Eq a, Show a) => String -> Int -> Maybe [a] -> Test
+testJl lab e a = TestList
+    [ TestCase $ assertBool  lab   (isJust a)
+    , TestCase $ assertEqual lab e (length (fromJust a))
+    ]
+
+testNo :: (Eq a, Show a) => String -> [[a]] -> Test
+testNo lab a =
+    TestCase $ assertBool  lab   (null a)
+
+testIn :: (Eq a, Show a) => String -> a -> [a] -> Test
+testIn lab eg a = TestCase $ assertBool lab (eg `elem` a)
+
+--  test1:  simple query with URI, literal and blank nodes.
+
+scope1 = Namespace "scope1"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope1"
+
+prefix1 =
+    "@prefix ex: <http://example.org/> . \n" ++
+    " \n"
+
+graph1    = makeRDFGraphFromN3String graph1str
+graph1str = prefix1 ++
+    "ex:s1  ex:p  ex:o1 . \n"  ++
+    "ex:s2  ex:p  \"lit1\" . \n" ++
+    "[ ex:p ex:o3 ] . \n"
+
+query11    = makeRDFGraphFromN3String query11str
+query11str = prefix1 ++
+    "?s  ex:p  ?o . \n"
+
+result11    = makeRDFGraphFromN3String result11str
+result11str = prefix1 ++
+    "?s  ex:r  ?o . \n"
+
+result11a    = makeRDFGraphFromN3String result11astr
+result11astr = prefix1 ++
+    "ex:s1  ex:r  ex:o1    . \n" ++
+    "ex:s2  ex:r  \"lit1\" . \n" ++
+    "[ ex:r ex:o3 ]        . \n"
+
+result11b    = makeRDFGraphFromN3String result11bstr
+result11bstr = prefix1 ++
+    "ex:s1  ex:r  ex:o1    . \n"
+
+result11c    = makeRDFGraphFromN3String result11cstr
+result11cstr = prefix1 ++
+    "ex:s2  ex:r  \"lit1\" . \n"
+
+backsub11a    = makeRDFGraphFromN3String backsub11astr
+backsub11astr = prefix1 ++
+    "ex:s1  ex:p  ex:o1    . \n" ++
+    "ex:s2  ex:p  \"lit1\" . \n"
+
+backsub11b    = makeRDFGraphFromN3String backsub11bstr
+backsub11bstr = prefix1 ++
+    "ex:s2  ex:p  \"lit1\" . \n"
+
+rul11 = makeN3ClosureSimpleRule scope1 "rul11" query11str result11str
+fwd11 = fwdApply rul11 [graph1]
+testFwd11  = testEq "testFwd11" 1 (length fwd11)
+testFwd11a = testIn "testFwd11a" result11a fwd11
+bwd11      = bwdApply rul11 (add result11b result11c)
+testBwd11  = testEq "testBwd11"  1 (length (head bwd11))
+testBwd11a = testIn "testBwd11a" backsub11a (head bwd11)
+
+test1 = TestList
+    [ testFwd11
+    , testFwd11a
+    , testBwd11
+    , testBwd11a
+    ]
+
+
+--  test2:  a range of more complex queries based on a
+--  single relationship graph.
+
+scope2 = Namespace "scope2"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope2"
+
+prefix2 =
+    "@prefix pers: <urn:pers:> . \n"      ++
+    "@prefix rel:  <urn:rel:> . \n"       ++
+    " \n"
+
+graph2    = makeRDFGraphFromN3String graph2str
+graph2str = prefix2 ++
+    "pers:St1 rel:wife     pers:Do1 ; \n" ++
+    "         rel:daughter pers:Ma2 ; \n" ++
+    "         rel:daughter pers:An2 . \n" ++
+    "pers:Pa2 rel:wife     pers:Ma2 ; \n" ++
+    "         rel:son      pers:Gr3 ; \n" ++
+    "         rel:son      pers:La3 ; \n" ++
+    "         rel:son      pers:Si3 ; \n" ++
+    "         rel:son      pers:Al3 . \n" ++
+    "pers:Br2 rel:wife     pers:Ri2 ; \n" ++
+    "         rel:daughter pers:Ma3 ; \n" ++
+    "         rel:son      pers:Wi3 . \n" ++
+    "pers:Gr3 rel:wife     pers:Ma3 ; \n" ++
+    "         rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter pers:Rh4 . \n" ++
+    "pers:Si3 rel:wife     pers:Jo3 ; \n" ++
+    "         rel:son      pers:Ol4 ; \n" ++
+    "         rel:son      pers:Lo4 . \n" ++
+    "pers:Al3 rel:wife     pers:Su3 ; \n" ++
+    "         rel:son      pers:Ha4 ; \n" ++
+    "         rel:son      pers:El4 . \n"
+
+query21    = makeRDFGraphFromN3String query21str
+query21str = prefix2 ++
+    "?a rel:wife ?b . \n"
+
+result21    = makeRDFGraphFromN3String result21str
+result21str = prefix2 ++
+    "?b rel:husband ?a . \n"
+
+result21a    = makeRDFGraphFromN3String result21astr
+result21astr = prefix2 ++
+    "pers:Do1 rel:husband pers:St1 . \n" ++
+    "pers:Ma2 rel:husband pers:Pa2 . \n" ++
+    "pers:Ri2 rel:husband pers:Br2 . \n" ++
+    "pers:Ma3 rel:husband pers:Gr3 . \n" ++
+    "pers:Jo3 rel:husband pers:Si3 . \n" ++
+    "pers:Su3 rel:husband pers:Al3 . \n"
+
+result21b    = makeRDFGraphFromN3String result21bstr
+result21bstr = prefix2 ++
+    "pers:Do1 rel:husband pers:St1 . \n" ++
+    "pers:Ma2 rel:husband pers:Pa2 . \n"
+
+bwd21a    = makeRDFGraphFromN3String bwd21astr
+bwd21astr = prefix2 ++
+    "pers:St1 rel:wife     pers:Do1 . \n" ++
+    "pers:Pa2 rel:wife     pers:Ma2 . \n"
+
+rul21 = makeN3ClosureSimpleRule scope2 "rul21" query21str result21str
+fwd21 = fwdApply rul21 [graph2]
+testFwd21  = testEq "testResult21" 1 (length fwd21)
+testFwd21a = testIn "testResult21a" result21a fwd21
+bwd21 = bwdApply rul21 result21b
+testBwd21  = testEq "testBwd21"  1 (length $ head bwd21)
+testBwd21a = testIn "testBwd21a" bwd21a (head bwd21)
+
+
+query22    = makeRDFGraphFromN3String query22str
+query22str = prefix2 ++
+    "?a rel:son ?b . \n" ++
+    "?b rel:son ?c . \n"
+
+result22    = makeRDFGraphFromN3String result22str
+result22str = prefix2 ++
+    "?a rel:grandparent ?c . \n"
+
+result22a    = makeRDFGraphFromN3String result22astr
+result22astr = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++
+    "pers:Pa2 rel:grandparent pers:Ol4 . \n" ++
+    "pers:Pa2 rel:grandparent pers:Lo4 . \n" ++
+    "pers:Pa2 rel:grandparent pers:Ha4 . \n" ++
+    "pers:Pa2 rel:grandparent pers:El4 . \n"
+
+result22b    = makeRDFGraphFromN3String result22bstr
+result22bstr = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++
+    "pers:Pa2 rel:grandparent pers:Ol4 . \n"
+
+bwd22a    = makeRDFGraphFromN3String bwd22astr
+bwd22astr = prefix2 ++
+    "pers:Pa2 rel:son      _:p1 . \n" ++
+    "_:p1 rel:son      pers:Ro4 . \n" ++
+    "pers:Pa2 rel:son      _:p2 . \n" ++
+    "_:p2 rel:son      pers:Ol4 . \n"
+
+rul22 = makeN3ClosureSimpleRule scope2 "rul22" query22str result22str
+fwd22 = fwdApply rul22 [graph2]
+testFwd22  = testEq "testResult22" 1 (length fwd22)
+testFwd22a = testIn "testResult22a" result22a fwd22
+bwd22 = bwdApply rul22 result22b
+testBwd22  = testEq "testBwd22"  1 (length $ head bwd22)
+testBwd22a = testIn "testBwd22a" bwd22a (head bwd22)
+
+
+query23    = makeRDFGraphFromN3String query23str
+query23str = prefix2 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+result23    = makeRDFGraphFromN3String result23str
+result23str = prefix2 ++
+    "?b rel:brother ?c . \n"
+
+result23a    = makeRDFGraphFromN3String result23astr
+result23astr = prefix2 ++
+    "pers:Gr3 rel:brother pers:Gr3 . \n" ++
+    "pers:Gr3 rel:brother pers:La3 . \n" ++
+    "pers:Gr3 rel:brother pers:Si3 . \n" ++
+    "pers:Gr3 rel:brother pers:Al3 . \n" ++
+    "pers:La3 rel:brother pers:Gr3 . \n" ++
+    "pers:La3 rel:brother pers:La3 . \n" ++
+    "pers:La3 rel:brother pers:Si3 . \n" ++
+    "pers:La3 rel:brother pers:Al3 . \n" ++
+    "pers:Si3 rel:brother pers:Gr3 . \n" ++
+    "pers:Si3 rel:brother pers:La3 . \n" ++
+    "pers:Si3 rel:brother pers:Si3 . \n" ++
+    "pers:Si3 rel:brother pers:Al3 . \n" ++
+    "pers:Al3 rel:brother pers:Gr3 . \n" ++
+    "pers:Al3 rel:brother pers:La3 . \n" ++
+    "pers:Al3 rel:brother pers:Si3 . \n" ++
+    "pers:Al3 rel:brother pers:Al3 . \n" ++
+    "pers:Wi3 rel:brother pers:Wi3 . \n" ++
+    "pers:Ro4 rel:brother pers:Ro4 . \n" ++
+    "pers:Ol4 rel:brother pers:Lo4 . \n" ++
+    "pers:Ol4 rel:brother pers:Ol4 . \n" ++
+    "pers:Lo4 rel:brother pers:Lo4 . \n" ++
+    "pers:Lo4 rel:brother pers:Ol4 . \n" ++
+    "pers:Ha4 rel:brother pers:El4 . \n" ++
+    "pers:Ha4 rel:brother pers:Ha4 . \n" ++
+    "pers:El4 rel:brother pers:El4 . \n" ++
+    "pers:El4 rel:brother pers:Ha4 . \n"
+
+result23b    = makeRDFGraphFromN3String result23bstr
+result23bstr = prefix2 ++
+    "pers:Gr3 rel:brother pers:Gr3 . \n" ++
+    "pers:Gr3 rel:brother pers:La3 . \n"
+
+bwd23a    = makeRDFGraphFromN3String bwd23astr
+bwd23astr = prefix2 ++
+    "_:a1 rel:son pers:Gr3 . \n" ++
+    "_:a1 rel:son pers:Gr3 . \n" ++
+    "_:a2 rel:son pers:Gr3 . \n" ++
+    "_:a2 rel:son pers:La3 . \n"
+
+rul23 = makeN3ClosureSimpleRule scope2 "rul23" query23str result23str
+fwd23 = fwdApply rul23 [graph2]
+testFwd23  = testEq "testResult23" 1 (length fwd23)
+testFwd23a = testIn "testResult23a" result23a fwd23
+bwd23 = bwdApply rul23 result23b
+testBwd23  = testEq "testBwd23"  1 (length $ head bwd23)
+testBwd23a = testIn "testBwd23a" bwd23a (head bwd23)
+
+
+--  Test case to return multiple alternative bindings
+--
+--  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)
+--
+--  a stepBrother b if
+--      (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)
+
+graph24    = makeRDFGraphFromN3String graph24str
+graph24str = prefix2 ++
+    "pers:Ma2 rel:son     pers:Gr3 . \n" ++
+    "pers:Ma2 rel:stepson pers:St3 . \n"
+
+query24    = makeRDFGraphFromN3String query24str
+query24str = prefix2 ++
+    "?c rel:son ?a     . \n" ++
+    "?c rel:stepson ?b . \n"
+
+result24    = makeRDFGraphFromN3String result24str
+result24str = prefix2 ++
+    "?a rel:stepbrother ?b . \n" ++
+    "?b rel:stepbrother ?a . \n"
+
+result24a    = makeRDFGraphFromN3String result24astr
+result24astr = prefix2 ++
+    "pers:Gr3 rel:stepbrother pers:St3 . \n" ++
+    "pers:St3 rel:stepbrother pers:Gr3 . \n"
+
+bwd24a1    = makeRDFGraphFromN3String bwd24a1str
+bwd24a1str = prefix2 ++
+    "_:c1 rel:son     pers:Gr3 . \n" ++
+    "_:c1 rel:stepson pers:St3 . \n" ++
+    "_:c2 rel:stepson pers:Gr3 . \n" ++
+    "_:c2 rel:son     pers:St3 . \n"
+
+bwd24a2    = makeRDFGraphFromN3String bwd24a2str
+bwd24a2str = prefix2 ++
+    "_:c1 rel:son     pers:Gr3 . \n" ++
+    "_:c1 rel:stepson pers:St3 . \n"
+
+bwd24a3    = makeRDFGraphFromN3String bwd24a3str
+bwd24a3str = prefix2 ++
+    "_:c2 rel:stepson pers:Gr3 . \n" ++
+    "_:c2 rel:son     pers:St3 . \n"
+
+bwd24a4    = makeRDFGraphFromN3String bwd24a4str
+bwd24a4str = prefix2 ++
+    "_:c1 rel:son     pers:Gr3 . \n" ++
+    "_:c1 rel:stepson pers:St3 . \n" ++
+    "_:c2 rel:stepson pers:Gr3 . \n" ++
+    "_:c2 rel:son     pers:St3 . \n"
+
+rul24 = makeN3ClosureSimpleRule scope2 "rul24" query24str result24str
+fwd24 = fwdApply rul24 [graph24]
+testFwd24  = testEq "testResult24" 1 (length fwd24)
+testFwd24a = testIn "testResult24a" result24a fwd24
+bwd24 = bwdApply rul24 result24a
+testBwd24   = testEq "testBwd24"  4 (length bwd24)
+testBwd24a1 = testIn "testBwd24a1" bwd24a1 (bwd24!!0)
+testBwd24a2 = testIn "testBwd24a2" bwd24a2 (bwd24!!1)
+testBwd24a3 = testIn "testBwd24a3" bwd24a3 (bwd24!!2)
+testBwd24a4 = testIn "testBwd24a4" bwd24a4 (bwd24!!3)
+
+
+--  bwd chain from partial conclusion
+--  Also, fail because conclusion is more than the rule
+--  can derive from any input.
+
+query25    = makeRDFGraphFromN3String query25str
+query25str = prefix2 ++
+    "?a rel:son      ?b . \n" ++
+    "?a rel:daughter ?c . \n"
+
+result25    = makeRDFGraphFromN3String result25str
+result25str = prefix2 ++
+    "?b rel:sister  ?c . \n" ++
+    "?c rel:brother ?b . \n"
+
+result25a    = makeRDFGraphFromN3String result25astr
+result25astr = prefix2 ++
+    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
+    "pers:Ma3 rel:brother pers:Wi3 . \n" ++
+    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n"
+
+{-
+result25b    = makeRDFGraphFromN3String result25bstr
+result25bstr = prefix2 ++
+    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n"
+-}
+
+result25c    = makeRDFGraphFromN3String result25cstr
+result25cstr = prefix2 ++
+    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
+    "pers:Ma3 rel:brother pers:Wi3 . \n" ++
+    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n" ++
+    "pers:xx3 rel:mother  pers:yy3 . \n" ++
+    "pers:yy3 rel:brother pers:xx3 . \n"
+
+result25d    = makeRDFGraphFromN3String result25dstr
+result25dstr = prefix2 ++
+    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
+    "pers:Ma3 rel:brother pers:Wi3 . \n" ++
+    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n" ++
+    "pers:xx3 rel:father  pers:yy3 . \n"
+
+conc25    = makeRDFGraphFromN3String conc25str
+conc25str = prefix2 ++
+    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n"
+
+bwd25a    = makeRDFGraphFromN3String bwd25astr
+bwd25astr = prefix2 ++
+    "_:a1 rel:son      pers:Wi3 . \n" ++
+    "_:a1 rel:daughter pers:Ma3 . \n" ++
+    "_:a2 rel:son      pers:Ro4 . \n" ++
+    "_:a2 rel:daughter pers:Rh4 . \n"
+
+rul25 = makeN3ClosureSimpleRule scope2 "rul25" query25str result25str
+fwd25 = fwdApply rul25 [graph2]
+testFwd25  = testEq "testResult25" 1 (length fwd25)
+testFwd25a = testIn "testResult25a" result25a fwd25
+bwd25 = bwdApply rul25 conc25
+testBwd25  = testEq "testBwd25"  1 (length $ head bwd25)
+testBwd25a = testIn "testBwd25a" bwd25a (head bwd25)
+-- testBwd25a1 = testEq "testBwd25a" bwd25a (head $ head bwd25)
+bwd25c = bwdApply rul25 result25c
+testBwd25c = testNo "testBwd25c" bwd25c
+bwd25d = bwdApply rul25 result25d
+testBwd25d = testNo "testBwd25d" bwd25d
+
+
+test2 = TestList
+    [ testFwd21
+    , testFwd21a
+    , testBwd21
+    , testBwd21a
+    , testFwd22
+    , testFwd22a
+    , testBwd22
+    , testBwd22a
+    , testFwd23
+    , testFwd23a
+    , testBwd23
+    , testBwd23a
+    , testFwd24, testFwd24a
+    , testBwd24, testBwd24a1, testBwd24a2, testBwd24a3, testBwd24a4
+    , testFwd25
+    , testFwd25a
+    , testBwd25
+    , testBwd25a, testBwd25c, testBwd25d
+    ]
+
+--  test3:  check variable binding filters
+
+scope3 = Namespace "scope3"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope3"
+
+query31    = makeRDFGraphFromN3String query31str
+query31str = prefix2 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+modify31 :: RDFVarBindingModify
+modify31 = makeVarFilterModify $ varFilterNE (Var "b") (Var "c")
+
+result31    = makeRDFGraphFromN3String result31str
+result31str = prefix2 ++
+    "?b rel:brother ?c . \n"
+
+result31a    = makeRDFGraphFromN3String result31astr
+result31astr = prefix2 ++
+    "pers:Gr3 rel:brother pers:La3 . \n" ++
+    "pers:Gr3 rel:brother pers:Si3 . \n" ++
+    "pers:Gr3 rel:brother pers:Al3 . \n" ++
+    "pers:La3 rel:brother pers:Gr3 . \n" ++
+    "pers:La3 rel:brother pers:Si3 . \n" ++
+    "pers:La3 rel:brother pers:Al3 . \n" ++
+    "pers:Si3 rel:brother pers:Gr3 . \n" ++
+    "pers:Si3 rel:brother pers:La3 . \n" ++
+    "pers:Si3 rel:brother pers:Al3 . \n" ++
+    "pers:Al3 rel:brother pers:Gr3 . \n" ++
+    "pers:Al3 rel:brother pers:La3 . \n" ++
+    "pers:Al3 rel:brother pers:Si3 . \n" ++
+    "pers:Ol4 rel:brother pers:Lo4 . \n" ++
+    "pers:Lo4 rel:brother pers:Ol4 . \n" ++
+    "pers:Ha4 rel:brother pers:El4 . \n" ++
+    "pers:El4 rel:brother pers:Ha4 . \n"
+
+result31b    = makeRDFGraphFromN3String result31bstr
+result31bstr = prefix2 ++
+    "pers:Gr3 rel:brother pers:Gr3 . \n"
+
+result31c    = makeRDFGraphFromN3String result31cstr
+result31cstr = prefix2 ++
+    "pers:Gr3 rel:brother pers:La3 . \n"
+
+bwd31c    = makeRDFGraphFromN3String bwd31cstr
+bwd31cstr = prefix2 ++
+    "_:a rel:son pers:Gr3 . \n" ++
+    "_:a rel:son pers:La3 . \n"
+
+rul31 = makeN3ClosureRule scope3 "rul31" query31str result31str modify31
+fwd31 = fwdApply rul31 [graph2]
+testFwd31  = testEq "testResult31" 1 (length fwd31)
+testFwd31a = testIn "testResult31a" result31a fwd31
+calcbwd31b = bwdApply rul31 result31b
+testBwd31b = testEq "testBwd31"  0 (length calcbwd31b)
+calcbwd31c = bwdApply rul31 result31c
+testBwd31cn = testEq "testBwd31"  1 (length $ head calcbwd31c)
+testBwd31c  = testIn "testBwd31c" bwd31c (head calcbwd31c)
+
+test3 = TestList
+    [ testFwd31
+    , testFwd31a
+    , testBwd31b
+    , testBwd31cn, testBwd31c
+    ]
+
+--  Instance entailment tests
+
+scope4 = Namespace "scope4"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope4"
+
+graph4    = makeRDFGraphFromN3String graph4str
+graph4str = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter pers:Rh4 . \n"
+
+vocab4 = allNodes (not . labelIsVar) graph4
+
+name4 = ScopedName scope4 "instance4"
+
+rule4 = makeRdfInstanceEntailmentRule name4 vocab4
+
+fwd42a    = makeRDFGraphFromN3String fwd42astr
+fwd42astr = prefix2 ++
+    "pers:Gr3 rel:son      _:Ro4 ;    \n" ++
+    "         rel:daughter pers:Rh4 . \n"
+
+fwd42b    = makeRDFGraphFromN3String fwd42bstr
+fwd42bstr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter _:Rh4 .    \n"
+
+fwd42c    = makeRDFGraphFromN3String fwd42cstr
+fwd42cstr = prefix2 ++
+    "pers:Gr3 rel:son      _:Ro4 ;    \n" ++
+    "         rel:daughter _:Rh4 .    \n"
+
+fwd42d    = makeRDFGraphFromN3String fwd42dstr
+fwd42dstr = prefix2 ++
+    "_:Gr3    rel:son      _:Ro4 ;    \n" ++
+    "         rel:daughter pers:Rh4 . \n"
+
+fwd42e    = makeRDFGraphFromN3String fwd42estr
+fwd42estr = prefix2 ++
+    "_:Gr3    rel:son      _:Ro4 ;    \n" ++
+    "         rel:daughter pers:Rh4 . \n"
+
+fwd42f    = makeRDFGraphFromN3String fwd42fstr
+fwd42fstr = prefix2 ++
+    "_:Gr3    rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter _:Rh4 .    \n"
+
+fwd42g    = makeRDFGraphFromN3String fwd42gstr
+fwd42gstr = prefix2 ++
+    "_:Gr3    rel:son      _:Ro4 ;    \n" ++
+    "         rel:daughter _:Rh4 .    \n"
+
+--  Non-entailments
+
+fwd42w    = makeRDFGraphFromN3String fwd42wstr
+fwd42wstr = prefix2 ++
+    "pers:Gr3 rel:daughter pers:Ro4 . \n"
+
+fwd42x    = makeRDFGraphFromN3String fwd42xstr
+fwd42xstr = prefix2 ++
+    "pers:Gr3 rel:daughter pers:Ro4 . \n"
+
+fwd42y    = makeRDFGraphFromN3String fwd42ystr
+fwd42ystr = prefix2 ++
+    "_:Gr3    rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter pers:Ro4 . \n"
+
+fwd42z    = makeRDFGraphFromN3String fwd42zstr
+fwd42zstr = prefix2 ++
+    "_:Gr3    rel:son      _:Ro4 ; \n" ++
+    "         rel:son      _:Rh4 . \n"
+
+
+bwd43 = makeRDFGraphFromN3String bwd43str
+bwd43str = prefix2 ++
+    "_:a1 rel:son      pers:Ro4 . \n" ++
+    "_:a2 rel:daughter pers:Rh4 . \n"
+
+bwd43a = makeRDFGraphFromN3String bwd43astr
+bwd43astr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
+    "pers:Gr3 rel:daughter pers:Rh4 . \n"
+
+bwd43b = makeRDFGraphFromN3String bwd43bstr
+bwd43bstr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
+    "pers:Ro4 rel:daughter pers:Rh4 . \n"
+
+bwd43c = makeRDFGraphFromN3String bwd43cstr
+bwd43cstr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
+    "pers:Rh4 rel:daughter pers:Rh4 . \n"
+
+bwd43d = makeRDFGraphFromN3String bwd43dstr
+bwd43dstr = prefix2 ++
+    "pers:Ro4 rel:son      pers:Ro4 . \n" ++
+    "pers:Gr3 rel:daughter pers:Rh4 . \n"
+
+bwd43e = makeRDFGraphFromN3String bwd43estr
+bwd43estr = prefix2 ++
+    "pers:Ro4 rel:son      pers:Ro4 . \n" ++
+    "pers:Ro4 rel:daughter pers:Rh4 . \n"
+
+bwd43f = makeRDFGraphFromN3String bwd43fstr
+bwd43fstr = prefix2 ++
+    "pers:Ro4 rel:son      pers:Ro4 . \n" ++
+    "pers:Rh4 rel:daughter pers:Rh4 . \n"
+
+bwd43g = makeRDFGraphFromN3String bwd43gstr
+bwd43gstr = prefix2 ++
+    "pers:Rh4 rel:son      pers:Ro4 . \n" ++
+    "pers:Gr3 rel:daughter pers:Rh4 . \n"
+
+bwd43h = makeRDFGraphFromN3String bwd43hstr
+bwd43hstr = prefix2 ++
+    "pers:Rh4 rel:son      pers:Ro4 . \n" ++
+    "pers:Ro4 rel:daughter pers:Rh4 . \n"
+
+bwd43i = makeRDFGraphFromN3String bwd43istr
+bwd43istr = prefix2 ++
+    "pers:Rh4 rel:son      pers:Ro4 . \n" ++
+    "pers:Rh4 rel:daughter pers:Rh4 . \n"
+
+--  Check basics
+testRuleName41 = testEq "testRuleName41" name4 (ruleName rule4)
+testVocab41    = testEq "testVocab41"    3     (length vocab4)
+
+--  Forward chaining
+fwdApply42      = fwdApply rule4 [graph4]
+testFwdLength42 = testEq "testFwdLength42" 7 (length fwdApply42)
+testFwdApply42a = testIn "testFwdApply42a"  fwd42a fwdApply42
+testFwdApply42b = testIn "testFwdApply42b"  fwd42b fwdApply42
+testFwdApply42c = testIn "testFwdApply42c"  fwd42c fwdApply42
+testFwdApply42d = testIn "testFwdApply42d"  fwd42d fwdApply42
+testFwdApply42e = testIn "testFwdApply42e"  fwd42e fwdApply42
+testFwdApply42f = testIn "testFwdApply42f"  fwd42f fwdApply42
+testFwdApply42g = testIn "testFwdApply42g"  fwd42g fwdApply42
+
+--  Backward chaining
+bwdApply43      = bwdApply rule4 bwd43
+testBwdLength43 = testEq "testBwdLength43" 9 (length bwdApply43)
+testBwdApply43a = testIn "testBwdApply43a"  [bwd43a] bwdApply43
+testBwdApply43b = testIn "testBwdApply43b"  [bwd43b] bwdApply43
+testBwdApply43c = testIn "testBwdApply43c"  [bwd43c] bwdApply43
+testBwdApply43d = testIn "testBwdApply43d"  [bwd43d] bwdApply43
+testBwdApply43e = testIn "testBwdApply43e"  [bwd43e] bwdApply43
+testBwdApply43f = testIn "testBwdApply43f"  [bwd43f] bwdApply43
+testBwdApply43g = testIn "testBwdApply43g"  [bwd43g] bwdApply43
+testBwdApply43h = testIn "testBwdApply43h"  [bwd43h] bwdApply43
+testBwdApply43i = testIn "testBwdApply43i"  [bwd43i] bwdApply43
+
+--  Entailment checks
+testEntail44a   = testEq "testEntail44a" True  (checkInference rule4 [graph4] fwd42a)
+testEntail44b   = testEq "testEntail44b" True  (checkInference rule4 [graph4] fwd42b)
+testEntail44g   = testEq "testEntail44g" True  (checkInference rule4 [graph4] fwd42g)
+testEntail44w   = testEq "testEntail44w" False (checkInference rule4 [graph4] fwd42w)
+testEntail44x   = testEq "testEntail44x" False (checkInference rule4 [graph4] fwd42x)
+testEntail44y   = testEq "testEntail44y" False (checkInference rule4 [graph4] fwd42y)
+testEntail44z   = testEq "testEntail44z" False (checkInference rule4 [graph4] fwd42z)
+
+test4 = TestList
+    [ testRuleName41
+    , testVocab41
+    , testFwdLength42
+    , testFwdApply42a
+    , testFwdApply42b
+    , testFwdApply42c
+    , testFwdApply42d
+    , testFwdApply42e
+    , testFwdApply42f
+    , testFwdApply42g
+    , testBwdLength43
+    , testBwdApply43a
+    , testBwdApply43b
+    , testBwdApply43c
+    , testBwdApply43d
+    , testBwdApply43e
+    , testBwdApply43f
+    , testBwdApply43g
+    , testBwdApply43h
+    , testBwdApply43i
+    , testEntail44a
+    , testEntail44b
+    , testEntail44g
+    , testEntail44w
+    , testEntail44x
+    , testEntail44y
+    , testEntail44z
+    ]
+
+--  Subgraph entailment tests
+
+scope5 = Namespace "scope5"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope5"
+
+graph5    = makeRDFGraphFromN3String graph5str
+graph5str = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter pers:Rh4 . \n" ++
+    "pers:Si3 rel:son      pers:Ol4 . \n"
+
+name5 = ScopedName scope5 "subgraph5"
+
+rule5 = makeRdfSubgraphEntailmentRule name5
+
+--  Forward chaining excludes null agraph and copy of antecedent
+fwd52a    = makeRDFGraphFromN3String fwd52astr
+fwd52astr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 . \n"
+
+fwd52b    = makeRDFGraphFromN3String fwd52bstr
+fwd52bstr = prefix2 ++
+    "pers:Gr3 rel:daughter pers:Rh4 . \n"
+
+fwd52c    = makeRDFGraphFromN3String fwd52cstr
+fwd52cstr = prefix2 ++
+    "pers:Si3 rel:son      pers:Ol4 . \n"
+
+fwd52d    = makeRDFGraphFromN3String fwd52dstr
+fwd52dstr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
+    "pers:Gr3 rel:daughter pers:Rh4 . \n"
+
+fwd52e    = makeRDFGraphFromN3String fwd52estr
+fwd52estr = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 . \n" ++
+    "pers:Si3 rel:son      pers:Ol4 . \n"
+
+fwd52f    = makeRDFGraphFromN3String fwd52fstr
+fwd52fstr = prefix2 ++
+    "pers:Gr3 rel:daughter pers:Rh4 . \n" ++
+    "pers:Si3 rel:son      pers:Ol4 . \n"
+
+--  Check basics
+testRuleName51 = testEq "testRuleName51" name5 (ruleName rule5)
+
+--  Forward chaining
+fwdApply52      = fwdApply rule5 [graph5]
+testFwdLength52 = testEq "testFwdLength52" 6 (length fwdApply52)
+testFwdApply52a = testIn "testFwdApply52a"  fwd52a fwdApply52
+testFwdApply52b = testIn "testFwdApply52b"  fwd52b fwdApply52
+testFwdApply52c = testIn "testFwdApply52c"  fwd52c fwdApply52
+testFwdApply52d = testIn "testFwdApply52d"  fwd52d fwdApply52
+testFwdApply52e = testIn "testFwdApply52e"  fwd52e fwdApply52
+testFwdApply52f = testIn "testFwdApply52f"  fwd52f fwdApply52
+
+test5 = TestList
+    [ testRuleName51
+    , testFwdLength52
+    , testFwdApply52a
+    , testFwdApply52b
+    , testFwdApply52c
+    , testFwdApply52d
+    , testFwdApply52e
+    , testFwdApply52f
+    ]
+
+--  Simple entailment test
+--  Simple entailment provides entailment check only, no forward or
+--  backward chaining.  For that use instance- and subgraph- rules.
+
+scope6 = Namespace "scope6"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope6"
+
+graph6    = makeRDFGraphFromN3String graph6str
+graph6str = prefix2 ++
+    "pers:Gr3 rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter pers:Rh4 . \n" ++
+    "pers:Si3 rel:son      pers:Ol4 ; \n" ++
+    "         rel:son      pers:Lo4 . \n"
+
+name6 = ScopedName scope5 "subgraph6"
+
+rule6 = makeRdfSimpleEntailmentRule name6
+
+simple6a    = makeRDFGraphFromN3String simple6astr
+simple6astr = prefix2 ++
+    "_:Gr3 rel:son      pers:Ro4 ; \n" ++
+    "      rel:daughter pers:Rh4 . \n"
+
+simple6b    = makeRDFGraphFromN3String simple6bstr
+simple6bstr = prefix2 ++
+    "_:Si3 rel:son      pers:Ol4 ; \n" ++
+    "      rel:son      pers:Lo4 . \n"
+
+simple6c    = makeRDFGraphFromN3String simple6cstr
+simple6cstr = prefix2 ++
+    "_:Si3 rel:son      _:Ol4 ; \n" ++
+    "      rel:son      _:Lo4 . \n"
+
+simple6d    = makeRDFGraphFromN3String simple6dstr
+simple6dstr = prefix2 ++
+    "_:Si3 rel:son      _:Ol4 ; \n" ++
+    "      rel:daughter _:Lo4 . \n"
+
+simple6e    = makeRDFGraphFromN3String simple6estr
+simple6estr = prefix2 ++
+    "_:Si3 rel:daughter _:Ol4 ; \n" ++
+    "      rel:mother   _:Lo4 . \n"
+
+testRuleName61 = testEq "testRuleName61" name6 (ruleName rule6)
+testSimple62 = test "testSimple62" (checkInference rule6 [graph6] simple6a)
+testSimple63 = test "testSimple63" (checkInference rule6 [graph6] simple6b)
+testSimple64 = test "testSimple64" (checkInference rule6 [graph6] simple6c)
+testSimple65 = test "testSimple65" (checkInference rule6 [graph6] simple6d)
+testSimple66 = test "testSimple66" (not $ checkInference rule6 [graph6] simple6e)
+testFwd67    = test "testFwd64"    (null $ fwdApply rule6 [graph6])
+testBwd68    = test "testBwd65"    (null $ bwdApply rule6 graph6)
+
+test6 = TestList
+    [ testRuleName61
+    , testSimple62
+    , testSimple63
+    , testSimple64
+    , testSimple65
+    , testSimple66
+    , testFwd67
+    , testBwd68
+    ]
+
+--  Test forward chaining node allocation logic
+--
+--  ?a uncle ?c => ?a father ?b, ?b brother ?c,   ?b allocTo ?a
+--
+--    Ro4 uncle La3, Ro4 uncle Si3, Rh4 uncle La3, Rh4 uncle Si3
+--  =>
+--    Ro4 father _:f1, _:f1 brother La3,
+--    Ro4 father _:f1, _:f1 brother Si3,
+--    Rh4 father _:f2, _:f2 brother La3,
+--    Rh4 father _:f2, _:f2 brother Si3
+
+scope7 = Namespace "scope7"
+    "http://id.ninebynine.org/wip/2003/rdfprooftest/scope7"
+
+graph7    = makeRDFGraphFromN3String graph7str
+graph7str = prefix2 ++
+    "pers:Ro4 rel:uncle pers:La3 ; \n" ++
+    "         rel:uncle pers:Si3 . \n" ++
+    "pers:Rh4 rel:uncle pers:La3 ; \n" ++
+    "         rel:uncle pers:Si3 . \n"
+
+query71    = makeRDFGraphFromN3String query71str
+query71str = prefix2 ++
+    "?a rel:uncle ?c . \n"
+
+result71    = makeRDFGraphFromN3String result71str
+result71str = prefix2 ++
+    "?a rel:father  ?b . \n" ++
+    "?b rel:brother ?c . \n"
+
+result71a    = makeRDFGraphFromN3String result71astr
+result71astr = prefix2 ++
+    "pers:Ro4 rel:father  _:f1     . \n" ++
+    "_:f1     rel:brother pers:La3 . \n" ++
+    "pers:Ro4 rel:father  _:f1     . \n" ++
+    "_:f1     rel:brother pers:Si3 . \n" ++
+    "pers:Rh4 rel:father  _:f2     . \n" ++
+    "_:f2     rel:brother pers:La3 . \n" ++
+    "pers:Rh4 rel:father  _:f2     . \n" ++
+    "_:f2     rel:brother pers:Si3 . \n"
+
+rul71 = makeN3ClosureAllocatorRule scope7 "rul71"
+    query71str result71str varBindingId mod71
+
+mod71 = makeNodeAllocTo (Var "b") (Var "a")
+
+var71      = rdfQueryFind query71 graph7
+testVar71  = testEq "testVar71" 4 (length var71)
+var71a     = vbmApply (mod71 (allLabels labelIsVar graph7)) var71
+testVar71a = testEq "testVar71a" 4 (length var71a)
+var71_1    = head var71a
+map71a     = Just (Var "#a")
+map71b     = Just (Var "#b")
+map71c     = Just (Var "#c")
+testVar71_1a = testEq "testVar71_1a" map71a ( vbMap var71_1 (Var "a"))
+testVar71_1b = testEq "testVar71_1b" map71b ( vbMap var71_1 (Var "b"))
+testVar71_1c = testEq "testVar71_1c" map71c ( vbMap var71_1 (Var "c"))
+sub71a     = rdfQuerySubs var71a result71
+testSub71a = testEq "testVar71a" 4 (length sub71a)
+
+fwd71 = fwdApply rul71 [graph7]
+testFwd71  = testEq "testResult71" 1 (length fwd71)
+testFwd71a = testIn "testResult71a" result71a fwd71
+
+test7 = TestList
+    [ testVar71,  testVar71a
+    -- , testVar71_1a, testVar71_1b, testVar71_1c
+    , testSub71a
+    , testFwd71
+    , testFwd71a
+    ]
+
+--  Full test suite, main program, and useful expressions for interactive use
+
+allTests = TestList
+  [ test1
+  , test2
+  , test3
+  , test4
+  , test5
+  , test6
+  , test7
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFProofTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.21 $
+-- $Log: RDFProofTest.hs,v $
+-- Revision 1.21  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.20  2003/12/20 12:53:40  graham
+-- Fix up code to compile and test with GHC 5.04.3
+--
+-- Revision 1.19  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.18  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.17  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.16  2003/10/24 21:05:09  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.15  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.14  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.13  2003/09/30 20:02:39  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.12  2003/09/30 16:39:41  graham
+-- Refactor proof code to use new ruleset logic.
+-- Moved some support code from RDFProofCheck to RDFRuleset.
+--
+-- Revision 1.11  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.10  2003/07/02 22:39:36  graham
+-- Subgraph entailment and Graph closure instance entailment rules
+-- now tested.  RDF forward chaining revised to combine output graphs,
+-- to preserve blank node relationships.
+--
+-- Revision 1.9  2003/07/02 21:27:30  graham
+-- Graph closure with instance rule tested.
+-- About to change ProofTest for graph forward chaining to return
+-- a single result graph.
+--
+-- Revision 1.8  2003/06/30 19:07:00  graham
+-- Instance entailment, subgraph entailment and simple entailment
+-- tests now working.
+--
+-- Revision 1.7  2003/06/27 20:46:00  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.6  2003/06/25 10:18:55  graham
+-- Added variable binding filter test case for forward and backward chaining.
+--
+-- Revision 1.5  2003/06/25 09:52:25  graham
+-- Replaced Rule class with algebraic data type
+--
+-- Revision 1.4  2003/06/19 19:49:07  graham
+-- RDFProofCheck compiles, but test fails
+--
+-- Revision 1.3  2003/06/18 18:40:08  graham
+-- Basic proof backchaining tests OK.
+-- Next:  add filtering on variable bindings.
+--
+-- Revision 1.2  2003/06/18 01:29:29  graham
+-- Fixed up some problems with backward chaining queries.
+-- Query test cases still to complete.
+-- Proof incomplete.
+--
+-- Revision 1.1  2003/06/13 21:43:47  graham
+-- Add proof test module.
+-- Many tests pass, backward chaining still problem.
+-- Need to add proof-checker test cases.
+--
+ Swish/HaskellRDF/RDFQuery.hs view
@@ -0,0 +1,737 @@+--------------------------------------------------------------------------------
+--  $Id: RDFQuery.hs,v 1.32 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFQuery
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines functions for querying an RDF graph to obtain
+--  a set of variable substitutions, and to apply a set of variable
+--  substitutions to a query pattern to obtain a new graph.
+--
+--  It also defines a few primitive graph access functions.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFQuery
+    ( rdfQueryFind, rdfQueryFilter
+    , rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify
+    , rdfQueryInstance
+    , rdfQuerySubs, rdfQueryBackSubs
+    , rdfQuerySubsAll
+    , rdfQuerySubsBlank, rdfQueryBackSubsBlank
+    , rdfFindArcs, rdfSubjEq, rdfPredEq, rdfObjEq
+    , rdfFindPredVal, rdfFindPredInt, rdfFindValSubj
+    , rdfFindList
+    -- debug
+    , rdfQuerySubs2 )
+where
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding, nullRDFVarBinding
+    , RDFVarBindingFilter
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( Arc(..), LDGraph(..)
+    , arcSubj, arcPred, arcObj
+    , RDFLabel(..)
+    , isDatatyped, isBlank, isQueryVar
+    , getLiteralText, makeBlank
+    , RDFTriple
+    , RDFGraph, emptyRDFGraph
+    , allLabels, remapLabels
+    , res_rdf_first
+    , res_rdf_rest
+    , res_rdf_nil
+    )
+
+import Swish.HaskellRDF.MapXsdInteger
+    ( mapXsdInteger
+    )
+
+import Swish.HaskellRDF.Datatype
+    ( DatatypeMap(..)
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    , makeVarBinding
+    , applyVarBinding, joinVarBindings
+    , VarBindingModify(..)
+    , VarBindingFilter(..)
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( xsd_integer, xsd_nonneg_integer
+    )
+
+import Swish.HaskellUtils.FunctorM
+    ( FunctorM(..) )
+
+import Swish.HaskellUtils.ListHelpers
+    ( listProduct, allp, anyp )
+
+import Control.Monad.State
+    ( State(..), modify )
+
+import Data.Maybe
+    ( catMaybes, isJust, fromJust )
+
+------------------------------------------------------------
+--  Primitive RDF graph queries
+------------------------------------------------------------
+
+-- |Basic graph-query function.
+--  A very basic form of graph query, a query graph and
+--  a target graph, and returns a list of 'RDFVarBinding'
+--  values, each of which corresponds to a set of variable
+--  bindings that make the query graph a subgraph of the
+--  target graph, or [] if the query cannot be matched.
+--
+--  The triples of the query graph are matched sequentially
+--  against the target graph, each taking account of any
+--  variable bindings that have already been determined,
+--  and adding new variable bindings as triples containing
+--  query variables are matched against the graph.
+--
+rdfQueryFind :: RDFGraph -> RDFGraph -> [RDFVarBinding]
+rdfQueryFind qg =
+    rdfQueryPrim1 matchQueryVariable nullRDFVarBinding (getArcs qg)
+
+--  Helper function to match query against a graph.
+--  A node-query function is supplied to determine how query nodes
+--  are matched against target graph nodes.  Also supplied is
+--  an initial variable binding.
+--
+rdfQueryPrim1 ::
+    NodeQuery RDFLabel -> RDFVarBinding -> [Arc RDFLabel]
+    -> RDFGraph
+    -> [RDFVarBinding]
+rdfQueryPrim1 _     initv []       _  = [initv]
+rdfQueryPrim1 nodeq initv (qa:qas) tg =
+    let
+        qam  = fmap (applyVarBinding initv) qa      -- subst vars already bound
+        newv = rdfQueryPrim2 nodeq qam tg           -- new bindings, or null
+    in
+        concat
+            [ rdfQueryPrim1 nodeq v2 qas tg
+            | v1 <- newv
+            , let v2 = joinVarBindings initv v1
+            ]
+
+--  Match single query term against graph, and return any new sets
+--  of variable bindings thus defined, or [] if the query term
+--  cannot be matched.  Each of the RDFVarBinding values returned
+--  represents an alternative possible match for the query arc.
+--
+rdfQueryPrim2 ::
+    NodeQuery RDFLabel -> Arc RDFLabel
+    -> RDFGraph
+    -> [RDFVarBinding]
+rdfQueryPrim2 nodeq qa tg =
+        catMaybes $ map (getBinding nodeq qa) $ getArcs tg
+
+-- |RDF query filter.  This function applies a supplied query binding
+--  filter to the result from a call of 'rdfQueryFind'.
+--
+--  If none of the query bindings found satisfy the filter, a null
+--  list is returned (which is what 'rdfQueryFind' returns if the
+--  query cannot be satisfied).
+--
+--  (Because of lazy evaluation, this should be as efficient as
+--  applying the filter as the search proceeds.  I started to build
+--  the filter logic into the query function itself, with consequent
+--  increase in complexity, until I remembered lazy evaluation lets
+--  me keep things separate.)
+--
+rdfQueryFilter ::
+    RDFVarBindingFilter -> [RDFVarBinding] -> [RDFVarBinding]
+rdfQueryFilter qbf qbs = filter (vbfTest qbf) qbs
+
+------------------------------------------------------------
+--  Backward-chaining RDF graph queries
+------------------------------------------------------------
+
+-- |Reverse graph-query function.
+--  Similar to rdfQueryFind, but with different success criteria.
+--  The query graph is matched against the supplied graph,
+--  but not every triple of the query is required to be matched.
+--  Rather, every triple of the target graph must be matched,
+--  and substitutions for just the variables thus bound are
+--  returned.  In effect, these are subsitutions in the query
+--  that entail the target graph (where rdfQueryFind returns
+--  substitutions that are entailed by the target graph).
+--
+--  Multiple substitutions may be used together, so the result
+--  returned is a list of lists of query bindings.  Each inner
+--  list contains several variable bindings that must all be applied
+--  separately to the closure antecendents to obtain a collection of
+--  expressions that together are antecedent to the supplied
+--  conclusion.  A null list of bindings returned means the
+--  conclusion can be inferred without any antecedents.
+--
+--  Note:  in back-chaining, the conditions required to prove each
+--  target triple are derived independently, using the inference rule
+--  for each such triple, so there are no requirements to check
+--  consistency with previously determined variable bindings, as
+--  there are when doing forward chaining.  A result of this is that
+--  there may be redundant triples generated by the back-chaining
+--  process.  Any process using back-chaining should deal with the
+--  results returned accordingly.
+--
+--  An empty outer list is returned if no combination of
+--  substitutions can infer the supplied target.
+--
+rdfQueryBack :: RDFGraph -> RDFGraph -> [[RDFVarBinding]]
+rdfQueryBack qg tg =
+    rdfQueryBack1 matchQueryVariable [] (getArcs qg) (getArcs tg)
+
+rdfQueryBack1 ::
+    NodeQuery RDFLabel -> [RDFVarBinding] -> [Arc RDFLabel] -> [Arc RDFLabel]
+    -> [[RDFVarBinding]]
+rdfQueryBack1 _     initv _   []       = [initv]
+rdfQueryBack1 nodeq initv qas (ta:tas) = concat
+    [ rdfQueryBack1 nodeq (nv:initv) qas tas
+    | nv <- rdfQueryBack2 nodeq qas ta ]
+
+--  Match a query against a single graph term, and return any new sets of
+--  variable bindings thus defined.  Each member of the result is an
+--  alternative possible set of variable bindings.  An empty list returned
+--  means no match.
+--
+rdfQueryBack2 ::
+    NodeQuery RDFLabel -> [Arc RDFLabel] -> Arc RDFLabel
+    -> [RDFVarBinding]
+rdfQueryBack2 nodeq qas ta =
+    [ fromJust b | qa <- qas, let b = getBinding nodeq qa ta, isJust b ]
+
+-- |RDF back-chaining query filter.  This function applies a supplied
+--  query binding filter to the result from a call of 'rdfQueryBack'.
+--
+--  Each inner list contains bindings that must all be used to satisfy
+--  the backchain query, so if any query binding does not satisfy the
+--  filter, the entire corresponding row is removed
+rdfQueryBackFilter ::
+    RDFVarBindingFilter -> [[RDFVarBinding]] -> [[RDFVarBinding]]
+rdfQueryBackFilter qbf qbss = filter (and . map (vbfTest qbf)) qbss
+
+-- |RDF back-chaining query modifier.  This function applies a supplied
+--  query binding modifier to the result from a call of 'rdfQueryBack'.
+--
+--  Each inner list contains bindings that must all be used to satisfy
+--  a backchaining query, so if any query binding does not satisfy the
+--  filter, the entire corresponding row is removed
+--
+rdfQueryBackModify ::
+    VarBindingModify a b -> [[VarBinding a b]] -> [[VarBinding a b]]
+rdfQueryBackModify qbm qbss = concatMap (rdfQueryBackModify1 qbm) qbss
+
+--  Auxiliary back-chaining query variable binding modifier function:
+--  for a supplied list of variable bindings, all of which must be used
+--  together when backchaining:
+--  (a) make each list member into a singleton list
+--  (b) apply the binding modifier to each such list, which may result
+--      in a list with zero, one or more elements.
+--  (c) return the listProduct of these, each member of which is
+--      an alternative list of variable bindings, where the members of
+--      each alternative must be used together.
+--
+rdfQueryBackModify1 ::
+    VarBindingModify a b -> [VarBinding a b] -> [[VarBinding a b]]
+rdfQueryBackModify1 qbm qbs = listProduct $ map ((vbmApply qbm) . (:[])) qbs
+
+------------------------------------------------------------
+--  Simple entailment graph query
+------------------------------------------------------------
+
+-- |Simple entailment (instance) graph query.
+--  This function queries a graph to find instances of the
+--  query graph in the target graph.  It is very similar
+--  to the normal forward chaining query 'rdfQueryFind',
+--  except that blank nodes rather than query variable nodes
+--  in the query graph are matched against nodes in the target
+--  graph.  Neither graph should contain query variables.
+--
+--  An "instance" is defined by the RDF semantics specification,
+--  per <http://www.w3.org/TR/rdf-mt/>, and is obtained by replacing
+--  blank nodes with URIs, literals or other blank nodes.  RDF
+--  "simple entailment" can be determined in terms of instances.
+--  This function looks for a subgraph of the target graph that
+--  is an instance of the query graph, which is a necessary and
+--  sufficient condition for RDF entailment (see the Interpolation
+--  Lemma in RDF Semantics, section 1.2).
+--
+--  It is anticipated that this query function can be used in
+--  conjunction with backward chaining to determine when the
+--  search for sufficient antecendents to determine some goal
+--  has been concluded.
+rdfQueryInstance :: RDFGraph -> RDFGraph -> [RDFVarBinding]
+rdfQueryInstance qg =
+    rdfQueryPrim1 matchQueryBnode nullRDFVarBinding (getArcs qg)
+
+------------------------------------------------------------
+--  Primitive RDF graph query support functions
+------------------------------------------------------------
+
+-- |Type of query node testing function.  Return value is:
+--  - Nothing    if no match
+--  - Just True  if match with new variable binding
+--  - Just False if match with new variable binding
+type NodeQuery a = a -> a -> Maybe Bool
+
+--  Extract query binding from matching a single query triple with a
+--  target triple, returning:
+--  - Nothing if the query is not matched
+--  - Just nullVarBinding if there are no new variable bindings
+--  - Just binding is a new query binding for this match
+getBinding ::
+    NodeQuery RDFLabel -> Arc RDFLabel -> Arc RDFLabel
+    -> Maybe RDFVarBinding
+getBinding nodeq (Arc s1 p1 o1) (Arc s2 p2 o2) =
+    makeBinding [(s1,s2),(p1,p2),(o1,o2)] []
+    where
+        makeBinding [] bs = Just $ makeVarBinding bs
+        makeBinding (vr@(v,r):bvrs) bs =
+            case nodeq v r of
+                Nothing    -> Nothing
+                Just False -> makeBinding bvrs bs
+                Just True  -> makeBinding bvrs (vr:bs)
+
+--  Match variable node against target node, returning
+--  Nothing if they do not match, Just True if a variable
+--  node is matched (thereby creating a new variable binding)
+--  or Just False if a non-blank node is matched.
+matchQueryVariable :: NodeQuery RDFLabel
+matchQueryVariable (Var _) _ = Just True
+matchQueryVariable q t
+    | q == t    = Just False
+    | otherwise = Nothing
+
+--  Match blank query node against target node, returning
+--  Nothing if they do not match, Just True if a blank node
+--  is matched (thereby creating a new equivalence) or
+--  Just False if a non-blank node is matched.
+matchQueryBnode :: NodeQuery RDFLabel
+matchQueryBnode (Blank _) _ = Just True
+matchQueryBnode q t
+    | q == t    = Just False
+    | otherwise = Nothing
+
+------------------------------------------------------------
+--  Substitute results from RDF query back into a graph
+------------------------------------------------------------
+
+-- |Graph substitution function.
+--  Uses the supplied variable bindings to substitute variables in
+--  a supplied graph, returning a list of result graphs corresponding
+--  to each set of variable bindings applied to the input graph.
+--  This function is used for formward chaining substitutions, and
+--  returns only those result graphs for which all query variables
+--  are bound.
+rdfQuerySubs :: [RDFVarBinding] -> RDFGraph -> [RDFGraph]
+rdfQuerySubs vars gr =
+    map fst $ filter (null . snd) $ rdfQuerySubsAll vars gr
+
+-- |Graph back-substitution function.
+--  Uses the supplied variable bindings from 'rdfQueryBack' to perform
+--  a series of variable substitutions in a supplied graph, returning
+--  a list of lists of result graphs corresponding to each set of variable
+--  bindings applied to the input graphs.
+--
+--  The outer list of the result contains alternative antecedent lists
+--  that satisfy the query goal.  Each inner list contains graphs that
+--  must all be inferred to satisfy the query goal.
+rdfQueryBackSubs ::
+    [[RDFVarBinding]] -> RDFGraph -> [[(RDFGraph,[RDFLabel])]]
+rdfQueryBackSubs varss gr = [ rdfQuerySubsAll v gr | v <- varss ]
+
+-- |Graph substitution function.
+--  This function performs the substitutions and returns a list of
+--  result graphs each paired with a list unbound variables in each.
+rdfQuerySubsAll :: [RDFVarBinding] -> RDFGraph -> [(RDFGraph,[RDFLabel])]
+rdfQuerySubsAll vars gr = [ rdfQuerySubs2 v gr | v <- vars ]
+
+-- |Graph substitution function.
+--  This function performs each of the substitutions in 'vars', and
+--  replaces any nodes corresponding to unbound query variables
+--  with new blank nodes.
+rdfQuerySubsBlank :: [RDFVarBinding] -> RDFGraph -> [RDFGraph]
+rdfQuerySubsBlank vars gr =
+    [ remapLabels vs bs makeBlank g
+    | v <- vars
+    , let (g,vs) = rdfQuerySubs2 v gr
+    , let bs     = allLabels isBlank g
+    ]
+
+-- |Graph back-substitution function, replacing variables with bnodes.
+--  Uses the supplied variable bindings from 'rdfQueryBack' to perform
+--  a series of variable substitutions in a supplied graph, returning
+--  a list of lists of result graphs corresponding to each set of variable
+--  bindings applied to the input graphs.
+--
+--  The outer list of the result contains alternative antecedent lists
+--  that satisfy the query goal.  Each inner list contains graphs that
+--  must all be inferred to satisfy the query goal.
+rdfQueryBackSubsBlank :: [[RDFVarBinding]] -> RDFGraph -> [[RDFGraph]]
+rdfQueryBackSubsBlank varss gr = [ rdfQuerySubsBlank v gr | v <- varss ]
+
+--  This function applies a substitution for a single set of variable
+--  bindings, returning the result and a list of unbound variables.
+--  It uses a state transformer monad to collect the list of
+--  unbound variables.
+--
+--  Adding an empty graph forces elimination of duplicate arcs.
+rdfQuerySubs2 :: RDFVarBinding -> RDFGraph -> (RDFGraph,[RDFLabel])
+rdfQuerySubs2 varb gr = (add emptyRDFGraph g,vs)
+    where
+        (g,vs) = runState ( fmapM (mapNode varb) gr ) []
+
+--  Auxiliary monad function for rdfQuerySubs2.
+--  This returns a state transformer Monad which in turn returns the
+--  substituted node value based on the supplied query variable bindings.
+--  The monad state is a list of labels which accumulates all those
+--  variables seen for which no substitution was available.
+mapNode :: RDFVarBinding -> RDFLabel -> State [RDFLabel] RDFLabel
+mapNode varb lab =
+    case vbMap varb lab of
+        Just v  -> return v
+        Nothing ->
+            if isQueryVar lab then
+                do  { modify (addVar lab)
+                    ; return lab
+                    }
+            else
+                return lab
+
+--  Add variable to list of variables, if not already there
+addVar :: RDFLabel -> [RDFLabel] -> [RDFLabel]
+addVar var vars = if var `elem` vars then vars else var:vars
+
+------------------------------------------------------------
+--  Simple lightweight query primitives
+------------------------------------------------------------
+--
+--  [[[TODO:  modify above code to use these for all graph queries]]]
+
+-- |rdfFindArcs is the main function here:  it takes a predicate on an
+--  RDF statement and a graph, and returns all statements in the graph
+--  satisfying that predicate.
+--
+--  Use combinations of these as follows:
+--
+--  (a) find all statements with given subject:
+--          rdfQuerySimple (rdfSubjEq s)
+--  (b) find all statements with given property:
+--          rdfQuerySimple (rdfPredEq p)
+--  (c) find all statements with given object:
+--          rdfQuerySimple (rdfObjEq  o)
+--  (d) find all statements matching conjunction of these conditions:
+--          rdfQuerySimple (allp [...])
+--  (e) find all statements matching disjunction of these conditions:
+--          rdfQuerySimple (anyp [...])
+--  (See ListHelpers for allp, anyp.)
+--
+--  Custom predicates can also be used.
+--
+rdfFindArcs :: (RDFTriple -> Bool) -> RDFGraph -> [RDFTriple]
+rdfFindArcs p = filter p . getArcs
+
+-- |Test if statement has given subject
+rdfSubjEq :: RDFLabel -> RDFTriple -> Bool
+rdfSubjEq s = (s==) . arcSubj
+
+-- |Test if statement has given predicate
+rdfPredEq :: RDFLabel -> RDFTriple -> Bool
+rdfPredEq p = (p==) . arcPred
+
+-- |Test if statement has given object
+rdfObjEq  :: RDFLabel -> RDFTriple -> Bool
+rdfObjEq o  = (o==) . arcObj
+
+{-
+-- |Find statements with given subject
+rdfFindSubj :: RDFLabel -> RDFGraph -> [RDFTriple]
+rdfFindSubj s = rdfFindArcs (rdfSubjEq s)
+
+-- |Find statements with given predicate
+rdfFindPred :: RDFLabel -> RDFGraph -> [RDFTriple]
+rdfFindPred p = rdfFindArcs (rdfPredEq p)
+-}
+
+-- |Find values of given predicate for a given subject
+rdfFindPredVal :: RDFLabel -> RDFLabel -> RDFGraph -> [RDFLabel]
+rdfFindPredVal s p = map arcObj . rdfFindArcs (allp [rdfSubjEq s,rdfPredEq p])
+
+-- |Find integer values of a given predicate for a given subject
+rdfFindPredInt :: RDFLabel -> RDFLabel -> RDFGraph -> [Integer]
+rdfFindPredInt s p = catMaybes . map getint . filter isint . pvs
+    where
+        pvs = rdfFindPredVal s p
+        isint  = anyp
+            [ isDatatyped xsd_integer
+            , isDatatyped xsd_nonneg_integer
+            ]
+        getint = mapL2V mapXsdInteger . getLiteralText
+
+-- |Find all subjects that have a of given value for for a given predicate
+rdfFindValSubj :: RDFLabel -> RDFLabel -> RDFGraph -> [RDFLabel]
+rdfFindValSubj p o = map arcSubj . rdfFindArcs (allp [rdfPredEq p,rdfObjEq o])
+
+------------------------------------------------------------
+--  List query
+------------------------------------------------------------
+
+-- |Return a list of nodes that comprise an rdf:collection value,
+--  given the head element of the collection.  If the list is
+--  ill-formed then some arbitrary value is returned.
+--
+rdfFindList :: RDFGraph -> RDFLabel -> [RDFLabel]
+rdfFindList gr hd = findhead $ rdfFindList gr findrest
+    where
+        findhead  = headOr (const []) $
+                    map (:) (rdfFindPredVal hd res_rdf_first gr)
+        findrest  = headOr res_rdf_nil (rdfFindPredVal hd res_rdf_rest gr)
+        {-
+        findhead  = headOr (const [])
+                    [ (ob:) | Arc _ sb ob <- subgr, sb == res_rdf_first ]
+        findrest  = headOr res_rdf_nil
+                    [ ob | Arc _ sb ob <- subgr, sb == res_rdf_rest  ]
+        subgr     = filter ((==) hd . arcSubj) $ getArcs gr
+        -}
+        headOr    = foldr const
+        -- headOr _ (x:_) = x
+        -- headOr x []    = x
+
+------------------------------------------------------------
+--  Interactive tests
+------------------------------------------------------------
+
+{-
+s1 = Blank "s1"
+p1 = Blank "p1"
+o1 = Blank "o1"
+s2 = Blank "s2"
+p2 = Blank "p2"
+o2 = Blank "o2"
+qs1 = Var "s1"
+qp1 = Var "p1"
+qo1 = Var "o1"
+qs2 = Var "s2"
+qp2 = Var "p2"
+qo2 = Var "o2"
+
+qa1 = Arc qs1 qp1 qo1
+qa2 = Arc qs2 qp2 qo2
+qa3 = Arc qs2  p2 qo2
+ta1 = Arc s1 p1 o1
+ta2 = Arc s2 p2 o2
+
+g1  = toRDFGraph [ta1,ta2]
+g2  = toRDFGraph [qa3]
+
+gb1  = getBinding matchQueryVariable qa1 ta1    -- ?s1=_:s1, ?p1=_:p1, ?o1=_:o1
+gvs1 = qbMap (fromJust gb1) qs1                 -- _:s1
+gvp1 = qbMap (fromJust gb1) qp1                 -- _:p1
+gvo1 = qbMap (fromJust gb1) qo1                 -- _:o1
+gvs2 = qbMap (fromJust gb1) qs2                 -- Nothing
+
+gb3  = getBinding matchQueryVariable qa3 ta1    -- Nothing
+gb4  = getBinding matchQueryVariable qa3 ta2    -- ?s2=_:s1, ?o2=_:o1
+
+mqvs1 = matchQueryVariable qs2 s1
+mqvp1 = matchQueryVariable p2  p1
+
+--  rdfQueryFind
+
+qfa  = rdfQueryFind g2 g1
+
+qp2a = rdfQueryPrim2 matchQueryVariable qa3 g1
+-}
+
+{- more tests
+
+qb1a = rdfQueryBack1 [] [qa1] [ta1,ta2]
+qb1 = rdfQueryBack1 [] [qa1,qa2] [ta1,ta2]
+ql1 = length qb1
+qv1 = map (qb1!!0!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv2 = map (qb1!!0!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv3 = map (qb1!!1!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv4 = map (qb1!!1!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv5 = map (qb1!!2!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv6 = map (qb1!!2!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv7 = map (qb1!!3!!0) [qs1,qp1,qo1,qs2,qp2,qo2]
+qv8 = map (qb1!!3!!1) [qs1,qp1,qo1,qs2,qp2,qo2]
+
+qb2 = rdfQueryBack2 matchQueryVariable [qa1,qa2] ta1
+ql2 = length qb2
+qv1 = map (qbMap $ head qb2)        [qs1,qp1,qo1,qs2,qp2,qo2]
+qv2 = map (qbMap $ head $ tail qb2) [qs1,qp1,qo1,qs2,qp2,qo2]
+qb3 = rdfQueryBack2 matchQueryVariable [qa1,qa3] ta1
+
+-}
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFQuery.hs,v $
+-- $Author: graham $
+-- $Revision: 1.32 $
+-- $Log: RDFQuery.hs,v $
+-- Revision 1.32  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.31  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.30  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.29  2003/11/14 16:04:43  graham
+-- Add primitive query to get integer values from a graph.
+--
+-- Revision 1.28  2003/11/14 16:01:30  graham
+-- Separate RDFVarBinding from module RDFQuery.
+--
+-- Revision 1.27  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.26  2003/10/16 16:01:48  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.25  2003/10/15 16:40:52  graham
+-- Reworked RDFQuery to use new query binding framework.
+-- (Note: still uses VarBindingFilter rather than VarBindingModify.
+-- The intent is to incorproate the VarBindingModify logic into RDFProof,
+-- displaying the existing use of BindingFilter.)
+--
+-- Revision 1.24  2003/10/09 17:16:13  graham
+-- Added test cases to exercise features of rules used to capture
+-- RDF semantics.  Also added proof test case using XML literal.
+--
+-- Revision 1.23  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.22  2003/10/01 00:38:00  graham
+-- Correct error in previous commit.
+--
+-- Revision 1.21  2003/10/01 00:36:25  graham
+-- Added RDFGraph method to test for container membership property label.
+-- Added RDFQuery filter function to select container membership properties.
+--
+-- Revision 1.20  2003/09/30 20:02:40  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.19  2003/09/30 16:39:41  graham
+-- Refactor proof code to use new ruleset logic.
+-- Moved some support code from RDFProofCheck to RDFRuleset.
+--
+-- Revision 1.18  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.17  2003/07/03 20:31:07  graham
+-- Add initial draft of datatype framework.
+--
+-- Revision 1.16  2003/07/02 22:39:36  graham
+-- Subgraph entailment and Graph closure instance entailment rules
+-- now tested.  RDF forward chaining revised to combine output graphs,
+-- to preserve blank node relationships.
+--
+-- Revision 1.15  2003/07/02 21:27:30  graham
+-- Graph closure with instance rule tested.
+-- About to change ProofTest for graph forward chaining to return
+-- a single result graph.
+--
+-- Revision 1.14  2003/07/02 13:51:14  graham
+-- Intermediate save:  partially coded RDFS rules.
+--
+-- Revision 1.13  2003/06/27 20:46:00  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.12  2003/06/26 15:37:23  graham
+-- Added rdfQueryInstance, and tests, all works.
+--
+-- Revision 1.11  2003/06/25 09:52:25  graham
+-- Replaced Rule class with algebraic data type
+--
+-- Revision 1.10  2003/06/19 19:49:07  graham
+-- RDFProofCheck compiles, but test fails
+--
+-- Revision 1.9  2003/06/19 00:26:29  graham
+-- Query binding filter methods tested.
+--
+-- Revision 1.8  2003/06/18 23:37:53  graham
+-- Added query binding filter methods.  Not yet tested.
+--
+-- Revision 1.7  2003/06/18 14:59:27  graham
+-- Augmented query variable binding structure.
+-- RDFQuery tests OK.
+--
+-- Revision 1.6  2003/06/18 01:29:29  graham
+-- Fixed up some problems with backward chaining queries.
+-- Query test cases still to complete.
+-- Proof incomplete.
+--
+-- Revision 1.5  2003/06/17 17:53:08  graham
+-- Added backward chaining query primitive.
+--
+-- Revision 1.4  2003/06/17 16:29:20  graham
+-- Eliminate redundant Maybe in return type of rdfQueryPrim.
+-- (A null list suffices for the Nothing case.)
+--
+-- Revision 1.3  2003/06/17 15:59:09  graham
+-- Update to use revised version of remapNodes, which accepts a
+-- node-mapping function rather than just a Boolean to control conversion
+-- of query variable nodes to blank
+-- nodes.
+--
+-- Revision 1.2  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.1  2003/06/12 00:49:06  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--
+ Swish/HaskellRDF/RDFQueryTest.hs view
@@ -0,0 +1,1711 @@+--------------------------------------------------------------------------------
+--  $Id: RDFQueryTest.hs,v 1.23 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFQueryTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + multi-parameter classes
+--
+--  This module defines test cases for querying an RDF graph to obtain
+--  a set of variable substitutions, and to apply a set of variable
+--  substitutions to a query pattern to obtain a new graph.
+--
+--  It also tests some primitive graph access functions.
+--
+--------------------------------------------------------------------------------
+
+--  WNH RIP OUT module Swish.HaskellRDF.RDFQueryTest
 where
+
+import Swish.HaskellRDF.RDFQuery
+    ( rdfQueryFind, rdfQueryFilter
+    , rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify
+    , rdfQueryInstance
+    , rdfQuerySubs, rdfQueryBackSubs
+    , rdfQuerySubsAll
+    , rdfQuerySubsBlank, rdfQueryBackSubsBlank
+    , rdfFindArcs, rdfSubjEq, rdfPredEq, rdfObjEq, rdfFindPredVal
+    , rdfFindValSubj, rdfFindPredVal, rdfFindPredInt, rdfFindList
+    -- debug
+    , rdfQuerySubs2
+    )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding, nullRDFVarBinding
+    , RDFVarBindingModify, RDFVarBindingFilter
+    , rdfVarBindingUriRef, rdfVarBindingBlank
+    , rdfVarBindingLiteral
+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
+    , rdfVarBindingMemberProp
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( Arc(..), arcSubj
+    , RDFGraph, RDFLabel(..)
+    , isLiteral, isBlank, isQueryVar, makeBlank
+    , setArcs, getArcs, addArc, add, delete, extract, labels, merge
+    , allLabels, remapLabels
+    , mapnode, maplist
+    , res_rdf_type, res_rdf_first, res_rdf_rest, res_rdf_nil
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..), nullVarBinding
+    , boundVars, subBinding, makeVarBinding
+    , applyVarBinding, joinVarBindings
+    , VarBindingModify(..)
+    , vbmCompatibility, vbmCompose
+    , findCompositions, findComposition
+    , VarBindingFilter(..)
+    , makeVarFilterModify
+    , makeVarTestFilter, makeVarCompareFilter
+    , varBindingId, varFilterDisjunction, varFilterConjunction
+    , varFilterEQ, varFilterNE
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , makeNamespaceQName
+    , ScopedName(..)
+    , getQName
+    , makeScopedName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceXSD
+    , namespaceLang, langName
+    , swishName
+    , rdf_type, rdf_XMLLiteral
+    , xsd_boolean, xsd_integer
+    )
+
+import Swish.HaskellRDF.N3Parser
+    ( ParseResult(..), parseN3fromString )
+
+import Swish.HaskellUtils.QName
+    ( QName(..) )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Swish.HaskellUtils.ErrorM
+    ( ErrorM(Error,Result) )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertBool, assertEqual, assertString
+    , runTestTT, runTestText, putTextToHandle )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn )
+
+import Data.Maybe
+    ( isJust, fromJust )
+
+------------------------------------------------------------
+--  misc helpers
+------------------------------------------------------------
+
+newtype Set a = Set [a] deriving Show
+instance (Eq a) => Eq (Set a) where
+    Set v1 == Set v2 = v1 `equiv` v2
+
+test :: String -> Bool -> Test
+test lab tst = TestCase $ assertBool lab tst
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab e a = TestCase $ assertEqual lab e a
+
+testLs :: (Eq a, Show a) => String -> [a] -> [a] -> Test
+testLs lab e a = TestCase $ assertEqual lab (Set e) (Set a)
+
+testGr :: String -> String -> [RDFGraph] -> Test
+testGr lab e a = TestCase $ assertBool lab (eg `elem` a)
+    where eg = graphFromString e
+
+graphFromString :: String -> RDFGraph
+graphFromString str = case parseN3fromString str of
+    Result gr -> gr
+    Error msg -> error msg
+
+-- Compare lists for set equivalence:
+
+data ListTest a = ListTest [a]
+
+instance (Eq a) => Eq (ListTest a) where
+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
+
+instance (Show a) => Show (ListTest a) where
+    show (ListTest a) = show a
+
+testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
+testEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
+
+------------------------------------------------------------
+--  test1:  simple query qith URI, literal and blank nodes.
+------------------------------------------------------------
+
+prefix1 =
+    "@prefix ex: <http://example.org/> . \n" ++
+    " \n"
+
+graph1    = graphFromString graph1str
+graph1str = prefix1 ++
+    "ex:s1  ex:p  ex:o1 . \n"  ++
+    "ex:s2  ex:p  \"lit1\" . \n" ++
+    "[ ex:p ex:o3 ] . \n"
+
+query11    = graphFromString query11str
+query11str = prefix1 ++
+    "?s  ex:p  ?o . \n"
+
+result11    = graphFromString result11str
+result11str = prefix1 ++
+    "?s  ex:r  ?o . \n"
+
+result11a = prefix1 ++
+    "ex:s1  ex:r  ex:o1 . \n"
+
+result11b = prefix1 ++
+    "ex:s2  ex:r  \"lit1\" . \n"
+
+result11c = prefix1 ++
+    "[ ex:r ex:o3 ] . \n"
+
+var11         = rdfQueryFind query11 graph1
+testQuery11   = test "testQuery11" (not $ null var11)
+res11         = rdfQuerySubs var11 result11
+testResult11  = testEq "testResult11" 3 (length res11)
+testResult11a = testGr "testResult11a" result11a res11
+testResult11b = testGr "testResult11b" result11b res11
+testResult11c = testGr "testResult11c" result11c res11
+
+test1 = TestList
+    [ testQuery11,   testResult11
+    , testResult11a, testResult11b, testResult11c
+    ]
+
+------------------------------------------------------------
+--  test2:  a range of more complex queries based on a
+--  single relationship graph.
+------------------------------------------------------------
+
+prefix2 =
+    "@prefix pers: <urn:pers:> . \n"      ++
+    "@prefix rel:  <urn:rel:> . \n"       ++
+    " \n"
+
+graph2    = graphFromString graph2str
+graph2str = prefix2 ++
+    "pers:St1 rel:wife     pers:Do1 ; \n" ++
+    "         rel:daughter pers:Ma2 ; \n" ++
+    "         rel:daughter pers:An2 . \n" ++
+    "pers:Pa2 rel:wife     pers:Ma2 ; \n" ++
+    "         rel:son      pers:Gr3 ; \n" ++
+    "         rel:son      pers:La3 ; \n" ++
+    "         rel:son      pers:Si3 ; \n" ++
+    "         rel:son      pers:Al3 . \n" ++
+    "pers:Br2 rel:wife     pers:Ri2 ; \n" ++
+    "         rel:daughter pers:Ma3 ; \n" ++
+    "         rel:son      pers:Wi3 . \n" ++
+    "pers:Gr3 rel:wife     pers:Ma3 ; \n" ++
+    "         rel:son      pers:Ro4 ; \n" ++
+    "         rel:daughter pers:Rh4 . \n" ++
+    "pers:Si3 rel:wife     pers:Jo3 ; \n" ++
+    "         rel:son      pers:Ol4 ; \n" ++
+    "         rel:son      pers:Lo4 . \n" ++
+    "pers:Al3 rel:wife     pers:Su3 ; \n" ++
+    "         rel:son      pers:Ha4 ; \n" ++
+    "         rel:son      pers:El4 . \n"
+
+query21    = graphFromString query21str
+query21str = prefix2 ++
+    "?a rel:wife ?b . \n"
+
+result21    = graphFromString result21str
+result21str = prefix2 ++
+    "?b rel:husband ?a . \n"
+
+result21a = prefix2 ++
+    "pers:Do1 rel:husband pers:St1 . \n"
+
+result21b = prefix2 ++
+    "pers:Ma2 rel:husband pers:Pa2 . \n"
+
+result21c = prefix2 ++
+    "pers:Ri2 rel:husband pers:Br2 . \n"
+
+result21d = prefix2 ++
+    "pers:Ma3 rel:husband pers:Gr3 . \n"
+
+result21e = prefix2 ++
+    "pers:Jo3 rel:husband pers:Si3 . \n"
+
+result21f = prefix2 ++
+    "pers:Su3 rel:husband pers:Al3 . \n"
+
+var21         = rdfQueryFind query21 graph2
+testQuery21   = test "testQuery21" (not $ null var21)
+res21         = rdfQuerySubs var21 result21
+testResult21  = testEq "testResult21" 6 (length res21)
+testResult21a = testGr "testResult21a" result21a res21
+testResult21b = testGr "testResult21b" result21b res21
+testResult21c = testGr "testResult21c" result21c res21
+testResult21d = testGr "testResult21d" result21d res21
+testResult21e = testGr "testResult21e" result21e res21
+testResult21f = testGr "testResult21f" result21f res21
+
+query22    = graphFromString query22str
+query22str = prefix2 ++
+    "?a rel:son ?b . \n" ++
+    "?b rel:son ?c . \n"
+
+result22    = graphFromString result22str
+result22str = prefix2 ++
+    "?a rel:grandparent ?c . \n"
+
+result22a = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Ro4 . \n"
+
+result22b = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Ol4 . \n"
+
+result22c = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Lo4 . \n"
+
+result22d = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Ha4 . \n"
+
+result22e = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:El4 . \n"
+
+var22         = rdfQueryFind query22 graph2
+testQuery22   = test "testQuery22" (not $ null var22)
+res22         = rdfQuerySubs var22 result22
+testResult22  = testEq "testResult22" 5 (length res22)
+testResult22a = testGr "testResult22a" result22a res22
+testResult22b = testGr "testResult22b" result22b res22
+testResult22c = testGr "testResult22c" result22c res22
+testResult22d = testGr "testResult22d" result22d res22
+testResult22e = testGr "testResult22e" result22e res22
+
+query23    = graphFromString query23str
+query23str = prefix2 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+result23    = graphFromString result23str
+result23str = prefix2 ++
+    "?b rel:brother ?c . \n"
+
+result23a = prefix2 ++
+    "pers:Gr3 rel:brother pers:Gr3 . \n"
+
+result23b = prefix2 ++
+    "pers:Gr3 rel:brother pers:La3 . \n"
+
+result23c = prefix2 ++
+    "pers:Gr3 rel:brother pers:Si3 . \n"
+
+result23d = prefix2 ++
+    "pers:Gr3 rel:brother pers:Al3 . \n"
+
+result23e = prefix2 ++
+    "pers:La3 rel:brother pers:Gr3 . \n"
+
+result23f = prefix2 ++
+    "pers:La3 rel:brother pers:La3 . \n"
+
+result23g = prefix2 ++
+    "pers:La3 rel:brother pers:Si3 . \n"
+
+result23h = prefix2 ++
+    "pers:La3 rel:brother pers:Al3 . \n"
+
+result23i = prefix2 ++
+    "pers:Si3 rel:brother pers:Gr3 . \n"
+
+result23j = prefix2 ++
+    "pers:Si3 rel:brother pers:La3 . \n"
+
+result23k = prefix2 ++
+    "pers:Si3 rel:brother pers:Si3 . \n"
+
+result23l = prefix2 ++
+    "pers:Si3 rel:brother pers:Al3 . \n"
+
+result23m = prefix2 ++
+    "pers:Al3 rel:brother pers:Gr3 . \n"
+
+result23n = prefix2 ++
+    "pers:Al3 rel:brother pers:La3 . \n"
+
+result23o = prefix2 ++
+    "pers:Al3 rel:brother pers:Si3 . \n"
+
+result23p = prefix2 ++
+    "pers:Al3 rel:brother pers:Al3 . \n"
+
+result23q = prefix2 ++
+    "pers:Wi3 rel:brother pers:Wi3 . \n"
+
+result23r = prefix2 ++
+    "pers:Ro4 rel:brother pers:Ro4 . \n"
+
+result23s = prefix2 ++
+    "pers:Ol4 rel:brother pers:Lo4 . \n"
+
+result23t = prefix2 ++
+    "pers:Ol4 rel:brother pers:Ol4 . \n"
+
+result23u = prefix2 ++
+    "pers:Lo4 rel:brother pers:Lo4 . \n"
+
+result23v = prefix2 ++
+    "pers:Lo4 rel:brother pers:Ol4 . \n"
+
+result23w = prefix2 ++
+    "pers:Ha4 rel:brother pers:El4 . \n"
+
+result23x = prefix2 ++
+    "pers:Ha4 rel:brother pers:Ha4 . \n"
+
+result23y = prefix2 ++
+    "pers:El4 rel:brother pers:El4 . \n"
+
+result23z = prefix2 ++
+    "pers:El4 rel:brother pers:Ha4 . \n"
+
+var23         = rdfQueryFind query23 graph2
+testQuery23   = test "testQuery23" (not $ null var23)
+res23         = rdfQuerySubs var23 result23
+testResult23  = testEq "testResult23" 26 (length res23)
+testResult23a = testGr "testResult23a" result23a res23
+testResult23b = testGr "testResult23b" result23b res23
+testResult23c = testGr "testResult23c" result23c res23
+testResult23d = testGr "testResult23d" result23d res23
+testResult23e = testGr "testResult23e" result23e res23
+testResult23f = testGr "testResult23f" result23f res23
+testResult23g = testGr "testResult23g" result23g res23
+testResult23h = testGr "testResult23h" result23h res23
+testResult23i = testGr "testResult23i" result23i res23
+testResult23j = testGr "testResult23j" result23j res23
+testResult23k = testGr "testResult23k" result23k res23
+testResult23l = testGr "testResult23l" result23l res23
+testResult23m = testGr "testResult23m" result23m res23
+testResult23n = testGr "testResult23n" result23n res23
+testResult23o = testGr "testResult23o" result23o res23
+testResult23p = testGr "testResult23p" result23p res23
+testResult23q = testGr "testResult23q" result23q res23
+testResult23r = testGr "testResult23r" result23r res23
+testResult23s = testGr "testResult23s" result23s res23
+testResult23t = testGr "testResult23t" result23t res23
+testResult23u = testGr "testResult23u" result23u res23
+testResult23v = testGr "testResult23v" result23v res23
+testResult23w = testGr "testResult23w" result23w res23
+testResult23x = testGr "testResult23x" result23x res23
+testResult23y = testGr "testResult23y" result23y res23
+testResult23z = testGr "testResult23z" result23z res23
+
+-- apply filtering to result:
+filter23 = varFilterNE (Var "b") (Var "c") :: RDFVarBindingFilter
+var23F   = rdfQueryFilter filter23 var23
+res23F   = rdfQuerySubs var23F result23
+testResult23F  = testEq "testResult23" 16 (length res23F)
+testResult23bF = testGr "testResult23b" result23b res23F
+testResult23cF = testGr "testResult23c" result23c res23F
+testResult23dF = testGr "testResult23d" result23d res23F
+testResult23eF = testGr "testResult23e" result23e res23F
+testResult23gF = testGr "testResult23g" result23g res23F
+testResult23hF = testGr "testResult23h" result23h res23F
+testResult23iF = testGr "testResult23i" result23i res23F
+testResult23jF = testGr "testResult23j" result23j res23F
+testResult23lF = testGr "testResult23l" result23l res23F
+testResult23mF = testGr "testResult23m" result23m res23F
+testResult23nF = testGr "testResult23n" result23n res23F
+testResult23oF = testGr "testResult23o" result23o res23F
+testResult23sF = testGr "testResult23s" result23s res23F
+testResult23vF = testGr "testResult23v" result23v res23F
+testResult23wF = testGr "testResult23w" result23w res23F
+testResult23zF = testGr "testResult23z" result23z res23F
+
+
+query24    = graphFromString query24str
+query24str = prefix2 ++
+    "?a rel:daughter ?b . \n" ++
+    "?a rel:daughter ?c . \n"
+
+result24    = graphFromString result24str
+result24str = prefix2 ++
+    "?b rel:sister ?c . \n"
+
+result24a = prefix2 ++
+    "pers:Ma2 rel:sister pers:Ma2 . \n"
+
+result24b = prefix2 ++
+    "pers:Ma2 rel:sister pers:An2 . \n"
+
+result24c = prefix2 ++
+    "pers:An2 rel:sister pers:Ma2 . \n"
+
+result24d = prefix2 ++
+    "pers:An2 rel:sister pers:An2 . \n"
+
+result24e = prefix2 ++
+    "pers:Ma3 rel:sister pers:Ma3 . \n"
+
+result24f = prefix2 ++
+    "pers:Rh4 rel:sister pers:Rh4 . \n"
+
+var24         = rdfQueryFind query24 graph2
+testQuery24   = test "testQuery24" (not $ null var24)
+res24         = rdfQuerySubs var24 result24
+testResult24  = testEq "testResult24" 6 (length res24)
+testResult24a = testGr "testResult24a" result24a res24
+testResult24b = testGr "testResult24b" result24b res24
+testResult24c = testGr "testResult24c" result24c res24
+testResult24d = testGr "testResult24d" result24d res24
+testResult24e = testGr "testResult24e" result24e res24
+testResult24f = testGr "testResult24f" result24f res24
+
+
+query25    = graphFromString query25str
+query25str = prefix2 ++
+    "?a rel:son      ?b . \n" ++
+    "?a rel:daughter ?c . \n"
+
+result25    = graphFromString result25str
+result25str = prefix2 ++
+    "?b rel:sister  ?c . \n" ++
+    "?c rel:brother ?b . \n"
+
+result25a = prefix2 ++
+    "pers:Wi3 rel:sister  pers:Ma3 . \n" ++
+    "pers:Ma3 rel:brother pers:Wi3 . \n"
+
+result25b = prefix2 ++
+    "pers:Ro4 rel:sister  pers:Rh4 . \n" ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n"
+
+var25         = rdfQueryFind query25 graph2
+testQuery25   = test "testQuery25" (not $ null var25)
+res25         = rdfQuerySubs var25 result25
+testResult25  = testEq "testResult25" 2 (length res25)
+testResult25a = testGr "testResult25a" result25a res25
+testResult25b = testGr "testResult25b" result25b res25
+
+test2 = TestList
+    [ testQuery21,   testResult21
+    , testResult21a, testResult21b, testResult21c
+    , testResult21d, testResult21e, testResult21f
+    , testQuery22,   testResult22
+    , testResult22a, testResult22b, testResult22c
+    , testResult22d, testResult22e
+    , testQuery23,   testResult23
+    , testResult23a, testResult23b, testResult23c
+    , testResult23d, testResult23e, testResult23f
+    , testResult23g, testResult23h, testResult23i
+    , testResult23j, testResult23k, testResult23l
+    , testResult23m, testResult23n, testResult23o
+    , testResult23p, testResult23q, testResult23r
+    , testResult23s, testResult23t, testResult23u
+    , testResult23v, testResult23w, testResult23x
+    , testResult23y, testResult23z
+    , testResult23F
+    , testResult23bF, testResult23cF
+    , testResult23dF, testResult23eF
+    , testResult23gF, testResult23hF, testResult23iF
+    , testResult23jF, testResult23lF
+    , testResult23mF, testResult23nF, testResult23oF
+    , testResult23sF
+    , testResult23vF, testResult23wF
+    , testResult23zF
+    , testQuery24,   testResult24
+    , testResult24a, testResult24b, testResult24c
+    , testResult24d, testResult24e, testResult24f
+    ]
+
+------------------------------------------------------------
+--  test handling of unsubstituted variables, and
+--  rdfQuerySubsAll, rdfQuerySubsBlank
+------------------------------------------------------------
+
+graph3    = graphFromString graph3str
+graph3str = prefix2 ++
+    "pers:Pa2 rel:grandparent pers:Ro4 . \n" ++
+    "pers:Pa2 rel:grandparent pers:Ol4 . \n"
+
+query31    = graphFromString query31str
+query31str = prefix2 ++
+    "?a rel:grandparent ?c . \n"
+
+result31    = graphFromString result31str
+result31str = prefix2 ++
+    "?a rel:son ?b . \n" ++
+    "?b rel:son ?c . \n"
+
+result31a = prefix2 ++
+    "pers:Pa2 rel:son ?b . \n" ++
+    "?b rel:son pers:Ro4 . \n"
+
+result31b = prefix2 ++
+    "pers:Pa2 rel:son ?b . \n" ++
+    "?b rel:son pers:Ol4 . \n"
+
+var31          = rdfQueryFind query31 graph3
+testQuery31    = test "testQuery31" (not $ null var31)
+res31pairs     = rdfQuerySubsAll var31 result31
+(res31,res31v) = unzip res31pairs
+testUnsubs31   = testEq "testUnsubs31" 2 (length res31v)
+testUnsubs31a  = testEq "testUnsubs31a" [(Var "b")] (head res31v)
+testUnsubs31b  = testEq "testUnsubs31a" [(Var "b")] (head . tail $ res31v)
+testResult31   = testEq "testResult31" 2 (length res31)
+testResult31a  = testGr "testResult31a" result31a res31
+testResult31b  = testGr "testResult31b" result31b res31
+
+query32    = graphFromString query32str
+query32str = prefix2 ++
+    "?a rel:grandparent ?c . \n"
+
+result32    = graphFromString result32str
+result32str = prefix2 ++
+    "?a rel:wife _:b  . \n" ++
+    "?d rel:any  _:b0 . \n" ++
+    "?a rel:son ?b . \n"    ++
+    "?b rel:son ?c . \n"
+
+result32a = prefix2 ++
+    "pers:Pa2 rel:wife _:b      . \n" ++
+    "_:d0     rel:any  _:b0     . \n" ++
+    "pers:Pa2 rel:son  _:b1     . \n" ++
+    "_:b1     rel:son  pers:Ro4 . \n"
+
+result32b = prefix2 ++
+    "pers:Pa2 rel:wife _:b      . \n" ++
+    "_:d0     rel:any  _:b0     . \n" ++
+    "pers:Pa2 rel:son  _:b1     . \n" ++
+    "_:b1     rel:son  pers:Ol4 . \n"
+
+res32          = rdfQuerySubsBlank var31 result32
+testResult32   = testEq "testResult32" 2 (length res32)
+testResult32a  = testGr "testResult32a" result32a res32
+testResult32b  = testGr "testResult32b" result32b res32
+
+res33          = rdfQuerySubs var31 result32
+testResult33   = testEq "testResult33" 0 (length res33)
+
+test3 = TestList
+    [ testQuery31
+    , testUnsubs31, testUnsubs31a, testUnsubs31b
+    , testResult31, testResult31a, testResult31b
+    , testResult32, testResult32a, testResult32b
+    , testResult33
+    ]
+
+--  Debug sequence for rdfQuerySubsBlank
+--  (using internals of rdfQuerySubsBlank implementation)
+--  res32 = rdfQuerySubsBlank (fromJust var31) result32
+d1 = result32
+d2 = rdfQuerySubs2 (head $ var31) d1
+d3 = allLabels isBlank (fst d2)
+d4 = remapLabels (snd d2) d3 makeBlank (fst d2)
+
+------------------------------------------------------------
+--  test4:  test of backward-chaining query
+------------------------------------------------------------
+
+prefix4 =
+    "@prefix pers: <urn:pers:> . \n"      ++
+    "@prefix rel:  <urn:rel:> . \n"       ++
+    " \n"
+
+graph41    = graphFromString graph41str
+graph41str = prefix4 ++
+    "pers:St1 rel:wife     pers:Do1 . \n"
+
+query41    = graphFromString query41str
+query41str = prefix4 ++
+    "?a rel:wife ?b . \n"
+
+result41    = graphFromString result41str
+result41str = prefix4 ++
+    "?b rel:husband ?a . \n"
+
+result41a = prefix4 ++
+    "pers:Do1 rel:husband pers:St1 . \n"
+
+var41          = rdfQueryBack query41 graph41
+testQuery41    = test "testQuery41" (not $ null var41)
+testQuery41a   = testEq "testQuery41a" 1 (length var41)
+res41          = rdfQueryBackSubs var41 result41
+testResult41   = testEq "testResult41" 1 (length res41)
+testResult41a  = testGr "testResult41a" result41a (fst $ unzip $ head res41)
+testUnbound41a = testLs "testUnbound41a" [] (snd $ head $ head res41)
+
+graph42    = graphFromString graph42str
+graph42str = prefix4 ++
+    "pers:Pa2 rel:grandparent pers:Ro4 . \n"
+
+query42    = graphFromString query42str
+query42str = prefix4 ++
+    "?a rel:grandparent ?c . \n"
+
+result42    = graphFromString result42str
+result42str = prefix4 ++
+    "?a rel:son ?b . \n" ++
+    "?b rel:son ?c . \n"
+
+result42a = prefix4 ++
+    "pers:Pa2 rel:son ?b       . \n" ++
+    "?b       rel:son pers:Ro4 . \n"
+
+var42          = rdfQueryBack query42 graph42
+testQuery42    = test "testQuery42" (not $ null var42)
+testQuery42a   = testEq "testQuery42a" 1 (length var42)
+res42          = rdfQueryBackSubs var42 result42
+testResult42   = testEq "testResult42" 1 (length res42)
+testResult42a  = testGr "testResult42a" result42a (fst $ unzip $ head res42)
+testUnbound42a = testLs "testUnbound42a" [(Var "b")] (snd $ head $ head res42)
+
+
+graph43    = graphFromString graph43str
+graph43str = prefix4 ++
+    "pers:Gr3 rel:brother pers:La3 . \n"
+
+query43    = graphFromString query43str
+query43str = prefix4 ++
+    "?b rel:brother ?c . \n"
+
+result43    = graphFromString result43str
+result43str = prefix4 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+result43a = prefix4 ++
+    "?a rel:son pers:Gr3 . \n" ++
+    "?a rel:son pers:La3 . \n"
+
+var43          = rdfQueryBack query43 graph43
+testQuery43    = test "testQuery43" (not $ null var43)
+testQuery43a   = testEq "testQuery43a" 1 (length var43)
+res43          = rdfQueryBackSubs var43 result43
+testResult43   = testEq "testResult43" 1 (length res43)
+testResult43a  = testGr "testResult43a" result43a (fst $ unzip $ head res43)
+testUnbound43a = testLs "testUnbound43a" [(Var "a")] (snd $ head $ head res43)
+
+
+graph44    = graphFromString graph44str
+graph44str = prefix4 ++
+    "pers:Pa2 rel:grandson pers:Ro4 . \n"
+
+query44    = graphFromString query44str
+query44str = prefix4 ++
+    "?a rel:grandson ?b . \n" ++
+    "?c rel:grandson ?d . \n"
+
+result44    = graphFromString result44str
+result44str = prefix4 ++
+    "?a rel:son      ?m . \n" ++
+    "?m rel:son      ?b . \n" ++
+    "?c rel:daughter ?n . \n" ++
+    "?n rel:son      ?d . \n"
+
+result44a = prefix4 ++
+    "pers:Pa2 rel:son ?m       . \n" ++
+    "?m       rel:son pers:Ro4 . \n" ++
+    "?c rel:daughter ?n . \n" ++
+    "?n rel:son      ?d . \n"
+unbound44a = [(Var "m"),(Var "c"),(Var "n"),(Var "d")]
+
+result44b = prefix4 ++
+    "?a rel:son      ?m . \n" ++
+    "?m rel:son      ?b . \n" ++
+    "pers:Pa2 rel:daughter ?n .       \n" ++
+    "?n       rel:son      pers:Ro4 . \n"
+unbound44b = [(Var "a"),(Var "m"),(Var "b"),(Var "n")]
+
+var44          = rdfQueryBack query44 graph44
+testQuery44    = test "testQuery44" (not $ null var44)
+testQuery44a   = testEq "testQuery44a"   2 (length var44)
+res44          = rdfQueryBackSubs var44 result44
+testResult44   = testEq "testResult44"   2 (length res44)
+[res44_1,res44_2] = res44
+testResult44a  = testGr "testResult44a"  result44a  (fst $ unzip res44_2)
+testUnbound44a = testLs "testUnbound44a" unbound44a (snd $ head res44_2)
+testResult44b  = testGr "testResult44b"  result44b  (fst $ unzip res44_1)
+testUnbound44b = testLs "testUnbound44b" unbound44b (snd $ head res44_1)
+
+--  test45:  multiple substitutions used together
+--
+--  (?a daughter ?b, ?a son ?c) => ?b brother ?c
+--
+--  (b1 brother c1, b2 brother c2) if
+--      (?a daughter b1, ?a son c1) && (?a daughter b2, ?a son c2)
+
+graph45    = graphFromString graph45str
+graph45str = prefix4 ++
+    "pers:Rh4 rel:brother pers:Ro4 . \n" ++
+    "pers:Ma3 rel:brother pers:Wi3 . \n"
+
+query45    = graphFromString query45str
+query45str = prefix4 ++
+    "?b rel:brother ?c . \n"
+
+result45    = graphFromString result45str
+result45str = prefix4 ++
+    "?a rel:daughter ?b . \n" ++
+    "?a rel:son      ?c . \n"
+
+result45a1 = prefix4 ++
+    "?a rel:daughter pers:Rh4 . \n" ++
+    "?a rel:son      pers:Ro4 . \n"
+unbound45a1 = [(Var "a")]
+
+result45a2 = prefix4 ++
+    "?a rel:daughter pers:Ma3 . \n" ++
+    "?a rel:son      pers:Wi3 . \n"
+unbound45a2 = [(Var "a")]
+
+var45          = rdfQueryBack query45 graph45
+testQuery45    = test "testQuery45" (not $ null var45)
+testQuery45a   = testEq "testQuery45a"   1 (length var45)
+res45          = rdfQueryBackSubs var45 result45
+testResult45   = testEq "testResult45"   1 (length res45)
+[res45_1] = res45
+testResult45_1 = testEq "testResult45_1" 2 (length res45_1)
+[res45_11,res45_12] = res45_1
+testResult45a1  = testGr "testResult45a1"  result45a1  [fst res45_11]
+testUnbound45a1 = testLs "testUnbound45a1" unbound45a1 (snd res45_11)
+testResult45a2  = testGr "testResult45a2"  result45a2  [fst res45_12]
+testUnbound45a2 = testLs "testUnbound45a2" unbound45a2 (snd res45_12)
+
+--  test46:  multiple ways to get solution
+--
+--  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)
+--
+--  a stepBrother b if
+--      (_:c1 son a, _:c1 stepSon b) || (_:c2 stepSon a, _:c2 son b)
+
+graph46    = graphFromString graph46str
+graph46str = prefix4 ++
+    "pers:Gr3 rel:stepbrother pers:St3 . \n"
+
+query46    = graphFromString query46str
+query46str = prefix4 ++
+    "?b rel:stepbrother ?c . \n" ++
+    "?c rel:stepbrother ?b . \n"
+
+result46    = graphFromString result46str
+result46str = prefix4 ++
+    "?a rel:son     ?b . \n" ++
+    "?a rel:stepson ?c . \n"
+
+result46a = prefix4 ++
+    "?a rel:son     pers:St3 . \n" ++
+    "?a rel:stepson pers:Gr3 . \n"
+unbound46a = [(Var "a")]
+
+result46b = prefix4 ++
+    "?a rel:son     pers:Gr3 . \n" ++
+    "?a rel:stepson pers:St3 . \n"
+unbound46b = [(Var "a")]
+
+var46          = rdfQueryBack query46 graph46
+testQuery46    = test "testQuery46" (not $ null var46)
+testQuery46a   = testEq "testQuery46a"   2 (length var46)
+res46          = rdfQueryBackSubs var46 result46
+testResult46   = testEq "testResult46"   2 (length res46)
+[res46_1,res46_2] = res46
+testResult46_1 = testEq "testResult46_1" 1 (length res46_1)
+testResult46_2 = testEq "testResult46_2" 1 (length res46_2)
+[res46_11] = res46_1
+[res46_21] = res46_2
+testResult46a  = testGr "testResult46a"  result46a  [fst res46_11]
+testUnbound46a = testLs "testUnbound46a" unbound46a (snd res46_11)
+testResult46b  = testGr "testResult46b"  result46b  [fst res46_21]
+testUnbound46b = testLs "testUnbound46b" unbound46b (snd res46_21)
+
+
+--  test47:  multiple ways to multiple solutions
+--
+--  (?c son ?a, ?c stepSon b) => (?a stepBrother ?b, ?b stepBrother ?a)
+--
+--  (a stepBrother b, c stepBrother d) if
+--      ((_:e son a, _:e stepSon b) && (_:f son a, _:f stepSon b)) ||
+--      ((_:e son a, _:e stepSon b) && (_:f stepSon a, _:f son b)) ||
+--      ((_:e stepSon a, _:e son b) && (_:f son a, _:f stepSon b)) ||
+--      ((_:e stepSon a, _:e son b) && (_:f stepSon a, _:f son b))
+
+graph47    = graphFromString graph47str
+graph47str = prefix4 ++
+    "pers:Gr3 rel:stepbrother pers:St3 . \n" ++
+    "pers:St3 rel:stepbrother pers:Gr3 . \n"
+
+query47    = graphFromString query47str
+query47str = prefix4 ++
+    "?b rel:stepbrother ?c . \n" ++
+    "?c rel:stepbrother ?b . \n"
+
+result47    = graphFromString result47str
+result47str = prefix4 ++
+    "?a rel:son     ?b . \n" ++
+    "?a rel:stepson ?c . \n"
+
+result47a1 = prefix4 ++
+    "?a rel:son     pers:St3 . \n" ++
+    "?a rel:stepson pers:Gr3 . \n"
+unbound47a1 = [(Var "a")]
+
+result47a2 = prefix4 ++
+    "?a rel:son     pers:Gr3 . \n" ++
+    "?a rel:stepson pers:St3 . \n"
+unbound47a2 = [(Var "a")]
+
+result47b1 = prefix4 ++
+    "?a rel:stepson pers:St3 . \n" ++
+    "?a rel:son     pers:Gr3 . \n"
+unbound47b1 = [(Var "a")]
+
+result47b2 = prefix4 ++
+    "?a rel:stepson pers:St3 . \n" ++
+    "?a rel:son     pers:Gr3 . \n"
+unbound47b2 = [(Var "a")]
+
+result47c1 = prefix4 ++
+    "?a rel:son     pers:St3 . \n" ++
+    "?a rel:stepson pers:Gr3 . \n"
+unbound47c1 = [(Var "a")]
+
+result47c2 = prefix4 ++
+    "?a rel:son     pers:St3 . \n" ++
+    "?a rel:stepson pers:Gr3 . \n"
+unbound47c2 = [(Var "a")]
+
+result47d1 = prefix4 ++
+    "?a rel:stepson pers:St3 . \n" ++
+    "?a rel:son     pers:Gr3 . \n"
+unbound47d1 = [(Var "a")]
+
+result47d2 = prefix4 ++
+    "?a rel:son     pers:St3 . \n" ++
+    "?a rel:stepson pers:Gr3 . \n"
+unbound47d2 = [(Var "a")]
+
+var47          = rdfQueryBack query47 graph47
+testQuery47    = test "testQuery47" (not $ null var47)
+testQuery47a   = testEq "testQuery47a"   4 (length var47)
+res47          = rdfQueryBackSubs var47 result47
+testResult47   = testEq "testResult47"   4 (length res47)
+[res47_1,res47_2,res47_3,res47_4] = res47
+testResult47_1 = testEq "testResult47_1" 2 (length res47_1)
+testResult47_2 = testEq "testResult47_2" 2 (length res47_2)
+testResult47_3 = testEq "testResult47_3" 2 (length res47_3)
+testResult47_4 = testEq "testResult47_4" 2 (length res47_4)
+[res47_11,res47_12] = res47_1
+[res47_21,res47_22] = res47_2
+[res47_31,res47_32] = res47_3
+[res47_41,res47_42] = res47_4
+testResult47a1  = testGr "testResult47a1"  result47a1  [fst res47_11]
+testUnbound47a1 = testLs "testUnbound47a1" unbound47a1 (snd res47_11)
+testResult47a2  = testGr "testResult47a2"  result47a2  [fst res47_12]
+testUnbound47a2 = testLs "testUnbound47a2" unbound47a2 (snd res47_12)
+testResult47b1  = testGr "testResult47b1"  result47b1  [fst res47_21]
+testUnbound47b1 = testLs "testUnbound47b1" unbound47b1 (snd res47_21)
+testResult47b2  = testGr "testResult47b2"  result47b2  [fst res47_22]
+testUnbound47b2 = testLs "testUnbound47b2" unbound47b2 (snd res47_22)
+testResult47c1  = testGr "testResult47c1"  result47c1  [fst res47_31]
+testUnbound47c1 = testLs "testUnbound47c1" unbound47c1 (snd res47_31)
+testResult47c2  = testGr "testResult47c2"  result47c2  [fst res47_32]
+testUnbound47c2 = testLs "testUnbound47c2" unbound47c2 (snd res47_32)
+testResult47d1  = testGr "testResult47d1"  result47d1  [fst res47_41]
+testUnbound47d1 = testLs "testUnbound47d1" unbound47d1 (snd res47_41)
+testResult47d2  = testGr "testResult47d2"  result47d2  [fst res47_42]
+testUnbound47d2 = testLs "testUnbound47d2" unbound47d2 (snd res47_42)
+
+
+--  test48:  redundant multiple ways to get solution
+--
+--  (?a son ?b, ?a son ?c) => (?b brother ?c, ?c brother ?b)
+--
+--  (a brother b) if
+--      (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a)
+
+graph48    = graphFromString graph48str
+graph48str = prefix4 ++
+    "pers:Gr3 rel:brother pers:La3 . \n"
+
+query48    = graphFromString query48str
+query48str = prefix4 ++
+    "?b rel:brother ?c . \n" ++
+    "?c rel:brother ?b . \n"
+
+result48    = graphFromString result48str
+result48str = prefix4 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+result48a = prefix4 ++
+    "?a rel:son pers:La3 . \n" ++
+    "?a rel:son pers:Gr3 . \n"
+unbound48a = [(Var "a")]
+
+result48b = prefix4 ++
+    "?a rel:son pers:Gr3 . \n" ++
+    "?a rel:son pers:La3 . \n"
+unbound48b = [(Var "a")]
+
+var48          = rdfQueryBack query48 graph48
+testQuery48    = test "testQuery48" (not $ null var48)
+testQuery48a   = testEq "testQuery48a"   2 (length var48)
+res48          = rdfQueryBackSubs var48 result48
+testResult48   = testEq "testResult48"   2 (length res48)
+[res48_1,res48_2] = res48
+testResult48_1 = testEq "testResult48_1" 1 (length res48_1)
+testResult48_2 = testEq "testResult48_2" 1 (length res48_2)
+[res48_11] = res48_1
+[res48_21] = res48_2
+testResult48a  = testGr "testResult48a"  result48a  [fst res48_11]
+testUnbound48a = testLs "testUnbound48a" unbound48a (snd res48_11)
+testResult48b  = testGr "testResult48b"  result48b  [fst res48_21]
+testUnbound48b = testLs "testUnbound48b" unbound48b (snd res48_21)
+
+
+-- test49: goal not satisfiable by rule
+--
+--  (?a foo ?b, ?b foo ?a) => (?a bar ?a)
+--
+--  (a bar b) cannot be deduced directly
+
+graph49    = graphFromString graph49str
+graph49str = prefix4 ++
+    "pers:Gr3 rel:foo pers:La3 . \n"
+
+query49    = graphFromString query49str
+query49str = prefix4 ++
+    "?a rel:bar ?a . \n"
+
+result49    = graphFromString result49str
+result49str = prefix4 ++
+    "?a rel:foo ?b . \n" ++
+    "?b rel:foo ?a . \n"
+
+var49          = rdfQueryBack query49 graph49
+testQuery49    = test "testQuery49" (null var49)
+testQuery49a   = testEq "testQuery49a"   0 (length var49)
+res49          = rdfQueryBackSubs var49 result49
+testResult49   = testEq "testResult49"   0 (length res49)
+
+--  test50:  back-chaining with filter
+--
+--  (?a son ?b, ?a son ?c) => (?b brother ?c, ?c brother ?b)
+--
+--  (a brother b) if
+--      (_:c1 son a, _:c1 son b) || (_:c2 son b, _:c2 son a)
+
+graph50    = graphFromString graph50str
+graph50str = prefix4 ++
+    "pers:Gr3 rel:brother pers:Gr3 . \n"
+
+query50    = graphFromString query50str
+query50str = prefix4 ++
+    "?b rel:brother ?c . \n" ++
+    "?c rel:brother ?b . \n"
+
+result50    = graphFromString result50str
+result50str = prefix4 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+result50a = prefix4 ++
+    "?a rel:son pers:Gr3 . \n" ++
+    "?a rel:son pers:Gr3 . \n"
+unbound50a = [(Var "a")]
+
+result50b = prefix4 ++
+    "?a rel:son pers:Gr3 . \n" ++
+    "?a rel:son pers:Gr3 . \n"
+unbound50b = [(Var "a")]
+
+var50          = rdfQueryBack query50 graph50
+testQuery50    = test "testQuery50" (not $ null var50)
+testQuery50a   = testEq "testQuery50a"   2 (length var50)
+res50          = rdfQueryBackSubs var50 result50
+testResult50   = testEq "testResult50"   2 (length res50)
+[res50_1,res50_2] = res50
+testResult50_1 = testEq "testResult50_1" 1 (length res50_1)
+testResult50_2 = testEq "testResult50_2" 1 (length res50_2)
+[res50_11] = res50_1
+[res50_21] = res50_2
+testResult50a  = testGr "testResult50a"  result50a  [fst res50_11]
+testUnbound50a = testLs "testUnbound50a" unbound50a (snd res50_11)
+testResult50b  = testGr "testResult50b"  result50b  [fst res50_21]
+testUnbound50b = testLs "testUnbound50b" unbound50b (snd res50_21)
+
+filter50       = varFilterNE (Var "b") (Var "c") :: RDFVarBindingFilter
+var50F         = rdfQueryBackFilter filter50 var50
+res50F         = rdfQueryBackSubs var50F result50
+testResult50F  = testEq "testResult50F" 0 (length res50F)
+
+
+--  Backward substitution query test suite
+
+test4 = TestList
+    [ testQuery41, testQuery41a, testResult41
+    , testResult41a, testUnbound41a
+    , testQuery42, testQuery42a, testResult42
+    , testResult42a, testUnbound42a
+    , testQuery43, testQuery43a, testResult43
+    , testResult43a, testUnbound43a
+    , testQuery44, testQuery44a, testResult44
+    , testResult44a, testUnbound44a
+    , testResult44b, testUnbound44b
+    , testQuery45, testQuery45a, testResult45
+    , testResult45_1
+    , testResult45a1, testUnbound45a1
+    , testResult45a2, testUnbound45a2
+    , testQuery46, testQuery46a, testResult46
+    , testResult46_1, testResult46_2
+    , testResult46a, testUnbound46a
+    , testResult46b, testUnbound46b
+    , testQuery47, testQuery47a, testResult47
+    , testResult47_1, testResult47_2, testResult47_3, testResult47_4
+    , testResult47a1, testUnbound47a1
+    , testResult47a2, testUnbound47a2
+    , testResult47b1, testUnbound47b1
+    , testResult47b2, testUnbound47b2
+    , testResult47c1, testUnbound47c1
+    , testResult47c2, testUnbound47c2
+    , testResult47d1, testUnbound47d1
+    , testResult47d2, testUnbound47d2
+    , testQuery48, testQuery48a, testResult48
+    , testResult48_1, testResult48_2
+    , testResult48a, testUnbound48a
+    , testResult48b, testUnbound48b
+    , testQuery49, testQuery49a, testResult49
+    , testQuery50, testQuery50a, testResult50
+    , testResult50_1, testResult50_2
+    , testResult50a, testUnbound50a
+    , testResult50b, testUnbound50b
+    , testResult50F
+    ]
+
+------------------------------------------------------------
+--  Instance query test suite
+------------------------------------------------------------
+--
+--  The test plan is this:
+--  (1) perform a backward chaining query against some desired result.
+--      ?f father ?a, ?f father ?b, ?a /= ?b => ?a brother ?b
+--      against
+--      Gr3 brother La3, Gr3 brother Si3
+--      should yield:
+--      _:a father Gr3
+--      _:a father La3
+--      _:b father Gr3
+--      _:b father Si3
+--  (2) Perform instance query of result against 'graph2' (see above)
+--      should yield:
+--      _:a = Pa2
+--      _:b = Pa2
+--  (3) Substitute this into query, should yield:
+--      Pa2 father Gr3
+--      Pa2 father La3
+--      Pa2 father Gr3
+--      Pa2 father Si3
+--  (4) Use this result in an instance query against 'graph2':  it should
+--      match without any variable substitutions, indicating that it is
+--      a subgraph
+
+graph61    = graphFromString graph61str
+graph61str = prefix4 ++
+    "pers:Gr3 rel:brother pers:La3 . \n" ++
+    "pers:Gr3 rel:brother pers:Si3 . \n"
+
+query61    = graphFromString query61str
+query61str = prefix4 ++
+    "?b rel:brother ?c . \n"
+
+result61    = graphFromString result61str
+result61str = prefix4 ++
+    "?a rel:son ?b . \n" ++
+    "?a rel:son ?c . \n"
+
+result61a = prefix4 ++
+    "_:a1 rel:son pers:Gr3 . \n" ++
+    "_:a1 rel:son pers:La3 . \n" ++
+    "_:a2 rel:son pers:Gr3 . \n" ++
+    "_:a2 rel:son pers:Si3 . \n"
+
+result63a = prefix4 ++
+    "pers:Pa2 rel:son pers:Gr3 . \n" ++
+    "pers:Pa2 rel:son pers:La3 . \n" ++
+    "pers:Pa2 rel:son pers:Gr3 . \n" ++
+    "pers:Pa2 rel:son pers:Si3 . \n"
+
+--  1. Backchain query with blank substutions
+var61          = rdfQueryBack query61 graph61
+testQuery61    = test   "testQuery61" (not $ null var61)
+testQuery61a   = testEq "testQuery61a" 1 (length var61)
+res61          = rdfQueryBackSubsBlank var61 result61
+testResult61   = testEq "testResult61" 1 (length res61)
+[[res61a1,res61a2]] = res61
+res61a         = merge res61a1 res61a2
+testResult61a  = testGr "testResult61a" result61a [res61a]
+--  2. Instance query against 'graph2'
+var62          = rdfQueryInstance res61a graph2
+testQuery62    = test   "testQuery62" (not $ null var62)
+testQuery62a   = testEq "testQuery62a" 1 (length var62)
+--  3. Substitute into instance query graph
+res63          = rdfQuerySubs var62 res61a
+testQuery63    = test   "testQuery63" (not $ null res63)
+testQuery63a   = testEq "testQuery63a" 1 (length res63)
+[res63a]       = res63
+testResult63a  = testGr "testResult63a" result63a [res63a]
+--  4. Repeat instance query against 'graph2'
+--     Query bindings should be null.
+var64          = rdfQueryInstance res63a graph2
+testQuery64    = test   "testQuery64" (not $ null var64)
+testQuery64a   = testEq "testQuery64a" 1 (length var64)
+[var64a]       = var64
+testQuery64b   = test   "testQuery64b" (null $ vbEnum var64a)
+
+test6 = TestList
+    [ testQuery61, testQuery61a, testResult61, testResult61a
+    , testQuery62, testQuery62a
+    , testQuery63, testQuery63a, testResult63a
+    , testQuery64, testQuery64a, testQuery64b
+    ]
+
+------------------------------------------------------------
+--  Specific test cases
+------------------------------------------------------------
+
+--  Back-chaining query binding modifier
+
+--  Set up call of rdfQueryBackModify
+--  (1) simple filter
+--  (2) allocate new binding
+{-
+rdfQueryBackModify ::
+    RDFVarBindingModify -> [[RDFVarBinding]] -> [[RDFVarBinding]]
+rdfQueryBackModify qbm qbss = concatMap (rdfQueryBackModify1 qbm) qbss
+-}
+
+baseex   = "http://example.org/"
+baserdf  = nsURI namespaceRDF
+q_dattyp = (makeScopedName "" baseex "datatype")
+
+v_a   = Var "a"
+v_b   = Var "b"
+v_c   = Var "c"
+v_x   = Var "x"
+v_y   = Var "y"
+v_z   = Var "z"
+u_s   = Res (makeScopedName "" baseex "s")
+u_o   = Res (makeScopedName "" baseex "o")
+u_p   = Res (makeScopedName "" baseex "p")
+u_p1  = Res (makeScopedName "" baseex "p1")
+u_p2a = Res (makeScopedName "" baseex "p2a")
+u_p2b = Res (makeScopedName "" baseex "p2b")
+u_m1  = Res (makeScopedName "" baserdf "_1")
+u_m2  = Res (makeScopedName "" baserdf "_2")
+u_rt  = Res rdf_type
+u_xt  = Res rdf_XMLLiteral
+u_dt  = Res q_dattyp
+l_1   = Lit "l1" Nothing
+l_2   = Lit "l2" (Just $ langName "fr")
+l_3   = Lit "l3" (Just q_dattyp)
+l_4   = Lit "l4" (Just q_dattyp) -- was: (Lang "fr")
+l_5   = Lit "l5" (Just rdf_XMLLiteral)
+b_1   = Blank "1"
+b_2   = Blank "2"
+b_3   = Blank "3"
+b_l1  = Blank "l1"
+b_l2  = Blank "l2"
+
+vbss01a =               -- ?a is uri, ?b is uri
+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,u_o) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,b_1) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]
+    ]
+
+vbss01b =               -- ?c is blank
+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,b_1) ]
+    ]
+
+vbss01c =               -- ?c is literal
+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_2) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_3) ]
+    ]
+
+vbss01d =               -- ?c is untyped literal
+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_1) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_2) ]
+    ]
+
+vbss01e =               -- ?c is typed literal
+    [ makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_3) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_4) ]
+    , makeVarBinding [ (v_a,b_3), (v_b,u_p),  (v_c,l_5) ]
+    ]
+
+vbss01f =               -- ?c is XML literal
+    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_5) ]
+    ]
+
+vbss01g =               -- ?b is member property
+    [ makeVarBinding [ (v_a,b_1), (v_b,u_m1), (v_c,u_o) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_m2), (v_c,b_1) ]
+    ]
+
+vbss01h =               -- ?c is datatyped with ?x
+    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_3), (v_x,u_dt) ]
+    , makeVarBinding [ (v_a,b_2), (v_b,u_p),  (v_c,l_4), (v_x,u_dt) ]
+    , makeVarBinding [ (v_a,u_s), (v_b,u_p),  (v_c,l_5), (v_x,u_xt) ]
+    ]
+
+vbss01i =               -- ?c is not datatyped with ?x
+    [ makeVarBinding [ (v_a,b_1), (v_b,u_p),  (v_c,l_3), (v_x,u_dt) ]
+    , makeVarBinding [ (v_a,b_2), (v_b,u_p),  (v_c,l_4), (v_x,u_xt) ]
+    , makeVarBinding [ (v_a,b_3), (v_b,u_p),  (v_c,l_5), (v_x,u_xt) ]
+    ]
+
+vbss01  = [ vbss01a     -- ?a is uri, ?b is uri
+          , vbss01b     -- ?c is blank
+          , vbss01c     -- ?c is literal
+          , vbss01d     -- ?c is untyped literal
+          , vbss01e     -- ?c is typed literal
+          , vbss01f     -- ?c is XML literal
+          , vbss01g     -- ?b is member property
+          , vbss01h     -- ?c is datatyped with ?x
+          , vbss01i     -- ?c is not datatyped with ?x
+          ]
+
+testBackMod01 = testEq "testBackMod01" vbss01 $
+                rdfQueryBackModify varBindingId vbss01
+
+testBackMod02 = testEq "testBackMod02" [vbss01a,vbss01b,vbss01c,vbss01d] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingUriRef v_a)
+                    vbss01
+
+testBackMod03 = testEq "testBackMod03" [vbss01f,vbss01i] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingBlank v_a)
+                    vbss01
+
+testBackMod04 = testEq "testBackMod04" vbss01 $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingUriRef v_b)
+                    vbss01
+
+testBackMod05 = testEq "testBackMod05"
+                [vbss01c,vbss01d,vbss01e,vbss01f,vbss01h,vbss01i] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingLiteral v_c)
+                    vbss01
+
+testBackMod06 = testEq "testBackMod06" [vbss01d] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingUntypedLiteral v_c)
+                    vbss01
+
+testBackMod07 = testEq "testBackMod07" [vbss01e,vbss01f,vbss01h,vbss01i] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingTypedLiteral v_c)
+                    vbss01
+
+testBackMod08 = testEq "testBackMod08" [vbss01f] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingXMLLiteral v_c)
+                    vbss01
+
+testBackMod09 = testEq "testBackMod09" [vbss01g] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingMemberProp v_b)
+                    vbss01
+
+testBackMod10 = testEq "testBackMod10" [vbss01h] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingDatatyped v_x v_c)
+                    vbss01
+
+vbss02a = [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]
+          , makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
+          , makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
+          , makeVarBinding [ (v_b,b_l1) ]
+          , makeVarBinding [ (v_b,b_l2) ]
+          ]
+
+vbss02b = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
+          , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt) ]
+          , makeVarBinding [ (v_b,b_l2) ]
+          ]
+
+vbss02c = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
+          , makeVarBinding [ (v_b,b_l1) ]
+          , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt) ]
+          ]
+
+vbss02d = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
+          , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt) ]
+          , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt) ]
+          ]
+
+vbss02  = [ vbss02a
+          , vbss02b
+          , vbss02c
+          , vbss02d
+          ]
+
+testBackMod20 = testEq "testBackMod20" vbss02 $
+                rdfQueryBackModify varBindingId vbss02
+
+testBackMod21 = testEq "testBackMod21" [vbss02d] $
+                rdfQueryBackModify
+                    (makeVarFilterModify $ rdfVarBindingUriRef v_a)
+                    vbss02
+
+--  Variable binding modifier that adds new bindings, if certain
+--  others are present.
+vbm22 = VarBindingModify
+        { vbmName  = swishName "vbm22"
+        , vbmApply = concatMap apply1
+        , vbmVocab = [v_a,v_b,v_x,v_y]
+        , vbmUsage = [[v_y]]
+        }
+    where
+        apply1 :: RDFVarBinding -> [RDFVarBinding]
+        apply1 vb = apply2 vb (vbMap vb v_a) (vbMap vb v_b) (vbMap vb v_x)
+        apply2 vb (Just a) (Just b) (Just _) =
+            [ joinVarBindings nva vb, joinVarBindings nvb vb ]
+            where
+                nva = makeVarBinding [(v_y,a)]
+                nvb = makeVarBinding [(v_y,b)]
+        apply2 _ _ _ _ = []
+
+vbss02dy = sequence
+    [ [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,u_p1)  ]
+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,b_l1)  ]
+      ]
+    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,u_p2a) ]
+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,b_l2)  ]
+      ]
+    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2), (v_y,u_p2b) ]
+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2), (v_y,b_l2)  ]
+      ]
+    , [ makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt), (v_y,u_rt)  ]
+      , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_xt), (v_y,u_xt)  ]
+      ]
+    , [ makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt), (v_y,u_rt)  ]
+      , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_xt), (v_y,u_xt)  ]
+      ]
+    ]
+
+testBackMod22 = testEq "testBackMod22" vbss02dy $
+                rdfQueryBackModify vbm22 vbss02
+
+
+--  simplified version of above for debugging --
+
+vbss03a = [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]
+          , makeVarBinding [ (v_b,b_l1) ]
+          ]
+
+vbss03b = [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+          , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+          ]
+
+vbss03  = [ vbss03a
+          , vbss03b
+          ]
+
+vbss03by = sequence
+    [ [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,u_p1)  ]
+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1), (v_y,b_l1)  ]
+      ]
+    , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,u_p2a) ]
+      , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2), (v_y,b_l2)  ]
+      ]
+    ]
+
+testBackMod30 = testEq "testBackMod30" vbss03by $
+                rdfQueryBackModify vbm22 vbss03
+
+test7 = TestList
+    [ testBackMod01, testBackMod02, testBackMod03, testBackMod04
+    , testBackMod05, testBackMod06, testBackMod07, testBackMod08
+    , testBackMod09, testBackMod10
+    , testBackMod20, testBackMod21, testBackMod22
+    , testBackMod30
+    ]
+
+------------------------------------------------------------
+--  Test simple value and list queries
+------------------------------------------------------------
+
+namespacetest    =
+    Namespace   "test"   "urn:test:"
+namespacelist    =
+    Namespace   "list"   "urn:list:"
+
+qntest loc = ScopedName namespacetest loc
+qnlist loc = ScopedName namespacelist loc
+
+prefixlist =
+    "@prefix rdf  : <" ++ nsURI namespaceRDF ++ "> . \n"  ++
+    "@prefix xsd  : <" ++ nsURI namespaceXSD ++ "> . \n"  ++
+    "@prefix test : <" ++ nsURI namespacetest ++ "> . \n" ++
+    "@prefix list : <" ++ nsURI namespacelist ++ "> . \n" ++
+    " \n"
+
+graphlist    = graphFromString graphliststr
+graphliststr = prefixlist ++
+    "test:a rdf:type test:C1 ; "                   ++
+    "  test:p test:item1 ; "                       ++
+    "  test:p test:item2 . "                       ++
+    "test:b rdf:type test:C1 ; "                   ++
+    "  test:p \"1\"^^xsd:integer ; "               ++
+    "  test:p \"2\"^^xsd:integer ; "               ++
+    "  test:p \"3\"^^xsd:integer . "               ++
+    "test:c rdf:type test:C1 ; "                   ++
+    "  test:q \"1\"^^xsd:integer ; "               ++
+    "  test:q \"2\"^^xsd:boolean ; "               ++
+    "  test:q \"3\" . "                            ++
+    "list:three :- (list:_1 list:_2 list:_3) . \n" ++
+    "list:empty :- () . \n"
+
+testC1  = Res (qntest "C1")
+testabc = [ Res (qntest "a"),Res (qntest "b"),Res (qntest "c") ]
+testp   = Res (qntest "p")
+testq   = Res (qntest "q")
+testi12 = [ Res (qntest "item1"),Res (qntest "item2") ]
+test123 = [ Lit "1" (Just xsd_integer)
+          , Lit "2" (Just xsd_integer)
+          , Lit "3" (Just xsd_integer)
+          ]
+test1fp = [ Lit "1" (Just xsd_integer)
+          , Lit "2" (Just xsd_boolean)
+          , Lit "3" Nothing
+          ]
+
+list01 = [Res (qnlist "_1"),Res (qnlist "_2"),Res (qnlist "_3")]
+list02 = []
+
+testVal01  = testEqv "testVal01" testabc $
+                rdfFindValSubj res_rdf_type testC1 graphlist
+testVal02  = testEqv "testVal02" testi12 $
+                rdfFindPredVal (testabc!!0) testp graphlist
+testVal03  = testEqv "testVal03" test123 $
+                rdfFindPredVal (testabc!!1) testp graphlist
+testVal04  = testEqv "testVal04" test1fp $
+                rdfFindPredVal (testabc!!2) testq graphlist
+testVal05  = testEqv "testVal05" [] $
+                rdfFindPredVal (testabc!!2) testp graphlist
+testVal06  = testEqv "testVal06" [] $
+                rdfFindPredInt (testabc!!0) testp graphlist
+testVal07  = testEqv "testVal07" [1,2,3] $
+                rdfFindPredInt (testabc!!1) testp graphlist
+testVal08  = testEqv "testVal08" [1] $
+                rdfFindPredInt (testabc!!2) testq graphlist
+
+testlist01 = testEq "testlist01" list01 $
+    rdfFindList graphlist (Res $ qnlist "three")
+testlist02 = testEq "testlist02" list02 $
+    rdfFindList graphlist (Res $ qnlist "empty")
+
+test8 = TestList
+    [ testVal01, testVal02, testVal03, testVal04
+    , testVal05, testVal06, testVal07, testVal08
+    , testlist01, testlist02
+    ]
+
+{-----
+queryList :: RDFGraph -> RDFLabel -> [RDFLabel]
+-- queryList gr res_rdf_nil = []
+-- queryList gr hd          = findhead g:rdfQueryList gr (findrest g)
+queryList gr hd
+    | hd == res_rdf_nil = []
+    | otherwise         = (findhead g):(queryList gr (findrest g))
+    where
+        g = subgr gr hd
+
+findhead g = headOrNil [ ob | Arc _ sb ob <- g, sb == res_rdf_first ]
+findrest g = headOrNil [ ob | Arc _ sb ob <- g, sb == res_rdf_rest  ]
+subgr g h  = filter ((==) h . arcSubj) $ getArcs g
+headOrNil  = foldr const res_rdf_nil
+
+th1  = (Res $ qnlist "empty")
+th3  = (Res $ qnlist "three")
+th3a = subgr graphlist th3
+th3b = findhead th3a
+th3c = findrest th3a
+tl3c = queryList graphlist th3c
+th3d = subgr graphlist th3c
+th3e = findhead th3d
+th3f = findrest th3d
+
+tl3  = queryList graphlist th3
+-----}
+
+------------------------------------------------------------
+--  Full test suite, main program,
+--  and useful expressions for interactive use
+------------------------------------------------------------
+
+allTests = TestList
+  [ test1
+  , test2
+  , test3
+  , test4
+  , test6
+  , test7
+  , test8
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+shres32 = TestCase $ assertString (show res32)
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFQueryTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.23 $
+-- $Log: RDFQueryTest.hs,v $
+-- Revision 1.23  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.22  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.21  2003/12/20 12:53:40  graham
+-- Fix up code to compile and test with GHC 5.04.3
+--
+-- Revision 1.20  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.19  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.18  2003/11/24 15:46:03  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.17  2003/11/14 16:04:43  graham
+-- Add primitive query to get integer values from a graph.
+--
+-- Revision 1.16  2003/11/14 16:01:30  graham
+-- Separate RDFVarBinding from module RDFQuery.
+--
+-- Revision 1.15  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.14  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.13  2003/10/15 16:40:52  graham
+-- Reworked RDFQuery to use new query binding framework.
+-- (Note: still uses VarBindingFilter rather than VarBindingModify.
+-- The intent is to incorproate the VarBindingModify logic into RDFProof,
+-- displaying the existing use of BindingFilter.)
+--
+-- Revision 1.12  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.11  2003/07/02 22:39:36  graham
+-- Subgraph entailment and Graph closure instance entailment rules
+-- now tested.  RDF forward chaining revised to combine output graphs,
+-- to preserve blank node relationships.
+--
+-- Revision 1.10  2003/06/26 15:37:23  graham
+-- Added rdfQueryInstance, and tests, all works.
+--
+-- Revision 1.9  2003/06/19 00:26:29  graham
+-- Query binding filter methods tested.
+--
+-- Revision 1.8  2003/06/18 14:59:27  graham
+-- Augmented query variable binding structure.
+-- RDFQuery tests OK.
+--
+-- Revision 1.7  2003/06/18 13:47:33  graham
+-- Backchaining query tests complete.
+--
+-- Revision 1.6  2003/06/18 01:29:29  graham
+-- Fixed up some problems with backward chaining queries.
+-- Query test cases still to complete.
+-- Proof incomplete.
+--
+-- Revision 1.5  2003/06/17 17:53:08  graham
+-- Added backward chaining query primitive.
+--
+-- Revision 1.4  2003/06/17 16:29:20  graham
+-- Eliminate redundant Maybe in return type of rdfQueryPrim.
+-- (A null list suffices for the Nothing case.)
+--
+-- Revision 1.3  2003/06/17 15:59:09  graham
+-- Update to use revised version of remapNodes, which accepts a
+-- node-mapping function rather than just a Boolean to control conversion
+-- of query variable nodes to blank
+-- nodes.
+--
+-- Revision 1.2  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.1  2003/06/12 00:49:06  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--
+ Swish/HaskellRDF/RDFRuleset.hs view
@@ -0,0 +1,621 @@+--------------------------------------------------------------------------------
+--  $Id: RDFRuleset.hs,v 1.20 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFRuleset
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines some datatypes and functions that are
+--  used to define rules and rulesets over RDF graphs
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFRuleMap
+    , RDFClosure, RDFRuleset, RDFRulesetMap
+    , nullRDFFormula
+    , GraphClosure(..), makeGraphClosureRule
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    , makeRDFClosureRule
+    , makeN3ClosureRule
+    , makeN3ClosureSimpleRule
+    , makeN3ClosureModifyRule
+    , makeN3ClosureAllocatorRule
+    , makeNodeAllocTo
+    -- for debugging
+    , graphClosureFwdApply, graphClosureBwdApply
+    )
+where
+
+import Swish.HaskellRDF.RDFQuery
+    ( rdfQueryFind
+    , rdfQueryBack, rdfQueryBackModify
+    , rdfQuerySubs
+    , rdfQuerySubsBlank
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( Label (..), RDFLabel(..), RDFGraph
+    , makeBlank, newNodes
+    , merge, allLabels
+    , toRDFGraph, emptyRDFGraph )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding, RDFVarBindingModify )
+
+import Swish.HaskellRDF.N3Parser
+    ( parseN3fromString )
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..), RulesetMap
+    )
+
+import Swish.HaskellRDF.Rule
+    ( Formula(..), Rule(..), RuleMap
+    , fwdCheckInference
+    , nullScope
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( makeVarBinding
+    , applyVarBinding, joinVarBindings
+    , VarBindingModify(..)
+    , vbmCompose
+    , varBindingId
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..) )
+
+import Swish.HaskellRDF.Vocabulary
+    ( swishName )
+
+{-+import Swish.HaskellRDF.Proof
+    ( Proof(..), Step(..) )
+-}+
+import Swish.HaskellRDF.GraphClass
+    ( Label(..), Arc(..), LDGraph(..) )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv, flist )
+
+import Swish.HaskellUtils.ErrorM
+    ( ErrorM(..) )
+
+import Data.List
+    ( nub )
+
+
+------------------------------------------------------------
+--  Datatypes for RDF ruleset
+------------------------------------------------------------
+
+type RDFFormula     = Formula RDFGraph
+
+type RDFRule        = Rule RDFGraph
+
+type RDFRuleMap     = RuleMap RDFGraph
+
+type RDFClosure     = GraphClosure RDFLabel
+
+type RDFRuleset     = Ruleset RDFGraph
+
+type RDFRulesetMap  = RulesetMap RDFGraph
+
+------------------------------------------------------------
+--  Declare null RDF formula
+------------------------------------------------------------
+
+nullRDFFormula :: Formula RDFGraph+nullRDFFormula = Formula
+    { formName = ScopedName nullScope "nullRDFGraph"
+    , formExpr = emptyRDFGraph
+    }
+
+------------------------------------------------------------
+--  Datatype for graph closure rule
+------------------------------------------------------------
+
+-- |Datatype for constructing a graph closure rule
+data GraphClosure lb = GraphClosure
+    { nameGraphRule :: ScopedName   -- ^ Name of rule for proof display
+    , ruleAnt       :: [Arc lb]     -- ^ Antecedent triples pattern
+                                    --   (may include variable nodes)
+    , ruleCon       :: [Arc lb]     -- ^ Consequent triples pattern
+                                    --   (may include variable nodes)
+    , ruleModify    :: VarBindingModify lb lb
+                                    -- ^ Structure that defines additional
+                                    --   constraints and/or variable
+                                    --   bindings based on other matched
+                                    --   query variables.  Matching the
+                                    --   antecedents.  Use 'varBindingId' if
+                                    --   no additional variable constraints
+                                    --   or bindings are added beyond those
+                                    --   arising from graph queries.
+    }
+
+instance (Label lb) => Eq (GraphClosure lb) where
+    c1 == c2 = (nameGraphRule c1 == nameGraphRule c2) &&
+               (ruleAnt c1) `equiv` (ruleAnt c2) &&
+               (ruleCon c1) `equiv` (ruleCon c2)
+
+instance (Label lb) => Show (GraphClosure lb) where
+    show c = "GraphClosure "++show (nameGraphRule c)
+
+------------------------------------------------------------
+--  Define inference rule based on RDF graph closure rule
+------------------------------------------------------------
+
+-- |Define a value of type Rule based on an RDFClosure value.
+makeGraphClosureRule :: GraphClosure RDFLabel -> Rule RDFGraph
+makeGraphClosureRule grc = newrule
+    where
+        newrule = Rule
+            { ruleName       = nameGraphRule grc
+            , fwdApply       = graphClosureFwdApply grc
+            , bwdApply       = graphClosureBwdApply grc
+            , checkInference = fwdCheckInference newrule
+            }
+
+--  Forward chaining function based on RDF graph closure description
+--
+--  Note:  antecedents here are presumed to share bnodes.
+--
+graphClosureFwdApply :: GraphClosure RDFLabel -> [RDFGraph] -> [RDFGraph]
+graphClosureFwdApply grc grs =
+    let gr   = if null grs then emptyRDFGraph else foldl1 add grs
+        vars = queryFind (ruleAnt grc) gr
+        varm = vbmApply (ruleModify grc) vars
+        cons = querySubs varm (ruleCon grc)
+    in
+        {-
+        seq cons $
+        seq (trace "\ngraphClosureFwdApply") $
+        seq (traceShow "\nvars: " vars) $
+        seq (traceShow "\nvarm: " varm) $
+        seq (traceShow "\ncons: " cons) $
+        seq (trace "\n") $
+        -}
+        --  Return null list or single result graph that is the union
+        --  (not merge) of individual results:
+        if null cons then [] else [foldl1 add cons]
+        -- cons {- don't merge results -}
+
+--  Backward chaining function based on RDF graph closure description
+graphClosureBwdApply :: GraphClosure RDFLabel -> RDFGraph -> [[RDFGraph]]
+graphClosureBwdApply grc gr =
+    let vars = rdfQueryBackModify (ruleModify grc) $
+               queryBack (ruleCon grc) gr
+        --  This next function eliminates duplicate variable bindings.
+        --  It is strictly redundant, but comparing variable
+        --  bindings is much cheaper than comparing graphs.
+        --  I don't know if many duplicate graphs will be result
+        --  of exact duplicate variable bindings, so this may be
+        --  not very effective.
+        varn = map nub vars
+    in
+        --  The 'nub ante' below eliminates duplicate antecedent graphs,
+        --  based on graph matching, which tests for equivalence under
+        --  bnode renaming, with a view to reducing redundant arcs in
+        --  the merged antecedent graph, hence less to prove in
+        --  subsequent back-chaining steps.
+        --
+        --  Each antecedent is reduced to a single RDF graph, when
+        --  bwdApply specifies a list of expressions corresponding to
+        --  each antecedent.
+        [ [foldl1 merge (nub ante)]
+          | vs <- varn
+          , let ante = querySubsBlank vs (ruleAnt grc) ]
+
+------------------------------------------------------------
+--  RDF graph query and substitution support functions
+------------------------------------------------------------
+
+queryFind :: [Arc RDFLabel] -> RDFGraph -> [RDFVarBinding]
+queryFind qas tg = rdfQueryFind (toRDFGraph qas) tg
+
+queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]
+queryBack qas tg = rdfQueryBack (toRDFGraph qas) tg
+
+querySubs :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]
+querySubs vars qas =
+    {-
+    seq (trace "\nquerySubs") $
+    seq (traceShow "\nvars: " vars)
+    seq (traceShow "\narcs: "  qas)
+    seq (trace "\n") $
+    -}
+    rdfQuerySubs vars (toRDFGraph qas)
+
+querySubsBlank :: [RDFVarBinding] -> [Arc RDFLabel] -> [RDFGraph]
+querySubsBlank vars qas = rdfQuerySubsBlank vars (toRDFGraph qas)
+
+------------------------------------------------------------
+--  Method for creating an RDF formula value from N3 text
+------------------------------------------------------------
+
+-- |Helper function to parse a string containing Notation3
+--  and return the corresponding RDFGraph value.
+makeRDFGraphFromN3String :: String -> RDFGraph
+makeRDFGraphFromN3String str = case parseN3fromString str of
+    Error  msg -> error msg
+    Result gr  -> gr
+
+-- |Create an RDF formula given:
+--  a namespace, a local name and a Notation 3 string that
+--  is parsed to yield an RDF graph value.
+makeRDFFormula ::
+    Namespace -> String -> String -> RDFFormula
+makeRDFFormula scope local gr = Formula
+    { formName = ScopedName scope local
+    , formExpr = makeRDFGraphFromN3String gr
+    }
+
+------------------------------------------------------------
+--  Create an RDF closure rule from supplied graphs
+------------------------------------------------------------
+
+-- |Constructs an RDF graph closure rule.  That is, a rule that
+--  given some set of antecedent statements returns new statements
+--  that may be added to the graph.
+--
+--  sname   is a scoped name for the new rule.
+--  antgrs  is a list of RDFGraphs that are the entecedent of the rule.
+--          (Note:  bnodes and variable names are assumed to be shared
+--          by all the entecedent graphs supplied.  [[[is this right?]]])
+--  congr   is an RDFGraph containing that is the consequent graph.
+--  vmod    is a variable binding modifier value that may impose
+--          additional conditions on the variable bindings that
+--          can be used for this inference rule, or which may
+--          cause new values to be allocated for unbound variables.
+--          These modifiers allow for certain inference patterns
+--          that are not captured by simple "closure rules", such
+--          as the allocation of bnodes corresponding to literals,
+--          and are an extension point for incorporating datatypes
+--          into an inference process.
+--          If no additional constraints or variable bindings are
+--          to be applied, use value 'varBindingId'
+--
+makeRDFClosureRule ::
+    ScopedName -> [RDFGraph] -> RDFGraph -> RDFVarBindingModify
+    -> RDFRule
+makeRDFClosureRule sname antgrs congr vmod = makeGraphClosureRule
+    GraphClosure
+        { nameGraphRule = sname
+        , ruleAnt       = concatMap getArcs antgrs
+        , ruleCon       = getArcs congr
+        , ruleModify    = vmod
+        }
+
+------------------------------------------------------------
+--  Methods to create an RDF closure rule from N3 input
+------------------------------------------------------------
+--
+--  These functions are used internally by Swish to construct
+--  rules from textual descriptions.
+
+-- |Constructs an RDF graph closure rule.  That is, a rule that
+--  given some set of antecedent statements returns new statements
+--  that may be added to the graph.  This is the basis for
+--  implementation of most of the inference rules given in the
+--  RDF formal semantics document.
+--
+--  scope   is a namespace to which the rule is allocated
+--  local   is a local name for the rule in the given namespace
+--  ant     is a string containing the Notation3 representation
+--          of the antecedent graph.  (Note: multiple antecedents
+--          can be handled by combining multiple graphs.)
+--  con     is a string containing the Notation3 representation
+--          of the consequent graph.
+--  vmod    is a variable binding modifier value that may impose
+--          additional conditions on the variable bindings that
+--          can be used for this inference rule, or which may
+--          cause new values to be allocated for unbound variables.
+--          These modifiers allow for certain inference patterns
+--          that are not captured by simple "closure rules", such
+--          as the allocation of bnodes corresponding to literals,
+--          and are an extension point for incorporating datatypes
+--          into an inference process.
+--          If no additional constraints or variable bindings are
+--          to be applied, use value 'varBindingId'
+--
+makeN3ClosureRule ::
+    Namespace -> String
+    -> String -> String -> RDFVarBindingModify
+    -> RDFRule
+makeN3ClosureRule scope local ant con vmod =
+    makeRDFClosureRule (ScopedName scope local) [antgr] congr vmod
+    where
+        antgr = makeRDFGraphFromN3String ant
+        congr = makeRDFGraphFromN3String con
+
+-- |Construct a simple RDF graph closure rule without
+--  additional node allocations or variable binding constraints.
+--
+makeN3ClosureSimpleRule ::
+    Namespace -> String -> String -> String -> RDFRule
+makeN3ClosureSimpleRule scope local ant con =
+    makeN3ClosureRule scope local ant con varBindingId
+
+-- |Constructs an RDF graph closure rule that incorporates
+--  a variable binding filter and a variable binding modifier.
+--
+--  scope   is a namespace to which the rule is allocated
+--  local   is a local name for the rule in the given namespace
+--  ant     is a string containing the Notation3 representation
+--          of the antecedent graph.  (Note: multiple antecedents
+--          can be handled by combining multiple graphs.)
+--  con     is a string containing the Notation3 representation
+--          of the consequent graph.
+--  vflt    is a variable binding modifier value that may impose
+--          additional conditions on the variable bindings that
+--          can be used for this inference rule.
+--          These modifiers allow for certain inference patterns
+--          that are not captured by simple "closure rules", such
+--          as deductions that pertain only to certain kinds of
+--          nodes in a graph.
+--  vmod    is a variable binding modifier that is applied to the
+--          variable bindings obtained, typically to create some
+--          additional variable bindings.  This is applied before
+--          the filter rule 'vflt'.
+--
+makeN3ClosureModifyRule ::
+    Namespace -> String
+    -> String -> String -> RDFVarBindingModify -> RDFVarBindingModify
+    -> RDFRule
+makeN3ClosureModifyRule scope local ant con vflt vmod =
+    makeN3ClosureRule scope local ant con modc
+    where
+        modc  = case vbmCompose vmod vflt of
+            Just x  -> x
+            Nothing -> varBindingId
+{-
+    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc
+    where
+        antgr = makeRDFGraphFromN3String ant
+        congr = makeRDFGraphFromN3String con
+        modc  = case vbmCompose vmod vflt of
+            Just x  -> x
+            Nothing -> varBindingId
+-}
+
+-- |Construct an RDF graph closure rule with a bnode allocator.
+--
+--  This function is rather like makeN3ClosureModifyRule, except that
+--  the variable binding modifier is a function from the variables in
+--  the variables and bnodes contained in the antecedent graph.
+--
+--  scope   is a namespace tom which the rule is allocated
+--  local   is a local name for the rule in the given namespace
+--  ant     is a string containing the Notation3 representation
+--          of the antecedent graph.  (Note: multiple antecedents
+--          can be handled by combining multiple graphs.)
+--  con     is a string containing the Notation3 representation
+--          of the consequent graph.
+--  vflt    is a variable binding modifier value that may impose
+--          additional conditions on the variable bindings that
+--          can be used for this inference rule.
+--  aloc    is a function applied to a list of nodes to yield a
+--          variable binding modifier value.
+--          The supplied parameter is applied to a list of all of
+--          the variable nodes (including all blank nodes) in the
+--          antecedent graph, and then composed with the 'vflt'
+--          value (above).  This allows any node allocation
+--          function to avoid allocating any blank nodes that
+--          are already used in the antecedent graph.
+--          (See function makeNodeAllocTo).
+--
+makeN3ClosureAllocatorRule ::
+    Namespace -> String
+    -> String -> String
+    -> RDFVarBindingModify -> ( [RDFLabel] -> RDFVarBindingModify )
+    -> RDFRule
+makeN3ClosureAllocatorRule scope local ant con vflt aloc =
+    makeRDFClosureRule (ScopedName scope local) [antgr] congr modc
+    where
+        antgr = makeRDFGraphFromN3String ant
+        congr = makeRDFGraphFromN3String con
+        vmod  = aloc (allLabels labelIsVar antgr)
+        modc  = case vbmCompose vmod vflt of
+            Just x  -> x
+            Nothing -> varBindingId
+
+
+------------------------------------------------------------
+--  Query binding modifier for "allocated to" logic
+------------------------------------------------------------
+
+-- |This function defines a variable binding mofifier that
+--  allocates a new blank node for each value bound to
+--  a query variable, and binds it to another variable
+--  in each query binding.
+--
+--  This provides a single binding for query variables that would
+--  otherwise be unbound by a query.  For example, consider the
+--  inference pattern:
+--    ?a hasUncle ?c => ?a hasFather ?b . ?b hasBrother ?c .
+--  For a given ?a and ?c, there is insufficient information
+--  here to instantiate a value for variable ?b.  Using this
+--  function as part of a graph instance closure rule allows
+--  forward chaining to allocate a single bnode for each
+--  occurrence of ?a, so that given:
+--    Jimmy hasUncle Fred .
+--    Jimmy hasUncle Bob .
+--  leads to exactly one bnode inference of:
+--    Jimmy hasFather _:f .
+--  giving:
+--    Jimmy hasFather _:f .
+--    _:f hasBrother Fred .
+--    _:f hasBrother Bob .
+--  rather than:
+--    Jimmy hasFather _:f1 .
+--    _:f1 hasBrother Fred .
+--    Jimmy hasFather _:f2 .
+--    _:f2 hasBrother Bob .
+--
+--  This form of constrained allocation of bnodes is also required for
+--  some of the inference patterns described by the RDF formal semantics,
+--  particularly those where bnodes are substituted for URIs or literals.
+--
+--  bindvar is a variable node to which a new blank node is bound
+--  alocvar is a variable which is bound in each query to a graph
+--          node to which new blank nodes are allocated.
+--
+makeNodeAllocTo ::
+    RDFLabel -> RDFLabel
+    -> [RDFLabel] -> RDFVarBindingModify
+makeNodeAllocTo bindvar alocvar exbnode = VarBindingModify
+        { vbmName   = swishName "makeNodeAllocTo"
+        , vbmApply  = applyNodeAllocTo bindvar alocvar exbnode
+        , vbmVocab  = [alocvar,bindvar]
+        , vbmUsage  = [[bindvar]]
+        }
+
+--  Auxiliary function that performs the node allocation defined
+--  by makeNodeAllocTo.
+--
+--  bindvar is a variable node to which a new blank node is bound
+--  alocvar is a variable which is bound in each query to a graph
+--          node to which new blank nodes are allocated.
+--  exbnode is a list of existing blank nodes, to be avoided by
+--          the new blank node allocator.
+--  vars    is a list of variable bindings to which new bnode
+--          allocations for the indicated bindvar are to be added.
+--
+applyNodeAllocTo ::
+    RDFLabel -> RDFLabel -> [RDFLabel] -> [RDFVarBinding] -> [RDFVarBinding]
+applyNodeAllocTo bindvar alocvar exbnode vars =
+    let
+        app vbind = applyVarBinding vbind
+        alocnodes = zip (nub $ flist (map app vars) alocvar)
+                        (newNodes (makeBlank bindvar) exbnode)
+        newvb var = joinVarBindings
+            ( makeVarBinding $ head
+              [ [(bindvar,b)] | (v,b) <- alocnodes, app var alocvar == v ] )
+            var
+    in
+        map newvb vars
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFRuleset.hs,v $
+-- $Author: graham $
+-- $Revision: 1.20 $
+-- $Log: RDFRuleset.hs,v $
+-- Revision 1.20  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.19  2003/12/20 12:53:40  graham
+-- Fix up code to compile and test with GHC 5.04.3
+--
+-- Revision 1.18  2003/12/20 12:00:14  graham
+-- Introduced new TraceHelpers module for Hugs-2003 compatibility.
+--
+-- Revision 1.17  2003/12/19 21:01:25  graham
+-- Change Debug.Trace import (from Hugs.Trace)
+--
+-- Revision 1.16  2003/12/18 18:27:47  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.15  2003/12/16 07:05:37  graham
+-- Working on updated RDFProofContext
+--
+-- Revision 1.14  2003/12/11 19:10:29  graham
+-- Forward chaining now adds antecedent graphs rather than merging them,
+-- so that
+-- bnodes carried over from the original input are not separated.
+-- Future developments should provide controlled scoping for bnodes,
+-- to avoid
+-- errors this may cause.
+--
+-- Revision 1.13  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.12  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.11  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.10  2003/11/25 23:02:17  graham
+-- Reworked datatype variable modifier logic.
+-- Limited range of test cases so far all pass.
+--
+-- Revision 1.9  2003/11/14 21:48:35  graham
+-- First cut cardinality-checked datatype-constraint rules to pass test cases.
+-- Backward chaining is still to do.
+--
+-- Revision 1.8  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.7  2003/11/06 17:58:33  graham
+-- About to rework Datatype to better support class-based reasoning.
+--
+-- Revision 1.6  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.5  2003/10/09 17:16:13  graham
+-- Added test cases to exercise features of rules used to capture
+-- RDF semantics.  Also added proof test case using XML literal.
+--
+-- Revision 1.4  2003/10/09 13:58:59  graham
+-- Sync with CVS.  Preparing to eliminate QueryBindingFilter in favour
+-- of using just QueryBindingModifier.
+--
+-- Revision 1.3  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.2  2003/09/30 20:02:40  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.1  2003/09/30 16:38:19  graham
+-- Add Ruleset and RDFRuleset modules to provide proof context elements
+--

+ Swish/HaskellRDF/RDFRulesetTest.hs view
@@ -0,0 +1,470 @@+--------------------------------------------------------------------------------
+--  $Id: RDFRulesetTest.hs,v 1.12 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFRulesetTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test cases for ruleset data.
+--
+--  Note that the proof-related methods defined in RDFRuleset are tested
+--  by RDFProofTest and/or RDFProofCheck.
+--
+{--------+---------+---------+---------+---------+---------+---------+---------}
+
+--   WNH RIP OUTmodule Swish.HaskellRDF.RDFRulesetTest where
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFClosure, RDFRuleset
+    , nullRDFFormula
+    , GraphClosure(..), makeGraphClosureRule
+    , makeRDFGraphFromN3String
+    , makeRDFFormula
+    , makeN3ClosureAllocatorRule
+    , makeN3ClosureRule
+    , makeN3ClosureSimpleRule
+    , makeNodeAllocTo
+    -- for debugging
+    , graphClosureFwdApply, graphClosureBwdApply
+    )
+
+import Swish.HaskellRDF.RDFQuery
+    ( rdfQueryBack, rdfQueryBackFilter, rdfQueryBackModify )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding
+    , RDFVarBindingModify
+    , RDFVarBindingFilter
+    , rdfVarBindingUriRef, rdfVarBindingBlank
+    , rdfVarBindingLiteral
+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
+    , rdfVarBindingMemberProp
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( Label (..), RDFLabel(..), RDFGraph
+    , setArcs, getArcs, addArc, add, delete, extract, labels, merge
+    , allLabels, allNodes, remapLabels, remapLabelList
+    , toRDFGraph, emptyRDFGraph
+    , Label (..), Arc(..), arc, arcSubj, arcPred, arcObj, Selector
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..), nullVarBinding
+    , makeVarBinding
+    , vbmCompatibility, vbmCompose
+    , makeVarFilterModify
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( Ruleset(..)
+    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules
+    , getRulesetAxiom, getRulesetRule
+    , getContextAxiom, getContextRule, getMaybeContextRule )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..)
+    , fwdCheckInference
+    , showsFormula, showsFormulae, showsWidth )
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getScopePrefix, getScopeURI
+    , getQName, getScopedNameURI
+    , makeScopedName
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( namespaceRDF
+    , namespaceRDFO
+    , namespaceOWL
+    , scopeRDF
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..) )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertBool, assertEqual, assertString
+    , runTestTT, runTestText, putTextToHandle
+    )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    )
+
+import Data.List
+    ( nub, sort )
+
+import Data.Maybe
+    ( isJust, fromJust )
+
+------------------------------------------------------------
+--  Test case helpers
+------------------------------------------------------------
+
+test :: String -> Bool -> Test
+test lab bv =
+    TestCase ( assertBool ("test:"++lab) bv )
+
+testVal :: (Eq a, Show a) => String -> a -> a -> Test
+testVal lab a1 a2 =
+    TestCase ( assertEqual ("testVal:"++lab) a1 a2 )
+
+testEq :: (Eq a, Show a) => String -> Bool -> a -> a -> Test
+testEq lab eq a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) eq (a1==a2) )
+
+testEqual :: (Eq a, Show a) => String -> a -> a -> Test
+testEqual lab a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
+
+testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
+testLe lab eq a1 a2 =
+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
+
+testStringEq :: String -> String -> String -> Test
+testStringEq lab s1 s2 =
+    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )
+
+testSameNamespace :: String -> Namespace -> Namespace -> Test
+testSameNamespace lab n1 n2 =
+    TestCase ( assertBool ("testSameNamespace:"++lab) ((p1==p2)&&(u1==u2)) )
+    where
+        p1 = nsPrefix n1
+        p2 = nsPrefix n2
+        u1 = nsURI n1
+        u2 = nsURI n2
+
+testScopedNameEq :: String -> Bool -> ScopedName -> ScopedName -> Test
+testScopedNameEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testScopedNameEq:"++lab) eq (n1==n2) )
+
+{-
+testQNameEq :: String -> Bool -> QName -> QName -> Test
+testQNameEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )
+-}
+
+testSameAxioms :: String -> [RDFFormula] -> [RDFFormula] -> Test
+testSameAxioms lab as1 as2 =
+    TestCase ( assertBool ("testSameAxioms:"++lab) sameas )
+    where
+        sameas = (sort as1) == (sort as2)
+
+testSameRules :: String -> [RDFRule] -> [RDFRule] -> Test
+testSameRules lab rs1 rs2 =
+    TestCase ( assertBool ("testSameRules:"++lab) samers )
+    where
+        samers = (sort rs1) == (sort rs2)
+
+------------------------------------------------------------
+--  Common values
+------------------------------------------------------------
+
+pref_rdf = nsURI namespaceRDF
+pref_op  = nsURI namespaceRDFO
+pref_owl = nsURI namespaceOWL
+
+------------------------------------------------------------
+--  Define and manipulate rulesets
+------------------------------------------------------------
+--
+--  A ruleset is essentially a collection of axioms and rules
+--  associated with a namespace.
+--
+--  Rulesets for RDF, RDFS and basic datatyping are predefined:
+--  see RDFRuleset, RDFSRuleset and RDFDRuleset.
+--  Additional rulesets may be defined for specific datatypes.
+--
+--  A proof context is a list of rulesets,
+--  which may be cited by a proof.
+
+rn1  = Namespace "r1" "http://id.ninebynine.org/wip/2003/rulesettest/r1"
+
+-- Common prefix declarations for graph expressions
+pref =
+    "@prefix rdf:  <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" ++
+    "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" ++
+    "@prefix ex:   <http://example.org/> . \n" ++
+    " \n"
+
+a11  = makeRDFFormula rn1 "a11" (pref++"ex:R1 rdf:type ex:C1 .")
+a12  = makeRDFFormula rn1 "a12" (pref++"ex:R2 rdf:type ex:C2 .")
+
+r11  = makeN3ClosureSimpleRule rn1 "r11"
+            ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )
+            ( pref++"?r1 ex:P1 ?r2 ." )
+
+r12  = makeN3ClosureSimpleRule rn1 "r12"
+            ( pref++"?r1 rdf:type ex:C1 . ?r2 rdf:type ex:C2 ." )
+            ( pref++"?r2 ex:P2 ?r1 ." )
+
+--  Basic formula and rule comparison tests
+--  (tests support code added in module Proof.hs)
+
+testCmpAX01 = testEq "testCmpAX01" True  a11 a11
+testCmpAX02 = testEq "testCmpAX02" False a11 a12
+testCmpAX03 = testLe "testCmpAX03" True  a11 a11
+testCmpAX04 = testLe "testCmpAX04" True  a11 a12
+testCmpAX05 = testLe "testCmpAX05" False a12 a11
+
+testFormulaSuite = TestList
+    [ testCmpAX01, testCmpAX02, testCmpAX03, testCmpAX04, testCmpAX05
+    ]
+
+testCmpRU01 = testEq "testCmpRU01" True  r11 r11
+testCmpRU02 = testEq "testCmpRU02" False r11 r12
+testCmpRU03 = testLe "testCmpRU03" True  r11 r11
+testCmpRU04 = testLe "testCmpRU04" True  r11 r12
+testCmpRU05 = testLe "testCmpRU05" False r12 r11
+
+testRuleSuite = TestList
+    [ testCmpRU01, testCmpRU02, testCmpRU03, testCmpRU04, testCmpRU05
+    ]
+
+--  Test simple ruleset construction and access
+
+a1s  = [ a11, a12 ]
+
+r1s  = [ r11, r12 ]
+
+r1   = makeRuleset rn1 a1s r1s
+
+testNS01  = testSameNamespace "testNS01" rn1 (getRulesetNamespace r1)
+testAX01  = testSameAxioms    "testAX01" a1s (getRulesetAxioms r1)
+testRU01  = testSameRules     "testRU01" r1s (getRulesetRules r1)
+
+testGeta11 = testEqual "testGeta11" (Just a11) $
+    getRulesetAxiom (ScopedName rn1 "a11") r1
+testGeta12 = testEqual "testGeta11" (Just a12) $
+    getRulesetAxiom (ScopedName rn1 "a12") r1
+testGetr11 = testEqual "testGetr11" (Just r11) $
+    getRulesetRule (ScopedName rn1 "r11") r1
+testGetr12 = testEqual "testGetr12" (Just r12) $
+    getRulesetRule (ScopedName rn1 "r12") r1
+testGetnone = testEqual "testGetnone" Nothing $
+    getRulesetRule (ScopedName rn1 "none") r1
+
+testRulesetSuite = TestList
+    [ testNS01, testAX01, testRU01
+    , testGeta11, testGeta12
+    , testGetr11, testGetr12
+    , testGetnone
+    ]
+
+------------------------------------------------------------
+--  Component tests for RDF proof context
+------------------------------------------------------------
+
+prefix =
+    "@prefix rdf:  <http://www.w3.org/1999/02/22-rdf-syntax-ns#> . \n" ++
+    "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> . \n" ++
+    "@prefix ex:   <http://example.org/> . \n" ++
+    " \n"
+
+scopeex   = Namespace "ex"   "http://id.ninebynine.org/wip/2003/RDFProofCheck#"
+
+makeFormula :: Namespace -> String -> String -> RDFFormula
+makeFormula scope local gr =
+    makeRDFFormula scope local (prefix++gr)
+
+allocateTo :: String -> String -> [RDFLabel] -> RDFVarBindingModify
+allocateTo bv av = makeNodeAllocTo (vn bv) (vn av)
+    where
+        vn ('?':n) = Var n
+
+isXMLLit     ('?':x) = rdfVarBindingXMLLiteral     (Var x)
+
+queryBack :: [Arc RDFLabel] -> RDFGraph -> [[RDFVarBinding]]
+queryBack qas tg = rdfQueryBack (toRDFGraph qas) tg
+
+-- Backward chaining rdf:r2
+
+rdfr2ant  = makeRDFGraphFromN3String "?x  ?a ?l . "
+rdfr2con  = makeRDFGraphFromN3String "?x  ?a ?b . ?b rdf:type rdf:XMLLiteral ."
+rdfr2modv = (allocateTo "?b" "?l") (allLabels labelIsVar rdfr2ant)
+rdfr2modc = vbmCompose (makeVarFilterModify $ isXMLLit "?l") rdfr2modv
+
+testRDF01 = test    "testRDF01" $ isJust rdfr2modc
+
+rdfr2grc = GraphClosure
+            { nameGraphRule = ScopedName scopeRDF "r2"
+            , ruleAnt       = getArcs rdfr2ant
+            , ruleCon       = getArcs rdfr2con
+            , ruleModify    = fromJust rdfr2modc
+            }
+
+rdfr2rul = Rule
+            { ruleName       = nameGraphRule rdfr2grc
+            , fwdApply       = graphClosureFwdApply rdfr2grc
+            , bwdApply       = graphClosureBwdApply rdfr2grc
+            , checkInference = fwdCheckInference rdfr2rul
+            }
+
+con03  = formExpr $ makeFormula scopeex "con03" $
+    "ex:s ex:p1 _:l1 ; ex:p2a _:l2; ex:p2b _:l2 ." ++
+    "_:l1 rdf:type rdf:XMLLiteral ." ++
+    "_:l2 rdf:type rdf:XMLLiteral ."
+
+v_a   = Var "a"
+v_b   = Var "b"
+v_x   = Var "x"
+u_s   = Res (makeScopedName "" "http://example.org/" "s")
+u_p1  = Res (makeScopedName "" "http://example.org/" "p1")
+u_p2a = Res (makeScopedName "" "http://example.org/" "p2a")
+u_p2b = Res (makeScopedName "" "http://example.org/" "p2b")
+u_rt  = Res (makeScopedName "" pref_rdf "type")
+u_rx  = Res (makeScopedName "" pref_rdf "XMLLiteral")
+b_l1  = Blank "l1"
+b_l2  = Blank "l2"
+
+rdfr2v1 = queryBack (ruleCon rdfr2grc) con03
+rdfr2b1 = [ [ makeVarBinding [ (v_x,u_s), (v_a,u_p1),  (v_b,b_l1) ]
+            , makeVarBinding [ (v_x,u_s), (v_a,u_p2a), (v_b,b_l2) ]
+            , makeVarBinding [ (v_x,u_s), (v_a,u_p2b), (v_b,b_l2) ]
+            , makeVarBinding [ (v_b,b_l1) ]
+            , makeVarBinding [ (v_b,b_l2) ]
+            ]
+          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
+            , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_rx) ]
+            , makeVarBinding [ (v_b,b_l2) ]
+            ]
+          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
+            , makeVarBinding [ (v_b,b_l1) ]
+            , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_rx) ]
+            ]
+          , [ makeVarBinding [ (v_x,u_s),  (v_a,u_p1),  (v_b,b_l1) ]
+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2a), (v_b,b_l2) ]
+            , makeVarBinding [ (v_x,u_s),  (v_a,u_p2b), (v_b,b_l2) ]
+            , makeVarBinding [ (v_x,b_l1), (v_a,u_rt),  (v_b,u_rx) ]
+            , makeVarBinding [ (v_x,b_l2), (v_a,u_rt),  (v_b,u_rx) ]
+            ]
+          ]
+
+rdfr2v2 = rdfQueryBackModify (ruleModify rdfr2grc) rdfr2v1
+rdfr2v3 = map nub rdfr2v2
+
+testRDF02 = testVal "testRDF02" rdfr2b1 rdfr2v1
+testRDF03 = testVal "testRDF03" [] rdfr2v2
+testRDF04 = testVal "testRDF04" [] rdfr2v3
+
+testRDF09 = testEq "testRDF09" True [] $ bwdApply rdfr2rul con03
+
+testRDFSuite = TestList
+    [ testRDF01, testRDF02, testRDF03, testRDF04
+    , testRDF09
+    ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ testFormulaSuite
+  , testRuleSuite
+  , testRulesetSuite
+  , testRDFSuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFRulesetTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.12 $
+-- $Log: RDFRulesetTest.hs,v $
+-- Revision 1.12  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.11  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.10  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.9  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.8  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.7  2003/11/24 15:46:04  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.6  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.5  2003/10/22 16:18:37  graham
+-- Move common namespace definitions into Namespace module
+-- (May later move these into separate modules.)
+--
+-- Revision 1.4  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.3  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.2  2003/09/30 20:02:40  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.1  2003/09/30 16:38:19  graham
+-- Add Ruleset and RDFRuleset modules to provide proof context elements
+--

+ Swish/HaskellRDF/RDFVarBinding.hs view
@@ -0,0 +1,211 @@+--------------------------------------------------------------------------------
+--  $Id: RDFVarBinding.hs,v 1.4 2003/12/18 18:27:47 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  RDFVarBinding
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module instantiates the VarBinding types and methods for use
+--  with RDF graph labels.
+--
+--  See module RDFQueryTest for test cases.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBinding, nullRDFVarBinding
+    , RDFVarBindingModify, RDFOpenVarBindingModify, RDFOpenVarBindingModifyMap
+    , RDFVarBindingFilter
+    , rdfVarBindingUriRef, rdfVarBindingBlank
+    , rdfVarBindingLiteral
+    , rdfVarBindingUntypedLiteral, rdfVarBindingTypedLiteral
+    , rdfVarBindingXMLLiteral, rdfVarBindingDatatyped
+    , rdfVarBindingMemberProp
+    )
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFLabel(..)
+    , isLiteral, isUntypedLiteral, isTypedLiteral, isXMLLiteral
+    , isDatatyped, isMemberProp, isUri, isBlank, isQueryVar
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..), nullVarBinding
+    , boundVars, subBinding, makeVarBinding
+    , applyVarBinding, joinVarBindings
+    , VarBindingModify(..), OpenVarBindingModify
+    , vbmCompatibility, vbmCompose
+    , findCompositions, findComposition
+    , VarBindingFilter(..)
+    , makeVarFilterModify
+    , makeVarTestFilter, makeVarCompareFilter
+    , varBindingId, varFilterDisjunction, varFilterConjunction
+    , varFilterEQ, varFilterNE
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( swishName )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupMap(..) )
+
+------------------------------------------------------------
+--  Types for RDF query variable bindings and modifiers
+------------------------------------------------------------
+
+-- |RDFVarBinding is the specific type type of a variable
+--  binding value used with RDF graph queries, returned by
+--  'RDFVarBindingFind' and used by 'RDFVarBindingSubs'
+type RDFVarBinding  = VarBinding RDFLabel RDFLabel
+
+-- |nullRDFVarBinding:  maps no query variables.
+nullRDFVarBinding :: RDFVarBinding
+nullRDFVarBinding = nullVarBinding
+
+-- |Define type of query binding modifier for RDF graph inference
+type RDFVarBindingModify = VarBindingModify RDFLabel RDFLabel
+
+-- |Open variable binding modifier that operates on RDFLabel values
+--
+--  RDFOpenVarBindingModify = [RDFLabel] -> RDFVarBindingModify
+--
+type RDFOpenVarBindingModify = OpenVarBindingModify RDFLabel RDFLabel
+
+-- |Define type for lookup map of open query binding modifiers
+type RDFOpenVarBindingModifyMap = LookupMap RDFOpenVarBindingModify
+
+-- |RDFVarBindingFilter is a function type that tests to see if
+--  a query binding satisfies some criterion, and is used to
+--  create a variable binding modifier that simply filers
+--  given variable bindings.
+--
+--  Queries often want to apply some kind of filter or condition
+--  to the variable bindings that are processed.  In inference rules,
+--  it sometimes seems desirable to stipulate additional conditions on
+--  the things that are matched.
+--
+--  This function type is used to perform such tests.
+--  A number of simple implementations are included below.
+--
+type RDFVarBindingFilter = VarBindingFilter RDFLabel RDFLabel
+
+------------------------------------------------------------
+--  Declare some query binding filters
+------------------------------------------------------------
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to a URI reference.
+rdfVarBindingUriRef :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingUriRef =
+    makeVarTestFilter (swishName "rdfVarBindingUriRef") isUri
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to a blank node.
+rdfVarBindingBlank :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingBlank =
+    makeVarTestFilter (swishName "rdfVarBindingBlank") isBlank
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to a literal value.
+rdfVarBindingLiteral :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingLiteral =
+    makeVarTestFilter (swishName "rdfVarBindingLiteral") isLiteral
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to an untyped literal value.
+rdfVarBindingUntypedLiteral :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingUntypedLiteral =
+    makeVarTestFilter (swishName "rdfVarBindingUntypedLiteral") isUntypedLiteral
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to a typed literal value.
+rdfVarBindingTypedLiteral :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingTypedLiteral =
+    makeVarTestFilter (swishName "rdfVarBindingTypedLiteral") isTypedLiteral
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to an XML literal value.
+rdfVarBindingXMLLiteral :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingXMLLiteral =
+    makeVarTestFilter (swishName "rdfVarBindingXMLLiteral") isXMLLiteral
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to container membership property.
+rdfVarBindingMemberProp :: RDFLabel -> RDFVarBindingFilter
+rdfVarBindingMemberProp =
+    makeVarTestFilter (swishName "rdfVarBindingMemberProp") isMemberProp
+
+-- |This function generates a query binding filter that ensures
+--  an indicated variable is bound to a literal value with a
+--  datatype whose URI is bound to another node
+--
+--  dvar    a variable bound to the required datatype.
+--  lvar    a variable bound to the literal node to be tested.
+--
+rdfVarBindingDatatyped :: RDFLabel -> RDFLabel -> RDFVarBindingFilter
+rdfVarBindingDatatyped dvar lvar = VarBindingFilter
+    { vbfName   = swishName "rdfVarBindingDatatyped"
+    , vbfVocab  = [dvar,lvar]
+    , vbfTest   = \vb -> testDatatyped vb dvar lvar
+    }
+
+testDatatyped :: RDFVarBinding -> RDFLabel -> RDFLabel -> Bool
+testDatatyped vb dvar lvar = and $
+        [ isUri dtype
+        , isDatatyped dqnam $ applyVarBinding vb lvar
+        ]
+        where
+            dtype = applyVarBinding vb dvar
+            -- NOTE: dqnam is not evaluated unless (isUri dtype)
+            dqnam = case dtype of { (Res dqnam) -> dqnam }
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/RDFVarBinding.hs,v $
+-- $Author: graham $
+-- $Revision: 1.4 $
+-- $Log: RDFVarBinding.hs,v $
+-- Revision 1.4  2003/12/18 18:27:47  graham
+-- Datatyped literal inferences all working
+-- (except equivalent literals with different datatypes)
+--
+-- Revision 1.3  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.2  2003/12/08 17:29:19  graham
+-- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
+--
+-- Revision 1.1  2003/11/14 16:01:30  graham
+-- Separate RDFVarBinding from module RDFQuery.
+--

+ Swish/HaskellRDF/Rule.hs view
@@ -0,0 +1,265 @@+{-# OPTIONS -XMultiParamTypeClasses #-}++--------------------------------------------------------------------------------
+--+--  $Id: Rule.hs,v 1.8 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Rule
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a framework for defining inference rules
+--  over some expression form.  It is intended to be used with
+--  RDF graphs, but the structures aim to be quite generic with
+--  respect to the expression forms allowed.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..), RuleMap
+    , nullScope, nullFormula, nullRule
+    , fwdCheckInference, bwdCheckInference
+    , showsFormula, showsFormulae, showsWidth
+    )
+where
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getScopePrefix, getScopeURI
+    , getQName, getScopedNameURI
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    )
+
+import Swish.HaskellUtils.ShowM
+    ( ShowM(..), showm )
+
+import Swish.HaskellUtils.ListHelpers
+    ( subset )
+
+{- in Prelude????+import List
+    ( union, intersect )
+
+import Maybe
+    ( isJust, fromJust )
+-}+
+------------------------------------------------------------
+--  Expressions
+------------------------------------------------------------
+
+-- |Expression is a type class for values over which proofs
+--  may be constructed.
+class (Eq ex) => Expression ex where
+    -- |Is expression true in all interpretations?
+    --  If so, then its truth is assumed without justification.
+    isValid :: ex -> Bool
+
+------------------------------------------------------------
+--  Formula:  a named expression
+------------------------------------------------------------
+
+-- |A Formula is a named expression.
+data Formula ex = Formula
+    { formName :: ScopedName        -- ^ Name used for formula in proof chain
+    , formExpr :: ex                -- ^ Named formula value
+    } deriving Show
+
+-- |Define equality of formulae as equality of formula names
+instance Eq (Formula ex) where
+    f1 == f2 = formName f1 == formName f2
+
+-- |Define ordering of formulae based on formula names
+instance Ord (Formula ex) where
+    f1 <= f2 = formName f1 <= formName f2
+
+instance LookupEntryClass (Formula ex) ScopedName (Formula ex)
+    where
+    newEntry (_,form) = form
+    keyVal form = (formName form, form)
+
+nullScope :: Namespace
+nullScope = Namespace "null" "http://id.ninebynine.org/2003/Ruleset/null"
+
+nullFormula :: Formula ex
+nullFormula = Formula
+    { formName = ScopedName nullScope "nullFormula"
+    , formExpr = error "Null formula"
+    }
+
+-- testf1 = Formula "f1" ('f',1)
+-- testf2 = Formula "f2" ('f',2)
+
+-- |showsFormulae
+--  Return a displayable form of a list of labelled formulae
+showsFormulae :: (ShowM ex) => String -> [Formula ex] -> String -> ShowS
+showsFormulae _       []     _     = id
+showsFormulae newline [f]    after = showsFormula  newline f .
+                                     showString    after
+showsFormulae newline (f:fs) after = showsFormula  newline f .
+                                     showString    newline .
+                                     showsFormulae newline fs after
+
+-- |showsFormula
+--  Create a displayable form of a labelled formula
+showsFormula :: (ShowM ex) => String -> Formula ex -> ShowS
+showsFormula newline f =
+    showsWidth 16 ("["++show (formName f)++"] ") .
+    showms (newline++(replicate 16 ' ')) (formExpr f)
+
+------------------------------------------------------------
+--  Rule
+------------------------------------------------------------
+
+-- |Rule is a data type for inference rules that can be used
+--  to construct a step in a proof.
+data Rule ex = Rule
+    -- |Name of rule, for use when displaying a proof
+    { ruleName :: ScopedName
+    -- |Forward application of a rule, takes a list of
+    --  expressions and returns a list (possibly empty)
+    --  of forward applications of the rule to combinations
+    --  of the antecedent expressions.
+    --  Note that all of the results returned can be assumed to
+    --  be (simultaneously) true, given the antecedents provided.
+    , fwdApply :: [ex] -> [ex]
+    -- |Backward application of a rule, takes an expression
+    --  and returns a list of alternative antecedents, each of
+    --  which is a list of expressions that jointly yield the
+    --  given consequence through application of the inference
+    --  rule.  An empty list is returned if no antecedents
+    --  will allow the consequence to be inferred.
+    , bwdApply :: ex -> [[ex]]
+    -- |Inference check.  Takes a list of antecedent expressions
+    --  and a consequent expression, returning True if the
+    --  consequence can be obtained from the antecedents by
+    --  application of the rule.  When the antecedents and
+    --  consequent are both given, this is generally more efficient
+    --  that using either forward or backward chaining.
+    --  Also, a particular rule may not fully support either
+    --  forward or backward chaining, but all rules are required
+    --  to fully support this function.
+    --
+    --  A default implementation based on forward chaining is
+    --  given below.
+    , checkInference :: [ex] -> ex -> Bool
+    }
+
+-- |Define equality of rules as equality of rule names
+instance Eq (Rule ex) where
+    r1 == r2 = ruleName r1 == ruleName r2
+
+-- |Define ordering of rules based on rule names
+instance Ord (Rule ex) where
+    r1 <= r2 = ruleName r1 <= ruleName r2
+
+instance Show (Rule ex) where
+    show rl = "Rule "++show (ruleName rl)
+
+instance LookupEntryClass (Rule ex) ScopedName (Rule ex)
+    where
+    newEntry (_,rule) = rule
+    keyVal rule = (ruleName rule, rule)
+
+type RuleMap ex = LookupMap (Rule ex)
+
+fwdCheckInference :: (Eq ex) => Rule ex -> [ex] -> ex -> Bool
+fwdCheckInference rule ante cons =
+    (cons `elem` fwdApply rule ante)
+
+bwdCheckInference :: (Eq ex) => Rule ex -> [ex] -> ex -> Bool
+bwdCheckInference rule ante cons = any checkAnts (bwdApply rule cons)
+    where
+        checkAnts = all (`elem` ante)
+
+nullRule :: Rule ex
+nullRule = Rule
+    { ruleName = ScopedName nullScope "nullRule"
+    , fwdApply = \ _ -> []
+    , bwdApply = \ _ -> []
+    , checkInference = \ _ _ -> False
+    }
+
+------------------------------------------------------------
+--  Shows formatting support functions
+-----------------------------------------------------------
+
+-- |Show a string left justified in a field of at least the specified
+--  number of characters width.
+showsWidth :: Int -> String -> ShowS
+showsWidth wid str more = str++replicate pad ' '++more
+    where
+        pad = wid - length str
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/Rule.hs,v $
+-- $Author: graham $
+-- $Revision: 1.8 $
+-- $Log: Rule.hs,v $
+-- Revision 1.8  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.7  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.6  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.5  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.4  2003/11/06 17:58:33  graham
+-- About to rework Datatype to better support class-based reasoning.
+--
+-- Revision 1.3  2003/10/24 21:05:09  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.2  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.1  2003/09/30 20:00:46  graham
+-- Add module Rule as common dependency for Proof and Ruleset
+--

+ Swish/HaskellRDF/Ruleset.hs view
@@ -0,0 +1,190 @@+{-# OPTIONS -XMultiParamTypeClasses #-}++--------------------------------------------------------------------------------
+--  $Id: Ruleset.hs,v 1.9 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Ruleset
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a ruleset data type, used to collect information
+--  about a ruleset that may contribute torwards inferences in RDF;
+--  e.g. RDF and RDFS are rulesets.
+--
+--  A ruleset consists of a namespace, a collection of axioms and
+--  a collection of rules.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.Ruleset
+    ( Ruleset(..), RulesetMap
+    , makeRuleset, getRulesetNamespace, getRulesetAxioms, getRulesetRules
+    , getRulesetAxiom, getRulesetRule
+    , getContextAxiom, getMaybeContextAxiom
+    , getContextRule,  getMaybeContextRule
+    )
+where
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , ScopedName(..)
+    , getScopePrefix, getScopeURI
+    , getQName, getScopedNameURI
+    , matchName )
+
+import Swish.HaskellRDF.Rule
+    ( Expression(..), Formula(..), Rule(..)
+    , fwdCheckInference
+    , showsFormula, showsFormulae, showsWidth
+    )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , mapFindMaybe
+    )
+
+import Data.Maybe
+    ( Maybe(..), isJust, fromJust, fromMaybe, listToMaybe, mapMaybe )
+
+------------------------------------------------------------
+--  Ruleset, having namespace, axioms and rules
+------------------------------------------------------------
+
+data Ruleset ex = Ruleset
+    { rsNamespace :: Namespace
+    , rsAxioms    :: [Formula ex]
+    , rsRules     :: [Rule ex]
+    }
+
+instance Eq (Ruleset ex) where
+    r1 == r2 = rsNamespace r1 == rsNamespace r2
+
+instance LookupEntryClass (Ruleset ex) Namespace (Ruleset ex)
+    where
+        keyVal   r@(Ruleset k _ _) = (k,r)
+        newEntry (_,r)             = r
+
+type RulesetMap ex = LookupMap (Ruleset ex)
+
+makeRuleset :: Namespace -> [Formula ex] -> [Rule ex] -> Ruleset ex
+makeRuleset nsp fms rls = Ruleset
+    { rsNamespace = nsp
+    , rsAxioms    = fms
+    , rsRules     = rls
+    }
+
+getRulesetNamespace :: Ruleset ex -> Namespace
+getRulesetNamespace = rsNamespace
+
+getRulesetAxioms :: Ruleset ex -> [Formula ex]
+getRulesetAxioms = rsAxioms
+
+getRulesetRules :: Ruleset ex -> [Rule ex]
+getRulesetRules = rsRules
+
+------------------------------------------------------------
+--  Find a named axiom or rule in a ruleset or proof context
+------------------------------------------------------------
+
+getRulesetAxiom :: ScopedName -> Ruleset ex -> Maybe (Formula ex)
+getRulesetAxiom nam rset =
+    mapFindMaybe nam (LookupMap (getRulesetAxioms rset))
+    -- listToMaybe $ filter ( (matchName nam) . formName ) $ getRulesetAxioms rset
+
+getRulesetRule :: ScopedName -> Ruleset ex -> Maybe (Rule ex)
+getRulesetRule nam rset =
+    mapFindMaybe nam (LookupMap (getRulesetRules rset))
+    -- listToMaybe $ filter ( (matchName nam) . ruleName ) $ getRulesetRules rset
+
+getContextAxiom :: ScopedName -> Formula ex -> [Ruleset ex] -> Formula ex
+getContextAxiom nam def rsets = fromMaybe def (getMaybeContextAxiom nam rsets)
+    {-
+    foldr (flip fromMaybe) def $ map (getRulesetAxiom nam) rsets
+    -}
+
+getMaybeContextAxiom :: ScopedName -> [Ruleset ex] -> Maybe (Formula ex)
+getMaybeContextAxiom nam rsets =
+    listToMaybe $ mapMaybe (getRulesetAxiom nam) rsets
+
+getContextRule :: ScopedName -> Rule ex -> [Ruleset ex] -> Rule ex
+getContextRule nam def rsets = fromMaybe def (getMaybeContextRule nam rsets)
+    {-
+    foldr (flip fromMaybe) def $ map (getRulesetRule nam) rsets
+    -}
+
+getMaybeContextRule :: ScopedName -> [Ruleset ex] -> Maybe (Rule ex)
+getMaybeContextRule nam rsets =
+    listToMaybe $ mapMaybe (getRulesetRule nam) rsets
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/Ruleset.hs,v $
+-- $Author: graham $
+-- $Revision: 1.9 $
+-- $Log: Ruleset.hs,v $
+-- Revision 1.9  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.8  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.7  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.6  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.5  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.4  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.3  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.2  2003/09/30 20:02:40  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.1  2003/09/30 16:38:19  graham
+-- Add Ruleset and RDFRuleset modules to provide proof context elements
+--

+ Swish/HaskellRDF/Sort/AdaptiveHeapSort.lhs view
@@ -0,0 +1,37 @@+%-------------------------------=  --------------------------------------------
+\section{Adaptive heap sort}
+%-------------------------------=  --------------------------------------------
+
+%include CartesianTree.lhs
+
+%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Adaptive heap sort}
+%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
+
+%align
+
+> module Swish.HaskellRDF.Sort.AdaptiveHeapSort
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+> import Swish.HaskellRDF.Sort.CartesianTree (BinTree(..), cartesianTree)
+> import Swish.HaskellRDF.Sort.HeapSort (Heap(..), leaf, insertBy)
+> import Swish.HaskellRDF.Sort.BraunHeap (siftBy, joinBy)
+
+%align 33
+
+> adaptiveHeapSort		:: (Ord a) => [a] -> [a]
+> adaptiveHeapSort		=  adaptiveHeapSortBy (<=)
+
+> adaptiveHeapSortBy (<=) as	=  unheap (leaf (cartesianTree as))
+>   where
+>
+>   Leaf      <== _		=  True
+>   Node _ a _ <== Node _ b _	=  a <= b
+>   Node _ _ _ <== _		=  False
+
+>   unheap Empty		=  []
+>   unheap (Bin t hl hr)	=  case t of
+>       Node Leaf a Leaf	-> a : unheap (joinBy (<==) hl hr)
+>       Node l a Leaf		-> a : unheap (siftBy (<==) l hl hr)
+>       Node Leaf a r		-> a : unheap (siftBy (<==) r hl hr)
+>       Node l a r		-> a : unheap (insertBy (<==) r $ siftBy (<==) l hl hr)

+ Swish/HaskellRDF/Sort/BraunHeap.lhs view
@@ -0,0 +1,91 @@+%-------------------------------=  --------------------------------------------
+\chapter{Braun heaps}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.BraunHeap
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+> import Swish.HaskellRDF.Sort.ListLib (prefold)
+> import Swish.HaskellRDF.Sort.HeapSort (Heap(..), leaf, insertBy)
+
+%align 33
+
+%-------------------------------=  --------------------------------------------
+\section{Top-down heap sort}
+%-------------------------------=  --------------------------------------------
+
+Here is a variant of heap sort due to Paulson \cite[p. 160]{Pau96ML}
+which follows the original more closely. Recall that imperative
+implementations of heap sort use an implicit representation of binary
+heaps ie the binary tree is embedded in an array. For a functional
+explanation we step backward and represent an array by a binary tree.
+The original heap sort uses left-complete trees. We use Braun
+trees~\cite[p. 154]{Pau96ML} instead. However, every implementation of
+functional arrays would do. We could generalize the following to an
+array-based implementation of priority queues.
+
+The construction of the heap works as before.  The second phase mimics
+the imperative version: the smallest element (ie the leftmost) is
+replaced by an arbitrary element (usually the rightmost) which is
+sifted down the heap. Here we replace the root (ie the leftmost) by the
+leftmost leaf (ie an element in the rear part of the array). Both
+|splitLeft| and |sift| employ the fact that their arguments are Braun
+trees.
+
+> unHeapBy			:: Rel a -> Heap a -> [a]
+> unHeapBy (<=) Empty		=  []
+> unHeapBy (<=) (Bin a l r)	=  a : unHeapBy (<=) (joinBy (<=) l r)
+>
+> joinBy			:: Rel a -> Heap a -> Heap a -> Heap a
+> joinBy (<=) l r		=  case splitLeft l of
+>     Null			-> Empty
+>     Pair a l'			-> siftBy (<=) a r l'
+>
+> splitLeft			:: Heap a -> OptPair a (Heap a)
+> splitLeft Empty		=  Null
+> splitLeft (Bin a l r)		=  case splitLeft l of
+>     Null			-> Pair a Empty		-- |r == Empty|
+>     Pair b l'			-> Pair b (Bin a r l')
+
+The recursion scheme is dual to that of |insert|: the element is always
+deleted into the left subtree (which is possibly bigger). Additionally,
+the left and the right branch are interchanged (in case both subtrees
+have the same size).
+
+> siftBy			:: Rel a -> a -> Heap a -> Heap a -> Heap a
+> siftBy (<=)			=  sift
+>   where
+>   sift a Empty r		=  leaf a		-- |r == Empty|
+>   sift a l@(Bin b _ _) Empty				-- |l == leaf b|
+>       | a <= b		=  Bin a l Empty
+>       | otherwise		=  Bin b (leaf a) Empty
+>   sift a l@(Bin a1 l1 r1) r@(Bin a2 l2 r2)
+>       | a <= a1 && a <= a2	=  Bin a l r
+>       | a1 <= a2		=  Bin a1 (sift a l1 r1) r
+>       | otherwise		=  Bin a2 l (sift a l2 r2)
+
+We do not use the |sift| function defined in |HeapSort| because |sift|
+on Braun trees is slightly simpler. Note, however, that |sift| makes a
+redundant comparison if |a2 < a <= a1|.
+
+> braunSort			:: (Ord a) => [a] -> [a]
+> braunSort			=  braunSortBy (<=)
+>
+> braunSortBy			:: Rel a -> [a] -> [a]
+> braunSortBy (<=)		=  unHeapBy (<=) . foldr (insertBy (<=)) Empty
+
+%-------------------------------=  --------------------------------------------
+\section{Bottom-up heap sort}
+%-------------------------------=  --------------------------------------------
+
+The bottom-up variant is straightforward and a true transliteration of
+Williams' heap sort apart from the fact that we use Braun trees instead
+of left-complete trees.
+
+> bottomUpBraunSort		:: (Ord a) => [a] -> [a]
+> bottomUpBraunSort		=  bottomUpBraunSortBy (<=)
+>
+> bottomUpBraunSortBy		:: Rel a -> [a] -> [a]
+> bottomUpBraunSortBy (<=)	=  unHeapBy (<=) . prefold (siftBy (<=)) Empty

+ Swish/HaskellRDF/Sort/CartesianTree.lhs view
@@ -0,0 +1,48 @@+%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Cartesian trees}
+%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
+
+%align
+
+> module Swish.HaskellRDF.Sort.CartesianTree 
+> where
+
+%align 33
+
+> data BinTree a		=  Leaf
+>				|  Node (BinTree a) a (BinTree a)
+>				   deriving (Show)
+
+Constructing a cartesian tree in linear time.
+
+> data Spine a			=  Nil
+>				|  Cons a (BinTree a) (Spine a)
+
+> up				:: BinTree a -> Spine a -> BinTree a
+> up l Nil			=  l
+> up l (Cons a r s)		=  up (Node l a r) s
+
+> cartesianTree			:: (Ord a) => [a] -> BinTree a
+> cartesianTree			=  cartesianTreeBy (<=)
+>
+> cartesianTreeBy (<=)		=  up Leaf . foldr (\a s -> cons a Leaf s) Nil
+>   where cons a t Nil		=  Cons a t Nil
+>         cons a t s@(Cons a' t' s')
+>             | a <= a'		=  cons a (Node t a' t') s'
+>             | otherwise	=  Cons a t s
+
+|cartesianTree [5, 8, 2, 3, 7, 4, 10, 0]|
+
+\NB The obvious approaches (top-down and bottom-up) both lead to
+$\Theta(n\log n)$ algorithms. For curiosity here is the top-down
+variant of |meld|.
+
+> meld				:: (Ord a) => BinTree a -> BinTree a -> BinTree a
+> meld Leaf u			=  u
+> meld t Leaf			=  t
+> meld t@(Node l a r) u@(Node l' a' r')
+>     | a <= a'			=  Node l a (meld r u)
+>     | otherwise		=  Node (meld t l') a' r'
+
+Note that the relative order of elements is preserved. The bottom-up
+variants of cartesian trees are called \technical{pagodas}.

+ Swish/HaskellRDF/Sort/DigitalSort.lhs view
@@ -0,0 +1,51 @@+%-------------------------------=  --------------------------------------------
+\chapter{Digital sorting}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.DigitalSort +> where
+> import Data.Array
+> import Data.Bits
+> import Data.Int
+
+%align 33
+
+> bucketSort			:: (Ix b) => (b, b) -> (a -> b) -> [a] -> [a]
+> bucketSort bs key as		=  [ a | b <- elems buckets, a <- reverse b ]
+>     where buckets		=  distribute bs [ (key a, a) | a <- as ]
+>
+> distribute			:: (Ix a) => (a, a) -> [(a, b)] -> Array a [b]
+> distribute			=  accumArray (flip (:)) []
+>
+> radixSort			:: (Ix b) => (b, b) -> [a -> b] -> [a] -> [a]
+> radixSort bs keys x		=  foldr (bucketSort bs) x keys
+
+|keys| must satisfy the following property: let $a \leq_i b
+\Longleftrightarrow |key|_i\;a \leq |key|_i\;b$ and $a(R\fatsemi S)b
+\Longleftrightarrow aRb \vee (a=b \wedge aSb)$, then $(\leq)
+\Longleftrightarrow (\leq_1)\fatsemi\ldots\fatsemi(\leq_n)$.
+
+\NB |Word| should be used instead of |Int| since the sign bit is
+ignored.
+
+> int32Keys'			:: [Int32 -> Bool]
+> int32Keys'			=  [ \i -> testBit i k | k <- [s - 1, s - 2 .. 0] ]
+>     where s			=  bitSize (0 :: Int32)
+>
+> int32RadixSort'		:: [Int32] -> [Int32]
+> int32RadixSort'		=  radixSort (False, True) int32Keys'
+
+|shiftR| does not work properly, that's why |32 - 24| instead of |24|
+is used below.
+
+> int32Keys			:: [Int32 -> Int32]
+> int32Keys			=  [ \i -> shiftR i (32 - 24) .&. 255
+>				   , \i -> shiftR i (32 - 16) .&. 255
+>				   , \i -> shiftR i (32 - 8) .&. 255
+>				   , \i -> i .&. 255 ]
+>
+> int32RadixSort		:: [Int32] -> [Int32]
+> int32RadixSort		=  radixSort (0, 255) int32Keys
+>

+ Swish/HaskellRDF/Sort/FingerSearchtree.lhs view
@@ -0,0 +1,125 @@+%-------------------------------=  --------------------------------------------
+\chapter{Finger search trees}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.FingerSearchtree 
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+
+%align 33
+
+This is work in progress \ldots
+
+> data Empty a			=  E
+>
+> data Pennant tree a		=  Top a (tree a)
+>
+> data Node23 tree23 a		=  N2 (tree23 a) a (tree23 a)
+>				|  N3 (tree23 a) a (tree23 a) a (tree23 a) 
+
+> data FingerTree23 tree23 a	=  Nil
+>				|  One (Pennant tree23 a) (FingerTree23 (Node23 tree23) a)
+>				|  Two (Pennant (Node23 tree23) a) (FingerTree23 (Node23 tree23) a)
+>
+> type Bag a			=  FingerTree23 Empty a
+
+> incr						:: Pennant tree23 a -> FingerTree23 tree23 a -> FingerTree23 tree23 a
+> incr p Nil					=  One p Nil
+> incr (Top a1 t1) (One (Top a2 t2) ds)		=  Two (Top a1 (N2 t1 a2 t2)) ds
+> incr (Top a1 t1) (Two (Top a2 (N2 t2 a3 t3)) ds)
+>						=  Two (Top a1 (N3 t1 a2 t2 a3 t3)) ds
+> incr (Top a1 t1) (Two (Top a2 (N3 t2 a3 t3 a4 t4)) ds)
+>						=  Two (Top a1 (N2 t1 a2 t2)) (incr (Top a3 (N2 t3 a4 t4)) ds)
+
+> data Grown tree23 a		=  U (tree23 a)  
+>				|  G (tree23 a) a (tree23 a)
+>
+> class Ins tree23 where
+>     ins			:: (Ord a) => a -> tree23 a -> Grown tree23 a
+
+> instance Ins Empty where
+>     ins a E			=  G E a E
+>
+> instance (Ins tree23) => Ins (Node23 tree23) where
+>     ins a (N2 t1 a1 t2)
+>         | a <= a1		=  node2l (ins a t1) a1 t2
+>         | otherwise		=  node2r t1 a1 (ins a t2)
+>     ins a (N3 t1 a1 t2 a2 t3)
+>         | a <= a1		=  node3l (ins a t1) a1 t2 a2 t3
+>         | a <= a2		=  node3m t1 a1 (ins a t2) a2 t3
+>         | otherwise		=  node3r t1 a1 t2 a2 (ins a t3)
+
+> node2l			:: Grown tree23 a -> a -> tree23 a -> Grown (Node23 tree23) a
+> node2l (U t1) a1 t2		=  U (N2 t1 a1 t2)
+> node2l (G t1 a1 t2) a2 t3	=  U (N3 t1 a1 t2 a2 t3)
+
+> node2r t1 a1 (U t2)		=  U (N2 t1 a1 t2)
+> node2r t1 a1 (G t2 a2 t3)	=  U (N3 t1 a1 t2 a2 t3)
+
+> node3l (U t1) a1 t2 a2 t3	=  U (N3 t1 a1 t2 a2 t3)
+> node3l (G t1 a1 t2)a2 t3 a3 t4=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
+
+> node3m t1 a1 (U t2) a2 t3	=  U (N3 t1 a1 t2 a2 t3)
+> node3m t1 a1 (G t2 a2 t3)a3 t4=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
+>
+> node3r t1 a1 t2 a2 (U t3)	=  U (N3 t1 a1 t2 a2 t3)
+> node3r t1 a1 t2 a2(G t3 a3 t4)=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
+
+> insert'			:: (Ord a, Ins tree23) => a -> FingerTree23 tree23 a -> Maybe (FingerTree23 tree23 a)
+> insert' a Nil			=  Nothing
+> insert' a (One p@(Top a1 t1) ds)
+>     | a <= a1			=  Nothing
+>     | otherwise		=  case insert' a ds of
+>         Nothing		-> Just (one a1 (ins a t1) ds)
+>         Just ds'		-> Just (One p ds')
+> insert' a (Two p@(Top a1 t1) ds)
+>     | a <= a1			=  Nothing
+>     | otherwise		=  case insert' a ds of
+>         Nothing		-> Just (two a1 (ins a t1) ds)
+>         Just ds'		-> Just (Two p ds')
+
+> one				:: a -> Grown tree23 a -> FingerTree23 (Node23 tree23) a -> FingerTree23 tree23 a
+> one a1 (U t1) t2		=  One (Top a1 t1) t2
+> one a1 (G t1 a2 t2) t3	=  Two (Top a1 (N2 t1 a2 t2)) t3
+>
+> two				:: a -> Grown (Node23 tree23) a -> FingerTree23 (Node23 tree23) a -> FingerTree23 tree23 a
+> two a1 (U t1) t2		=  Two (Top a1 t1) t2
+> two a1 (G t1 a2 t2) t3	=  Two (Top a1 t1) (incr (Top a2 t2) t3)
+
+> insert			:: (Ord a) => a -> Bag a -> Bag a
+> insert a t			=  case insert' a t of
+>     Nothing			-> incr (Top a E) t
+>     Just t'			-> t'
+
+> class Inord tree23 where
+>     inord			:: tree23 a -> Sequ a
+>
+> instance Inord Empty where
+>     inord E			=  empty
+>
+> instance (Inord tree23) => Inord (Node23 tree23) where
+>     inord (N2 t1 a1 t2)	=  inord t1 . single a1 . inord t2
+>     inord (N3 t1 a1 t2 a2 t3)	=  inord t1 . single a1 . inord t2
+>				.  single a2 . inord t3
+>
+> instance (Inord tree23) => Inord (Pennant tree23) where
+>     inord (Top a t)		=  single a . inord t
+
+> inorder'			:: (Inord tree23) => FingerTree23 tree23 a -> Sequ a
+> inorder' Nil			=  empty
+> inorder' (One p ds)		=  inord p . inorder' ds
+> inorder' (Two p ds)		=  inord p . inorder' ds
+>
+> inorder			:: Bag a -> [a]
+> inorder b			=  inorder' b []
+
+> fingerTreeSort		:: (Ord a) => [a] -> [a]
+> fingerTreeSort		=  inorder . foldr insert Nil
+
+> type Sequ a			=  [a] -> [a]
+>
+> empty				=  \x -> x
+>
+> single a			=  \x -> a : x

+ Swish/HaskellRDF/Sort/Force.lhs view
@@ -0,0 +1,27 @@+%-------------------------------=  --------------------------------------------
+\section{Hyper-strict evaluation}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.Force 
+> where
+
+%align 33
+
+Vollst"andige Auswertung.
+
+> class Force a where
+>     force			:: a -> ()
+>
+>     force a			=  a `seq` ()
+
+> instance Force Bool
+> instance Force Char
+> instance Force Int
+> instance Force Integer
+> instance Force Double
+>
+> instance (Force a) => Force [a] where
+>     force []			=  ()
+>     force (a : as)		=  force a `seq` force as

+ Swish/HaskellRDF/Sort/HeapSort.lhs view
@@ -0,0 +1,140 @@+%-------------------------------=  --------------------------------------------
+\chapter{Heap sort}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.HeapSort 
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+> import Swish.HaskellRDF.Sort.ListLib
+> import Swish.HaskellRDF.Sort.MergeSort (mergeBy)
+
+%align 33
+
+%-------------------------------=  --------------------------------------------
+\section{Top-down heap sort}
+%-------------------------------=  --------------------------------------------
+
+It appears that the functional variant of heap sort has been invented
+several times. See, for instance, \cite[p.~155]{HinFun92} or
+\cite[p.~20]{Bir96Fun}.
+
+Heap sort is based on binary heap ordered trees.
+
+> data Heap a			=  Empty
+>				|  Bin a (Heap a) (Heap a)
+>
+> leaf				:: a -> Heap a
+> leaf a			=  Bin a Empty Empty
+
+The top-down variant works by repeatedly inserting elements into an
+empty initial tree.
+
+> insertBy			:: Rel a -> a -> Heap a -> Heap a
+> insertBy (<=) a Empty		=  leaf a
+> insertBy (<=) a (Bin b l r)
+>     | a <= b			=  Bin a (insertBy (<=) b r) l
+>     | otherwise		=  Bin b (insertBy (<=) a r) l
+
+Repeated |insert|'s constructs a so-called Braun tree (|size r <= size
+l <= size r+1| holds for each |Bin l a r|). This guarantees a worst
+case running time of $O(n\log n)$ for |heapSort|. The recursion scheme
+is typical for Braun trees:  the element is always inserted into the
+right subtree (which is possibly smaller). Additionally, the left and
+the right branch are interchanged (in case both subtrees have the same
+size). This implies, however, that |heapSort| is not stable.
+
+> unHeapBy			:: Rel a -> Heap a -> [a]
+> unHeapBy (<=) Empty		=  []
+> unHeapBy (<=) (Bin a l r)	=  a : mergeBy (<=) (unHeapBy (<=) l)
+>				                    (unHeapBy (<=) r)
+>
+> heapSort			:: (Ord a) => [a] -> [a]
+> heapSort			=  heapSortBy (<=)
+>
+> heapSortBy			:: Rel a -> [a] -> [a]
+> heapSortBy (<=)		=  unHeapBy (<=) . foldr (insertBy (<=)) Empty
+
+
+The function |unheap| resorts to |merge| which probably not in the
+spirit of the original heap sort by Williams (see also
+\cite[p.~21]{Bir96Fun} where |meld| is called combine). Instead we can
+combine the two subheaps into one.
+
+> unHeap			:: (Ord a) => Heap a -> [a]
+> unHeap Empty			=  []
+> unHeap (Bin a l r)		=  a : unHeap (meld l r)
+>
+> meld				:: (Ord a) => Heap a -> Heap a -> Heap a
+> meld Empty t'			=  t'
+> meld t@(Bin _ _ _) Empty	=  t
+> meld t@(Bin a l r) t'@(Bin a' l' r')
+>        | a <= a'		=  Bin a  (meld l r) t'
+>        | otherwise		=  Bin a' t (meld l' r')
+
+This variant of |unHeap| also clarifies the relationship to merge
+sort. First note that |meld| is closely related to |merge|. We have
+%
+\begin{eqnarray*}
+    |toOrdList (meld t u)|
+        & = & |merge (toOrdList t) (toOrdList u)| \enskip.
+\end{eqnarray*}
+%
+Thus
+
+> heapSort'			:: (Ord a) => [a] -> [a]
+> heapSort'			=  unHeap . gfoldm Empty leaf meld
+
+is structurally equivalent to |mergeSort| (ie it performs the same
+comparisons during the sorting process). In essence, this shows that it
+is unlikely that heap sort is faster than merge sort. As a final remark
+note that |heapSort'| is stable and lazy.
+
+%-------------------------------=  --------------------------------------------
+\section{Bottom-up heap sort}
+%-------------------------------=  --------------------------------------------
+
+It is well known that a heap can be constructed in linear time.  We
+have already seen a simple method, namely |gfoldm empty leaf meld|!
+The classical solution employs a function termed |sift|. Functionally
+speaking, |sift| is a smart constructor for binary heaps, ie it
+combines an element and two heaps into a single heap.
+{\setlength{\lwidth}{\lwidth + 1cm}
+
+> siftBy			:: Rel a -> a -> Heap a -> Heap a -> Heap a
+> siftBy (<=)			=  sift
+>   where
+>   sift a Empty Empty		=  leaf a
+>   sift a Empty r@(Bin _ _ _)	=  siftr a Empty r
+>   sift a l@(Bin _ _ _) Empty	=  siftl a l Empty
+>   sift a l@(Bin b _ _) r@(Bin c _ _)
+>       | b <= c		=  siftl a l r
+>       | otherwise		=  siftr a l r
+>
+>   siftl a Empty r		=  error "siftl"
+>   siftl a l@(Bin b ll lr) r
+>       | a <= b		=  Bin a l r
+>       | otherwise		=  Bin b (sift a ll lr) r
+> 
+>   siftr a l Empty		=  error "siftr"
+>   siftr a l r@(Bin b rl rr)
+>       | a <= b		=  Bin a l r
+>       | otherwise		=  Bin b l (sift a rl rr)
+
+Note that |sift| does not change the structure of the subheaps. We
+could be more reluctant and replace |siftr| by |siftl|.  Unfortunately,
+|sift| is not stable, ie the relative order of elements is not
+preserved.}
+
+> bottomUpHeapSort		:: (Ord a) => [a] -> [a]
+> bottomUpHeapSort		=  bottomUpHeapSortBy (<=)
+>
+> bottomUpHeapSortBy		:: Rel a -> [a] -> [a]
+> bottomUpHeapSortBy (<=)	=  unHeapBy (<=) . prefold (siftBy (<=)) Empty
+
+To see what |prefold| does, consider the call |prefold Bin Empty as|.
+The result is a Braun tree the preorder traversal of which yields
+|as|.  An alternative algorithm which constructs a tree whose
+\technical{level-order} traversal is equal to the original sequence is
+given in \cite[p.~22]{Bir96Fun}.

+ Swish/HaskellRDF/Sort/LibBase.lhs view
@@ -0,0 +1,24 @@+%-------------------------------=  --------------------------------------------
+\section{Base functions and types}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.LibBase 
+> where
+
+%align 33
+
+> type Rel a			=  a -> a -> Bool
+
+> data OptPair a b		=  Null
+>				|  Pair a b
+
+> ordered			:: (Ord a) => [a] -> Bool
+> ordered			=  orderedBy (<=)
+
+> orderedBy			:: Rel a -> [a] -> Bool
+> orderedBy (<=) []		=  True
+> orderedBy (<=) (a : as)	=  ordered a as
+>   where ordered a1 []		=  True
+>         ordered a1 (a2 : as)	=  a1 <= a2 && ordered a2 as

+ Swish/HaskellRDF/Sort/ListLib.lhs view
@@ -0,0 +1,119 @@+%-------------------------------=  --------------------------------------------
+\section{List library}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.ListLib 
+> where
+
+%align 33
+
+> simple			:: [a] -> Bool
+> simple []			=  True
+> simple [a]			=  True
+> simple (a1 : a2 : as)		=  False
+
+> halve				:: [a] -> ([a], [a])
+> halve as			=  splitAt (length as `div` 2) as
+
+> repSplit			:: [Int] -> [a] -> [[a]]
+> repSplit ns []		=  []
+> repSplit [] xs		=  [xs]
+> repSplit (n : ns) xs		=  ys : repSplit ns zs
+>   where (ys, zs)		=  splitAt n xs
+
+> copy				:: [a] -> [a]
+> copy				=  concat . repeat
+
+> interleave			:: [a] -> [a] -> [a]
+> interleave [] y		=  y
+> interleave (a:x) y		=  a : interleave y x
+
+> uninterleave			:: [a] -> ([a], [a])
+> uninterleave []		=  ([], [])
+> uninterleave [a]		=  ([a], [])
+> uninterleave (a1 : a2 : as)	=  (a1 : odds, a2 : evens)
+>     where (odds, evens)	=  uninterleave as
+
+%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
+\subsection{folds}
+%- - - - - - - - - - - - - - - -=  - - - - - - - - - - - - - - - - - - - - - -
+
+Here is yet another colleague of |foldr| and |foldl|: |foldm|
+constructs a balanced expression tree.
+
+> foldm				:: (a -> a -> a) -> a -> [a] -> a
+> foldm (*) e []		=  e
+> foldm (*) e x			=  fst (rec (length x) x)
+>     where rec 1 (a:x)		=  (a, x)
+>           rec n x		=  (a * b, z)
+>               where m		=  n `div` 2
+>                     (a, y)	=  rec (n - m) x 
+>                     (b, z)	=  rec m       y
+
+> gfoldm			:: a -> (b -> a) -> (a -> a -> a) -> [b] -> a
+> gfoldm e f (*) []		=  e
+> gfoldm e f (*) x		=  fst (rec (length x) x)
+>     where rec 1 (a:x)		=  (f a, x)
+>           rec n x		=  (a * b, z)
+>               where m		=  n `div` 2
+>                     (a, y)	=  rec (n - m) x 
+>                     (b, z)	=  rec m       y
+
+Jon's |treefold|. In a sense |foldm| works top-down and |treefold|
+works bottom-up.
+
+> treefold			:: (a -> a -> a) -> a -> [a] -> a
+> treefold (*) e []		=  e
+> treefold (*) e [a]		=  a
+> treefold (*) e (a:b:x)	=  treefold (*) e (a * b : pairfold (*) x)
+
+> pairfold			:: (a -> a -> a) -> [a] -> [a]
+> pairfold (*) (a:b:x)		=  a * b : pairfold (*) x
+> pairfold (*) x		=  x -- here |x| will have fewer than two 
+
+Note that |foldm| and |treefold| construct different trees: |foldm|
+returns a Braun tree while |treefold| returns a tree of the form
+\[	
+    |t1 * (t2 * (.. (tn-1 * tn) ..))|
+\]
+where the |ti|'s are complete binary trees in decreasing size. The size
+of the trees corresponds to the binary decomposition of the input
+length.
+
+"`Inverse"' Funktion zum Preorder-Durchlauf.
+
+> prefold			:: (a -> b -> b -> b) -> b -> [a] -> b
+> prefold f e as		=  fst (rec (length as) as)
+>     where rec 0 as		=  (e, as)
+>           rec (n + 1) []	=  error "rec"
+>           rec (n + 1) (a : as)=  (f a l r, as2)
+>               where m		=  n `div` 2
+>                     (l, as1)	=  rec (n - m) as
+>                     (r, as2)	=  rec m       as1
+
+> perms				:: [a] -> [[a]]
+> perms []			=  [ [] ]
+> perms (a:x)			=  [ z | y <- perms x, z <- insertions a y ]
+>
+> insertions			:: a -> [a] -> [[a]]
+> insertions a []		=  [ [a] ]
+> insertions a x@(b:y)		=  (a:x) : [ b:z | z <- insertions a y ]
+
+> spaces			:: Int -> [Char]
+> spaces n			=  replicate (max n 0) ' '
+
+> cjustify, ljustify, rjustify	:: Int -> String -> String
+> cjustify                      =  cjustifyWith ' '
+> ljustify n s			=  s ++ spaces (n - length s)
+> rjustify n s			=  spaces (n - length s) ++ s
+
+> indent			:: Int -> String -> String
+> indent n s			=  spaces n ++ s
+
+> cjustifyWith			:: a -> Int -> [a] -> [a]
+> cjustifyWith c n s            =  replicate l c ++ s ++ replicate r c
+>     where m                   =  n - length s
+>           l                   =  m `div` 2
+>           r                   =  m - l

+ Swish/HaskellRDF/Sort/MargeSort.lhs view
@@ -0,0 +1,576 @@+%if codeOnly
+
+> module Swish.HaskellRDF.Sort.MargeSort (margeSort, naturalMargeSort)
+> where
+> import Swish.HaskellRDF.Sort.MergeSort (upDownRunsBy)
+>
+> data OptPair a b		=  NoPair | Pair a b
+>
+> data Empty a			=  E
+>
+> data Node23 tree a		=  N2 (tree a) a (tree a)
+>				|  N3 (tree a) a (tree a) a (tree a)
+>
+> type FST1			=  FingerSearchTree1
+>
+> type OS			=  OrdSequence
+>
+> data Grown tree a		=  U (tree a)  
+>				|  G (tree a) a (tree a)
+
+%endif
+%format Cons (a) (t)		=  a "\triangleleft " t
+%format Snoc (t) (a)		=  t "\triangleright " a
+%-------------------------------=  --------------------------------------------
+\section{Double-ended Finger Search Trees}
+\label{sec:fstvariations}
+%-------------------------------=  --------------------------------------------
+
+\Todo{Min-Max-Heaps}. The datatype |FST| implements one-sided ordered
+sequences.  In order to support operations on both ends --- |snoc =
+addMax| and |rear = splitMax| in addition to |cons = AddMin| and |front
+= splitMin| --- we must base finger search trees on the symmetric spine
+view of 2-3 trees. Here are the necessary type definitions.
+%align 9
+%{
+%format S2			=  Simple2
+%format S3			=  Simple3
+%format C			=  Composite
+
+> data FingerSearchTree1 tree a
+>	=  S2 a
+>	|  S3 a (tree a) a
+>	|  C (Digit Front tree a)
+>            (FingerSearchTree1 (Node23 tree) a)
+>            (Digit Rear tree a)
+>
+> data Digit pennant tree a
+>	=  One (pennant tree a)
+>	|  Two (pennant (Node23 tree) a)
+
+%}
+%align 33
+
+> data Front tree a		=  Cons a (tree a)
+>
+> data Rear tree a		=  Snoc (tree a) a
+>
+> data OrdSequence a		=  Nil | Id (FingerSearchTree1 Empty a)
+
+Two points are worth mentioning. First of all, |FST1| is not capable of
+representing the empty sequence. For that reason we have introduced the
+wrapper datatype |OS| (see also Section~\ref{sec:external}). Second, we
+use different types of pennants for the digits on the left and for
+those on the right spine view. The types have been chosen so that the
+order of elements within an expression reflects the order of elements
+within the sequence represented.
+
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Deque operations}
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+
+The deque operations, |cons|, |incr|, |splitMin|, |zero| and their
+colleagues |snoc|, |rcni|, |splitMax|, |eroz|, can be easily adapted to
+the new design. Here, we show the modified versions of |cons| and
+|incr| only.
+%{
+%format One			=  O
+%format Two			=  T
+%align 41
+
+> cons					:: a -> OrdSequence a -> OrdSequence a
+> cons a Nil				=  Id (S2 a)
+> cons a (Id s)				=  Id (incr a E s)
+>
+> incr					:: a -> t a -> FST1 t a -> FST1 t a
+> incr a1 t1 (S2 a2)			=  S3 a1 t1 a2
+> incr a1 t1 (S3 a2 t2 a3)		=  C (One (Cons a1 t1)) (S2 a2) (One (Snoc t2 a3))
+> incr a1 t1 (C (One (Cons a2 t2)) m r)	=  C (Two (Cons a1 (N2 t1 a2 t2))) m r
+> incr a1 t1 (C (Two (Cons a2 (N2 t2 a3 t3))) m r)
+>     =  {-"\enskip\,"-} C (Two (Cons a1 (N3 t1 a2 t2 a3 t3))) m r
+> incr a1 t1 (C (Two (Cons a2 (N3 t2 a3 t3 a4 t4))) m r)
+>     =  {-"\enskip\,"-} C (Two (Cons a1 (N2 t1 a2 t2))) (incr a3 (N2 t3 a4 t4) m) r
+
+It is instructive to relate the equations to the rebalancing operations
+on 2-3 trees.  The first equation corresponds to an expansion of a
+2-node to a 3-node, the second equation realizes a split of a 3-node
+into two 2-nodes.
+%if codeOnly
+
+> s4					:: a -> t a -> a -> t a -> a -> FST1 t a
+> s4 a1 t1 a2 t2 a3			=  C (One (Cons a1 t1)) (S2 a2) (One (Snoc t2 a3))
+>
+> snoc					:: OrdSequence a -> a -> OrdSequence a
+> snoc Nil a				=  Id (S2 a)
+> snoc (Id s) a				=  Id (rcni s E a)
+>
+> rcni					:: FST1 t a -> t a -> a -> FST1 t a
+> rcni (S2 a1) t1 a2	 		=  S3 a1 t1 a2
+> rcni (S3 a1 t1 a2) t2 a3		=  s4 a1 t1 a2 t2 a3
+> rcni (C f m (One (Snoc t1 a1))) t2 a2	=  C f m (Two (Snoc (N2 t1 a1 t2) a2))
+> rcni (C f m (Two (Snoc (N2 t1 a1 t2) a2))) t3 a3
+>     =  {-"\enskip\,"-} C f m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3))
+> rcni (C f m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3))) t4 a4
+>     =  {-"\enskip\,"-} C f (rcni m (N2 t1 a1 t2) a2) (Two (Snoc (N2 t3 a3 t4) a4))
+
+> zero'					:: FST1 (Node23 t) a -> Digit Rear t a -> FST1 t a
+> zero' (S2 a1) (One (Snoc t1 a2))	=  S3 a1 t1 a2
+> zero' (S2 a1) (Two (Snoc (N2 t1 a2 t2) a3))
+>					=  s4 a1 t1 a2 t2 a3
+> zero' (S2 a1) (Two (Snoc (N3 t1 a2 t2 a3 t3) a4))
+>					=  C (One (Cons a1 t1)) (S2 a2) (Two (Snoc (N2 t2 a3 t3) a4))
+> zero' (S3 a1 t1 a2) d			=  C (Two (Cons a1 t1)) (S2 a2) d
+> zero' (C (One p) m r) d		=  C (Two p) (zero' m r) d
+> zero' (C (Two (Cons a1 (N2 t1 a2 t2))) m r) d
+>					=  C (Two (Cons a1 t1)) (C (One (Cons a2 t2)) m r) d
+> zero' (C (Two (Cons a1 (N3 t1  a2 t2 a3 t3))) m r) d
+>					=  C (Two (Cons a1 t1)) (C (Two (Cons a2 (N2 t2 a3 t3))) m r) d
+>
+> splitMin				:: OrdSequence a -> OptPair a (OrdSequence a)
+> splitMin Nil				=  NoPair
+> splitMin (Id (S2 a1))			=  Pair a1 Nil
+> splitMin (Id (S3 a1 E a2))		=  Pair a1 (Id (S2 a2))
+> splitMin (Id (C (One (Cons a1   E)) m r))
+>					=  Pair a1 (Id (zero' m r))
+> splitMin (Id (C (Two (Cons a1  (N2 E a2 E))) m r))
+>					=  Pair a1 (Id (C (One (Cons a2 E)) m r))
+> splitMin (Id (C (Two (Cons a1  (N3 E a2 E a3 E))) m r))
+>					=  Pair a1 (Id (C (Two (Cons a2 (N2 E a3 E))) m r))
+
+> eroz					:: Digit Front t a -> FST1 (Node23 t) a -> FST1 t a
+> eroz (One (Cons a1 t1)) (S2 a2)	=  S3 a1 t1 a2
+> eroz (Two (Cons a1 (N2 t1 a2 t2))) (S2 a3)
+>					=  s4 a1 t1 a2 t2 a3
+> eroz (Two (Cons a1 (N3 t1 a2 t2 a3 t3))) (S2 a4)
+>					=  C (Two (Cons a1 (N2 t1 a2 t2))) (S2 a3) (One (Snoc t3 a4))
+> eroz d (S3 a1 t1 a2)			=  C d (S2 a1) (Two (Snoc t1 a2))
+> eroz d (C f m (One p))		=  C d (eroz f m) (Two p) 
+> eroz d (C f m (Two (Snoc (N2 t1 a1 t2) a2)))
+>					=  C d (C f m (One (Snoc t1 a1))) (Two (Snoc t2 a2)) 
+> eroz d (C f m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3)))
+>					=  C d (C f m (Two (Snoc (N2 t1 a1 t2) a2))) (Two (Snoc t3 a3)) 
+
+%endif
+%}
+%align 33
+
+\smallskip
+\noindent\textbf{Remark.} \Todo{Pattern abstractions}
+
+< D1 a1 t1			=  One (Cons a1 t1)
+< D2 a1 t1 a2 t2		=  Two (Cons a1 (N2 t1 a2 t2))
+< D3 a1 t1 a2 t2 a3 t3		=  Two (Cons a1 (N3 t1 a2 t2 a3 t3))
+
+blub\hfill$\Box$
+
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Bag operations}
+\label{sec:bag}
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+
+\Todo{Worte zu |insert| und |delete|}. To adapt |member| we must first
+symmetrize the auxiliary datatype |Loc|.
+%format fun			=  "(\star)"
+%format `fun`			=  "\star "
+
+> data Loc a			=  Lt | Eq a | Gt
+> 
+> between			:: a -> Loc a -> a -> a
+> between a1 Lt a3		=  a1
+> between a1 (Eq a2) a3		=  a2
+> between a1 Gt a3		=  a3
+
+%format fun (f) (a)		=  f "\star " a
+The function |between| generalizes the operator |after| of
+Section~\ref{sec:search}. Depending on the value of the second
+argument the search is continued to the left or to the right.
+
+%format min'			=  min
+%format max'			=  max
+%subst code a    	= "\begin{array}{@{}lcl}'n" a "'n\end{array}"
+\[
+\begin{array}{c@@{\qquad}c}
+
+> min' (One (Cons m t))		=  m
+> min' (Two (Cons m t))		=  m
+>
+> max' (One (Snoc t m))		=  m
+> max' (Two (Snoc t m))		=  m
+
+&
+
+> memf a (One (Cons m t))	=  mem a t
+> memf a (Two (Cons m t))	=  mem a t
+>
+> memr a (One (Snoc t m))	=  mem a t
+> memr a (Two (Snoc t m))	=  mem a t
+
+\end{array}
+\]
+%subst code a    	= "\[\begin{array}{@{}lcl}'n\hspace{\lwidth}&\hspace{\cwidth}&\\[-10pt]'n" a "'n\end{array}\]"
+The function |member'| implements a quasi-parallel search along the two
+spines.  If $d_1$ is the distance from the smallest element and $d_2$
+the distance from the largest element, then |member| runs in
+$\Theta(\min\{d_1, d_2\})$.
+
+> member'			:: (Ord a, Mem t) => a -> FST1 t a -> Loc Bool
+> member' a (S2 a1)
+>     | a < a1			=  Lt
+>     | a > a1			=  Gt
+>     | otherwise		=  Eq True
+> member' a (S3 a1 t1 a2)
+>     | a < a1			=  Lt
+>     | a > a2			=  Gt
+>     | otherwise		=  Eq (mem a t1)
+> member' a (C f m r)
+>     | a < min' f		=  Lt
+>     | a > max' r		=  Gt
+>     | otherwise		=  Eq (between (memf a f) (member' a m) (memr a r))
+>
+> member			:: (Ord a) => a -> OrdSequence a -> Bool
+> member a Nil			=  False
+> member a (Id s)		=  between False (member' a s) False
+
+
+The adaptive sorting algorithm described in Section~\ref{sec:insert}
+has the irritating property that the worst case is a list in descending
+order which is arguably almost sorted. In a sense this is due to the
+measure |Inv| which yields the largest value for lists in descreasing
+order. If we represent ordered sequences with 2-3 trees under the
+symmetric spine view we obtain a sorting algorithm which is optimal
+with respect to $\widehat{|Inv|}$ given by
+\[
+    \widehat{|Inv|}(x) = \min\{|Inv|(x), |Inv|(|reverse x|)\} \enskip.
+\]
+The new worst-case is an interleaving of an ascending and a descending
+list:
+\[
+    1, 2n, 2, 2n-1, 3, 2n-2, \ldots, n-2, n+1, n-1, n \enskip.
+\]
+
+%if codeOnly
+
+> fun				:: (a -> b) -> Loc a -> Loc b
+> f `fun` Lt			=  Lt
+> f `fun` (Eq a)		=  Eq (f a)
+> f `fun` Gt			=  Gt
+
+> class Mem tree where
+>     mem			:: (Ord a) => a -> tree a -> Bool
+>
+> instance Mem Empty where
+>     mem a E			=  False
+>
+> instance (Mem tree) => Mem (Node23 tree) where
+>     mem a (N2 t1 a1 t2)
+>         | a < a1		=  mem a t1
+>         | a == a1		=  True
+>         | otherwise		=  mem a t2
+>     mem a (N3 t1 a1 t2 a2 t3)
+>         | a < a1		=  mem a t1
+>         | a == a1		=  True
+>         | a < a2		=  mem a t2
+>         | a == a2		=  True
+>         | otherwise		=  mem a t3
+
+> type Sequ a			=  [a] -> [a]
+>
+> empty				=  \x -> x
+>
+> unit a			=  \x -> a : x
+
+> class Inorder tree where
+>     inorder			:: tree a -> Sequ a
+>
+> instance Inorder Empty where
+>     inorder E			=  empty
+>
+> instance (Inorder tree) => Inorder (Node23 tree) where
+>     inorder (N2 t1 a1 t2)	=  inorder t1 . unit a1 . inorder t2
+>     inorder(N3 t1 a1 t2 a2 t3)=  inorder t1 . unit a1 . inorder t2 . unit a2 . inorder t3
+>
+> inord (One p)			=  inorder p
+> inord (Two p)			=  inorder p
+>
+> instance (Inorder tree) => Inorder (Front tree) where
+>     inorder (Cons a t)	=  unit a . inorder t
+>
+> instance (Inorder tree) => Inorder (Rear tree) where
+>     inorder (Snoc t a)	=  inorder t . unit a
+
+> toList'			:: (Inorder tree) => FingerSearchTree1 tree a -> Sequ a
+> toList' (S2 a1)		=  unit a1
+> toList' (S3 a1 t1 a2)		=  unit a1 . inorder t1 . unit a2
+> toList' (C f m r)		=  inord f . toList' m . inord r
+
+> toList			:: OrdSequence a -> [a]
+> toList Nil			=  []
+> toList (Id s)			=  toList' s []
+
+%endif
+
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Concatenation}
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+
+%include Pic8.lhs
+
+> (<>)				:: OrdSequence a -> OrdSequence a -> OrdSequence a
+> Nil <> s2			=  s2
+> s1 <> Nil			=  s1
+> Id s1 <> Id s2		=  Id (app s1 (U E) s2)
+
+$a3 = (a+1)1$
+
+%align 49
+
+> norm (Two (Cons a1 (N3 t1 a2 t2 a3 t3))) m	=  (One (Cons a1 t1), incr a2 (N2 t2 a3 t3) m)
+> norm f m					=  (f, m)
+
+%align 41
+
+> app					:: FST1 t a -> Grown t a -> FST1 t a -> FST1 t a
+> app (S2 a1) (U t1) x			=  incr a1 t1 x
+> app (S2 a1) (G t1 a2 t2) x		=  incr a1 t1 (incr a2 t2 x)
+> app x (U t1) (S2 a1)			=  rcni x t1 a1
+> app x (G t1 a1 t2) (S2 a2)		=  rcni (rcni x t1 a1) t2 a2
+> app (S3 a1 t1 a2) (U t2) x		=  incr a1 t1 (incr a2 t2 x)
+> app (S3 a1 t1 a2) (G t2 a3 t3) x	=  incr a1 t1 (incr a2 t2 (incr a3 t3 x))
+> app x (U t1) (S3 a1 t2 a2)		=  rcni (rcni x t1 a1) t2 a2
+> app x (G t1 a1 t2) (S3 a2 t3 a3)	=  rcni (rcni (rcni x t1 a1) t2 a2) t3 a3
+> app (C f1 m1 r1) t (C f2 m2 r2)	=  C f1 (app m1' (join r1' t f2') m2') r2
+>     where (m1', r1')			=  mron m1 r1
+>           (f2', m2')			=  norm f2 m2
+
+%align 33
+
+< join				:: Digit Rear t a -> Grown t a -> Digit Front t a -> Grown (Node23 t) a
+< join (One (Snoc t1 a1))  (U t2) (One (Cons a2 t3))
+<				=  U (N3 t1 a1 t2 a2 t3)
+< join (One (Snoc t1 a1)) (G t2 a2 t3) (One (Cons a3 t4))
+<				=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
+< {-"\ldots"-}
+< join (Two (Snoc (N2 t1 a1 t2) a2)) (G t3 a3 t4) (Two (Cons a4 (N2 t5 a5 t6)))
+<				=  G (N3 t1 a1 t2 a2 t3) a3 (N3 t4 a4 t5 a5 t6)
+
+%if codeOnly
+
+
+> mron m (Two (Snoc (N3 t1 a1 t2 a2 t3) a3))	=  (rcni m (N2 t1 a1 t2) a2, One (Snoc t3 a3))
+> mron m r					=  (m, r)
+>
+> join				:: Digit Rear t a -> Grown t a -> Digit Front t a -> Grown (Node23 t) a
+> join (One (Snoc t1 a1))  (U t2) (One (Cons a2 t3))
+>				=  U (N3 t1 a1 t2 a2 t3)
+> join (One (Snoc t1 a1)) (G t2 a2 t3) (One (Cons a3 t4))
+>				=  G (N2 t1 a1 t2) a2 (N2 t3 a3 t4)
+> join (One (Snoc t1 a1))  (U t2) (Two (Cons a2 t3))
+>				=  G (N2 t1 a1 t2) a2 t3
+> join (One (Snoc t1 a1)) (G t2 a2 t3) (Two (Cons a3 t4))
+>				=  G (N3 t1 a1 t2 a2 t3) a3 t4
+> join (Two (Snoc t1 a1)) (U  t2) (One (Cons a2 t3))
+>				=  G t1 a1 (N2 t2 a2 t3)
+> join (Two (Snoc t1 a1)) (G t2 a2 t3) (One (Cons a3 t4))
+>				=  G t1 a1 (N3 t2 a2 t3 a3 t4)
+> join (Two (Snoc (N2 t1 a1 t2) a2)) (U t3) (Two (Cons a3 t4))
+>				=  G (N3 t1 a1 t2 a2 t3) a3 t4
+> join (Two (Snoc (N2 t1 a1 t2) a2)) (G t3 a3 t4) (Two (Cons a4 (N2 t5 a5 t6)))
+>				=  G (N3 t1 a1 t2 a2 t3) a3 (N3 t4 a4 t5 a5 t6)
+
+%endif
+
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Splitting}
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+
+> part				:: (Ord a) => a -> FST1 t a -> Loc (FST1 t a, t a, FST1 t a)
+> part a (S2 a1)
+>     | a <= a1			=  Lt
+>     | otherwise		=  Gt
+> part a (S3 a1 t1 a2)
+>     | a <= a1			=  Lt
+>     | a >= a2			=  Gt
+>     | otherwise		=  Eq (S2 a1, t1, S2 a2)
+> part a (C f m r)
+>     | a <= min' f		=  Lt
+>     | a >= max' r		=  Gt
+>     | otherwise		=  Eq (between (cutf f) (cutm `fun` part a m) (cutr r))
+>     where
+>     cutm (m1, t, m2)		=  split a f m1 t m2 r
+>     cutf (One (Cons a1 t1))	=  (S2 a1, t1, zero' m r)
+>     cutf (Two (Cons a1 t1))	=  lsplit a a1 t1 m r
+>     cutr (One (Snoc t1 a1))	=  (eroz f m, t1, S2 a1)
+>     cutr (Two (Snoc t1 a1))	=  rsplit a f m t1 a1
+
+> split a f m1 (N2 t1 a1 t2) m2 r
+>     | a <= a1			=  (eroz f m1, t1, C (One (Cons a1 t2)) m2 r)
+>     | otherwise		=  (C f m1 (One (Snoc t1 a1)), t2, zero' m2 r)
+> split a f m1 (N3 t1 a1 t2 a2 t3) m2 r
+>     | a <= a1			=  (eroz f m1, t1, C (Two (Cons a1 (N2 t2 a2 t3))) m2 r)
+>     | a <= a2			=  (C f m1 (One (Snoc t1 a1)), t2, C (One (Cons a2 t3)) m2 r)
+>     | otherwise		=  (C f m1 (Two (Snoc (N2 t1 a1 t2) a2)), t3, zero' m2 r)
+
+%if codeOnly
+
+> lsplit a a1 (N2 t1 a2 t2) m2 r
+>     | a <= a2			=  (S2 a1, t1, C (One (Cons a2 t2)) m2 r)
+>     | otherwise		=  (zero' (S2 a1) (One (Snoc t1 a2)), t2, zero' m2 r)
+> lsplit a a1 (N3 t1 a2 t2 a3 t3) m2 r
+>     | a <= a2			=  (S2 a1, t1, C (Two (Cons a2 (N2 t2 a3 t3))) m2 r)
+>     | a <= a3			=  (zero' (S2 a1) (One (Snoc t1 a2)), t2, C (One (Cons a3 t3)) m2 r)
+>     | otherwise		=  (zero' (S2 a1) (Two (Snoc (N2 t1 a2 t2) a3)), t3, zero' m2 r)
+
+> rsplit a f m1 (N2 t1 a1 t2) a2
+>     | a <= a1			=  (eroz f m1, t1, eroz (One (Cons a1 t2)) (S2 a2))
+>     | otherwise		=  (C f m1 (One (Snoc t1 a1)), t2, S2 a2)
+> rsplit a f m1 (N3 t1 a1 t2 a2 t3) a3
+>     | a <= a1			=  (eroz f m1, t1, eroz (Two (Cons a1 (N2 t2 a2 t3))) (S2 a3))
+>     | a <= a2			=  (C f m1 (One (Snoc t1 a1)), t2, eroz (One (Cons a2 t3)) (S2 a3))
+>     | otherwise		=  (C f m1 (Two (Snoc (N2 t1 a1 t2) a2)), t3, S2 a3)
+
+%endif
+
+> partition			:: (Ord a) => a -> OS a -> (OS a, OS a)
+> partition a Nil		=  (Nil, Nil)
+> partition a (Id t)		=  between (Nil, Id t) (wrap `fun` part a t) (Id t, Nil)
+>   where wrap (t1, E, t2)	=  (Id t1, Id t2)
+
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+\subsection{Margesort}
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+
+Nicht stabil!
+
+> merge				:: (Ord a) => OS a -> OS a -> OS a
+> merge x y			=  case splitMin y of
+>     NoPair			-> x
+>     Pair a y'			-> x1 <> cons a (merge y' x2)
+>         where (x1, x2)	=  partition a x
+
+> margeSort			:: (Ord a) => [a] -> [a]
+> margeSort			=  toList . foldm merge Nil . map single
+>
+> single			:: a -> OrdSequence a
+> single a			=  Id (S2 a)
+
+> naturalMargeSort		:: (Ord a) => [a] -> [a]
+> naturalMargeSort		=  toList . foldm merge Nil . map fromList . upDownRunsBy (<=)
+
+Wenn es viele gleiche Elemente gibt ... NAJA lineare Suche statt bin"arer
+
+> merge2			:: (Ord a) => OS a -> OS a -> OS a
+> merge2 x y			=  case splitMin y of
+>     NoPair			-> x
+>     Pair a y'			-> (x1 <> x3) <> cons a (merge2 y' x4)
+>         where (x1, x2)	=  partition a x
+>               (x3, x4)	=  splitWhile (== a) x2
+
+> splitWhile p s		=  case splitMin s of
+>     NoPair			-> (Nil, Nil)
+>     Pair a s'
+>         | p a			-> (cons a s1, s2)
+>         | otherwise		-> (Nil, s)
+>         where (s1, s2)	=  splitWhile p s'
+
+% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
+%if codeOnly
+
+and [ x == toList (fromList x) | n <- [0 .. 500], let x = [1 .. n] ]
+
+and [ x ++ y == toList (fromList x <> fromList y) | m <- [0 .. 100], n <- [0 .. 100], let x = [1 .. m], let y = [1 .. n] ]
+
+[ (m, n) | m <- [0 .. 100], n <- [0 .. 100], let x = [1 .. m], let y = [m `div` 2 .. n + m `div` 2], meld x y /= toList (fromList x `merge` fromList y) ]
+
+ordered (margeSort $ take 1500 $ random2Ints 2432 234)
+
+and [ ordered (margeSort $ take n $ random2Ints 2432 234) | n <- [0 .. 1500] ]
+
+> fromList []			=  Nil
+> fromList as			=  Id (fromList1 as)
+>
+> fromList1 [a]			=  S2 a
+> fromList1 (a : as)		=  incr a E (fromList1 as)
+
+> foldm				:: (a -> a -> a) -> a -> [a] -> a
+> foldm (*) e []		=  e
+> foldm (*) e x			=  fst (rec (length x) x)
+>     where rec 1 (a:x)		=  (a, x)
+>           rec n x		=  (a * b, z)
+>               where m		=  n `div` 2
+>                     (a, y)	=  rec (n - m) x 
+>                     (b, z)	=  rec m       y
+
+> random2Ints           	:: Int -> Int -> [Int]
+> random2Ints s1 s2
+>   | s1 < 1 || s1 > 2147483562	=  error "random2Ints: Bad first seed."
+>   | s2 < 1 || s2 > 2147483398	=  error "random2Ints: Bad second seed."
+>   | otherwise			=  rands s1 s2
+
+> rands                		:: Int -> Int -> [Int]
+> rands s1 s2
+>     | z < 1			=  z + 2147483562 : rands s1'' s2''
+>     | otherwise		=  z              : rands s1'' s2''
+>     where k			=  s1 `div` 53668
+>           s1'			=  40014 * (s1 - k * 53668) - k * 12211
+>           s1'' | s1' < 0	=  s1' + 2147483563
+>                | otherwise	=  s1'
+>           k'			=  s2 `div` 52774
+>           s2'			=  40692 * (s2 - k' * 52774) - k' * 3791
+>           s2'' | s2' < 0	=  s2' + 2147483399
+>                | otherwise    =  s2'
+>           z			=  s1'' - s2''
+
+> ordered			:: (Ord a) => [a] -> Bool
+> ordered []			=  True
+> ordered [a]			=  True
+> ordered (a1 : as @ (a2 : _))	=  a1 <= a2 && ordered as
+
+> meld [] y			=  y
+> meld x@(a:_) []		=  x
+> meld x@(a:x') y@(b:y')
+>     | a <= b			=  a : meld x' y
+>     | otherwise		=  b : meld x  y'
+
+Konversion in `richtige' 2-3-4 B"aume f"ur die graphische Darstellung.
+
+> data Tree24 a			=  Void
+>				|  Node2 (Tree24 a) a (Tree24 a)
+>				|  Node3 (Tree24 a) a (Tree24 a) a (Tree24 a)
+>				|  Node4 (Tree24 a) a (Tree24 a) a (Tree24 a) a (Tree24 a)
+
+> class Conv tree where
+>     conv			:: tree a -> Tree24 a
+>
+> instance Conv Empty where
+>     conv E			=  Void
+>
+> instance (Conv tree) => Conv (Node23 tree) where
+>     conv (N2 t1 a1 t2)	=  Node2 (conv t1) a1 (conv t2)
+>     conv (N3 t1 a1 t2 a2 t3)	=  Node3 (conv t1) a1 (conv t2) a2 (conv t3)
+
+> convert Nil			=  Void
+> convert (Id s)		=  convert' Void s Void
+
+> convert'			:: (Conv t) => Tree24 a -> FST1 t a -> Tree24 a -> Tree24 a
+> convert' l (S2 a1) r		=  Node2 l a1 r
+> convert' l (S3 a1 t1 a2) r	=  Node3 l a1 (conv t1) a2 r
+> convert' l (C f m r) r'	=  convert' (link l f) m (knil r r')
+
+> link t1 (One (Cons a1 t2))			=  Node2 t1 a1 (conv t2)
+> link t1 (Two (Cons a1 (N2 t2 a2 t3)))		=  Node3 t1 a1 (conv t2) a2 (conv t3)
+> link t1 (Two (Cons a1 (N3 t2 a2 t3 a3 t4)))	=  Node4 t1 a1 (conv t2) a2 (conv t3) a3 (conv t4)
+>
+> knil (One (Snoc t1 a1)) t2			=  Node2 (conv t1) a1 t2
+> knil (Two (Snoc (N2 t1 a1 t2) a2)) t3		=  Node3 (conv t1) a1 (conv t2) a2 t3
+> knil (Two (Snoc (N3 t1 a1 t2 a2 t3) a3)) t4	=  Node4 (conv t1) a1 (conv t2) a2 (conv t3) a3 t4
+
+convert $ fromList [1 .. 12]
+
+convert $ fromList [1 .. 17]
+convert $ fromList [18 .. 24]
+convert $ fromList [1 .. 17] <> fromList [18 .. 24]
+
+convert $ fst $ partition 13 (fromList [1 .. 17] <> fromList [18 .. 24])
+convert $ snd $ partition 13 (fromList [1 .. 17] <> fromList [18 .. 24])
+
+%endif

+ Swish/HaskellRDF/Sort/MergeSort.lhs view
@@ -0,0 +1,295 @@+%-------------------------------=  --------------------------------------------
+\chapter{Sorting by merging}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.MergeSort 
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+> import Swish.HaskellRDF.Sort.ListLib
+
+> infixr {-"\,"-} `merge`, \+/
+
+%align 33
+
+> sort				:: (Ord a) => [a] -> [a]
+> sort				=  bottomUpMergeSort
+
+%-------------------------------=  --------------------------------------------
+\section{Top-down merge sort}
+%-------------------------------=  --------------------------------------------
+
+The archetypical functional sorting algorithm is without any doubt
+merge sort. It follows the divide and conquer scheme: the input list is
+split into two halves, both are sorted recursively and the results are
+finally merged together.
+
+> merge				:: (Ord a) => [a] -> [a] -> [a]
+> merge				=  mergeBy (<=)
+>
+> (\+/)				:: (Ord a) => [a] -> [a] -> [a]
+> (\+/)				=  mergeBy (<=)
+>
+> mergeBy			:: Rel a -> [a] -> [a] -> [a]
+> mergeBy (<=)			=  merge
+>     where
+>     merge [] bs		=  bs
+>     merge as@(_ : _) []	=  as
+>     merge as@(a : as') bs@(b : bs')
+>         | a <= b		=  a : merge as' bs
+>	  | otherwise		=  b : merge as  bs'
+>
+> mergeSort			:: (Ord a) => [a] -> [a]
+> mergeSort			=  mergeSortBy (<=)
+>
+> mergeSortBy			:: Rel a -> [a] -> [a]
+> mergeSortBy (<=) as
+>     | simple as		=  as
+>     | otherwise		=  mergeBy (<=) (mergeSortBy (<=) as1)
+>				                (mergeSortBy (<=) as2)
+>     where (as1, as2)		=  halve as
+
+Since the divide phase takes $\Theta(n\log n)$ time, |mergeSort| is
+not lazy: |head . mergeSort| has a running time of $\Theta(n\log n)$.
+
+%-------------------------------=  --------------------------------------------
+\section{Bottom-up merge sort}
+%-------------------------------=  --------------------------------------------
+
+The function |bottomUpMergeSort| improves the divide phase to
+$\Theta(n)$ and is consequently asymptotically optimal, stable, and
+lazy, but alas not in any way adaptive.
+
+> bottomUpMergeSort		:: (Ord a) => [a] -> [a]
+> bottomUpMergeSort		=  bottomUpMergeSortBy (<=)
+>
+> bottomUpMergeSortBy		:: Rel a -> [a] -> [a]
+> bottomUpMergeSortBy (<=)	=  gfoldm [] (\a -> [a]) (mergeBy (<=))
+
+%-------------------------------=  --------------------------------------------
+\section{Straight merge sort}
+%-------------------------------=  --------------------------------------------
+
+Both |mergeSort| and |bottomUpMergeSort| take $\Theta(n\log n)$
+irrespective of the presortedness of the input. If we replace the test
+|simple| by |ordered| we obtain an adaptive variant which is optimal
+with respect to the measure |Runs| and adaptive wrt |Inv| and |Rem|
+\cite[p.~449]{ECW92Sur}.
+
+> straightMergeSort		:: (Ord a) => [a] -> [a]
+> straightMergeSort		=  straightMergeSortBy (<=)
+
+> straightMergeSortBy		:: Rel a -> [a] -> [a]
+> straightMergeSortBy (<=) as
+>     | orderedBy (<=) as	=  as
+>     | otherwise		=  mergeBy (<=) (straightMergeSortBy (<=) as1)
+>				                (straightMergeSortBy (<=) as2)
+>     where (as1, as2)		=  halve as
+
+\Todo{To adapt to ascending as well as descending sequences we could
+reverse the sublists in every step and apply Augustson's
+stable/anti-stable trick.}
+
+%-------------------------------=  --------------------------------------------
+\section{Odd-even merge sort}
+%-------------------------------=  --------------------------------------------
+
+If we use a different partioning scheme, |uninterleave| instead of
+|halve|, we obtain an adaptive variant which is optimal wrt |Dis = Max|
+\cite[p.~450]{ECW92Sur}.
+
+> oddEvenMergeSort		:: (Ord a) => [a] -> [a]
+> oddEvenMergeSort		=  oddEvenMergeSortBy (<=)
+>
+> oddEvenMergeSortBy		:: Rel a -> [a] -> [a]
+> oddEvenMergeSortBy (<=) as
+>     | orderedBy (<=) as	=  as
+>     | otherwise		=  mergeBy (<=) (oddEvenMergeSortBy (<=) as1)
+>						(oddEvenMergeSortBy (<=) as2)
+>     where (as1, as2)		=  uninterleave as
+
+Unfortunately, |oddEvenMergeSort| is no longer stable. Consider, for
+instance, |uninterleave [a1, a2, a3] = ([a1, a3], [a2])| and assume
+that the three elements are equal. However, |oddEvenMergeSort| can be
+improved so that the divide phase takes only linear time. This is left
+as an instructive exercise to the reader.
+
+%-------------------------------=  --------------------------------------------
+\section{Split sort}
+%-------------------------------=  --------------------------------------------
+
+A partioning scheme which adapts to |Rem| was given by Levcopoulos
+and Petersson \cite[p.~451]{ECW92Sur} and is based on a method by
+Cook and Kim for removing $\Theta(|Rem(as)|)$ elements from a list
+|as|, such that an ordered sequence is left over.
+
+The function |lpDivision as| divides its input into three lists |g|,
+|s|, and |l| such that |s| is sorted and |g| and |l| have the same
+length which is at most |Rem(as)|. The tricky thing is to ensure that
+the splitting is performed in a stable way, ie the order in which the
+elements in |g| and |l| appear is the same in which they appear in
+|as|. Consider the sequence |1 2 5 1 4 3 1 9 2 8 9 1|:
+%
+\[
+\begin{array}{l||l||r}
+\text{|g| and |s|} & |l| & |as| \\\hline
+|1 2 5| & & |1 4 3 1 9 2 8 9 1| \\
+|1 2 [5]| & |1| & |4 3 1 9 2 8 9 1| \\
+|1 2 [5] 4| & |1| & |3 1 9 2 8 9 1| \\
+|1 2 [5 4]| & |3 1| & |1 9 2 8 9 1| \\
+|1 [2 5 4]| & |1 3 1| & |9 2 8 9 1| \\
+|1 [2 5 4] 9| & |1 3 1| & |2 8 9 1| \\
+|1 [2 5 4 9]| & |2 1 3 1| & |8 9 1| \\
+|1 [2 5 4 9] 8| & |2 1 3 1| & |9 1| \\
+|1 [2 5 4 9] 8 9| & |2 1 3 1| & |1| \\
+|1 [2 5 4 9] 8 [9]| & |1 2 1 3 1| &
+\end{array}
+\]
+The data type |Region| is designed to represent |g| and |s|. Elements
+in |g| are grouped to allow for efficient access to the last element in
+|s|. For instance, |1 [2 5 4 9] 8 [9]| is essentially represented by |G
+(S (G (S Nil 1) [2, 5, 4, 9]) 8) [9]|.
+
+> type Sequ a			=  [a] -> [a]
+>
+> data Region a			=  Nil
+>				|  S (Region a) a
+>				|  G (Region a) (Sequ a)
+>
+> single			:: a -> Sequ a
+> single a			=  \x -> a : x
+>
+> g				:: Region a -> Sequ a -> Region a
+> g Nil gs			=  G Nil gs
+> g (S s a) gs			=  G (S s a) gs
+> g (G s gs1) gs2		=  G s (gs1 . gs2)
+>
+> lpDivisionBy			:: Rel a -> [a] -> ([a], [a], [a])
+> lpDivisionBy (<=) []          =  ([], [], [])
+> lpDivisionBy (<=) (a : as)    =  lp (S Nil a) [] as
+>     where
+>     lp s l []              	=  (g [], reverse s', reverse l)
+>         where (g, s')		=  lpPart s
+>     lp Nil l (a : as)		=  lp (S Nil a) l as
+>     lp s@(G Nil gs) l (a : as)=  lp (S s a) l as
+>     lp s@(G (S s' m) gs) l (a : as)
+>         | m <= a		=  lp (S s a) l as
+>         | otherwise		=  lp (g s' (single m . gs)) (a : l) as
+>     lp (G (G _ _) _) _ (_ : _)=  error "lp"
+>     lp s@(S s' m) l (a : as)
+>         | m <= a		=  lp (S s a) l as
+>         | otherwise		=  lp (g s' (single m)) (a : l) as
+>
+> lpPart			:: Region a -> ([a] -> [a], [a])
+> lpPart Nil			=  (id, [])
+> lpPart (S s a)		=  (g, a : s')
+>     where (g, s')		=  lpPart s
+> lpPart (G s gs)		=  (gs . g, s')
+>     where (g, s')		=  lpPart s
+
+Unfortunately, the relative order between equal elements in |g ++ s ++ l|
+is not the same as in |as|. Hence, |lpMergeSort| is not stable either.
+
+> lpMergeSort			:: (Ord a) => [a] -> [a]
+> lpMergeSort			=  lpMergeSortBy (<=)
+>
+> lpMergeSortBy			:: Rel a -> [a] -> [a]
+> lpMergeSortBy (<=) as
+>     | simple as		=  as
+>     | otherwise		=  mergeBy (<=) (lpMergeSortBy (<=) as1)
+>				       (mergeBy (<=) s (lpMergeSortBy (<=) as2))
+>     where (as1, s, as2)	=  lpDivisionBy (<=) as
+
+\Todo{To adapt to ascending as well as descending sequences we could
+reverse the sublists in every step. \NB stability is already lost.}
+
+%-------------------------------=  --------------------------------------------
+\section{Adaptive merge sort}
+%-------------------------------=  --------------------------------------------
+%format sort1			=  sort "_1"
+%format sort2			=  sort "_2"
+%format sort3			=  sort "_3"
+
+If we combine |halve|, |uninterleave|, and |lpDivision| we obtain
+a sorting algorithm which is adaptive wrt |Exc|, |Dis|, |Inv|, |Rem|,
+and |Runs| \cite[p.~451]{ECW92Sur}.
+
+> adaptiveMergeSort		:: (Ord a) => [a] -> [a]
+> adaptiveMergeSort		=  adaptiveMergeSortBy (<=)
+>
+> adaptiveMergeSortBy		:: Rel a -> [a] -> [a]
+> adaptiveMergeSortBy (<=)	=  sort1
+>     where
+>     (\+/)			=  mergeBy (<=)
+>
+>     sort1 as
+>         | simple as		=  as
+>         | otherwise		=  sort2 as1 \+/ s \+/ sort2 as2
+>         where (as1, s, as2)	=  lpDivisionBy (<=) as
+>
+>     sort2 as			=  sort3 as1 \+/ sort3 as2
+>         where (as1, as2)	=  uninterleave as
+>
+>     sort3 as			=  sort1 as1 \+/ sort1 as2
+>         where (as1, as2)	=  halve as
+
+\Todo{How about reversing the lists in the first step in order to adapt
+to descending sequences as well? cf.~\cite[p.~52]{ECW91Pra}}
+
+%-------------------------------=  --------------------------------------------
+\section{Natural merge sort}
+%-------------------------------=  --------------------------------------------
+
+The function |straightMergeSort| somehow guesses the number of runs. It is
+more efficient to group the input into runs beforehand.
+
+> naturalMergeSort		:: (Ord a) => [a] -> [a]
+> naturalMergeSort		=  naturalMergeSortBy (<=)
+>
+> naturalMergeSortBy		:: Rel a -> [a] -> [a]
+> naturalMergeSortBy (<=)	=  foldm (mergeBy (<=)) [] . runsBy (<=)
+>
+> runsBy			:: Rel a -> [a] -> [[a]]
+> runsBy (<=) []		=  [[]]
+> runsBy (<=) (a : as)		=  upRun a [] as
+>     where
+>     upRun m r []		=  [reverse (m : r)]
+>     upRun m r (a : as)
+>         | m <= a		=  upRun a (m : r) as
+>         | otherwise		=  reverse (m : r) : upRun a [] as
+
+Natural merge sort was first studied in the context of external
+sorting.  The hbc library contains a similar function.
+
+The function |runs| recognized only ascending runs. With little
+additional effort we can also detect descending runs.
+
+> symmetricNaturalMergeSort	:: (Ord a) => [a] -> [a]
+> symmetricNaturalMergeSort	=  symmetricNaturalMergeSortBy (<=)
+>
+> symmetricNaturalMergeSortBy	:: Rel a -> [a] -> [a]
+> symmetricNaturalMergeSortBy (<=)
+>				=  foldm (mergeBy (<=)) [] . upDownRunsBy (<=)
+>
+> upDownRunsBy			:: Rel a -> [a] -> [[a]]
+> upDownRunsBy (<=) []		=  []
+> upDownRunsBy (<=) (a : as)	=  upDownRun a as
+>     where
+>     upDownRun a []		=  [[a]]
+>     upDownRun a1 (a2 : as)
+>         | a1 <= a2		=  upRun   a2 [a1] as
+>         | otherwise		=  downRun a2 [a1] as
+>     upRun m r []		=  [reverse (m : r)]
+>     upRun m r (a : as)
+>         | m <= a		=  upRun a (m : r) as
+>         | otherwise		=  reverse (m : r) : upDownRun a as
+>
+>     downRun m r []		=  [m : r]
+>     downRun m r (a : as)
+>         | m <= a		=  (m : r) : upDownRun a as
+>         | otherwise		=  downRun a (m : r) as
+
+\NB To preserve stability |downRun| uses only \emph{strictly}
+decreasing sequences: |[n, n, n-1, n-1, .. 1, 1]| is split into |n|
+runs. Does anybody know of a better solution?

+ Swish/HaskellRDF/Sort/PairingHeap.lhs view
@@ -0,0 +1,88 @@+%-------------------------------=  --------------------------------------------
+\chapter{Pairing heaps}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.PairingHeap 
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+> import Swish.HaskellRDF.Sort.ListLib (treefold)
+> infixr {-"\,"-} \+/
+
+%align 33
+
+Sorting based on pairing heaps \cite[p.~52]{Oka98Pur} performs
+extremely well in practice and it combines many virtues: it is
+asymptotically optimal (at least |pairingSort|, for |mpPairingSort|
+which is based on multi-pass pairing heaps no tight theoretical bounds
+are known), it is lazy and I conjecture that it adapts to the input.
+However, to the best of my knowledge this has not been shown. On the
+negative side, it is not stable which is typical for sorting algorithms
+based on priority queues.
+
+> data PairingHeap a            =  Empty
+>                               |  Node a [PairingHeap a]
+
+\NB The constructor |Empty| is only used on the top-level, it never
+appears below a |Node|.
+
+> leaf				:: a -> PairingHeap a
+> leaf a                  	=  Node a []
+>
+> (\+/)				:: (Ord a) => PairingHeap a -> PairingHeap a -> PairingHeap a
+> (\+/)				=  meldBy (<=)
+>
+> meldBy			:: Rel a -> PairingHeap a -> PairingHeap a -> PairingHeap a
+> meldBy (<=) Empty u		=  u
+> meldBy (<=) t@(Node _ _) Empty=  t
+> meldBy (<=) t@(Node a ts) u@(Node b us)
+>     | a <= b			=  Node a (u : ts)
+>     | otherwise		=  Node b (t : us)
+>
+> pairingSort			:: (Ord a) => [a] -> [a]
+> pairingSort			=  pairingSortBy (<=)
+>
+> pairingSortBy			:: Rel a -> [a] -> [a]
+> pairingSortBy (<=)		=  unHeap . meldAll . map leaf
+>     where
+>     (\+/)			=  meldBy (<=)
+
+Different variants of pairing heaps differ in the implementation of
+|meldAll|.
+
+>     meldAll []		=  Empty
+>     meldAll [t]		=  t
+>     meldAll (t1 : t2 : ts)	=  (t1 \+/ t2) \+/ meldAll ts
+
+Note that subsequent trees are first paired using |meld|, hence the
+name of the data structure.
+
+>     unHeap Empty		=  []
+>     unHeap (Node a ts)	=  a : unHeap (meldAll ts)
+
+What about the running time? Fredman et al~\cite{FSS86Pai} show that
+|meld| and |splitMin| run in $O(\log n)$ amortized time. Hence we have
+$O(n\log n)$ worst case behaviour. \NB Chris Okasaki has developed a
+persistent variant of pairing heaps~\cite{Oka96Fun} which might be
+worth trying, as well.
+
+The function |meldAll| corresponds to |foldr meld empty . pairfold
+meld|. Alternatively, one can make repeated passes over the trees using
+|treefold meld empty|.
+
+> mpPairingSort			:: (Ord a) => [a] -> [a]
+> mpPairingSort			=  mpPairingSortBy (<=)
+>
+> mpPairingSortBy		:: Rel a -> [a] -> [a]
+> mpPairingSortBy (<=)		=  unHeap . meldAll . map leaf
+>     where
+>     meldAll			=  treefold (meldBy (<=)) Empty
+>     unHeap Empty		=  []
+>     unHeap (Node a ts)	=  a : unHeap (meldAll ts)
+
+Fredman et al~\cite{FSS86Pai} state that the multipass variant is not
+easy to analyse which is certainly true. They only succeeded in proving
+an $O(\log n\log\log n/\log\log\log n)$ bound on the amortized time per
+heap operation. Hence it is not clear whether |mpPairingSort| is an
+$O(n\log n)$ algorithm.

+ Swish/HaskellRDF/Sort/QuickSort.lhs view
@@ -0,0 +1,170 @@+%-------------------------------=  --------------------------------------------
+\chapter{Partioning sort}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.QuickSort
+> where
+> import Swish.HaskellRDF.Sort.MergeSort (mergeSortBy)
+> import Data.List
+> import Swish.HaskellRDF.Sort.LibBase
+
+%align 33
+
+%-------------------------------=  --------------------------------------------
+\section{Some variations of quick sort}
+%-------------------------------=  --------------------------------------------
+%format qsort1			=  qsort "_1"
+%format qsort2			=  qsort "_2"
+%format qsort3			=  qsort "_3"
+
+This section lists some variants of quick sort which \emph{cannot be
+recommended} for use. The first and probably the most popular of all
+appears in \cite[p.~154]{BiW88}, \cite[p.~128]{HinFun92},
+\cite[p.~433]{Tho96Has}, and \cite[p.~9]{HPF97Gen}.
+
+> qsort1			:: (Ord a) => [a] -> [a]
+> qsort1 []			=  []
+> qsort1 (p : as)		=  qsort1 [ a | a <- as, a < p ]
+>				++ p : qsort1 [ a | a <- as, p <= a ]
+
+Its main purpose is probably to demonstrate the use and elegancy of
+list comprehensions. The definition has, however, several drawbacks
+part from the fact that quick sort is not asymptotically optimal.
+%
+\begin{enumerate}
+\item
+it traverses the list twice,
+
+\item
+it has a space leak: |as| is alive until the second traversal is done
+\cite[p.~18]{Bir96Fun},
+
+\item
+it uses |(++)| to catenate the results of the recursive calls (note that
+|(++)| takes time proportional to the length of its first argument).
+\end{enumerate}
+
+The second variant uses the library function |partition| to avoid the
+double traversal.
+
+> qsort2			:: (Ord a) => [a] -> [a]
+> qsort2 []			=  []
+> qsort2 (p : as)		=  qsort2 l ++ p : qsort2 r
+>     where (l, r)		=  partition (< p) as
+
+And finally, here is a variant which employs a tail recursive partition
+function.
+
+> qsort3			:: (Ord a) => [a] -> [a]
+> qsort3 []			=  []
+> qsort3 [a]			=  [a]
+> qsort3 (p : as)		=  partition [] [] as
+>     where
+>     partition l r []		=  qsort3 l ++ p : qsort3 r
+>     partition l r (a : as)
+>         | p <= a 		=  partition l (a : r) as
+>	  | otherwise		=  partition (a : l) r as
+
+Note however that |qsort3| is no longer stable since |l| and |r| are in
+reverse order.
+
+%-------------------------------=  --------------------------------------------
+\section{Paulson's quicksort}
+%-------------------------------=  --------------------------------------------
+
+The following code is adpated from \cite[p.~110]{Pau96ML}. The main
+difference to |qsort3| is that it uses an accumulating argument to
+eliminate the calls to |(++)|.
+
+> quickSort			:: (Ord a) => [a] -> [a]
+> quickSort			=  quickSortBy (<=)
+>
+> quickSortBy			:: Rel a -> [a] -> [a]
+> quickSortBy (<=) as		=  qsort as []
+>     where
+>     qsort []       x		=  x
+>     qsort [a]      x		=  a : x
+>     qsort (p : as) x		=  partition [] [] as
+>         where
+>         partition l r []	=  qsort l (p : qsort r x)
+>         partition l r (a : as)
+>             | p <= a 		=  partition l (a : r) as
+>	      | otherwise	=  partition (a : l) r as
+
+%-------------------------------=  --------------------------------------------
+\section{Augustsson's stable quicksort}
+%-------------------------------=  --------------------------------------------
+
+Neither |qsort3| nor |quickSort| is stable. This is due to the fact
+that partition reverses the order of elements (the lists |l| and |r|
+are used as a stack). By duplicating the code into a stable and an
+anti-stable variant we obtain stability.
+
+> stableQuickSort		:: (Ord a) => [a] -> [a]
+> stableQuickSort		=  stableQuickSortBy (<=)
+>
+> stableQuickSortBy		:: Rel a -> [a] -> [a]
+> stableQuickSortBy (<=) as	=  qsortBy (<=) as []
+>
+> qsortBy			:: Rel a -> [a] -> [a] -> [a]
+> qsortBy (<=) []       x 	=  x
+> qsortBy (<=) [a]      x	=  a : x
+> qsortBy (<=) (p : as) x	=  partition [] [] as
+>     where
+
+The function |partition| partitions and sorts the sublists. Note that
+|l| and |r| are in reverse order and must be sorted with an anti-stable
+sorting.
+
+>     partition l r []		=  rqsortBy (<=) l (p : rqsortBy (<=) r x)
+>     partition l r (a : as)
+>         | p <= a 		=  partition l (a : r) as
+>	  | otherwise		=  partition (a : l) r as
+
+The function |rqsortBy| is as |qsort| but anti-stable, ie it reverses
+equal elements (compare the last two equations of |partition|).
+
+> rqsortBy			:: Rel a -> [a] -> [a] -> [a]
+> rqsortBy (<=) []       x 	=  x
+> rqsortBy (<=) [a]      x	=  a : x
+> rqsortBy (<=) (p : as) x	=  partition [] [] as
+>     where
+>     partition l r []		=  qsortBy (<=) l (p : qsortBy (<=) r x)
+>     partition l r (a : as)
+>         | a <= p 		=  partition (a : l) r as
+>	  | otherwise		=  partition l (a : r) as
+
+%-------------------------------=  --------------------------------------------
+\section{Introspective quicksort}
+%-------------------------------=  --------------------------------------------
+
+One of the big disadvantages of quick sort is its quadratic worst-case
+behaviour. It turns out that it is quite easy to solve this dilemma:
+simply limit the recursion depth to a fixed bound, and for subproblems
+which exceed the limit use an $\Theta(n\lg n)$ algorithm
+\cite{Mus97Int}.
+
+> introSort			:: (Ord a) => [a] -> [a]
+> introSort			=  introSortBy (<=)
+
+> introSortBy			:: Rel a -> [a] -> [a]
+> introSortBy (<=) as		=  isort (2 * floorLg (length as)) as []
+>   where
+>   isort 0       as       x	=  mergeSortBy (<=) as ++ x
+>   isort (d + 1) []       x	=  x
+>   isort (d + 1) [a]      x	=  a : x
+>   isort (d + 1) (p : as) x	=  partition [] [] as
+>     where
+>     partition l r []		=  isort d l (p : isort d r x)
+>     partition l r (a : as)
+>         | p <= a 		=  partition l (a : r) as
+>         | otherwise		=  partition (a : l) r as
+
+Musser recommends a depth bound of |2*floor (lg n)|.
+
+> floorLg                       :: Int -> Int
+> floorLg n
+>     | n == 1                  =  0
+>     | otherwise               =  1 + floorLg (n `div` 2)

+ Swish/HaskellRDF/Sort/RedBlackTree.lhs view
@@ -0,0 +1,119 @@+%-------------------------------=  --------------------------------------------
+\chapter{Red-black trees}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.RedBlackTree 
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+
+%align 33
+
+Every search tree scheme can be used for sorting: the elements are
+repeatedly inserted into an empty initial tree; an inorder traversal of
+the final tree yields the desired ordered permutation of the input.
+Here we use red-black trees as described by Chris Okasaki
+\cite[p.~24]{Oka98Pur}.
+
+Sorting on the basis of red-black trees is asymptotically optimal and
+stable but neither adpative nor lazy.
+
+> data RedBlackTree a		=  Empty
+>				|  Red (RedBlackTree a) a (RedBlackTree a)
+>				|  Black (RedBlackTree a) a (RedBlackTree a)
+
+\NB For reasons of efficiency nodes do not have a separate color field,
+instead the color is coded into the constructor.
+
+> insertBy			:: Rel a -> a -> RedBlackTree a -> RedBlackTree a
+> insertBy (<=) a t		=  blacken (ins t)
+>   where ins Empty		=  Red Empty a Empty
+>         ins (Red l b r)
+>             | a <= b		=  Red (ins l) b r
+>             | otherwise	=  Red l b (ins r)
+>         ins (Black l b r)
+>             | a <= b		=  lblack (ins l) b r
+>             | otherwise	=  rblack l b (ins r)
+>
+> blacken			:: RedBlackTree a -> RedBlackTree a
+> blacken (Red l a r)		=  Black l a r
+> blacken t			=  t
+
+%align 49
+{\setlength{\lwidth}{\lwidth + 1cm}
+
+> lblack					:: RedBlackTree a -> a -> RedBlackTree a -> RedBlackTree a
+> lblack (Red (Red t1 a1 t2) a2 t3) a3 t4	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
+> lblack (Red t1 a1 (Red t2 a2 t3)) a3 t4	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
+> lblack l a r					=  Black l a r
+>
+> rblack					:: RedBlackTree a -> a -> RedBlackTree a -> RedBlackTree a
+> rblack t1 a1 (Red (Red t2 a2 t3) a3 t4)	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
+> rblack t1 a1 (Red t2 a2 (Red t3 a3 t4))	=  Red (Black t1 a1 t2) a2 (Black t3 a3 t4)
+> rblack l a r					=  Black l a r
+
+}
+%align 33
+
+> inorder			:: RedBlackTree a -> [a]
+> inorder t			=  traverse t []
+>     where
+>     traverse Empty x		=  x
+>     traverse (Red l a r) x	=  traverse l (a : traverse r x)
+>     traverse (Black l a r) x	=  traverse l (a : traverse r x)
+>
+> redBlackSort			:: (Ord a) => [a] -> [a]
+> redBlackSort			=  redBlackSortBy (<=)
+>
+> redBlackSortBy		:: Rel a -> [a] -> [a]
+> redBlackSortBy (<=)		=  inorder . foldr (insertBy (<=)) Empty
+
+
+Note that |lblack| and |rblack| sometimes perform an unnecessary test
+since both subtrees are tested for red-red violations. Here is a
+variant of |insertBy| which remedies this shortcoming, albeit at the
+expense of readability (this solves exercise~3.10(b) in
+\cite{Oka98Pur}, the original version already solves
+exercise~3.10(a)).
+
+> insertBy'			:: Rel a -> a -> RedBlackTree a -> RedBlackTree a
+> insertBy' (<=) a t		=  blacken (ins t)
+>     where
+>     ins Empty			=  Red Empty a Empty
+>     ins (Red l b r)		=  error "red node"
+>     ins (Black l b r)		=  black l b r
+>
+>     black l b r
+>       | a <= b		=  case l of
+>         Empty			-> Black (Red Empty a Empty) b r
+>         Red ll lb lr
+>           | a <= lb		-> case ins ll of
+>             Red lll llb llr	-> Red (Black lll llb llr) lb (Black lr b r)
+>             ll'		-> Black (Red ll' lb lr) b r
+>           | otherwise		-> case ins lr of
+>             Red lrl lrb lrr	-> Red (Black ll lb lrl) lrb (Black lrr b r)
+>             lr'		-> Black (Red ll lb lr') b r
+>         Black ll lb lr	-> Black (black ll lb lr) b r
+>       | otherwise		=  case r of
+>         Empty			-> Black l b (Red Empty a Empty)
+>         Red rl rb rr
+>           | a <= rb		-> case ins rl of
+>             Red rll rlb rlr	-> Red (Black l b rll) rlb (Black rlr rb rr)
+>             rl'		-> Black l b (Red rl' rb rr)
+>           | otherwise		-> case ins rr of
+>             Red rrl rrb rrr	-> Red (Black l a rl) rb (Black rrl rrb rrr)
+>             rr'		-> Black l b (Red rl rb rr')
+>         Black ll lb lr	-> Black l b (black ll lb lr)
+>
+> redBlackSort'			:: (Ord a) => [a] -> [a]
+> redBlackSort'			=  redBlackSortBy (<=)
+>
+> redBlackSortBy'		:: Rel a -> [a] -> [a]
+> redBlackSortBy' (<=)		=  inorder . foldr (insertBy' (<=)) Empty
+
+Empirical tests show that the decrease in readability is not justified
+or counterbalanced by an increase in speed: |redBlackSort'| is
+sometimes marginally faster, and sometimes marginally slower.
+\Todo{Curiously, |redBlackSort'| outperforms |redBlackSort| on strictly
+increasing sequences thereby contradicting the theory.}

+ Swish/HaskellRDF/Sort/SplaySort.lhs view
@@ -0,0 +1,63 @@+%-------------------------------=  --------------------------------------------
+\chapter{Splay sort}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.SplaySort 
+> where
+> import Swish.HaskellRDF.Sort.LibBase
+
+%align 33
+
+Sorting on the basis on splay trees has most of the desired features:
+is asymptotically optimal, stable and it adapts to the input. In fact,
+it has been conjectured \cite{MEP96Spl} that it is optimatically
+adaptive to all accepted measures of presortedness. The following code
+is due to Chris Okasaki \cite[p.~46]{Oka98Pur}.
+
+> data SplayTree a 		=  Empty
+>				|  Bin (SplayTree a) a (SplayTree a)
+>
+> insertBy			:: Rel a -> a -> SplayTree a -> SplayTree a
+> insertBy (<=) a t		=  Bin lt a ge
+>    where (lt, ge)		=  partBy (<=) a t
+
+\NB |lt| means \U{l}ess \U{t}han and |ge| means \U{g}reater \U{e}qual.
+
+> partBy			:: Rel a -> a -> SplayTree a -> (SplayTree a, SplayTree a)
+> partBy (<=) k Empty		=  (Empty, Empty)
+> partBy (<=) k t@(Bin l a r)
+>    | k <= a			=  case l of
+>         Empty			-> (Empty, t)
+>         Bin ll la lr
+>             | k <= la		-> let (lt, ge) = partBy (<=) k ll in (lt, Bin ge la (Bin lr a r))
+>             | otherwise	-> let (lt, ge) = partBy (<=) k lr in (Bin ll la lt, Bin ge a r)
+>     | otherwise		=  case r of
+>         Empty			-> (t, Empty)
+>         Bin rl ra rr
+>             | k <= ra		-> let (lt, ge) =  partBy (<=) k rl in (Bin l a lt, Bin ge ra rr)
+>             | otherwise	-> let (lt, ge) =  partBy (<=) k rr in (Bin (Bin l a rl) ra lt, ge)
+
+\NB Throughout the library great care is taken to ensure that the
+relative order of equal elements is preserved. This is most easily
+accomplished if the order of the arguments to a function reflects the
+original order within the input. Consider, for example, the definition
+of |insertBy|: on the left hand side |a| appears before |t|, on the
+right hand side |a| appears before |ge| which may contain elements
+equal to |a|. Thus, the relative order of equal elements is preserved.
+That said, it is probably clear which we use |foldr| instead of |foldl|
+for building trees.
+
+> inorder			:: SplayTree a -> [a]
+> inorder t			=  traverse t []
+>     where
+>     traverse Empty x		=  x
+>     traverse (Bin l a r) x	=  traverse l (a : traverse r x)
+>
+> splaySort			:: (Ord a) => [a] -> [a]
+> splaySort			=  splaySortBy (<=)
+>
+> splaySortBy			:: Rel a -> [a] -> [a]
+> splaySortBy (<=)		=  inorder . foldr (insertBy (<=)) Empty
+

+ Swish/HaskellRDF/Sort/Squiggol.lhs view
@@ -0,0 +1,53 @@+%-------------------------------=  --------------------------------------------
+\chapter{Squiggol}
+%-------------------------------=  --------------------------------------------
+
+%align
+
+> module Swish.HaskellRDF.Sort.Squiggol (module Swish.HaskellRDF.Sort.Squiggol)
+> where
+> import Swish.HaskellRDF.Sort.ListLib (halve)
+> import Swish.HaskellRDF.Sort.MergeSort (merge)
+
+%align 33
+%format (cata (x))              = "\llparenthesis " x "\rrparenthesis "
+%format (ana (x))               = "\llbracket " x "\rrbracket "
+%format phi                     = "\varphi "
+%format psi                     = "\psi "
+%format (In (a))		=  a
+
+The squiggol approach to sorting.
+
+> newtype Mu f			=  In (f (Mu f))
+>
+> cata				:: (Functor f) => (f a -> a) -> Mu f -> a
+> cata phi (In x)		=  phi (fmap (cata phi) x)
+>
+> ana				:: (Functor f) => (a -> f a) -> a -> Mu f
+> ana psi x			=  In (fmap (ana psi) (psi x))
+>
+> data Cell a list		=  Nil | Cons a list
+>
+> type List a			=  Mu (Cell a)
+
+> data Node a bush		=  Empty | Leaf a | Fork bush bush
+>
+> instance Functor (Node a) where
+>     fmap f Empty		=  Empty
+>     fmap f (Leaf a)		=  Leaf a
+>     fmap f (Fork b1 b2)	=  Fork (f b1) (f b2)
+>
+> type Bush a			=  Mu (Node a)
+
+> mergeSort			:: (Ord a) => [a] -> [a]
+> mergeSort			=  cata join . ana split
+
+> split				:: [a] -> Node a [a]
+> split []			=  Empty
+> split [a]			=  Leaf a
+> split as			=  uncurry Fork (halve as)
+
+> join				:: (Ord a) => Node a [a] -> [a]
+> join Empty			=  []
+> join (Leaf a)			=  [a]
+> join (Fork l r)		=  merge l r

+ Swish/HaskellRDF/Sort/Stable.lhs view
@@ -0,0 +1,58 @@+> module Swish.HaskellRDF.Sort.Stable (module Swish.HaskellRDF.Sort.Stable)
+> where
+> import Data.List (group)
+> import Swish.HaskellRDF.Sort.ListLib
+> import Swish.HaskellRDF.Sort.LibBase
+> import Swish.HaskellRDF.Sort.PairingHeap
+
+Datentypen, um Stabilit"at zu testen.
+
+> data With a b                 =  a :- b
+>                               deriving (Show)
+>
+> sat				:: With a b -> b
+> sat (_ :- s)			=  s
+
+> instance (Eq a) => Eq (With a b) where
+>     a :- _ == b :- _          =  a == b
+>
+> instance (Ord a) => Ord (With a b) where
+>     a :- _ <= b :- _          =  a <= b
+
+> number			:: (Enum b, Num b) => [a] -> [With a b]
+> number as			=  [ a :- i | (a, i) <- zip as [1 ..] ]
+
+> isStable			:: (Num a, Num b, Enum b, Eq c, Ord d)
+>				=> ([With a b] -> [With c d]) -> [([a],[With c d])]
+> isStable sort			=  [ (as, s)
+>				   | as <- perms [1, 1, 2, 2, 2],
+>				     let as' = number as,
+>				     let s = sort as',
+>				     not (stable s) ]
+
+> stable			:: (Eq a, Ord b) => [With a b] -> Bool
+> stable as			=  and [ ordered (map sat g) | g <- group as ]
+
+%if False
+
+> {-
+> data A			=  A1 | A2 | A3
+>
+> instance Eq A where
+>     _ == _			=  True
+>
+> instance Ord A where
+>     compare _ _		=  EQ
+
+> eq A1 A1			=  True
+> eq A2 A2			=  True
+> eq A3 A3			=  True
+> eq _ _			=  False
+>
+> equal as1 as2			=  and [ eq a1 a2 | (a1, a2) <- zip as1 as2 ]
+
+[ (as, s) | as <- perms [A1, A2, A3], let s = heapSort as, not (equal as s) ]
+
+> -}
+
+%endif

+ Swish/HaskellRDF/Swish.hs view
@@ -0,0 +1,122 @@+--------------------------------------------------------------------------------
+--  $Id: Swish.hs,v 1.11 2004/01/09 14:36:33 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Swish
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module is a wrapper for the main program of Swish.
+--
+--------------------------------------------------------------------------------
+
+--     WNH RIP OUT module Swish.HaskellRDF.Swish where
+-- module Main where      WNH RIP OUT!!!!+
+import Swish.HaskellRDF.SwishMain
+++import System.Environment+       ( getArgs )++import System.Exit
+    ( ExitCode(ExitSuccess,ExitFailure), exitWith )
+
++------------------------------------------------------------
+--  Swish main program
+------------------------------------------------------------
+--
+--  This is a minimal wrapper for the real main program, to facilitate
+--  interactive execution (e.g. in HUGS) of different command lines.
+--
+--  execStateT runs the monad with a supplied initial state,
+--  then separates the resulting state from the IO monad.
+
+main :: IO ()
+main =
+    do  { +          putStrLn ("Swish-0.2.1 CLI\n\n")+        ;+          args <- getArgs
+        ; code <- runSwishArgs args
+        ; if code == ExitSuccess then
+            return ()
+          else
+          if code == (ExitFailure 1) then
+            putStrLn $ "Swish: graphs compare different"
+          else
+            putStrLn $ "Swish: "++show code
+        ; exitWith code
+        }
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/Swish.hs,v $
+-- $Author: graham $
+-- $Revision: 1.11 $
+-- $Log: Swish.hs,v $
+-- Revision 1.11  2004/01/09 14:36:33  graham
+-- Revert Swish.hs and Sw3ishtestAll.hs to declare module Main.
+-- GHC compilation without -main-is option.  Tests OK.
+--
+-- Revision 1.10  2004/01/06 16:29:56  graham
+-- Fix up module exports to avoid GHC warnings
+--
+-- Revision 1.9  2003/09/24 18:50:53  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.8  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.7  2003/05/29 12:39:49  graham
+-- Improved error handling for stand-alone swish program
+--
+-- Revision 1.6  2003/05/29 11:52:41  graham
+-- Juggle Swish code:  SwishMain.hs is main program logic, with
+-- Swish.hs and SwishTest.hs being alternative "Main" modules for
+-- the real program and test harness respectively.
+--
+-- Revision 1.5  2003/05/28 19:57:50  graham
+-- Adjusting code to compile with GHC
+--
+-- Revision 1.4  2003/05/23 00:02:42  graham
+-- Fixed blank node id generation bug in N3Formatter
+--
+-- Revision 1.3  2003/05/21 13:34:13  graham
+-- Various N3 parser bug fixes.
+-- Need to fix handling of :name terms.
+--
+-- Revision 1.2  2003/05/20 23:35:28  graham
+-- Modified code to compile with GHC hierarchical libraries
+--
+-- Revision 1.1  2003/05/20 17:30:48  graham
+-- Initial swish program skeleton runs using isolated tests under Hugs
+--

+ Swish/HaskellRDF/SwishCommands.hs view
@@ -0,0 +1,451 @@+--------------------------------------------------------------------------------
+--  $Id: SwishCommands.hs,v 1.14 2004/02/11 14:19:36 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  SwishCommands
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  SwishCommands:  functions to deal with indivudual Swish command options.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.SwishCommands
+    ( swishFormat
+    , swishInput
+    , swishOutput
+    , swishMerge
+    , swishCompare
+    , swishGraphDiff
+    , swishScript
+    )
+where
+
+import Swish.HaskellRDF.SwishMonad
+    ( SwishStateIO, SwishState(..)
+    , setFormat, setGraph
+    , resetInfo, resetError, setExitcode
+    , SwishFormat(..)
+    , swishError
+    , reportLine+    )
+
+import Swish.HaskellRDF.SwishScript
+    ( parseScriptFromString
+    )
+
+import Swish.HaskellRDF.GraphPartition
+    ( GraphPartition(..)
+    , partitionGraph, comparePartitions
+    , partitionShowP
+    )
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFGraph, merge )
+
+import Swish.HaskellRDF.N3Formatter
+    ( formatGraphAsShowS )
+
+import Swish.HaskellRDF.N3Parser
+    ( parseN3fromString )
+
+import Swish.HaskellRDF.GraphClass
+    ( LDGraph(..)
+    , Label(..)
+    )
+
+import Swish.HaskellUtils.ErrorM( ErrorM(..) )
+
+import System.IO
+    ( Handle, openFile, IOMode(..)
+    , hPutStr, hPutStrLn, hClose, hGetContents
+    , hIsReadable, hIsWritable
+    , stdin, stdout, stderr
+    )
+
+import Control.Monad.Trans( MonadTrans(..) )
+
+import Control.Monad.State
+    ( modify, gets
+    )
+
+import Data.Maybe
+    ( Maybe(..), isJust, fromJust )
+
+import Control.Monad
+    ( when )
++import System.Exit
+    ( ExitCode(..) )
+
+import System.IO.Error++------------------------------------------------------------
+--  Set file format to supplied value
+------------------------------------------------------------
+
+swishFormat :: SwishFormat -> SwishStateIO ()
+swishFormat fmt = modify $ setFormat fmt
+
+------------------------------------------------------------
+--  Read graph from named file
+------------------------------------------------------------
+
+swishInput :: String -> SwishStateIO ()
+swishInput fnam =
+    do  { maybegraph <- swishReadGraph fnam
+        ; case maybegraph of
+            Just g    -> modify $ setGraph g
+            _         -> return ()
+        }
+
+------------------------------------------------------------
+--  Merge graph from named file
+------------------------------------------------------------
+
+swishMerge :: String -> SwishStateIO ()
+swishMerge fnam =
+    do  { maybegraph <- swishReadGraph fnam
+        ; case maybegraph of
+            Just g    -> modify $ mergeGraph g
+            _         -> return ()
+        }
+
+mergeGraph gr state = state { graph = newgr }
+    where
+        newgr = merge gr (graph state)
+
+------------------------------------------------------------
+--  Compare graph from named file
+------------------------------------------------------------
+
+swishCompare :: String -> SwishStateIO ()
+swishCompare fnam =
+    do  { maybegraph <- swishReadGraph fnam
+        ; case maybegraph of
+            Just g    -> compareGraph g
+            _         -> return ()
+        }
+
+compareGraph :: RDFGraph -> SwishStateIO ()
+compareGraph gr =
+    do  { oldgr <- gets graph
+        ; let exitCode = if gr == oldgr then ExitSuccess
+                                        else ExitFailure 1
+        ; modify $ setExitcode exitCode
+        }
+
+------------------------------------------------------------
+--  Display graph differences from named file
+------------------------------------------------------------
+
+swishGraphDiff :: String -> SwishStateIO ()
+swishGraphDiff fnam =
+    do  { maybegraph <- swishReadGraph fnam
+        ; case maybegraph of
+            Just g    -> diffGraph g
+            _         -> return ()
+        }
+
+diffGraph :: RDFGraph -> SwishStateIO ()
+diffGraph gr =
+    do  { oldgr <- gets graph
+        ; let p1 = partitionGraph (getArcs oldgr)
+        ; let p2 = partitionGraph (getArcs gr)
+        ; let diffs = comparePartitions p1 p2
+        ; maybehandleclose <- swishWriteFile "" -- null filename -> stdout
+        ; case maybehandleclose of
+            Just (h,c) ->
+                do  { swishOutputDiffs "" h diffs
+                    ; if c then lift $ hClose h else return ()
+                    }
+            _          -> return ()
+        }
+
+swishOutputDiffs :: (Label lb) =>
+    String -> Handle
+    -> [(Maybe (GraphPartition lb),Maybe (GraphPartition lb))]
+    -> SwishStateIO ()
+swishOutputDiffs fnam hnd diffs =
+    do  { lift $ hPutStrLn hnd ("Graph differences: "++show (length diffs))
+        ; sequence_ $ map (swishOutputDiff fnam hnd) (zip [1..] diffs)
+        }
+
+swishOutputDiff :: (Label lb) =>
+    String -> Handle
+    -> (Int,(Maybe (GraphPartition lb),Maybe (GraphPartition lb)))
+    -> SwishStateIO ()
+swishOutputDiff fnam hnd (diffnum,(part1,part2)) =
+    do  { lift $ hPutStrLn hnd ("---- Difference "++show diffnum++" ----")
+        ; lift $ hPutStr hnd "Graph 1:"
+        ; swishOutputPart fnam hnd part1
+        ; lift $ hPutStr hnd "Graph 2:"
+        ; swishOutputPart fnam hnd part2
+        }
+
+swishOutputPart :: (Label lb) =>
+    String -> Handle -> Maybe (GraphPartition lb) -> SwishStateIO ()
+swishOutputPart fnam hnd part =
+    do  { let out = case part of
+                Just p  -> partitionShowP "\n" p
+                Nothing -> "\n(No arcs)"
+        ; lift $ hPutStrLn hnd out
+        }
+
+------------------------------------------------------------
+--  Execute script from named file
+------------------------------------------------------------
+
+swishScript :: String -> SwishStateIO ()
+swishScript fnam =
+    do  { scs <- swishReadScript fnam
+        ; sequence_ (map swishCheckResult scs)
+        }
+
+swishReadScript :: String -> SwishStateIO [SwishStateIO ()]
+swishReadScript fnam =
+    do  { maybefile <- swishOpenFile fnam
+        ; case maybefile of
+            Just (h,i) ->
+                do  { res <- swishParseScript fnam i
+                    ; lift $ hClose h
+                    ; return res
+                    }
+            _          -> return []
+        }
+
+swishParseScript ::
+    String -> String -> SwishStateIO [SwishStateIO ()]
+swishParseScript fnam inp =
+    do  { let base = if null fnam then Nothing else Just fnam
+        ; let sres = parseScriptFromString base inp
+        ; case sres of
+            Error err ->
+                do  { swishError ("Script syntax error in file "++fnam++": "++err) 2
+                    ; return []
+                    }
+            Result scs -> return scs
+        }
+
+swishCheckResult :: SwishStateIO () -> SwishStateIO ()
+swishCheckResult swishcommand =
+    do  { swishcommand
+        ; er <- gets errormsg
+        ; when (isJust er) $
+            do  { swishError (fromJust er) 5
+                ; modify $ resetError
+                }
+        ; ms <- gets infomsg
+        ; when (isJust ms) $
+            do  { reportLine (fromJust ms)
+                ; modify $ resetInfo
+                }
+        }
+
+------------------------------------------------------------
+--  Output graph to named file
+------------------------------------------------------------
+
+swishOutput :: String -> SwishStateIO ()
+swishOutput fnam =
+    do  { maybehandleclose <- swishWriteFile fnam
+        ; case maybehandleclose of
+            Just (h,c) ->
+                do  { swishOutputGraph fnam h
+                    ; if c then lift $ hClose h else return ()
+                    }
+            _          -> return ()
+        }
+
+swishOutputGraph :: String -> Handle -> SwishStateIO ()
+swishOutputGraph fnam hnd =
+    do  { fmt <- gets $ format
+        ; case fmt of
+            N3        -> swishFormatN3 fnam hnd
+            _         -> swishError
+                         ("Unsupported file format: "++(show fmt)) 4
+        }
+
+swishFormatN3 :: String -> Handle -> SwishStateIO ()
+swishFormatN3 fnam hnd =
+    do  { out <- gets $ formatGraphAsShowS . graph
+        ; lift $ hPutStr hnd (out "")
+        }
+
+------------------------------------------------------------
+--  Common input functions
+------------------------------------------------------------
+--
+--  Keep the logic separate for reading file data and
+--  parsing it to an RDF graph value.
+
+swishReadGraph :: String -> SwishStateIO (Maybe RDFGraph)
+swishReadGraph fnam =
+    do  { maybefile <- swishOpenFile fnam
+        ; case maybefile of
+            Just (h,i) ->
+                do  { res <- swishParse fnam i
+                    ; lift $ hClose h
+                    ; return res
+                    }
+            _          -> return Nothing
+        }
+
+-- Open and read file, returning its handle and content, or Nothing
+-- WARNING:  the handle must not be closed until input is fully evaluated
+swishOpenFile :: String -> SwishStateIO (Maybe (Handle,String))
+swishOpenFile fnam =
+    do  { (hnd,hop) <- lift $
+            if null fnam then
+                return (stdin,True)
+            else
+            do  { o <- try (openFile fnam ReadMode)
+                ; case o of
+                    Left  e -> return (stdin,False)
+                    Right h -> return (h,True)
+                }
+        ; hrd <- lift $ hIsReadable hnd
+        ; res <- if hop && hrd then
+            do  {
+                ; fc <- lift $ hGetContents hnd
+                ; return $ Just (hnd,fc)
+                }
+            else
+            do  { lift $ hClose hnd
+                ; swishError ("Cannot read file: "++fnam) 3
+                ; return Nothing
+                }
+        ; return res
+        }
+
+swishParse :: String -> String -> SwishStateIO (Maybe RDFGraph)
+swishParse fnam inp =
+    do  { fmt <- gets $ format
+        ; case fmt of
+            N3        -> swishParseN3 fnam inp
+            _         ->
+                do  { swishError ("Unsupported file format: "++(show fmt)) 4
+                    ; return Nothing
+                    }
+        }
+
+swishParseN3 :: String -> String -> SwishStateIO (Maybe RDFGraph)
+swishParseN3 fnam inp =
+    do  { let pres = parseN3fromString inp
+        ; case pres of
+            Error err ->
+                do  { swishError ("N3 syntax error in file "++fnam++": "++err) 2
+                    ; return Nothing
+                    }
+            Result gr -> return $ Just gr
+        }
+
+--  Open file for writing, returning its handle, or Nothing
+--  Also returned is a flag indicating whether or not the
+--  handled should be closed when writing is done (if writing
+--  to standard output, the handle should not be closed as the
+--  run-time system should deal with that).
+swishWriteFile :: String -> SwishStateIO (Maybe (Handle,Bool))
+swishWriteFile fnam =
+    do  { (hnd,hop,cls) <- lift $
+            if null fnam then
+                return (stdout,True,False)
+            else
+            do  { o <- try (openFile fnam WriteMode)
+                ; case o of
+                    Left  e -> return (stderr,False,False)
+                    Right h -> return (h,True,True)
+                }
+        ; hwt <- lift $ hIsWritable hnd
+        ; if hop && hwt then
+                return $ Just (hnd,cls)
+            else
+            do  { if cls then lift $ hClose hnd else return ()
+                ; swishError ("Cannot write file: "++fnam) 3
+                ; return Nothing
+                }
+        }
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/SwishCommands.hs,v $
+-- $Author: graham $
+-- $Revision: 1.14 $
+-- $Log: SwishCommands.hs,v $
+-- Revision 1.14  2004/02/11 14:19:36  graham
+-- Add graph-difference option to Swish
+--
+-- Revision 1.13  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.12  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.11  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.10  2003/12/01 18:51:38  graham
+-- Described syntax for Swish script.
+-- Created Swish scripting test data.
+-- Edited export/import lists in Swish main program modules.
+--
+-- Revision 1.9  2003/09/24 18:50:53  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.8  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.7  2003/05/29 12:39:49  graham
+-- Improved error handling for stand-alone swish program
+--
+-- Revision 1.6  2003/05/29 10:49:08  graham
+-- Added and tested merge option (-m) for Swish program
+--
+-- Revision 1.5  2003/05/29 00:57:37  graham
+-- Resolved swish performance problem, which turned out to an inefficient
+-- method used by the parser to add arcs to a graph.
+--
+-- Revision 1.4  2003/05/28 17:39:30  graham
+-- Trying to track down N3 formatter performance problem.
+--
+-- Revision 1.3  2003/05/23 00:03:55  graham
+-- Added HUnit test module for swish program.
+-- Greatly enhanced N3Formatter tests
+--
+-- Revision 1.2  2003/05/21 13:34:13  graham
+-- Various N3 parser bug fixes.
+-- Need to fix handling of :name terms.
+--
+-- Revision 1.1  2003/05/20 23:36:30  graham
+-- Add new Swish modules
+--
+ Swish/HaskellRDF/SwishMain.hs view
@@ -0,0 +1,273 @@+--------------------------------------------------------------------------------
+--  $Id: SwishMain.hs,v 1.15 2004/02/11 17:37:02 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  SwishMain
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  Swish:  Semantic Web Inference Scripting in Haskell
+--
+--  This program is a simple skeleton for constructing Semantic Web [1]
+--  inference tools in Haskell, using the RDF graph, Notation 3 parser
+--  and Notation 3 formatter modules.
+--
+--  It might be viewed as a kind of embroyonic CWM [2] in Haskell, except
+--  that the intent is that Haskell will be used as a primary language for
+--  defining inferences.  As such, Swish is an open-ended toolkit for
+--  constructing new special-purpose Semantic Web applications rather
+--  than a closed, self-contained general-purpose SW application.
+--  I anticipate that this module may be used as a starting point for
+--  creating new programs rathar then as a complete program in its own right.
+--  The functionality built into this code is selected with a view to testing
+--  the Haskell modules for handling RDF rather than for performing any
+--  particular application processing (though development as a tool with
+--  some broader utility is not ruled out).  As such, it is part of
+--  another experiment along the lines described in [3].
+--
+--  [1] Semantic werb: http://www.w3.org/2001/sw/
+--  [2] CWM:           http://www.w3.org/2000/10/swap/doc/cwm.html
+--  [3] Motivation:    http://www.w3.org/2000/10/swap/doc/Motivation.html
+--  [4] Notation 3:    http://www.w3.org/DesignIssues/Notation3.html
+--  [5] RDF:           http://www.w3.org/RDF/
+--
+--  For command line details, see 'usageText' below.
+--
+--  TODO:
+--  + Add RDF/XML input and output
+--  + Add N-triples input and output
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.SwishMain(runSwish,runSwishArgs) where
+
+import Swish.HaskellRDF.SwishCommands
+    ( swishFormat
+    , swishInput
+    , swishOutput
+    , swishMerge
+    , swishCompare
+    , swishGraphDiff
+    , swishScript
+    )
+
+import Swish.HaskellRDF.SwishMonad
+    ( SwishStateIO, SwishState(..)
+    , emptyState
+    , SwishFormat(..)
+    , swishError
+    , reportLines 
+    )
+
+import Swish.HaskellUtils.ListHelpers
+    ( breakAll )
+
+import Control.Monad.State
+    ( execStateT )
+
+import Data.Char
+    ( isSpace )
+
+import Control.Monad
+    ( when )
+
+import System.Exit
+    ( ExitCode(ExitSuccess) )
+
+------------------------------------------------------------
+--  Command line description
+------------------------------------------------------------
+
+usageText :: [[Char]]+usageText =
+    [ "Swish 0.2.1"
+    , "Read, merge, write, compare and process RDF graphs."
+    , ""
+    , "Usage: swish option option ..."
+    , ""
+    , "where the options are processed from left to right, and may be"
+    , "any of the following:"
+    , "-?        display this message."
+    , "-n3       use Notation3 format for subsequent input and output."
+    , "-i[=file] read file in selected format into the graph workspace,"
+    , "          replacing any existing graph."
+    , "-m[=file] merge file in selected format with the graph workspace."
+    , "-c[=file] compare file in selected format with the graph workspace."
+    , "-d[=file] show graph differences between the file in selected"
+    , "          format and the graph workspace.  Differences are displayed"
+    , "          to the standard output stream."
+    , "-o[=file] write the graph workspace to a file in the selected format."
+    , "-s[=file] read and execute Swish script commands from the named file."
+    , ""
+    , "    If an optional filename value is omitted, the standard input"
+    , "    or output stream is used, as appropriate."
+    , ""
+    , "Exit status codes:"
+    , "Success - operation completed successfully/graphs compare equal"
+    , "1 - graphs compare different"
+    , "2 - input data format error"
+    , "3 - file access problem"
+    , "4 - command line error"
+    , "5 - script file execution error"
+    , ""
+    , "Examples:"
+    , ""
+    , "swish -n3 -i=file"
+    , "    read file as Notation3, and report any syntax errors."
+    , "swich -n3 -i=file1 -c=file2"
+    , "    read file1 and file2 as notation3, report any syntax errors, and"
+    , "    if both are OK, compare the resulting graphs to indicate whether"
+    , "    or not they are equivalent."
+    , "swish -n3 -i=file1 -o=file2"
+    , "    read file1 as Notation3, report any syntax errors, and output the"
+    , "    resulting graph as reformatted Notation3.  (The output may be"
+    , "    unedifying, but is intended to be used to test round-tripping"
+    , "    of Notation 3 data.  The Notation3 formatter may be improved in"
+    , "    subsequent versions.)"
+    ]
+
+------------------------------------------------------------
+--  Swish command line interpreter
+------------------------------------------------------------
+--
+--  This is a composite monad combining some state with an IO
+--  Monad.  "lift" allows a pure IO monad to be used as a step
+--  of the computation.
+--
+--  sequence_ is a Monad sequencer, returning a new monad that
+--  executes members of a list in turn, passing state along the
+--  chain.
+--
+swishCommands :: [String] -> SwishStateIO ()
+swishCommands args =
+    do  { sequence_ (map swishCommand args)
+        }
+
+swishCommand :: String -> SwishStateIO ()
+swishCommand cmd =
+        let
+            (nam,more) = break (=='=') cmd
+            arg        = drop 1 more
+        in
+        case nam of
+            ""      -> return ()    -- do nothing
+            "-?"    -> swishHelp
+            "-n3"   -> swishFormat N3
+            "-i"    -> swishInput arg
+            "-m"    -> swishMerge arg
+            "-c"    -> swishCompare arg
+            "-d"    -> swishGraphDiff arg
+            "-o"    -> swishOutput arg
+            "-s"    -> swishScript arg
+            _       -> swishError ("Invalid command line element: "++cmd) 4
+
+swishHelp :: SwishStateIO ()
+swishHelp = reportLines usageText
+
+------------------------------------------------------------
+--  Interactive test function (e.g. for use in Hugs)
+------------------------------------------------------------
+
+runSwish :: String -> IO ExitCode
+runSwish cmdline =
+    do  { let args = breakAll isSpace cmdline
+        ; ec <- runSwishArgs args
+        ; when (ec /= ExitSuccess) (putStrLn $ "Swish exit: "++show ec)
+        ; return ec
+        }
+
+runSwishArgs :: [String] -> IO ExitCode
+runSwishArgs args =
+    do  { state <- execStateT (swishCommands args) emptyState
+        ; return $ exitcode state
+        }
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/SwishMain.hs,v $
+-- $Author: graham $
+-- $Revision: 1.15 $
+-- $Log: SwishMain.hs,v $
+-- Revision 1.15  2004/02/11 17:37:02  graham
+-- Update for Swish 0.2.1
+--
+-- Revision 1.14  2004/02/11 14:19:36  graham
+-- Add graph-difference option to Swish
+--
+-- Revision 1.13  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.12  2003/12/20 17:07:48  graham
+-- Display swish version number in usage message
+--
+-- Revision 1.11  2003/12/20 14:34:21  graham
+-- Update command line options help message.
+--
+-- Revision 1.10  2003/12/19 21:29:33  graham
+-- Minor edits
+--
+-- Revision 1.9  2003/12/19 16:34:12  graham
+-- Add 'test' function to run SwishTest script
+--
+-- Revision 1.8  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.7  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.6  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.5  2003/12/01 18:51:38  graham
+-- Described syntax for Swish script.
+-- Created Swish scripting test data.
+-- Edited export/import lists in Swish main program modules.
+--
+-- Revision 1.4  2003/09/24 18:50:53  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.3  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.2  2003/05/29 12:39:49  graham
+-- Improved error handling for stand-alone swish program
+--
+-- Revision 1.1  2003/05/29 11:52:41  graham
+-- Juggle Swish code:  SwishMain.hs is main program logic, with
+-- Swish.hs and SwishTest.hs being alternative "Main" modules for
+-- the real program and test harness respectively.

+ Swish/HaskellRDF/SwishMonad.hs view
@@ -0,0 +1,306 @@+{-# OPTIONS -XFlexibleInstances #-}+{-# OPTIONS -XMultiParamTypeClasses #-}+--------------------------------------------------------------------------------
+--  $Id: SwishMonad.hs,v 1.12 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  SwishMonad
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  SwishMonad:  Composed state and IO monad for Swish
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.SwishMonad
+    ( SwishStateIO, SwishState(..)
+    , setFormat, setGraph
+    , modGraphs, findGraph, findFormula
+    , modRules, findRule
+    , modRulesets, findRuleset
+    , findOpenVarModify, findDatatype
+    , setInfo, resetInfo, setError, resetError, setExitcode
+    , emptyState
+    , SwishFormat(..)
+    , NamedGraph(..)
+    , swishError
+    , reportLines, reportLine
+    )
+where
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFGraph, emptyRDFGraph )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule, RDFRuleMap, RDFRuleset, RDFRulesetMap )
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFOpenVarBindingModify
+    )
+
+import Swish.HaskellRDF.BuiltInMap
+    ( findRDFOpenVarBindingModifier
+    , findRDFDatatype
+    , rdfRulesetMap
+    )
+
+import Swish.HaskellRDF.Ruleset
+    ( getMaybeContextAxiom
+    , getMaybeContextRule
+    )
+
+import Swish.HaskellRDF.Rule
+    ( Formula(..)+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..) )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , emptyLookupMap
+    , mapFindMaybe
+    , mapVals
+    )
+
+import Control.Monad.Trans
+    ( MonadTrans(..) )
+
+import Control.Monad.State
+    ( modify, StateT(..))
+
+import System.Exit
+    ( ExitCode(ExitSuccess,ExitFailure) )
+
+import System.IO
+    ( hPutStrLn, stderr )
+
+------------------------------------------------------------
+--  State and state monad for Swish program
+------------------------------------------------------------
+--
+--  Uses StateT Monad transformer:
+--  See example by Mark Carroll at http://www.haskell.org/hawiki/MonadState
+
+data SwishFormat = N3 | NT | RDF
+    deriving (Eq, Show)
+
+data SwishState = SwishState
+    { format    :: SwishFormat
+    , graph     :: RDFGraph         -- current graph
+    , graphs    :: NamedGraphMap    -- script processor named graphs
+    , rules     :: RDFRuleMap       -- script processor named rules
+    , rulesets  :: RDFRulesetMap    -- script processor rulesets
+    , infomsg   :: Maybe String     -- information message, or Nothing
+    , errormsg  :: Maybe String     -- error message, or Nothing
+    , exitcode  :: ExitCode
+    }
+
+type SwishStateIO a = StateT SwishState IO a
+
+emptyState :: SwishState+emptyState = SwishState
+    { format    = N3
+    , graph     = emptyRDFGraph
+    , graphs    = emptyLookupMap
+    , rules     = emptyLookupMap
+    , rulesets  = rdfRulesetMap
+    , infomsg   = Nothing
+    , errormsg  = Nothing
+    , exitcode  = ExitSuccess
+    }
+
+setFormat :: SwishFormat -> SwishState -> SwishState
+setFormat   fm state = state { format = fm }
+
+setGraph :: RDFGraph -> SwishState -> SwishState
+setGraph    gr state = state { graph = gr }
+
+modGraphs ::
+    ( NamedGraphMap -> NamedGraphMap ) -> SwishState -> SwishState
+modGraphs grmod state = state { graphs = grmod (graphs state) }
+
+findGraph :: ScopedName -> SwishState -> Maybe [RDFGraph]
+findGraph nam state = mapFindMaybe nam (graphs state)
+
+findFormula :: ScopedName -> SwishState -> Maybe RDFFormula
+findFormula nam state = case findGraph nam state of
+        Nothing  -> getMaybeContextAxiom nam (mapVals $ rulesets state)
+        Just []  -> Just $ Formula nam emptyRDFGraph
+        Just grs -> Just $ Formula nam (head grs)
+
+modRules ::
+    ( RDFRuleMap -> RDFRuleMap ) -> SwishState -> SwishState
+modRules rlmod state = state { rules = rlmod (rules state) }
+
+findRule :: ScopedName -> SwishState -> Maybe RDFRule
+findRule nam state =
+    let
+        localrule   = mapFindMaybe nam (rules state)
+        contextrule = getMaybeContextRule nam $ mapVals $ rulesets state
+    in
+        case localrule of
+            Nothing -> contextrule
+            justlr  -> justlr
+
+modRulesets ::
+    ( RDFRulesetMap -> RDFRulesetMap ) -> SwishState -> SwishState
+modRulesets rsmod state = state { rulesets = rsmod (rulesets state) }
+
+findRuleset ::
+    ScopedName -> SwishState -> Maybe RDFRuleset
+findRuleset nam state = mapFindMaybe (snScope nam) (rulesets state)
+
+findOpenVarModify :: ScopedName -> SwishState -> Maybe RDFOpenVarBindingModify
+findOpenVarModify nam _ = findRDFOpenVarBindingModifier nam
+
+findDatatype :: ScopedName -> SwishState -> Maybe RDFDatatype
+findDatatype nam _ = findRDFDatatype nam
+
+setInfo :: String -> SwishState -> SwishState
+setInfo msg state = state { infomsg = Just msg }
+
+resetInfo :: SwishState -> SwishState
+resetInfo state = state { infomsg = Nothing }
+
+setError :: String -> SwishState -> SwishState
+setError msg state = state { errormsg = Just msg }
+
+resetError :: SwishState -> SwishState
+resetError state = state { errormsg = Nothing }
+
+setExitcode :: ExitCode -> SwishState -> SwishState
+setExitcode ec state = state { exitcode = ec }
+
+
+------------------------------------------------------------
+--  Data types for Swish script dictionaries
+------------------------------------------------------------
+--
+--  The graphs dictionary contains named graphs and/or lists
+--  of graphs that are created and used by script statements.
+
+data NamedGraph = NamedGraph
+    { ngName    :: ScopedName
+    , ngGraph   :: [RDFGraph]
+    }
+
+instance LookupEntryClass NamedGraph ScopedName [RDFGraph]
+    where
+        keyVal   (NamedGraph k v) = (k,v)
+        newEntry (k,v)            = (NamedGraph k v)
+
+type NamedGraphMap = LookupMap NamedGraph
+
+------------------------------------------------------------
+--  Report error and set exit status code
+------------------------------------------------------------
+
+swishError :: String -> Int -> SwishStateIO ()
+swishError msg sts =
+    do  { reportLine $ msg
+        ; if sts == 4 then
+            reportLine $ "Use 'Swish -?' for help"
+          else
+            return ()
+        ; modify $ setExitcode (ExitFailure sts)
+        }
+
+------------------------------------------------------------
+--  Output text to the standard error stream
+------------------------------------------------------------
+--
+--  Each string in the supplied list is a line of text to
+--  be displayed.
+
+reportLines  :: [String] -> SwishStateIO ()
+reportLines text =
+    sequence_ (map reportLine text)
+
+reportLine  :: String -> SwishStateIO ()
+reportLine line =
+    -- lift putStrLn line
+    lift $ hPutStrLn stderr line
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/SwishMonad.hs,v $
+-- $Author: graham $
+-- $Revision: 1.12 $
+-- $Log: SwishMonad.hs,v $
+-- Revision 1.12  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.11  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.10  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.9  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.8  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.7  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.6  2003/12/01 18:51:38  graham
+-- Described syntax for Swish script.
+-- Created Swish scripting test data.
+-- Edited export/import lists in Swish main program modules.
+--
+-- Revision 1.5  2003/09/24 18:50:53  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.4  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.3  2003/05/29 12:39:49  graham
+-- Improved error handling for stand-alone swish program
+--
+-- Revision 1.2  2003/05/21 13:34:13  graham
+-- Various N3 parser bug fixes.
+-- Need to fix handling of :name terms.
+--
+-- Revision 1.1  2003/05/20 23:36:30  graham
+-- Add new Swish modules
+--
+ Swish/HaskellRDF/SwishScript.hs view
@@ -0,0 +1,1031 @@+--------------------------------------------------------------------------------
+--  $Id: SwishScript.hs,v 1.10 2004/02/09 22:22:44 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  SwishScript
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module implements the Swish script processor:  it parses a script
+--  from a supplied string, and returns a list of Swish state transformer
+--  functions whose effect, when applied to a state value, is to implement
+--  the supplied script.
+--
+--  The script syntax is based loosely on Notation3, and the script parser is an
+--  extension of the Notation3 parser in module N3Parser.hs.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.SwishScript
+    ( parseScriptFromString
+    )
+where
+
+import Swish.HaskellRDF.SwishMonad
+    ( SwishStateIO +    , modGraphs, findGraph, findFormula
+    , modRules, findRule
+    , modRulesets, findRuleset
+    , findOpenVarModify, findDatatype
+    , setInfo, setError, setExitcode
+    , NamedGraph(..)
+    )
+
+import Swish.HaskellRDF.RDFDatatype
+    ( RDFDatatype )
+
+import Swish.HaskellRDF.RDFRuleset
+    ( RDFFormula, RDFRule
+    , RDFRuleset
+    , makeRDFClosureRule
+    )
+
+import Swish.HaskellRDF.RDFProof
+    ( RDFProofStep, makeRDFProof, makeRDFProofStep )
+
+import Swish.HaskellRDF.RDFVarBinding
+    ( RDFVarBindingModify
+    )
+
+import Swish.HaskellRDF.RDFGraphShowM()
+
+import Swish.HaskellRDF.RDFGraph
+    ( RDFGraph, RDFLabel(..)
+    , emptyRDFGraph
+    , NamespaceMap
+    , setNamespaces
+    , merge, add
+    )
+
+import Swish.HaskellRDF.N3Parser
+    ( parseAnyfromString
+    , N3Parser, N3State(..)
+    , whiteSpace, symbol, eof, identLetter
+    , defaultPrefix, namedPrefix
+    , document, subgraph, uriRef2, varid, lexUriRef
+    , newBlankNode
+    )
+
+import Swish.HaskellRDF.N3Formatter
+    ( formatGraphAsShowS )
+
+import Swish.HaskellRDF.Datatype
+    ( typeMkRules )
+
+import Swish.HaskellRDF.Proof
+    ( explainProof, showsProof )
+
+import Swish.HaskellRDF.Ruleset
+    ( makeRuleset, getRulesetRule, getMaybeContextRule )
+
+import Swish.HaskellRDF.Rule
+    ( Formula(..), Rule(..) -- , RuleMap
+    )
+
+import Swish.HaskellRDF.VarBinding
+    ( composeSequence )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..) )
+
+import Swish.HaskellUtils.LookupMap
+    ( mapReplaceOrAdd )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv, flist )
+
+import Swish.HaskellUtils.ErrorM
+    ( ErrorM(..) )
+
+import Text.ParserCombinators.Parsec+    ( (<?>), (<|>)
+    , many, manyTill, option, sepBy, between, try, notFollowedBy
+    , string, char, anyChar
+    , getState
+    )
+
+import Control.Monad.State
+    ( modify, gets, lift
+    -- , StateT(..), execStateT
+    )
+
+import Control.Monad
+    ( when, liftM )
+
+{- WNH+import System.IO
+    ( IOMode(..), hPutStr
+    , IOError, try, ioeGetErrorString
+    )
+
+import qualified System.IO
+    ( IOMode(..), hPutStr
+    , IOError, try, ioeGetErrorString
+    )
+
+import Directory
+    ( doesFileExist )
+-}+
++import qualified System.IO.Error as IO++import System.Exit
+    ( ExitCode(ExitFailure) )
+
+------------------------------------------------------------
+--  Parser for Swish script processor
+------------------------------------------------------------
+--
+--  The parser is based on the Notation3 parser, and uses many
+--  of the same syntax productions, but the top-level productions used
+--  are quite different.
+
+parseScriptFromString :: Maybe String -> String -> ErrorM [SwishStateIO ()]
+parseScriptFromString base inp =
+    case parseAnyfromString script base inp of
+        Left  err -> Error  err
+        Right scs -> Result scs
+
+----------------------------------------------------------------------
+--  Syntax productions
+----------------------------------------------------------------------
+
+script :: N3Parser [SwishStateIO ()]
+script =
+        do  { whiteSpace
+            ; scs <- many command
+            ; eof
+            ; return scs
+            }
+
+command :: N3Parser (SwishStateIO ())
+command =
+        do  { try $ symbol "@prefix"
+            ; ( defaultPrefix <|> namedPrefix )
+            ; return $ return ()
+            }
+    <|> nameItem
+    <|> readGraph
+    <|> writeGraph
+    <|> mergeGraphs
+    <|> compareGraphs
+    <|> assertEquiv
+    <|> assertMember
+    <|> defineRule
+    <|> defineRuleset
+    <|> defineConstraints
+    <|> checkProofCmd
+    <|> fwdChain
+    <|> bwdChain
+    <?>
+        "script command"
+
+nameItem :: N3Parser (SwishStateIO ())
+nameItem =
+        --  name :- graph
+        --  name :- ( graph* )
+        do  { u <- uriRef2
+            ; symbol ":-"
+            ; g <- graphOrList
+            ; return $ ssAddGraph u g
+            }
+
+readGraph :: N3Parser (SwishStateIO ())
+readGraph =
+        --  @read name  [ <uri> ]
+        do  { commandName "@read"
+            ; n <- uriRef2
+            ; u <- option "" lexUriRef
+            ; return $ ssRead n (if null u then Nothing else Just u)
+            }
+
+writeGraph :: N3Parser (SwishStateIO ())
+writeGraph =
+        --  @write name [ <uri> ] ; Comment
+        do  { commandName "@write"
+            ; n <- uriRef2
+            ; let gs = ssGetList n :: SwishStateIO (Either String [RDFGraph])
+            ; u <- option "" lexUriRef
+            ; symbol ";"
+            ; c <- restOfLine
+            ; let muri = if null u then Nothing else Just u
+            ; return $ ssWriteList muri gs c
+            }
+
+mergeGraphs :: N3Parser (SwishStateIO ())
+mergeGraphs =
+        --  @merge ( name* ) => name
+        do  { commandName "@merge"
+            ; gs <- graphList
+            ; symbol "=>"
+            ; n <- uriRef2
+            ; return $ ssMerge n gs
+            }
+
+compareGraphs :: N3Parser (SwishStateIO ())
+compareGraphs =
+        --  @compare  name name
+        do  { commandName "@compare"
+            ; n1 <- uriRef2
+            ; n2 <- uriRef2
+            ; return $ ssCompare n1 n2
+            }
+
+assertEquiv :: N3Parser (SwishStateIO ())
+assertEquiv =
+        --  @asserteq name name ; Comment
+        do  { commandName "@asserteq"
+            ; n1 <- uriRef2
+            ; n2 <- uriRef2
+            ; symbol ";"
+            ; c <- restOfLine
+            ; return $ ssAssertEq n1 n2 c
+            }
+
+assertMember :: N3Parser (SwishStateIO ())
+assertMember =
+        --  @assertin name name ; Comment
+        do  { commandName "@assertin"
+            ; n1 <- uriRef2
+            ; n2 <- uriRef2
+            ; symbol ";"
+            ; c <- restOfLine
+            ; return $ ssAssertIn n1 n2 c
+            }
+
+defineRule :: N3Parser (SwishStateIO ())
+defineRule =
+        --  @rule name :- ( name* ) => name [ | ( (name var*)* ) ]
+        do  { commandName "@rule"
+            ; rn <- uriRef2
+            ; symbol ":-"
+            ; ags <- graphOrList
+            ; symbol "=>"
+            ; cg  <- graphExpr
+            ; vms <- option [] varModifiers
+            ; return $ ssDefineRule rn ags cg vms
+            }
+
+defineRuleset :: N3Parser (SwishStateIO ())
+defineRuleset =
+        --  @ruleset name :- ( name* ) ; ( name* )
+        do  { commandName "@ruleset"
+            ; sn <- uriRef2
+            ; symbol ":-"
+            ; ags <- nameList
+            ; symbol ";"
+            ; rns <- nameList
+            ; return $ ssDefineRuleset sn ags rns
+            }
+
+defineConstraints :: N3Parser (SwishStateIO ())
+defineConstraints =
+        --  @constraints pref :- ( name* ) | ( name* )
+        do  { commandName "@constraints"
+            ; sn <- uriRef2
+            ; symbol ":-"
+            ; cgs <- graphOrList
+            ; symbol "|"
+            ; cns <- nameOrList
+            ; return $ ssDefineConstraints sn cgs cns
+            }
+
+checkProofCmd :: N3Parser (SwishStateIO ())
+checkProofCmd =
+        --  @proof name ( name* )
+        --    @input name
+        --    @step name ( name* ) => name  # rule-name, antecedents, consequent
+        --    @result name
+        do  { commandName "@proof"
+            ; pn  <- uriRef2
+            ; sns <- nameList
+            ; commandName "@input"
+            ; igf <- formulaExpr
+            ; sts <- many checkStep
+            ; commandName "@result"
+            ; rgf <- formulaExpr
+            ; return $ ssCheckProof pn sns igf sts rgf
+            }
+
+checkStep ::
+    N3Parser (Either String [RDFRuleset]
+                -> SwishStateIO (Either String RDFProofStep))
+checkStep =
+        do  { commandName "@step"
+            ; rn   <- uriRef2
+            ; agfs <- formulaList
+            ; symbol "=>"
+            ; cgf  <- formulaExpr
+            ; return $ ssCheckStep rn agfs cgf
+            }
+
+fwdChain :: N3Parser (SwishStateIO ())
+fwdChain =
+        --  #   ruleset rule (antecedents) => result
+        --  @fwdchain pref name ( name* ) => name
+        do  { commandName "@fwdchain"
+            ; sn  <- uriRef2
+            ; rn  <- uriRef2
+            ; ags <- graphOrList
+            ; symbol "=>"
+            ; cn  <- uriRef2
+            ; s <- getState             :: N3Parser N3State
+            ; let prefs = prefixUris s  :: NamespaceMap
+            ; return $ ssFwdChain sn rn ags cn prefs
+            }
+
+bwdChain :: N3Parser (SwishStateIO ())
+bwdChain =
+        --  #   ruleset rule consequent <= (antecedent-alts)
+        --  @bwdchain pref name graph <= name
+        do  { commandName "@bwdchain"
+            ; sn  <- uriRef2
+            ; rn  <- uriRef2
+            ; cg  <- graphExpr
+            ; symbol "<="
+            ; an  <- uriRef2
+            ; s <- getState             :: N3Parser N3State
+            ; let prefs = prefixUris s  :: NamespaceMap
+            ; return $ ssBwdChain sn rn cg an prefs
+            }
+
+----------------------------------------------------------------------
+--  Syntax clause helpers
+----------------------------------------------------------------------
+
+commandName :: String -> N3Parser ()
+commandName cmd = try $
+        do  { string cmd
+            ; notFollowedBy identLetter
+            ; whiteSpace
+            }
+
+restOfLine :: N3Parser String
+restOfLine =
+        do  { s <- manyTill anyChar (char '\n')
+            ; whiteSpace
+            ; return s
+            }
+
+nameList :: N3Parser [ScopedName]
+nameList =
+        do  { symbol "("
+            ; ns <- many uriRef2
+            ; symbol ")"
+            ; return ns
+            }
+
+nameOrList :: N3Parser [ScopedName]
+nameOrList =
+        do  { n <- uriRef2
+            ; return $ [n]
+            }
+    <|>
+        nameList
+    <?>
+        "Name, or list of names"
+
+graphExpr :: N3Parser (SwishStateIO (Either String RDFGraph))
+graphExpr =
+        graphOnly
+    <|>
+        do  { f <- formulaExpr
+            ; return $ liftM (liftM formExpr) f
+            }
+    <?>
+        "Graph expression, graph name or named graph definition"
+
+graphOnly :: N3Parser (SwishStateIO (Either String RDFGraph))
+graphOnly =
+        do  { symbol "{"
+            ; b <- newBlankNode
+            ; g <- subgraph b       :: N3Parser RDFGraph
+            ; symbol "}"
+            ; s <- getState
+            ; let gp = setNamespaces (prefixUris s) g
+            ; return $ return (Right gp)
+            }
+
+graphList :: N3Parser [SwishStateIO (Either String RDFGraph)]
+graphList = between (symbol "(") (symbol ")") (many graphExpr)
+    <?>
+        "List of graphs"
+
+graphOrList :: N3Parser [SwishStateIO (Either String RDFGraph)]
+graphOrList =
+        do  { g <- graphExpr
+            ; return $ [g]
+            }
+    <|>
+        graphList
+    <?>
+        "Graph, or list of graphs"
+
+formulaExpr :: N3Parser (SwishStateIO (Either String RDFFormula))
+formulaExpr =
+        do  { n <- uriRef2
+            ; namedGraph n
+            }
+    <?> "Formula (name or named graph)"
+
+namedGraph :: ScopedName -> N3Parser (SwishStateIO (Either String RDFFormula))
+namedGraph n =
+        do  { symbol ":-"
+            ; g <- graphOnly
+            ; return $ ssAddReturnFormula n g
+            }
+    <|>
+        return (ssGetFormula n)
+
+formulaList :: N3Parser [SwishStateIO (Either String RDFFormula)]
+formulaList = between (symbol "(") (symbol ")") (many formulaExpr)
+    <?>
+        "List of formulae (names or named graphs)"
+
+varModifiers :: N3Parser [(ScopedName,[RDFLabel])]
+varModifiers =
+        do  { symbol "|"
+            ; varModList
+            }
+
+varModList :: N3Parser [(ScopedName,[RDFLabel])]
+varModList =
+        do  { symbol "("
+            ; vms <- sepBy varMod (symbol ",")
+            ; symbol ")"
+            ; return vms
+            }
+    <|>
+        do  { vm <- varMod
+            ; return [vm]
+            }
+
+varMod :: N3Parser (ScopedName,[RDFLabel])
+varMod =
+        do  { rn  <- uriRef2
+            ; vns <- many varid
+            ; return (rn,vns)
+            }
+
+----------------------------------------------------------------------
+--  SwishState helper functions
+----------------------------------------------------------------------
+--
+--  The functions below operate in the SwishStateIO monad, and are used
+--  to assemble an executable version of the parsed script.
+
+ssAddReturnFormula ::
+    ScopedName -> SwishStateIO (Either String RDFGraph)
+    -> SwishStateIO (Either String RDFFormula)
+ssAddReturnFormula nam gf =
+        do  { egr <- gf
+            ; ssAddGraph nam [return egr]
+            ; return $ liftM (Formula nam) egr
+            }
+
+ssAddGraph ::
+    ScopedName -> [SwishStateIO (Either String RDFGraph)]
+    -> SwishStateIO ()
+ssAddGraph nam gf =
+    let errmsg = "Graph/list not added: "++show nam++"; "
+    in
+        do  { esg <- sequence gf        -- [Either String RDFGraph]
+            ; let egs = sequence esg    -- Either String [RDFGraph]
+            ; let fgs = case egs of
+                    Left  er -> setError  (errmsg++er)
+                    Right gs -> modGraphs (mapReplaceOrAdd (NamedGraph nam gs))
+            ; modify fgs
+            }
+
+ssGetGraph :: ScopedName -> SwishStateIO (Either String RDFGraph)
+ssGetGraph nam =
+        do  { grs <- ssGetList nam
+            ; return $ liftM head grs
+            }
+
+ssGetFormula :: ScopedName -> SwishStateIO (Either String RDFFormula)
+ssGetFormula nam = gets find
+    where
+        find st = case findFormula nam st of
+            Nothing -> Left ("Formula not present: "++show nam)
+            Just gr -> Right $ gr
+
+ssGetList :: ScopedName -> SwishStateIO (Either String [RDFGraph])
+ssGetList nam = gets find
+    where
+        find st = case findGraph nam st of
+            Nothing  -> Left ("Graph or list not present: "++show nam)
+            Just grs -> Right $ grs
+
+ssRead :: ScopedName -> Maybe String -> SwishStateIO ()
+ssRead nam muri = ssAddGraph nam [ssReadGraph muri]
+
+ssReadGraph :: Maybe String -> SwishStateIO (Either String RDFGraph)
+ssReadGraph muri =
+        do  { inp <- getResourceData muri
+            ; return $ gf inp
+            }
+        where
+            gf inp = case inp of
+                Left  es -> Left es
+                Right is -> parseAnyfromString document muri is
+
+ssWriteList ::
+    Maybe String -> SwishStateIO (Either String [RDFGraph]) -> String
+    -> SwishStateIO ()
+ssWriteList muri gf comment =
+        do  { esgs <- gf
+            ; case esgs of
+                Left  er   -> modify $ setError ("Cannot write list: "++er)
+                Right [gr] -> ssWriteGraph muri gr comment
+                Right grs  -> sequence_ writegrs where
+                    writegrs = if null grs
+                        then [putResourceData Nothing ("+ Swish: Writing empty list"++)]
+                        else map writegr (zip [0..] grs)
+                    writegr (n,gr) = ssWriteGraph (murin muri n) gr
+                        ("["++show n++"] "++comment)
+                    murin Nothing    _ = Nothing
+                    murin (Just uri) n = Just (inituri++show n++lasturi)
+                        where
+                            splituri1 = splitBy (=='/') uri
+                            splituri2 = splitBy (=='.') (lastseg splituri1)
+                            inituri   = concat (initseg splituri1 ++ initseg splituri2)
+                            lasturi   = lastseg splituri2
+            }
+
+splitBy :: (a->Bool) -> [a] -> [[a]]
+splitBy _ []  = []
+splitBy p (s0:str) = let (s1,sr) = break p str in
+    (s0:s1):splitBy p sr
+
+lastseg :: [[a]] -> [a]
+lastseg []   = []
+lastseg [as] = []
+lastseg ass  = last ass
+
+initseg :: [[a]] -> [[a]]
+initseg []   = []
+initseg [as] = [as]
+initseg ass  = init ass
+
+ssWrite ::
+    Maybe String -> SwishStateIO (Either String RDFGraph) -> String
+    -> SwishStateIO ()
+ssWrite muri gf comment =
+        do  { esg <- gf
+            ; case esg of
+                Left  er -> modify $ setError ("Cannot write graph: "++er)
+                Right gr -> ssWriteGraph muri gr comment
+            }
+
+ssWriteGraph :: Maybe String -> RDFGraph -> String -> SwishStateIO ()
+ssWriteGraph muri gr comment =
+    putResourceData muri ((c++) . (formatGraphAsShowS gr))
+    where
+        c = "# "++comment++"\n"
+
+ssMerge ::
+    ScopedName -> [SwishStateIO (Either String RDFGraph)]
+    -> SwishStateIO ()
+ssMerge nam gfs =
+    let errmsg = "Graph merge not defined: "++show nam++"; "
+    in
+        do  { esg <- sequence gfs       -- [Either String RDFGraph]
+            ; let egs = sequence esg    -- Either String [RDFGraph]
+            ; let fgs = case egs of
+                    Left  er -> setError  (errmsg++er)
+                    Right [] -> setError  (errmsg++"No graphs to merge")
+                    Right gs -> modGraphs (mapReplaceOrAdd (NamedGraph nam [g]))
+                            where g = foldl1 merge gs
+            ; modify fgs
+            }
+
+ssCompare :: ScopedName -> ScopedName -> SwishStateIO ()
+ssCompare n1 n2 =
+        do  { g1 <- ssGetGraph n1
+            ; g2 <- ssGetGraph n2
+            ; when (g1 /= g2) (modify $ setExitcode (ExitFailure 1))
+            }
+
+ssAssertEq :: ScopedName -> ScopedName -> String -> SwishStateIO ()
+ssAssertEq n1 n2 comment =
+    let er1 = ":\n  Graph or list compare not performed:  invalid graph/list."
+    in
+        do  { g1 <- ssGetList n1
+            ; g2 <- ssGetList n2
+            ; case (g1,g2) of
+                (Left er,_) -> modify $ setError (comment++er1++"\n  "++er)
+                (_,Left er) -> modify $ setError (comment++er1++"\n  "++er)
+                (Right gr1,Right gr2) ->
+                    when (not $ equiv gr1 gr2) $ modify $
+                      setError (comment++":\n  Graph "++show n1
+                                ++" differs from "++show n2++".")
+            }
+
+ssAssertIn :: ScopedName -> ScopedName -> String -> SwishStateIO ()
+ssAssertIn n1 n2 comment =
+    let er1 = ":\n  Membership test not performed:  invalid graph."
+        er2 = ":\n  Membership test not performed:  invalid list."
+    in
+        do  { g1 <- ssGetGraph n1
+            ; g2 <- ssGetList  n2
+            ; case (g1,g2) of
+                (Left er,_) -> modify $ setError (comment++er1++"\n  "++er)
+                (_,Left er) -> modify $ setError (comment++er2++"\n  "++er)
+                (Right gr,Right gs) ->
+                    when (not $ elem gr gs) $ modify $
+                    setError (comment++":\n  Graph "++show n1
+                              ++" not a member of "++show n2)
+            }
+
+--  Note:  this is probably incomplete, though it should work in simple cases.
+--  A complete solution would have the binding modifiers subject to
+--  re-arrangement to suit the actual bound variables encountered.
+--  See VarBinding.findCompositions and VarBinding.findComposition
+--
+--  This code should be adequate if variable bindings are always used
+--  in combinations consisting of a single modifier followed by any number
+--  of filters.
+--
+ssDefineRule ::
+    ScopedName
+    -> [SwishStateIO (Either String RDFGraph)]
+    -> (SwishStateIO (Either String RDFGraph))
+    -> [(ScopedName,[RDFLabel])]
+    -> SwishStateIO ()
+ssDefineRule rn agfs cgf vmds =
+    let errmsg1 = "Rule definition error in antecedent graph(s): "
+        errmsg2 = "Rule definition error in consequent graph: "
+        errmsg3 = "Rule definition error in variable modifier(s): "
+        errmsg4 = "Incompatible variable binding modifier sequence"
+    in
+        do  { aesg <- sequence agfs     -- [Either String RDFGraph]
+            ; let ags = sequence aesg   :: Either String [RDFGraph]
+            ; cg <- cgf                 -- Either String RDFGraph
+            ; let vmfs = map ssFindVarModify vmds
+            ; evms <- sequence vmfs     -- [Either String RDFVarBindingModify]
+            ; let vms = sequence evms   :: Either String [RDFVarBindingModify]
+            ; let frl = case (ags,cg,vms) of
+                    (Left er,_,_) -> setError (errmsg1++er)
+                    (_,Left er,_) -> setError (errmsg2++er)
+                    (_,_,Left er) -> setError (errmsg3++er)
+                    (Right agrs,Right cgr,Right vbms) ->
+                        let
+                            newRule vm = makeRDFClosureRule rn agrs cgr vm
+                        in
+                        case composeSequence vbms of
+                            Just vm -> modRules (mapReplaceOrAdd (newRule vm))
+                            Nothing -> setError errmsg4
+            ; modify frl
+            }
+
+ssFindVarModify ::
+    (ScopedName,[RDFLabel]) -> SwishStateIO (Either String RDFVarBindingModify)
+ssFindVarModify (nam,lbs) = gets $ findVarMod nam lbs
+    where
+        findVarMod nam lbs st = case findOpenVarModify nam st of
+            Just ovbm -> Right (ovbm lbs)
+            Nothing   -> Left  ("Undefined modifier: "++show nam)
+
+ssDefineRuleset ::
+    ScopedName
+    -> [ScopedName]
+    -> [ScopedName]
+    -> SwishStateIO ()
+ssDefineRuleset sn ans rns =
+    let errmsg1 = "Error in ruleset axiom(s): "
+        errmsg2 = "Error in ruleset rule(s): "
+    in
+        do  { let agfs = sequence $ map ssGetFormula ans
+                                        :: SwishStateIO [(Either String RDFFormula)]
+            ; aesg <- agfs              -- [Either String RDFFormula]
+            ; let eags = sequence aesg  :: Either String [RDFFormula]
+            ; let erlf = sequence $ map ssFindRule rns
+                                        :: SwishStateIO [(Either String RDFRule)]
+            ; rles <- erlf              -- [Either String RDFRule]
+            ; let erls = sequence rles  :: (Either String [RDFRule])
+            ; let frs = case (eags,erls) of
+                    (Left er,_) -> setError (errmsg1++er)
+                    (_,Left er) -> setError (errmsg2++er)
+                    (Right ags,Right rls) ->
+                        modRulesets (mapReplaceOrAdd rs)
+                        where
+                            rs = makeRuleset (snScope sn) ags rls
+            ; modify frs
+            }
+
+ssFindRule :: ScopedName -> SwishStateIO (Either String RDFRule)
+ssFindRule nam = gets $ find
+    where
+        find st = case findRule nam st of
+            Nothing -> Left ("Rule not found: "++show nam)
+            Just rl -> Right rl
+
+ssDefineConstraints  ::
+    ScopedName
+    -> [SwishStateIO (Either String RDFGraph)]
+    -> [ScopedName]
+    -> SwishStateIO ()
+ssDefineConstraints  sn cgfs dtns =
+    let errmsg1 = "Error in constraint graph(s): "
+        errmsg2 = "Error in datatype(s): "
+    in
+        do  { cges <- sequence cgfs     -- [Either String RDFGraph]
+            ; let ecgs = sequence cges  :: Either String [RDFGraph]
+            ; let ecgr = case ecgs of
+                    Left er   -> Left er
+                    Right []  -> Right $ emptyRDFGraph
+                    Right grs -> Right $ foldl1 merge grs
+            ; edtf <- sequence $ map ssFindDatatype dtns
+                                        -- [Either String RDFDatatype]
+            ; let edts = sequence edtf   :: Either String [RDFDatatype]
+            ; let frs = case (ecgr,edts) of
+                    (Left er,_) -> setError (errmsg1++er)
+                    (_,Left er) -> setError (errmsg2++er)
+                    (Right cgr,Right dts) ->
+                        modRulesets (mapReplaceOrAdd rs)
+                        where
+                            rs  = makeRuleset (snScope sn) [] rls
+                            rls = concatMap (flip typeMkRules cgr) dts
+            ; modify frs
+            }
+
+ssFindDatatype :: ScopedName -> SwishStateIO (Either String RDFDatatype)
+ssFindDatatype nam = gets $ find
+    where
+        find st = case findDatatype nam st of
+            Nothing -> Left ("Datatype not found: "++show nam)
+            Just dt -> Right dt
+
+
+ssCheckProof ::
+    ScopedName                                      -- proof name
+    -> [ScopedName]                                 -- ruleset names
+    -> SwishStateIO (Either String RDFFormula)      -- input formula
+    -> [Either String [RDFRuleset]                  -- proof step from rulesets
+        -> SwishStateIO (Either String RDFProofStep)]
+    -> SwishStateIO (Either String RDFFormula)      -- result formula
+    -> SwishStateIO ()
+ssCheckProof pn sns igf stfs rgf =
+    let
+        infmsg1 = "Proof satisfied: "
+        errmsg1 = "Error in proof ruleset(s): "
+        errmsg2 = "Error in proof input: "
+        errmsg3 = "Error in proof step(s): "
+        errmsg4 = "Error in proof goal: "
+        errmsg5 = "Proof not satisfied: "
+        proofname = " (Proof "++show pn++")"
+    in
+        do  { let rs1 = map ssFindRuleset sns       :: [SwishStateIO (Either String RDFRuleset)]
+            ; rs2 <- sequence $ rs1                 -- [Either String RDFRuleset]
+            ; let erss = sequence rs2               :: Either String [RDFRuleset]
+            ; eig <- igf                            -- Either String RDFFormula
+            ; let st1  = sequence $ flist stfs erss :: SwishStateIO [Either String RDFProofStep]
+            ; st2 <- st1                            -- [Either String RDFProofStep]
+            ; let ests = sequence st2               :: Either String [RDFProofStep]
+            ; erg  <- rgf                           -- Either String RDFFormula
+            ; let proof = case (erss,eig,ests,erg) of
+                    (Left er,_,_,_) -> Left (errmsg1++er++proofname)
+                    (_,Left er,_,_) -> Left (errmsg2++er++proofname)
+                    (_,_,Left er,_) -> Left (errmsg3++er++proofname)
+                    (_,_,_,Left er) -> Left (errmsg4++er++proofname)
+                    (Right rss, Right ig, Right sts, Right rg) ->
+                        Right (makeRDFProof rss ig rg sts)
+            ; when False $ case proof of
+                    (Left  er) -> return ()
+                    (Right pr) -> putResourceData Nothing $
+                                    (("Proof "++show pn++"\n")++)
+                                    . showsProof "\n" pr
+            ; let checkproof = case proof of
+                    (Left  er) -> setError er
+                    (Right pr) ->
+                        case explainProof pr of
+                            Nothing -> setInfo (infmsg1++show pn)
+                            Just ex -> setError (errmsg5++show pn++", "++ex)
+                        {-
+                        if not $ checkProof pr then
+                            setError (errmsg5++show pn)
+                        else
+                            setInfo (infmsg1++show pn)
+                        -}
+            ; modify $ checkproof
+            }
+
+ssCheckStep ::
+    ScopedName                                      -- rule name
+    -> [SwishStateIO (Either String RDFFormula)]    -- antecedent graph formulae
+    -> SwishStateIO (Either String RDFFormula)      -- consequent graph formula
+    -> Either String [RDFRuleset]                   -- rulesets
+    -> SwishStateIO (Either String RDFProofStep)    -- resulting proof step
+ssCheckStep _  _    _   (Left  er)  = return $ Left er
+ssCheckStep rn eagf ecgf (Right rss) =
+    let
+        errmsg1 = "Rule not in proof step ruleset(s): "
+        errmsg2 = "Error in proof step antecedent graph(s): "
+        errmsg3 = "Error in proof step consequent graph: "
+    in
+        do  { let mrul = getMaybeContextRule rn rss :: Maybe RDFRule
+            ; esag <- sequence $ eagf               -- [Either String RDFFormula]]
+            ; let eags = sequence $ esag            :: Either String [RDFFormula]
+            ; ecg  <- ecgf                          -- Either String RDFFormula
+            ; let est = case (mrul,eags,ecg) of
+                    (Nothing,_,_) -> Left (errmsg1++show rn)
+                    (_,Left er,_) -> Left (errmsg2++er)
+                    (_,_,Left er) -> Left (errmsg3++er)
+                    (Just rul,Right ags,Right cg) ->
+                        Right $ makeRDFProofStep rul ags cg
+            ; return est
+            }
+
+ssFwdChain ::
+    ScopedName                                      -- ruleset name
+    -> ScopedName                                   -- rule name
+    -> [SwishStateIO (Either String RDFGraph)]      -- antecedent graphs
+    -> ScopedName                                   -- consequent graph name
+    -> NamespaceMap                                 -- prefixes for new graph
+    -> SwishStateIO ()
+ssFwdChain sn rn agfs cn prefs =
+    let
+        errmsg1 = "FwdChain rule error: "
+        errmsg2 = "FwdChain antecedent error: "
+    in
+        do  { erl  <- ssFindRulesetRule sn rn
+            ; aesg <- sequence agfs     -- [Either String RDFGraph]
+            ; let eags = sequence aesg   :: Either String [RDFGraph]
+            ; let fcr = case (erl,eags) of
+                    (Left er,_) -> setError (errmsg1++er)
+                    (_,Left er) -> setError (errmsg2++er)
+                    (Right rl,Right ags) ->
+                        modGraphs (mapReplaceOrAdd (NamedGraph cn [cg]))
+                        where
+                            cg = case fwdApply rl ags of
+                                []  -> emptyRDFGraph
+                                grs -> setNamespaces prefs $ foldl1 add grs
+            ; modify fcr
+            }
+
+ssFindRulesetRule ::
+    ScopedName -> ScopedName -> SwishStateIO (Either String RDFRule)
+ssFindRulesetRule sn rn = gets $ find
+    where
+        find st = case findRuleset sn st of
+            Nothing -> Left ("Ruleset not found: "++show sn)
+            Just rs -> find1 rs
+        find1 rs = case getRulesetRule rn rs of
+            Nothing -> Left ("Rule not in ruleset: "++show sn++": "++show rn)
+            Just rl -> Right rl
+
+ssFindRuleset ::
+    ScopedName -> SwishStateIO (Either String RDFRuleset)
+ssFindRuleset sn = gets $ find
+    where
+        find st = case findRuleset sn st of
+            Nothing -> Left ("Ruleset not found: "++show sn)
+            Just rs -> Right rs
+
+ssBwdChain ::
+    ScopedName                                      -- ruleset name
+    -> ScopedName                                   -- rule name
+    -> SwishStateIO (Either String RDFGraph)        -- consequent graphs
+    -> ScopedName                                   -- antecedent alts name
+    -> NamespaceMap                                 -- prefixes for new graphs
+    -> SwishStateIO ()
+ssBwdChain sn rn cgf an prefs =
+    let
+        errmsg1 = "BwdChain rule error: "
+        errmsg2 = "BwdChain goal error: "
+    in
+        do  { erl <- ssFindRulesetRule sn rn
+            ; ecg <- cgf                -- Either String RDFGraph
+            ; let fcr = case (erl,ecg) of
+                    (Left er,_) -> setError (errmsg1++er)
+                    (_,Left er) -> setError (errmsg2++er)
+                    (Right rl,Right cg) ->
+                        modGraphs (mapReplaceOrAdd (NamedGraph an ags))
+                        where
+                            ags  = map mergegr (bwdApply rl cg)
+                            mergegr grs = case grs of
+                                [] -> emptyRDFGraph
+                                _  -> setNamespaces prefs $ foldl1 add grs
+            ; modify fcr
+            }
+
+--  Temporary implementation:  just read local file WNH
     +--  (Add logic to separate filenames from URIs, and
+--  attempt HTTP GET, or similar.)
+getResourceData :: Maybe String -> SwishStateIO (Either String String)
+getResourceData muri =
+    case muri of
+        Nothing  -> fromStdin
+        Just uri -> fromUri uri
+    where
+    fromStdin =
+        do  { dat <- lift getContents
+            ; return $ Right dat
+            }
+    fromUri uri =
+        do  { -- WNH  b <- lift $ doesFileExist uri
+              -- WNH; if not b then
+                -- WNH  return $ Left ("File not found: "++uri)
+                -- WNHelse
+                fromFile uri
+            }
+    fromFile uri =
+        do  { dat <- lift $ readFile uri
+            ; return $ Right dat
+            }
+
+--  Temporary implementation:  just write local file
+--  (Need to add logic to separate filenames from URIs, and
+--  attempt HTTP PUT, or similar.)
+putResourceData :: Maybe String -> ShowS -> SwishStateIO ()
+putResourceData muri gsh =
+    do  { ios <- lift $ IO.try $
+            case muri of
+                Nothing  -> toStdout
+                Just uri -> toUri uri
+        ; case ios of
+            Left  ioe -> modify $ setError
+                            ("Error writing graph: "++
+                             IO.ioeGetErrorString ioe)
+            Right a   -> return a
+        }
+    where
+        toStdout  = putStrLn gstr
+        toUri uri = writeFile uri gstr
+        gstr = gsh ""
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/SwishScript.hs,v $
+-- $Author: graham $
+-- $Revision: 1.10 $
+-- $Log: SwishScript.hs,v $
+-- Revision 1.10  2004/02/09 22:22:44  graham
+-- Graph matching updates:  change return value to give some indication
+-- of the extent match achieved in the case of no match.
+-- Added new module GraphPartition and test cases.
+-- Add VehicleCapcity demonstration script.
+--
+-- Revision 1.9  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.8  2003/12/19 15:51:41  graham
+-- Sync minor edits
+--
+-- Revision 1.7  2003/12/12 14:12:01  graham
+-- Add comment about parser structure to SwishScript.hs
+--
+-- Revision 1.6  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.5  2003/12/10 14:43:00  graham
+-- Backup.
+--
+-- Revision 1.4  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.3  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.2  2003/12/05 02:31:32  graham
+-- Script parsing complete.
+-- Some Swish script functions run successfully.
+-- Command execution to be completed.
+--
+-- Revision 1.1  2003/12/04 02:53:28  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--

+ Swish/HaskellRDF/SwishTest.hs view
@@ -0,0 +1,182 @@+--------------------------------------------------------------------------------
+--  $Id: SwishTest.hs,v 1.10 2004/01/06 13:53:10 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  SwishTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  SwishTest:  Test cases for Swish program.
+--
+--------------------------------------------------------------------------------
+
+--  WNH RIP OUT   module Swish.HaskellRDF.SwishTest where++import System.Exit
++import System.Time
+
+import Test.HUnit
+      ( Test(..), Assertable(..),
+        assertEqual, runTestTT, runTestText, putTextToHandle )
+
+import Swish.HaskellRDF.SwishMain
++
+------------------------------------------------------------
+--  Interactive test cases
+------------------------------------------------------------
+
+testSwish :: String -> IO Bool
+testSwish cmdline =
+    do  { exitcode <- runSwish cmdline
+        -- ; putStr $ "Exit status: "++(show exitcode)
+        ; return $ exitcode == ExitSuccess
+        }
+
+swishTestCase :: String -> Test
+swishTestCase cmdline = TestCase ( assert $ testSwish cmdline )
+
+test1 = runSwish "-?"
+test2 = runSwish "-!not=validcommand"
+
+test3 = swishTestCase "-i=Data/N3TestGenReport.n3"
+test4 = swishTestCase "-i=Data/sbp-data.n3"
+test5 = swishTestCase "-i=Data/Simple.n3 "
+test6 = swishTestCase "-i=Data/Simple.n3 -o=Data/Simple.tmp"
+test7 = swishTestCase "-i=Data/Simple.n3 -c=Data/Simple.n3"
+test8 = swishTestCase "-i=Data/Simple.n3 -c=Data/Simple.tmp"
+test9 = swishTestCase "-i=Data/Simple.tmp -c=Data/Simple.tmp"
+
+test10a = swishTestCase "-i=Data/Simple3.n3"
+test10b = swishTestCase "-i=Data/Simple3.n3 -o"
+
+test10 = swishTestCase "-i=Data/Simple3.n3 -o=Data/Simple3.tmp"
+test11 = swishTestCase "-i=Data/Simple3.n3 -c=Data/Simple3.n3"
+test12 = swishTestCase "-i=Data/Simple3.n3 -c=Data/Simple3.tmp"
+test13 = swishTestCase "-i=Data/Simple3.tmp -c=Data/Simple3.tmp"
+
+test20a = swishTestCase "-i=Data/N3TestGenReport.n3"
+test20b = swishTestCase "-i=Data/N3TestGenReport.n3 -o"
+
+test20 = swishTestCase "-i=Data/N3TestGenReport.n3 -o=Data/N3TestGenReport.tmp"
+test21 = swishTestCase "-i=Data/N3TestGenReport.n3 -c=Data/N3TestGenReport.n3"
+test22 = swishTestCase "-i=Data/N3TestGenReport.n3 -c=Data/N3TestGenReport.tmp"
+test23 = swishTestCase "-i=Data/N3TestGenReport.tmp -c=Data/N3TestGenReport.tmp"
+
+test30 = swishTestCase "-i=Data/Merge1.n3 -m=Data/Merge2.n3 -c=Data/Merge3.n3"
+
+test31 = swishTestCase "-s=Swishtest.ss"
+
+tests1a = swishTestCase "-i=Data/Simple2.n3 -o=Data/Simple2.tmp"
+tests1b = swishTestCase "-i=Data/Simple2.n3 -c=Data/Simple2.tmp"
+
+allTests = TestList
+    [ test3
+    , test4
+    , test5
+    , test6
+    , test7
+    , test8
+    , test9
+    , test10
+    , test11
+    , test12
+    , test13
+    , tests1a
+    , tests1b
+    , test20
+    , test21
+    , test22
+    , test23
+    , test30
+    , test31
+    ]
+
+runTest t =
+    do  { st <- getClockTime
+        ; putStr $ "Test started:  "++show st++"\n"
+        ; runTestTT t
+        ; ft <- getClockTime
+        ; putStr $ "Test finished: "++show ft++"\n"
+        ; let et = diffClockTimes ft st
+        ; return et
+        ; putStr $ "Test duration: "++show et++"\n"
+        }
+
+testAll = runTest allTests
+
+tt   = runTest
+t20a = runTest test20a
+t20b = runTest test20b
+
+main = testAll
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/SwishTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.10 $
+-- $Log: SwishTest.hs,v $
+-- Revision 1.10  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.9  2003/09/24 18:50:53  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.8  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.7  2003/05/29 11:53:31  graham
+-- Juggle Swish code:  SwishMain.hs is main program logic, with
+-- Swish.hs and SwishTest.hs being alternative "Main" modules for
+-- the real program and test harness respectively.
+--
+-- Revision 1.6  2003/05/29 10:49:08  graham
+-- Added and tested merge option (-m) for Swish program
+--
+-- Revision 1.5  2003/05/29 01:50:56  graham
+-- More performance tuning, courtesy of GHC profiler.
+-- All modules showing reasonable performance now.
+--
+-- Revision 1.4  2003/05/29 00:57:37  graham
+-- Resolved swish performance problem, which turned out to an inefficient
+-- method used by the parser to add arcs to a graph.
+--
+-- Revision 1.3  2003/05/28 19:57:50  graham
+-- Adjusting code to compile with GHC
+--
+-- Revision 1.2  2003/05/28 17:39:30  graham
+-- Trying to track down N3 formatter performance problem.
+--
+-- Revision 1.1  2003/05/23 00:03:55  graham
+-- Added HUnit test module for swish program.
+-- Greatly enhanced N3Formatter tests
+--
+ Swish/HaskellRDF/VarBinding.hs view
@@ -0,0 +1,593 @@+{-# OPTIONS -XMultiParamTypeClasses #-}+{-# OPTIONS -XTypeSynonymInstances #-}+--------------------------------------------------------------------------------
+--  $Id: VarBinding.hs,v 1.12 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  VarBinding
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines functions for representing and manipulating query
+--  binding variable sets.  This is the key data that mediates between
+--  query and back substitution when performing inferences.  A framework
+--  of query variable modifiers is provided that can be used to
+--  implement richer inferences, such as filtering of  query results,
+--  or replacing values based on known relationships.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.VarBinding
+    ( VarBinding(..), nullVarBinding
+    , boundVars, subBinding, makeVarBinding
+    , applyVarBinding, joinVarBindings, addVarBinding
+    , VarBindingModify(..), OpenVarBindingModify
+    , vbmCompatibility, vbmCompose
+    , composeSequence, findCompositions, findComposition
+    , VarBindingFilter(..)
+    , makeVarFilterModify
+    , makeVarTestFilter, makeVarCompareFilter
+    , varBindingId, nullVarBindingModify
+    , varFilterDisjunction, varFilterConjunction
+    , varFilterEQ, varFilterNE
+    )
+where
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..) +    , makeLookupMap, mapFindMaybe
+    )
+
+import Swish.HaskellUtils.Namespace
+    ( ScopedName(..) )
+
+import Swish.HaskellRDF.Vocabulary
+    ( swishName )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv, subset, flist, headOrNothing, permutations )
+
+import Data.Maybe
+    ( catMaybes, fromMaybe, isJust, fromJust, listToMaybe )
+
+import Data.List
+    ( find, intersect, union, (\\) )
+
+
+------------------------------------------------------------
+--  Query variable bindings
+------------------------------------------------------------
+
+-- |VarBinding is the type of an arbitrary variable bindings
+--  value, where the type of the bound values is not specified.
+--
+data VarBinding a b = VarBinding
+    { vbMap  :: a -> Maybe b
+    , vbEnum :: [(a,b)]
+    , vbNull :: Bool
+    }
+
+-- |VarBinding is an instance of class Eq, so that variable
+--  bindings can be compared for equivalence
+--
+instance (Eq a, Eq b) => Eq (VarBinding a b) where
+    vb1 == vb2 = (vbEnum vb1) `equiv` (vbEnum vb2)
+
+-- |VarBinding is an instance of class Show, so that variable
+--  bindings can be displayed
+--
+instance (Show a, Show b) => Show (VarBinding a b) where
+    show vb = show (vbEnum vb)
+
+-- |nullVarBinding:  maps no query variables.
+--
+nullVarBinding :: VarBinding a b
+nullVarBinding = VarBinding
+    { vbMap  = const Nothing
+    , vbEnum = []
+    , vbNull = True
+    }
+
+-- |Return a list of the variables bound by a supplied variable binding
+--
+boundVars :: VarBinding a b -> [a]
+boundVars = map fst . vbEnum
+
+-- |VarBinding subset function, tests to see if one query binding
+--  is a subset of another;  i.e. every query variable mapping defined
+--  by one is also defined by the other.
+--
+subBinding :: (Eq a, Eq b) => (VarBinding a b) -> (VarBinding a b) -> Bool
+subBinding vb1 vb2 = (vbEnum vb1) `subset` (vbEnum vb2)
+
+-- |Function to make a variable binding from a list of
+--  pairs of variable and corresponding assigned value.
+--
+makeVarBinding :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> VarBinding a b
+makeVarBinding vrbs =
+    if null vrbs then nullVarBinding -- (nullVarBinding :: VarBinding a b)
+    else VarBinding
+        { vbMap  = selectFrom vrbs
+        , vbEnum = vrbs
+        , vbNull = null vrbs
+        }
+    where
+        selectFrom = flip mapFindMaybe . makeLookupMap
+        --  selectFrom bs is the VarBinding lookup function
+        {-
+        selectFrom :: (Eq a) => [(a,b)] -> a -> Maybe b
+        selectFrom []         _ = Nothing
+        selectFrom ((v,r):bs) l = if l == v then Just r
+                                    else selectFrom bs l
+        -}
+
+-- |Apply query binding to a supplied value, returning the value
+--  unchanged if no binding is defined
+--
+applyVarBinding :: VarBinding a a -> a -> a
+applyVarBinding vbind v = fromMaybe v (vbMap vbind v)
+
+-- |Join a pair of query bindings, returning a new binding that
+--  maps all variables recognized by either of the input bindings.
+--  If the bindings should overlap, such overlap is not detected and
+--  the value from the first binding provided is used arbitrarily.
+--
+joinVarBindings :: (Eq a) => VarBinding a b -> VarBinding a b -> VarBinding a b
+joinVarBindings vb1 vb2
+    | vbNull vb1 = vb2
+    | vbNull vb2 = vb1
+    | otherwise  = VarBinding
+        { vbMap  = mv12
+        , vbEnum = map (\v -> (v,fromJust (mv12 v))) bv12
+        , vbNull = False
+        }
+    where
+        -- flist fs a = map ($ a) fs;  see also monad function 'ap'
+        mv12 = headOrNothing . filter isJust . flist [ vbMap vb1, vbMap vb2 ]
+        bv12 = boundVars vb1 `union` boundVars vb2
+
+-- |Add a single new value to a variable binding and return the resulting
+--  new variable binding.
+--
+addVarBinding :: (Eq a, Show a, Eq b, Show b) => a -> b -> VarBinding a b
+    -> VarBinding a b
+addVarBinding lb val vbind = joinVarBindings vbind $ makeVarBinding [(lb,val)]
+
+------------------------------------------------------------
+--  Datatypes for variable binding modifiers
+------------------------------------------------------------
+
+-- |Define the type of a function to modify variable bindings in
+--  forward chaining based on rule antecedent matches.  This
+--  function is used to implement the "allocated to" logic described
+--  in Appendix B of the RDF semantics document, in which a specific
+--  blank node is associated with all matches of some specific value
+--  by applications of the rule on a given graph.
+--  Use 'id' if no modification of the variable bindings is required.
+--
+--  This datatype consists of the modifier function itself, which
+--  operates on a list of variable bindings rather than a single
+--  variable binding (because some modifications share context across
+--  a set of bindings), and some additional descriptive information
+--  that allows possible usage patterns to be analyzed.
+--
+--  Some usage patterns (see vbmUsage):
+--  (a) filter:  all variables are input variables, and the effect
+--      of the modifier function is to drop variable bindings that
+--      don't satisfy some criterion.
+--      Identifiable by an empty element in vbmUsage.
+--  (b) source:  all variables are output variables:  a raw query
+--      could be viewed as a source of variable bindings.
+--      Identifiable by an element of vbmUsage equal to vbmVocab.
+--  (c) modifier:  for each supplied variable binding, one or more
+--      new variable bindings may be created that contain the
+--      input variables bound as supplied plus some additional variables.
+--      Identifiable by an element of vbmUsage some subset of vbmVocab.
+--
+--  A variety of variable usage patterns may be supported by a given
+--  modifier:  a modifier may be used to define new variable bindings
+--  from existing bindings in a number of ways, or simply to check that
+--  some required relationship between bindings is satisfied.
+--  (Example, for a + b = c, any one variable can be deduced from the
+--  other two, or all three may be supplied to check that the relationship
+--  does indeed hold.)
+--
+data VarBindingModify a b = VarBindingModify
+    { vbmName   :: ScopedName
+                            -- ^Name used to identify this variable binding
+                            --  modifier when building inference rules.
+    , vbmApply  :: [VarBinding a b] -> [VarBinding a b]
+                            -- ^Apply variable binding modifier to a
+                            --  list of variable bindings, returning a
+                            --  new list.  The result list is not
+                            --  necessarily the same length as the
+                            --  supplied list.
+    , vbmVocab  :: [a]      -- ^List of variables used by this modifier.
+                            --  All results of applying this modifier contain
+                            --  bindings for these variables.
+    , vbmUsage  :: [[a]]    -- ^List of binding modifier usage patterns
+                            --  supported.  Each pattern is characterized as
+                            --  a list of variables for which new bindings
+                            --  may be created by some application of this
+                            --  modifier, assuming that bindings for all other
+                            --  variables in vbmVocab are supplied.
+    }
+
+-- |Allow a VarBindingModify value to be accessed using a LookupMap.
+--
+instance LookupEntryClass
+    (VarBindingModify a b) ScopedName (VarBindingModify a b)
+    where
+        keyVal   vbm     = (vbmName vbm,vbm)
+        newEntry (_,vbm) = vbm
+
+-- |Type for variable binding modifier that has yet to be instantiated
+--  with respect to the variables that it operates upon.
+--
+type OpenVarBindingModify lb vn = [lb] -> VarBindingModify lb vn
+
+-- |Extract variable binding name from OpenVarBindingModify value
+--
+--  (Because only the name is required, the application to an undefined
+--  list of variable labels should never be evaluated, as long as the
+--  name is not dependent on the variable names in any way.)
+--
+--  NOT QUITE... some of the functions that create OpenVarBindingModify
+--  instances also pattern-match the number of labels provided, forcing
+--  evaluation of the labels parameter, even though it's not used.
+--
+openVbmName :: OpenVarBindingModify lb vn -> ScopedName
+openVbmName ovbm = vbmName (ovbm (error "Undefined labels in variable binding"))
+
+-- |Allow an OpenVarBindingModify value to be accessed using a LookupMap.
+--
+instance LookupEntryClass
+    (OpenVarBindingModify a b) ScopedName (OpenVarBindingModify a b)
+    where
+        keyVal   ovbm     = (openVbmName ovbm,ovbm)
+        newEntry (_,ovbm) = ovbm
+
+-- |Allow an OpenVarBindingModify value to be accessed using a LookupMap.
+--
+instance Show (OpenVarBindingModify a b)
+    where
+        show = show . openVbmName
+
+-- |Variable binding modifier compatibility test.
+--
+--  Given a list of bound variables and a variable binding modifier, return
+--  a list of new variables that may be bound, or Nothing.
+--
+--  Note:  if the usage pattern component is well-formed (i.e. all
+--  elements different) then at most one element can be compatible with
+--  a given input variable set.
+--
+vbmCompatibility :: (Eq a) => VarBindingModify a b -> [a] -> Maybe [a]
+vbmCompatibility vbm vars = find compat (vbmUsage vbm)
+    where
+        compat ovars = vbmCompatibleVars vars (vbmVocab vbm) ovars
+
+-- |Variable binding usage compatibility test.
+--
+--  bvars   are variables supplied with bindings
+--  vocab   are variables returned with bindings by a modifier
+--  ovars   are variables assigned new bindings by a modifier
+--
+--  Returns True if the supplied variable bindings can be compatibly
+--  processed by a variable binding usage with supplied vocabulary and
+--  usage pattern.
+--
+vbmCompatibleVars :: (Eq a) => [a] -> [a] -> [a] -> Bool
+vbmCompatibleVars bvars vocab ovars =
+    null (ivars `intersect` ovars) &&       -- ivars and ovars don't overlap
+    null ((vocab \\ ovars) \\ ivars)        -- ovars and ivars cover vocab
+    where
+        ivars = bvars `intersect` vocab
+
+-- |Compose variable binding modifiers.
+--
+--  Returns Just a new variable binding modifier that corresponds to
+--  applying the first supplied modifier and then applying the second
+--  one, or Nothing if the two modifiers cannot be compatibly composed.
+--
+--  NOTE:  this function does not, in general, commute.
+--
+--  NOTE:  if there are different ways to achieve the same usage, that
+--  usage is currently repeated in the result returned.
+--
+vbmCompose :: (Eq a) => VarBindingModify a b -> VarBindingModify a b
+    -> Maybe (VarBindingModify a b)
+vbmCompose
+    (VarBindingModify nam1 app1 voc1 use1)
+    (VarBindingModify nam2 app2 voc2 use2)
+    | not (null use12) = Just $ VarBindingModify
+        { vbmName  = swishName ("_"++(snLocal nam1)++"_"++(snLocal nam2)++"_")
+        , vbmApply = app2 . app1
+        , vbmVocab = voc1 `union` voc2
+        , vbmUsage = use12
+        }
+    | otherwise = Nothing
+    where
+        use12 = compatibleUsage voc1 use1 use2
+
+-- |Determine compatible ways in which variable binding modifiers may
+--  be combined.
+--
+--  voc1    is the total vocabulary of the first modifier to be applied
+--  use1    is a list of usage patterns for the first modifier.
+--  use2    is a list of usage patterns for the second modifier.
+--
+--  Returns a list of possible usage patterns for the composition of
+--  the first modifier with the second modifier, or an empty list if
+--  the modifiers are incompatible.
+--
+--  The total vocabulary of a modifier is the complete set of variables
+--  that are used or bound by the modifier.  After the modifier has been
+--  applied, bindings must exist for all of these variables.
+--
+--  A usage pattern of a modifier is a set of variables for which new
+--  bindings may be generated by the modifier.
+--
+--  The only way in which two variable binding modifiers can be incompatible
+--  with each other is when they both attempt to create a new binding for
+--  the same variable.  (Note that this does not mean the composition will
+--  be compatible with all inputs:  see vbmCompatibleVars above.)
+--
+--  NOTE:  if there are different ways to achieve the same usage, that
+--  usage is currently repeated in the result returned.
+--
+compatibleUsage :: (Eq a) => [a] -> [[a]] -> [[a]] -> [[a]]
+compatibleUsage voc1 use1 use2 =
+    [ u1++u2 | u2 <- use2, null (voc1 `intersect` u2), u1 <- use1 ]
+
+-- |Find all compatible compositions of a list of variable binding
+--  modifiers for a given set of supplied bound variables.
+findCompositions :: (Eq a) => [VarBindingModify a b] -> [a]
+    -> [VarBindingModify a b]
+findCompositions vbms vars =
+    catMaybes $ map (composeCheckSequence vars) (permutations vbms)
+
+-- |Compose sequence of variable binding modifiers, and check
+--  that the result can be used compatibly with a supplied list
+--  of bound variables, returning Just (composed modifier), or Nothing
+--
+composeCheckSequence :: (Eq a) => [a] -> [VarBindingModify a b]
+    -> Maybe (VarBindingModify a b)
+composeCheckSequence vars vbms = useWith vars $ composeSequence vbms
+    where
+        --  Check that a Maybe modifier is compatible for use with an
+        --  indicated set of bound variables, and return (Just modifier)
+        --  or Nothing.
+        useWith _    Nothing    = Nothing
+        useWith vars (Just vbm)
+            | isJust $ vbmCompatibility vbm vars = (Just vbm)
+            | otherwise                          = Nothing
+
+-- |Compose sequence of variable binding modifiers.
+--
+composeSequence :: (Eq a) => [VarBindingModify a b]
+    -> Maybe (VarBindingModify a b)
+composeSequence [] = Just varBindingId
+composeSequence (vbm:vbms) =
+    foldl composePair (Just vbm) vbms
+
+-- |Compose a pair of variable binding modifiers, returning
+--  Just (composed modifier), or Nothing
+--
+composePair :: (Eq a) => Maybe (VarBindingModify a b) -> VarBindingModify a b
+    -> Maybe (VarBindingModify a b)
+composePair Nothing     _    = Nothing
+composePair (Just vbm1) vbm2 = vbmCompose vbm1 vbm2
+
+-- |Return Just a compatible composition of variable binding modifiers
+--  for a given set of supplied bound variables, or Nothing if there
+--  is no compatible composition
+--
+findComposition :: (Eq a) => [VarBindingModify a b] -> [a]
+    -> Maybe (VarBindingModify a b)
+findComposition = listToMaybe `c2` findCompositions
+    where
+        c2 = (.) . (.)  -- compose with function of two arguments
+
+-- |Variable binding modifier that returns exactly those
+--  variable bindings presented.
+--
+varBindingId :: VarBindingModify a b
+varBindingId = VarBindingModify
+    { vbmName   = swishName "varBindingId"
+    , vbmApply  = id
+    , vbmVocab  = []
+    , vbmUsage  = [[]]
+    }
+
+-- |Null variable binding modifier
+--
+--  This is like varBindingId except parameterized by some labels.
+--  I think this is redundant, and should be eliminated.
+--
+nullVarBindingModify :: OpenVarBindingModify a b
+nullVarBindingModify lbs = VarBindingModify
+    { vbmName   = swishName "nullVarBindingModify"
+    , vbmApply  = id
+    , vbmVocab  = lbs
+    , vbmUsage  = [[]]
+    }
+
+------------------------------------------------------------
+--  Query binding filters
+------------------------------------------------------------
+
+-- |VarBindingFilter is a function type that tests to see if
+--  a query binding satisfies some criterion.
+--
+--  Queries often want to apply some kind of filter or condition
+--  to the variable bindings that are processed.  In inference rules,
+--  it sometimes seems desirable to stipulate additional conditions on
+--  the things that are matched.
+--
+--  This function type is used to perform such tests.
+--  A number of simple implementations are included below.
+data VarBindingFilter a b = VarBindingFilter
+    { vbfName   :: ScopedName
+    , vbfVocab  :: [a]
+    , vbfTest   :: (VarBinding a b) -> Bool
+    }
+
+-- |Make a variable binding modifier from a variable binding filter value.
+makeVarFilterModify :: VarBindingFilter a b -> VarBindingModify a b
+makeVarFilterModify vbf = VarBindingModify
+    { vbmName   = vbfName vbf
+    , vbmApply  = filter (vbfTest vbf)
+    , vbmVocab  = vbfVocab vbf
+    , vbmUsage  = [[]]
+    }
+
+-- |Make a variable test filter for a named variable using a
+--  supplied value testing function.
+makeVarTestFilter ::
+    ScopedName -> (b -> Bool) -> a -> VarBindingFilter a b
+makeVarTestFilter nam vtest var = VarBindingFilter
+    { vbfName   = nam
+    , vbfVocab  = [var]
+    , vbfTest   = \vb -> case vbMap vb var of
+                    Just val  -> vtest val
+                    _         -> False
+    }
+
+-- |Make a variable comparison filter for named variables using
+--  a supplied value comparison function.
+makeVarCompareFilter ::
+    ScopedName -> (b -> b -> Bool) -> a -> a -> VarBindingFilter a b
+makeVarCompareFilter nam vcomp v1 v2 = VarBindingFilter
+    { vbfName   = nam
+    , vbfVocab  = [v1,v2]
+    , vbfTest   = \vb -> case (vbMap vb v1,vbMap vb v2) of
+                    (Just val1, Just val2) -> vcomp val1 val2
+                    _                      -> False
+    }
+
+------------------------------------------------------------
+--  Declare some generally useful query binding filters
+------------------------------------------------------------
+
+-- |This function generates a query binding filter that ensures that
+--  two indicated query variables are mapped to the same value.
+varFilterEQ :: (Eq b) => a -> a -> VarBindingFilter a b
+varFilterEQ v1 v2 =
+    makeVarCompareFilter (swishName "varFilterEQ") (==) v1 v2
+
+-- |This function generates a query binding filter that ensures that
+--  two indicated query variables are mapped to different values.
+varFilterNE :: (Eq b) => a -> a -> VarBindingFilter a b
+varFilterNE v1 v2 =
+    makeVarCompareFilter (swishName "varFilterNE") (/=) v1 v2
+
+-- |This function composes a number of query binding filters
+--  into a composite filter that accepts any query binding that
+--  satisfies at least one of the component values.
+varFilterDisjunction :: (Eq a) => [VarBindingFilter a b]
+    -> VarBindingFilter a b
+varFilterDisjunction vbfs = VarBindingFilter
+    { vbfName   = swishName "varFilterDisjunction"
+    , vbfVocab  = foldl1 union (map vbfVocab vbfs)
+    , vbfTest   = or . flist (map vbfTest vbfs)
+    }
+
+-- |This function composes a number of query binding filters
+--  into a composite filter that accepts any query binding that
+--  satisfies all of the component values.
+--
+--  The same function could be achieved by composing the component
+--  filter-based modifiers, but this function is more convenient
+--  as it avoids the need to check for modifier compatibility.
+--
+varFilterConjunction :: (Eq a) => [VarBindingFilter a b]
+    -> VarBindingFilter a b
+varFilterConjunction vbfs = VarBindingFilter
+    { vbfName   = swishName "varFilterConjunction"
+    , vbfVocab  = foldl1 union (map vbfVocab vbfs)
+    , vbfTest   = and . flist (map vbfTest vbfs)
+    }
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/VarBinding.hs,v $
+-- $Author: graham $
+-- $Revision: 1.12 $
+-- $Log: VarBinding.hs,v $
+-- Revision 1.12  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.11  2003/12/10 03:48:58  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.10  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.9  2003/12/08 17:29:19  graham
+-- Moved OpenVarBinding type definitions from -Datatype to -VarBinding modules.
+--
+-- Revision 1.8  2003/12/08 16:58:27  graham
+-- Add name to variable binding modifiers and filters.
+-- Add namespace for Swish-defined names.
+--
+-- Revision 1.7  2003/12/04 02:53:28  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.6  2003/10/24 21:05:08  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.5  2003/10/22 15:47:46  graham
+-- Working on datatype inference support.
+--
+-- Revision 1.4  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.3  2003/10/15 16:40:52  graham
+-- Reworked RDFQuery to use new query binding framework.
+-- (Note: still uses VarBindingFilter rather than VarBindingModify.
+-- The intent is to incorproate the VarBindingModify logic into RDFProof,
+-- displaying the existing use of BindingFilter.)
+--
+-- Revision 1.2  2003/10/15 00:07:01  graham
+-- Added variable binding filter structures, and some common filters
+--
+-- Revision 1.1  2003/10/14 20:30:58  graham
+-- Add separate module for generic variable binding functions.
+--

+ Swish/HaskellRDF/VarBindingTest.hs view
@@ -0,0 +1,991 @@+--------------------------------------------------------------------------------
+--  $Id: VarBindingTest.hs,v 1.6 2004/01/06 13:53:10 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  VarBindingTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test cases for variable binding values and
+--  variable binding modifier values.
+--
+--------------------------------------------------------------------------------
+
+-- WNH RIP OUT module Swish.HaskellRDF.VarBindingTest where
+
+import Swish.HaskellRDF.VarBinding
+    ( VarBinding(..)
+    , subBinding, nullVarBinding, makeVarBinding
+    , boundVars, subBinding, makeVarBinding
+    , applyVarBinding, joinVarBindings
+    , VarBindingModify(..)
+    , vbmCompatibility, vbmCompose
+    , findCompositions, findComposition
+    , makeVarFilterModify
+    , makeVarTestFilter, makeVarCompareFilter
+    , varBindingId, varFilterDisjunction, varFilterConjunction
+    , varFilterEQ, varFilterNE
+    )
+
+import Swish.HaskellRDF.Vocabulary
+    ( swishName )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , Assertion
+    , assertBool, assertEqual, assertString, assertFailure
+    , runTestTT, runTestText, putTextToHandle
+    )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    )
+
+import Control.Monad ( unless )
+
+import Data.List
+    ( sort, union, intersect )
+
+import Data.Maybe
+    ( isJust, fromJust )
+
+
+------------------------------------------------------------
+--  Test case helpers
+------------------------------------------------------------
+
+assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
+assertMember preface expected actual =
+  unless (expected `elem` actual ) (assertFailure msg)
+  where msg = (if null preface then "" else preface ++ "\n") ++
+             "expected: " ++ show expected ++ "\nbut got: " ++ show actual
+
+test :: String -> Bool -> Test
+test lab bv =
+    TestCase ( assertBool ("test:"++lab) bv )
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
+
+testLe :: (Ord a, Show a) => String -> Bool -> a -> a -> Test
+testLe lab eq a1 a2 =
+    TestCase ( assertEqual ("testLe:"++lab) eq (a1<=a2) )
+
+-- Test for Just x or Nothing
+
+testJust :: String -> Maybe a -> Test
+testJust lab av =
+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
+
+testNothing :: String -> Maybe a -> Test
+testNothing lab av =
+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
+
+-- Compare lists and lists of lists and Maybe lists for set equivalence:
+
+data ListTest a = ListTest [a]
+
+instance (Eq a) => Eq (ListTest a) where
+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
+
+instance (Show a) => Show (ListTest a) where
+    show (ListTest a) = show a
+
+data MaybeListTest a = MaybeListTest (Maybe [a])
+
+instance (Eq a) => Eq (MaybeListTest a) where
+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
+    MaybeListTest Nothing   == MaybeListTest Nothing   = True
+    _                       == _                       = False
+
+instance (Show a) => Show (MaybeListTest a) where
+    show (MaybeListTest a) = show a
+
+testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
+testEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
+
+testEqvEqv :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
+testEqvEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqvEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest $ map ListTest a1
+        ma2 = ListTest $ map ListTest a2
+
+testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
+testHasEqv lab a1 a2 =
+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest a1
+        ma2 = map ListTest a2
+
+testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
+testMaybeEqv lab a1 a2 =
+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = (MaybeListTest a1)
+        ma2 = (MaybeListTest a2)
+
+------------------------------------------------------------
+--  Define and variable bindings
+------------------------------------------------------------
+
+vb1 :: VarBinding Int String
+vb1    = makeVarBinding [(1,"a"),(2,"b"),(3,"c")]
+vb1str = "[(1,\"a\"),(2,\"b\"),(3,\"c\")]"
+
+vb2 :: VarBinding Int String
+vb2    = makeVarBinding [(3,"c"),(2,"b"),(1,"a")]
+vb2str = "[(3,\"c\"),(2,\"b\"),(1,\"a\")]"
+
+vb3 :: VarBinding Int String
+vb3    = makeVarBinding [(1,"a"),(2,"b"),(3,"c"),(4,"d"),(5,"e")]
+vb3str = "[(1,\"a\"),(2,\"b\"),(3,\"c\"),(4,\"d\"),(5,\"e\")]"
+
+vb4 :: VarBinding Int String
+vb4 = nullVarBinding
+vb4str = "[]"
+
+testVarBinding01 = test   "testVarBinding01" $ (vb1==vb2)
+testVarBinding02 = test   "testVarBinding02" $ (vb1/=vb3)
+testVarBinding03 = test   "testVarBinding03" $ (vb1/=vb4)
+testVarBinding04 = testEq "testVarBinding04" vb1str  $ show vb1
+testVarBinding05 = testEq "testVarBinding05" vb2str  $ show vb2
+testVarBinding06 = testEq "testVarBinding06" vb4str  $ show vb4
+
+testVarBinding10 = testEq "testVarBinding10" [1,2,3] $ boundVars vb1
+testVarBinding11 = testEq "testVarBinding11" [3,2,1] $ boundVars vb2
+testVarBinding12 = testEq "testVarBinding12" []      $ boundVars vb4
+
+testVarBinding20 = test   "testVarBinding20" $ (subBinding vb1 vb2)
+testVarBinding21 = test   "testVarBinding21" $ (subBinding vb1 vb3)
+testVarBinding22 = test   "testVarBinding22" $ not (subBinding vb1 vb4)
+testVarBinding23 = test   "testVarBinding23" $ (subBinding vb2 vb1)
+testVarBinding24 = test   "testVarBinding24" $ not (subBinding vb3 vb1)
+testVarBinding25 = test   "testVarBinding25" $ (subBinding vb4 vb1)
+testVarBinding26 = test   "testVarBinding26" $ (subBinding vb4 vb4)
+
+vb5 :: VarBinding Int Int
+vb5 = makeVarBinding [(1,11),(2,22),(3,33)]
+
+testVarBinding30 = testEq "testVarBinding30"  0 $ applyVarBinding vb5 0
+testVarBinding31 = testEq "testVarBinding31" 11 $ applyVarBinding vb5 1
+testVarBinding32 = testEq "testVarBinding32" 22 $ applyVarBinding vb5 2
+testVarBinding33 = testEq "testVarBinding33" 33 $ applyVarBinding vb5 3
+testVarBinding34 = testEq "testVarBinding34"  4 $ applyVarBinding vb5 4
+testVarBinding35 = testEq "testVarBinding35" 11 $ applyVarBinding vb5 11
+
+vb6 :: VarBinding Int String
+vb6 = makeVarBinding [(3,"cc"),(4,"dd"),(5,"ee")]
+
+vb12 = joinVarBindings vb1 vb2
+vb13 = joinVarBindings vb1 vb3
+vb14 = joinVarBindings vb1 vb4
+vb16 = joinVarBindings vb1 vb6
+vb21 = joinVarBindings vb2 vb1
+vb44 = joinVarBindings vb4 vb4
+
+vb12str = vb1str
+vb13str = vb3str
+vb14str = vb1str
+vb16str = "[(1,\"a\"),(2,\"b\"),(3,\"c\"),(4,\"dd\"),(5,\"ee\")]"
+vb21str = vb2str
+vb44str = vb4str
+
+testVarBinding40 = test   "testVarBinding40" $ not (vbNull vb12)
+testVarBinding41 = test   "testVarBinding41" $ not (vbNull vb13)
+testVarBinding42 = test   "testVarBinding42" $ not (vbNull vb14)
+testVarBinding43 = test   "testVarBinding43" $ not (vbNull vb16)
+testVarBinding44 = test   "testVarBinding44" $ not (vbNull vb21)
+testVarBinding45 = test   "testVarBinding45" $ (vbNull vb44)
+
+testVarBinding50 = test   "testVarBinding50" $ (subBinding vb12 vb13)
+testVarBinding51 = test   "testVarBinding51" $ (subBinding vb12 vb14)
+testVarBinding52 = test   "testVarBinding52" $ (subBinding vb12 vb16)
+testVarBinding53 = test   "testVarBinding53" $ (subBinding vb12 vb21)
+testVarBinding54 = test   "testVarBinding54" $ not (subBinding vb12 vb44)
+testVarBinding55 = test   "testVarBinding55" $ not (subBinding vb13 vb12)
+testVarBinding56 = test   "testVarBinding56" $ (subBinding vb14 vb12)
+testVarBinding57 = test   "testVarBinding57" $ (subBinding vb44 vb12)
+testVarBinding58 = test   "testVarBinding58" $ not (subBinding vb16 vb12)
+
+testVarBinding60 = testEq "testVarBinding60" vb12str $ show vb12
+testVarBinding61 = testEq "testVarBinding61" vb13str $ show vb13
+testVarBinding62 = testEq "testVarBinding62" vb14str $ show vb14
+testVarBinding63 = testEq "testVarBinding63" vb16str $ show vb16
+testVarBinding64 = testEq "testVarBinding64" vb21str $ show vb21
+testVarBinding65 = testEq "testVarBinding65" vb44str $ show vb44
+
+testVarBinding70 = testEq "testVarBinding70" (Just "a")  $ vbMap vb16 1
+testVarBinding71 = testEq "testVarBinding71" (Just "c")  $ vbMap vb16 3
+testVarBinding72 = testEq "testVarBinding72" (Just "ee") $ vbMap vb16 5
+testVarBinding73 = testEq "testVarBinding73" Nothing     $ vbMap vb16 7
+
+testVarBindingSuite = TestList
+    [ testVarBinding01, testVarBinding02, testVarBinding03, testVarBinding04
+    , testVarBinding05, testVarBinding06
+    , testVarBinding10, testVarBinding11, testVarBinding12
+    , testVarBinding20, testVarBinding21, testVarBinding22, testVarBinding23
+    , testVarBinding24, testVarBinding25, testVarBinding26
+    , testVarBinding30, testVarBinding31, testVarBinding32, testVarBinding33
+    , testVarBinding34, testVarBinding35
+    , testVarBinding40, testVarBinding41, testVarBinding42, testVarBinding43
+    , testVarBinding44, testVarBinding45
+    , testVarBinding50, testVarBinding51, testVarBinding52, testVarBinding53
+    , testVarBinding54, testVarBinding55, testVarBinding56, testVarBinding57
+    , testVarBinding58
+    , testVarBinding60, testVarBinding61, testVarBinding62, testVarBinding63
+    , testVarBinding64, testVarBinding65
+    , testVarBinding70, testVarBinding71, testVarBinding72, testVarBinding73
+    ]
+
+------------------------------------------------------------
+--  Variable binding modifier tests
+------------------------------------------------------------
+
+vb1m :: VarBinding String Int
+vb1m    = makeVarBinding [("a",1)]
+
+vb2m :: VarBinding String Int
+vb2m    = makeVarBinding [("a",1),("b",2)]
+
+vb3m :: VarBinding String Int
+vb3m    = makeVarBinding [("a",1),("c",3)]
+
+vb4m :: VarBinding String Int
+vb4m    = makeVarBinding [("b",2),("c",3)]
+
+vb5m :: VarBinding String Int
+vb5m    = makeVarBinding [("a",1),("b",2),("c",3)]
+
+vb6m :: VarBinding String Int
+vb6m    = makeVarBinding [("a",1),("b",2),("c",4)]
+
+vb9m :: VarBinding String Int
+vb9m    = makeVarBinding [("i",9)]
+
+-- Add new bindings per vb9m
+vbm1 :: VarBindingModify String Int
+vbm1 = VarBindingModify
+    { vbmName  = swishName "vbm1"
+    , vbmApply = map (\vb -> joinVarBindings vb vb9m)
+    , vbmVocab = boundVars vb9m
+    , vbmUsage = [boundVars vb9m]
+    }
+
+[vb1m1] = vbmApply vbm1 [vb1m]
+[vb2m1] = vbmApply vbm1 [vb2m]
+
+testVarModifyName01 = testEq "testVarModifyName01"
+                        (swishName "vbm1") $
+                        vbmName vbm1
+
+testVarModify01 = testEq "testVarModify01" (Just 1) $ vbMap vb1m1 "a"
+testVarModify02 = testEq "testVarModify02" Nothing  $ vbMap vb1m1 "b"
+testVarModify03 = testEq "testVarModify03" Nothing  $ vbMap vb2m1 "c"
+testVarModify04 = testEq "testVarModify04" (Just 9) $ vbMap vb1m1 "i"
+testVarModify05 = testEq "testVarModify05" (Just 1) $ vbMap vb2m1 "a"
+testVarModify06 = testEq "testVarModify06" (Just 2) $ vbMap vb2m1 "b"
+testVarModify07 = testEq "testVarModify07" Nothing  $ vbMap vb2m1 "c"
+testVarModify08 = testEq "testVarModify08" (Just 9) $ vbMap vb2m1 "i"
+
+testVarModify10 = testEq "testVarModify10" (Just ["i"]) $
+                    vbmCompatibility vbm1 ["a","b"]
+testVarModify11 = testEq "testVarModify11" Nothing $
+                    vbmCompatibility vbm1 ["a","b","i"]
+
+-- Filter for bindings that define a
+vbm2 :: VarBindingModify String Int
+vbm2 = VarBindingModify
+    { vbmName  = swishName "vbm2"
+    , vbmApply = filter (\vb -> isJust $ vbMap vb "a")
+    , vbmVocab = ["a"]
+    , vbmUsage = [[]]
+    }
+
+vb12m2 = vbmApply vbm2 [vb1m,vb2m,vb9m]
+
+testVarModifyName02 = testEq "testVarModifyName02"
+                        (swishName "vbm2") $
+                        vbmName vbm2
+
+testVarModify20 = testEq "testVarModify20" 2 $ length vb12m2
+testVarModify21 = testEq "testVarModify21" vb1m $ vb12m2!!0
+testVarModify22 = testEq "testVarModify22" vb2m $ vb12m2!!1
+testVarModify23 = testEq "testVarModify23" (Just []) $
+                    vbmCompatibility vbm2 ["a","b"]
+testVarModify24 = testEq "testVarModify24" (Just []) $
+                    vbmCompatibility vbm2 ["a","b"]
+testVarModify25 = testEq "testVarModify25" (Just []) $
+                    vbmCompatibility vbm2 ["a","b","i"]
+testVarModify26 = testEq "testVarModify26" Nothing $
+                    vbmCompatibility vbm2 ["i"]
+
+-- Filter or add bindings so that a+b=c
+vbm3 :: VarBindingModify String Int
+vbm3 = VarBindingModify
+    { vbmName  = swishName "vbm3"
+    , vbmApply = sumBinding "a" "b" "c"
+    , vbmVocab = ["a","b","c"]
+    , vbmUsage = [[],["a"],["b"],["c"]]
+    }
+
+sumBinding :: String -> String -> String -> [VarBinding String Int]
+    -> [VarBinding String Int]
+sumBinding va vb vc vbinds = concatMap abSumc vbinds
+    where
+        abSumc :: VarBinding String Int -> [VarBinding String Int]
+        abSumc vbind =
+            abSumc1 (vbMap vbind va) (vbMap vbind vb) (vbMap vbind vc) vbind
+        abSumc1 (Just a) (Just b) (Just c) vbind
+            | (a+b) == c = [vbind]
+            | otherwise  = []
+        abSumc1 (Just a) (Just b) Nothing vbind  =
+            [ joinVarBindings vbind  $ makeVarBinding [(vc,a+b)] ]
+        abSumc1 (Just a) Nothing (Just c) vbind  =
+            [ joinVarBindings vbind  $ makeVarBinding [(vb,c-a)] ]
+        abSumc1 Nothing (Just b) (Just c) vbind  =
+            [ joinVarBindings vbind  $ makeVarBinding [(va,c-b)] ]
+        abSumc1 _ _ _ _ = []
+
+vb16m3 = vbmApply vbm3 [vb1m,vb2m,vb3m,vb4m,vb5m,vb6m]
+
+testVarModifyName03 = testEq "testVarModifyName03"
+                        (swishName "vbm3") $
+                        vbmName vbm3
+
+testVarModify30 = testEq "testVarModify30" 4 $ length vb16m3
+testVarModify31 = testEq "testVarModify31" vb5m $ (vb16m3!!0)
+testVarModify32 = testEq "testVarModify32" vb5m $ (vb16m3!!1)
+testVarModify33 = testEq "testVarModify33" vb5m $ (vb16m3!!2)
+testVarModify34 = testEq "testVarModify34" vb5m $ (vb16m3!!3)
+testVarModify35 = testEq "testVarModify35" (Just ["c"]) $
+                    vbmCompatibility vbm3 ["a","b"]
+testVarModify36 = testEq "testVarModify36" (Just ["b"]) $
+                    vbmCompatibility vbm3 ["a","c"]
+testVarModify37 = testEq "testVarModify37" (Just ["a"]) $
+                    vbmCompatibility vbm3 ["b","c","i"]
+testVarModify38 = testEq "testVarModify38" (Just []) $
+                    vbmCompatibility vbm3 ["i","c","a","b"]
+testVarModify39 = testEq "testVarModify39" Nothing $
+                    vbmCompatibility vbm3 ["i","a"]
+testVarModify40 = testEq "testVarModify40" Nothing $
+                    vbmCompatibility vbm3 ["i","b"]
+testVarModify41 = testEq "testVarModify41" Nothing $
+                    vbmCompatibility vbm3 ["i","c"]
+testVarModify42 = testEq "testVarModify42" Nothing $
+                    vbmCompatibility vbm3 ["i","d"]
+
+testVarModifySuite = TestList
+    [ testVarModifyName01, testVarModifyName02, testVarModifyName03
+    , testVarModify01, testVarModify02, testVarModify03
+    , testVarModify04, testVarModify05, testVarModify06
+    , testVarModify07, testVarModify08
+    , testVarModify10, testVarModify11
+    , testVarModify20, testVarModify21, testVarModify22
+    , testVarModify23, testVarModify24, testVarModify25
+    , testVarModify26
+    , testVarModify30, testVarModify31, testVarModify32
+    , testVarModify33, testVarModify34, testVarModify35
+    , testVarModify36, testVarModify37, testVarModify38
+    , testVarModify39, testVarModify40, testVarModify41
+    , testVarModify42
+    ]
+
+------------------------------------------------------------
+--  Variable binding modifier composition tests
+------------------------------------------------------------
+
+--  Given (1) a+b=c and (2) a+c=d, then:
+--    a=1 b=2   =>   c=3 d=4   by (1) then (2)
+--    a=1 c=3   =>   b=2 d=4   by (1) then (2) or (2) then (1)
+--    a=1 d=4   =>   b=2 c=3   by (2) then (1)
+--    b=2 c=3   =>   a=1 d=4   by (1) then (2)
+--    b=2 d=4   =>   insufficient data
+--    c=3 d=4   =>   a=1 b=2   by (2) then (1)
+
+
+-- Filter or add bindings so that a+b=c
+vbm4 :: VarBindingModify String Int
+vbm4 = VarBindingModify
+    { vbmName  = swishName "vbm4"
+    , vbmApply = sumBinding "a" "c" "d"
+    , vbmVocab = ["a","c","d"]
+    , vbmUsage = [[],["a"],["c"],["d"]]
+    }
+
+Just vbm34 = vbmCompose vbm3 vbm4
+vbm34vocab = [ "a", "b", "c", "d"]
+vbm34usage = [ ["a","d"], ["b","d"], ["c","d"]
+             , ["a"], ["b"], ["c"], ["d"], []
+             ]
+
+Just vbm43 = vbmCompose vbm4 vbm3
+vbm43vocab = [ "a", "b", "c", "d"]
+vbm43usage = [ ["a","b"], ["b","c"], ["b","d"]
+             , ["a"], ["b"], ["c"], ["d"], []
+             ]
+
+vbab :: VarBinding String Int
+vbab    = makeVarBinding [("a",1),("b",2)]
+
+vbac :: VarBinding String Int
+vbac    = makeVarBinding [("a",1),("c",3)]
+
+vbad :: VarBinding String Int
+vbad    = makeVarBinding [("a",1),("d",4)]
+
+vbbc :: VarBinding String Int
+vbbc    = makeVarBinding [("b",2),("c",3)]
+
+vbbd :: VarBinding String Int
+vbbd    = makeVarBinding [("b",2),("d",4)]
+
+vbcd :: VarBinding String Int
+vbcd    = makeVarBinding [("c",3),("d",4)]
+
+vbabcd :: VarBinding String Int
+vbabcd    = makeVarBinding [("a",1),("b",2),("c",3),("d",4)]
+
+
+testVarModifyName04 = testEq "testVarModifyName04"
+                        (swishName "vbm4") $
+                        vbmName vbm4
+
+testVarModifyName05 = testEq "testVarModifyName05"
+                        (swishName "_vbm4_vbm3_") $
+                        vbmName vbm43
+
+testVarModifyName06 = testEq "testVarModifyName06"
+                        (swishName "_vbm3_vbm4_") $
+                        vbmName vbm34
+
+testVarCompose01 = testEqv "testVarCompose01" vbm34vocab $
+                   vbmVocab vbm34
+testVarCompose02 = testEqvEqv "testVarCompose02" vbm34usage $
+                   vbmUsage vbm34
+testVarCompose03 = testMaybeEqv "testVarCompose03" (Just ["c","d"]) $
+                    vbmCompatibility vbm34 ["a","b"]
+testVarCompose04 = testMaybeEqv "testVarCompose04" (Just ["b","d"]) $
+                    vbmCompatibility vbm34 ["a","c"]
+testVarCompose05 = testMaybeEqv "testVarCompose05" Nothing $
+                    vbmCompatibility vbm34 ["a","d"]
+testVarCompose06 = testMaybeEqv "testVarCompose06" (Just ["a","d"]) $
+                    vbmCompatibility vbm34 ["b","c"]
+testVarCompose07 = testMaybeEqv "testVarCompose07" Nothing $
+                    vbmCompatibility vbm34 ["b","d"]
+testVarCompose08 = testMaybeEqv "testVarCompose08" Nothing $
+                    vbmCompatibility vbm34 ["c","d"]
+testVarCompose09 = testMaybeEqv "testVarCompose09" (Just ["a"]) $
+                    vbmCompatibility vbm34 ["b","c","d"]
+testVarCompose10 = testMaybeEqv "testVarCompose10" (Just ["b"]) $
+                    vbmCompatibility vbm34 ["a","c","d"]
+testVarCompose11 = testMaybeEqv "testVarCompose11" (Just ["c"]) $
+                    vbmCompatibility vbm34 ["a","b","d"]
+testVarCompose12 = testMaybeEqv "testVarCompose12" (Just ["d"]) $
+                    vbmCompatibility vbm34 ["a","b","c"]
+testVarCompose13 = testMaybeEqv "testVarCompose13" (Just []) $
+                    vbmCompatibility vbm34 ["a","b","c","d"]
+testVarCompose14 = testEqv "testVarCompose14" [vbabcd,vbabcd,vbabcd] $
+                    vbmApply vbm34 [vbab,vbac,vbbc]
+testVarCompose15 = testEqv "testVarCompose15" [] $
+                    vbmApply vbm34 [vbad,vbbd,vbcd]
+
+testVarCompose21 = testEqv "testVarCompose21" vbm43vocab $
+                   vbmVocab vbm43
+testVarCompose22 = testEqvEqv "testVarCompose22" vbm43usage $
+                   vbmUsage vbm43
+testVarCompose23 = testMaybeEqv "testVarCompose23" Nothing $
+                    vbmCompatibility vbm43 ["a","b"]
+testVarCompose24 = testMaybeEqv "testVarCompose24" (Just ["b","d"]) $
+                    vbmCompatibility vbm43 ["a","c"]
+testVarCompose25 = testMaybeEqv "testVarCompose25" (Just ["b","c"]) $
+                    vbmCompatibility vbm43 ["a","d"]
+testVarCompose26 = testMaybeEqv "testVarCompose26" Nothing $
+                    vbmCompatibility vbm43 ["b","c"]
+testVarCompose27 = testMaybeEqv "testVarCompose27" Nothing $
+                    vbmCompatibility vbm43 ["b","d"]
+testVarCompose28 = testMaybeEqv "testVarCompose28" (Just ["a","b"]) $
+                    vbmCompatibility vbm43 ["c","d"]
+testVarCompose29 = testMaybeEqv "testVarCompose29" (Just ["a"]) $
+                    vbmCompatibility vbm43 ["b","c","d"]
+testVarCompose30 = testMaybeEqv "testVarCompose30" (Just ["b"]) $
+                    vbmCompatibility vbm43 ["a","c","d"]
+testVarCompose31 = testMaybeEqv "testVarCompose31" (Just ["c"]) $
+                    vbmCompatibility vbm43 ["a","b","d"]
+testVarCompose32 = testMaybeEqv "testVarCompose32" (Just ["d"]) $
+                    vbmCompatibility vbm43 ["a","b","c"]
+testVarCompose33 = testMaybeEqv "testVarCompose33" (Just []) $
+                    vbmCompatibility vbm43 ["a","b","c","d"]
+testVarCompose34 = testEqv "testVarCompose34" [] $
+                    vbmApply vbm43 [vbab,vbbc,vbbd]
+testVarCompose35 = testEqv "testVarCompose35" [vbabcd,vbabcd,vbabcd] $
+                    vbmApply vbm43 [vbac,vbad,vbcd]
+
+-- [[[need test for incompatible composition]]] --
+--  Three ways to be incompatible:
+--  (a) both modifers define same new output
+--  (b) output from second modifier is input to first modifier
+
+vbm5 :: VarBindingModify String Int
+vbm5 = VarBindingModify
+    { vbmName  = swishName "vbm5"
+    , vbmApply = id                 -- incorrect: dummy for testing only
+    , vbmVocab = ["a","b","c"]
+    , vbmUsage = [["a"],["b"]]
+    }
+
+vbm6 :: VarBindingModify String Int
+vbm6 = VarBindingModify
+    { vbmName  = swishName "vbm6"
+    , vbmApply = id                 -- incorrect: dummy for testing only
+    , vbmVocab = ["a","b","c"]
+    , vbmUsage = [["a","b"],["b","c"],["a","c"]]
+    }
+
+vbm7 :: VarBindingModify String Int
+vbm7 = VarBindingModify
+    { vbmName  = swishName "vbm7"
+    , vbmApply = id                 -- incorrect: dummy for testing only
+    , vbmVocab = ["a","b","c"]
+    , vbmUsage = [["a"]]
+    }
+
+vbm8 :: VarBindingModify String Int
+vbm8 = VarBindingModify
+    { vbmName  = swishName "vbm8"
+    , vbmApply = id                 -- incorrect: dummy for testing only
+    , vbmVocab = ["b","c","d"]
+    , vbmUsage = [["b"],["c"],["b","c"]]
+    }
+
+vbm56 = vbmCompose vbm5 vbm6
+vbm65 = vbmCompose vbm6 vbm5
+vbm78 = vbmCompose vbm7 vbm8
+vbm87 = vbmCompose vbm8 vbm7
+vbm87usage = [["a","b"],["a","c"],["a","b","c"]]
+
+testVarCompose41 = test   "testVarCompose41" $ not (isJust vbm56)
+testVarCompose42 = test   "testVarCompose42" $ not (isJust vbm65)
+testVarCompose43 = test   "testVarCompose43" $ not (isJust vbm78)
+testVarCompose44 = test   "testVarCompose44" $     (isJust vbm87)
+testVarCompose45 = testEqvEqv "testVarCompose45" vbm87usage $
+                    vbmUsage (fromJust vbm87)
+
+jvbm1id    = vbmCompose vbm1 varBindingId
+jvbmid1    = vbmCompose varBindingId vbm1
+
+testVarCompose51 = test   "testVarCompose51" $ isJust jvbm1id
+testVarCompose52 = test   "testVarCompose52" $ isJust jvbmid1
+
+[vb1m1id] = vbmApply (fromJust jvbm1id) [vb1m]
+[vb2m1id] = vbmApply (fromJust jvbm1id) [vb2m]
+
+testVarModifyName07 = testEq "testVarModifyName07"
+                        (swishName "_vbm1_varBindingId_") $
+                        vbmName (fromJust jvbm1id)
+
+testVarModifyName08 = testEq "testVarModifyName08"
+                        (swishName "_varBindingId_vbm1_") $
+                        vbmName (fromJust jvbmid1)
+
+testVarCompose61 = testEq "testVarCompose61" (Just 1) $ vbMap vb1m1id "a"
+testVarCompose62 = testEq "testVarCompose62" Nothing  $ vbMap vb1m1id "b"
+testVarCompose63 = testEq "testVarCompose63" Nothing  $ vbMap vb2m1id "c"
+testVarCompose64 = testEq "testVarCompose64" (Just 9) $ vbMap vb1m1id "i"
+testVarCompose65 = testEq "testVarCompose65" (Just 1) $ vbMap vb2m1id "a"
+testVarCompose66 = testEq "testVarCompose66" (Just 2) $ vbMap vb2m1id "b"
+testVarCompose67 = testEq "testVarCompose67" Nothing  $ vbMap vb2m1id "c"
+testVarCompose68 = testEq "testVarCompose68" (Just 9) $ vbMap vb2m1id "i"
+
+[vb1mid1] = vbmApply (fromJust jvbmid1) [vb1m]
+[vb2mid1] = vbmApply (fromJust jvbmid1) [vb2m]
+
+testVarCompose71 = testEq "testVarCompose71" (Just 1) $ vbMap vb1mid1 "a"
+testVarCompose72 = testEq "testVarCompose72" Nothing  $ vbMap vb1mid1 "b"
+testVarCompose73 = testEq "testVarCompose73" Nothing  $ vbMap vb2mid1 "c"
+testVarCompose74 = testEq "testVarCompose74" (Just 9) $ vbMap vb1mid1 "i"
+testVarCompose75 = testEq "testVarCompose75" (Just 1) $ vbMap vb2mid1 "a"
+testVarCompose76 = testEq "testVarCompose76" (Just 2) $ vbMap vb2mid1 "b"
+testVarCompose77 = testEq "testVarCompose77" Nothing  $ vbMap vb2mid1 "c"
+testVarCompose78 = testEq "testVarCompose78" (Just 9) $ vbMap vb2mid1 "i"
+
+testVarComposeSuite = TestList
+    [ testVarModifyName04, testVarModifyName05, testVarModifyName06
+    , testVarModifyName07, testVarModifyName08
+    , testVarCompose01, testVarCompose02, testVarCompose03, testVarCompose04
+    , testVarCompose05, testVarCompose06, testVarCompose07, testVarCompose08
+    , testVarCompose09, testVarCompose10, testVarCompose11, testVarCompose12
+    , testVarCompose13, testVarCompose14, testVarCompose15
+    , testVarCompose21, testVarCompose22, testVarCompose23, testVarCompose24
+    , testVarCompose25, testVarCompose26, testVarCompose27, testVarCompose28
+    , testVarCompose29, testVarCompose30, testVarCompose31, testVarCompose32
+    , testVarCompose33, testVarCompose34, testVarCompose35
+    , testVarCompose41, testVarCompose42, testVarCompose43, testVarCompose44
+    , testVarCompose45
+    , testVarCompose51, testVarCompose52
+    , testVarCompose61, testVarCompose62, testVarCompose63, testVarCompose64
+    , testVarCompose65, testVarCompose66, testVarCompose67, testVarCompose68
+    , testVarCompose71, testVarCompose72, testVarCompose73, testVarCompose74
+    , testVarCompose75, testVarCompose76, testVarCompose77, testVarCompose78
+    ]
+
+------------------------------------------------------------
+--  Modifier composition discovery tests
+------------------------------------------------------------
+
+--  vbm3: a+b=c (1)
+--  vbm4: a+c=d (2)
+--  vbm9: c+d=e (3)
+--
+--  a,b -> c,d,e  by (1,2,3)
+--  a,c -> b,d,e  by (1,2,3)
+--         d,b,e  by (2,1,3)
+--         d,e,b  by (2,3,1)
+--  a,d -> c,b,e  by (2,1,3)
+--         c,e,b  by (2,3,1)
+--  a,e -> None
+--  b,c -> a,d,e  by (1,2,3)
+--  b,d -> None
+--  b,e -> None
+--  c,d -> a,b,e  by (2,1,3)
+--      -> a,e,a  by (2,3,1)
+--      -> e,a,b  by (3,2,1)
+--  c,e -> d,a,b  by (3,2,1)
+--  d,e -> c,a,b  by (3,2,1)
+
+vbm9 :: VarBindingModify String Int
+vbm9 = VarBindingModify
+    { vbmName  = swishName "vbm9"
+    , vbmApply = sumBinding "c" "d" "e"
+    , vbmVocab = ["c","d","e"]
+    , vbmUsage = [[],["c"],["d"],["e"]]
+    }
+
+compab = findCompositions [vbm3,vbm4,vbm9] ["a","b"]    -- 1
+compac = findCompositions [vbm3,vbm4,vbm9] ["a","c"]    -- 3
+compad = findCompositions [vbm3,vbm4,vbm9] ["a","d"]    -- 2
+compae = findCompositions [vbm3,vbm4,vbm9] ["a","e"]    -- 0
+compba = findCompositions [vbm3,vbm4,vbm9] ["b","a"]    -- 1
+compbc = findCompositions [vbm3,vbm4,vbm9] ["b","c"]    -- 1
+compbd = findCompositions [vbm3,vbm4,vbm9] ["b","d"]    -- 0
+compbe = findCompositions [vbm3,vbm4,vbm9] ["b","e"]    -- 0
+compca = findCompositions [vbm3,vbm4,vbm9] ["c","a"]    -- 3
+compcd = findCompositions [vbm3,vbm4,vbm9] ["c","d"]    -- 3
+compce = findCompositions [vbm3,vbm4,vbm9] ["c","e"]    -- 1
+compde = findCompositions [vbm3,vbm4,vbm9] ["d","e"]    -- 1
+
+testVarModifyName09 = testEq "testVarModifyName08"
+                        (swishName "__vbm4_vbm3__vbm9_") $
+                        vbmName (compad!!0)
+
+testVarModifyName10 = testEq "testVarModifyName08"
+                        (swishName "__vbm4_vbm9__vbm3_") $
+                        vbmName (compad!!1)
+
+testFindComp01 = testEq "testFindComp01" 1 $ (length compab)
+testFindComp02 = testEq "testFindComp02" 3 $ (length compac)
+testFindComp03 = testEq "testFindComp03" 2 $ (length compad)
+testFindComp04 = testEq "testFindComp04" 0 $ (length compae)
+testFindComp05 = testEq "testFindComp05" 1 $ (length compba)
+testFindComp06 = testEq "testFindComp06" 1 $ (length compbc)
+testFindComp07 = testEq "testFindComp07" 0 $ (length compbd)
+testFindComp08 = testEq "testFindComp08" 0 $ (length compbe)
+testFindComp09 = testEq "testFindComp09" 3 $ (length compca)
+testFindComp10 = testEq "testFindComp10" 3 $ (length compcd)
+testFindComp11 = testEq "testFindComp11" 1 $ (length compce)
+testFindComp12 = testEq "testFindComp12" 1 $ (length compde)
+
+compvocab = ["a","b","c","d","e"]
+
+testFindComp21 = testEqv "testFindComp21" compvocab $ vbmVocab (head compab)
+testFindComp22 = testEqv "testFindComp22" compvocab $ vbmVocab (head compac)
+testFindComp23 = testEqv "testFindComp23" compvocab $ vbmVocab (head compad)
+testFindComp24 = testEqv "testFindComp24" compvocab $ vbmVocab (head compba)
+testFindComp25 = testEqv "testFindComp25" compvocab $ vbmVocab (head compbc)
+testFindComp26 = testEqv "testFindComp26" compvocab $ vbmVocab (head compca)
+testFindComp27 = testEqv "testFindComp27" compvocab $ vbmVocab (head compcd)
+testFindComp28 = testEqv "testFindComp28" compvocab $ vbmVocab (head compce)
+testFindComp29 = testEqv "testFindComp29" compvocab $ vbmVocab (head compde)
+
+testFindComp31 = testHasEqv "testFindComp31" ["c","d","e"] $ vbmUsage (head compab)
+testFindComp32 = testHasEqv "testFindComp32" ["b","d","e"] $ vbmUsage (head compac)
+testFindComp33 = testHasEqv "testFindComp33" ["b","c","e"] $ vbmUsage (head compad)
+testFindComp34 = testHasEqv "testFindComp34" ["c","d","e"] $ vbmUsage (head compba)
+testFindComp35 = testHasEqv "testFindComp35" ["a","d","e"] $ vbmUsage (head compbc)
+testFindComp36 = testHasEqv "testFindComp36" ["b","d","e"] $ vbmUsage (head compca)
+testFindComp37 = testHasEqv "testFindComp37" ["a","b","e"] $ vbmUsage (head compcd)
+testFindComp38 = testHasEqv "testFindComp38" ["a","b","d"] $ vbmUsage (head compce)
+testFindComp39 = testHasEqv "testFindComp39" ["a","b","c"] $ vbmUsage (head compde)
+
+compBindings :: [VarBinding String Int]
+compBindings = map makeVarBinding
+    [ [ ("a",1), ("b",2) ]
+    , [ ("a",1), ("c",3) ]
+    , [ ("a",1), ("d",4) ]
+    , [ ("a",1), ("e",7) ]
+    , [ ("b",2), ("c",3) ]
+    , [ ("b",2), ("d",4) ]
+    , [ ("b",2), ("e",7) ]
+    , [ ("c",3), ("d",4) ]
+    , [ ("c",3), ("e",7) ]
+    , [ ("d",4), ("e",7) ]
+    ]
+
+compResult :: [VarBinding String Int]
+compResult = map makeVarBinding
+    [ [ ("a",1), ("b",2), ("c",3), ("d",4), ("e",7) ] ]
+
+compApply :: [VarBindingModify String Int] -> [VarBinding String Int]
+compApply vbms = (vbmApply (head vbms)) compBindings
+
+testFindComp41 = testEqv "testFindComp41" compResult $ (compApply compab)
+testFindComp42 = testEqv "testFindComp42" compResult $ (compApply compac)
+testFindComp43 = testEqv "testFindComp43" compResult $ (compApply compad)
+testFindComp44 = testEqv "testFindComp44" compResult $ (compApply compba)
+testFindComp45 = testEqv "testFindComp45" compResult $ (compApply compbc)
+testFindComp46 = testEqv "testFindComp46" compResult $ (compApply compca)
+testFindComp47 = testEqv "testFindComp47" compResult $ (compApply compcd)
+testFindComp48 = testEqv "testFindComp48" compResult $ (compApply compce)
+testFindComp49 = testEqv "testFindComp49" compResult $ (compApply compde)
+
+jcompab = findComposition [vbm3,vbm4,vbm9] ["a","b"]    -- 1
+jcompac = findComposition [vbm3,vbm4,vbm9] ["a","c"]    -- 3
+jcompad = findComposition [vbm3,vbm4,vbm9] ["a","d"]    -- 1
+jcompae = findComposition [vbm3,vbm4,vbm9] ["a","e"]    -- 0
+jcompba = findComposition [vbm3,vbm4,vbm9] ["b","a"]    -- 1
+jcompbc = findComposition [vbm3,vbm4,vbm9] ["b","c"]    -- 1
+jcompbd = findComposition [vbm3,vbm4,vbm9] ["b","d"]    -- 0
+jcompbe = findComposition [vbm3,vbm4,vbm9] ["b","e"]    -- 0
+jcompca = findComposition [vbm3,vbm4,vbm9] ["c","a"]    -- 3
+jcompcd = findComposition [vbm3,vbm4,vbm9] ["c","d"]    -- 3
+jcompce = findComposition [vbm3,vbm4,vbm9] ["c","e"]    -- 1
+jcompde = findComposition [vbm3,vbm4,vbm9] ["d","e"]    -- 1
+
+testFindComp51 = testJust    "testFindComp51" jcompab
+testFindComp52 = testJust    "testFindComp52" jcompac
+testFindComp53 = testJust    "testFindComp53" jcompad
+testFindComp54 = testNothing "testFindComp54" jcompae
+testFindComp55 = testJust    "testFindComp55" jcompba
+testFindComp56 = testJust    "testFindComp56" jcompbc
+testFindComp57 = testNothing "testFindComp57" jcompbd
+testFindComp58 = testNothing "testFindComp58" jcompbe
+testFindComp59 = testJust    "testFindComp59" jcompca
+testFindComp60 = testJust    "testFindComp60" jcompcd
+testFindComp61 = testJust    "testFindComp61" jcompce
+testFindComp62 = testJust    "testFindComp62" jcompde
+
+testFindCompSuite = TestList
+    [ testVarModifyName09, testVarModifyName10
+    , testFindComp01, testFindComp02, testFindComp03, testFindComp04
+    , testFindComp05, testFindComp06, testFindComp07, testFindComp08
+    , testFindComp09, testFindComp10, testFindComp11, testFindComp12
+    , testFindComp21, testFindComp22, testFindComp23, testFindComp24
+    , testFindComp25, testFindComp26, testFindComp27, testFindComp28
+    , testFindComp29
+    , testFindComp31, testFindComp32, testFindComp33, testFindComp34
+    , testFindComp35, testFindComp36, testFindComp37, testFindComp38
+    , testFindComp39
+    , testFindComp41, testFindComp42, testFindComp43, testFindComp44
+    , testFindComp45, testFindComp46, testFindComp47, testFindComp48
+    , testFindComp49
+    ]
+
+------------------------------------------------------------
+--  Variable binding filters
+------------------------------------------------------------
+
+testFilterBindings :: [VarBinding String Int]
+testFilterBindings = map makeVarBinding
+    [ [ ("a",0), ("b",2), ("c",2) ]
+    , [ ("a",0), ("b",2), ("c",3) ]
+    , [ ("a",1), ("b",2), ("c",2) ]
+    , [ ("a",1), ("b",2), ("c",3) ]
+    , [ ("a",1), ("b",2), ("c",0) ]
+    , [ ("a",0), ("b",2), ("c",0) ]
+    , [ ("a",4), ("b",2), ("c",4) ]
+    , [ ("x",4), ("y",2), ("z",4) ]
+    ]
+
+filtertesta0 :: VarBindingModify String Int
+filtertesta0 = makeVarFilterModify $
+        makeVarTestFilter (swishName "filtertesta0") (==0) "a"
+vba0 :: [VarBinding String Int]
+vba0 = map makeVarBinding
+    [ [ ("a",0), ("b",2), ("c",2) ]
+    , [ ("a",0), ("b",2), ("c",3) ]
+    , [ ("a",0), ("b",2), ("c",0) ]
+    ]
+
+filtertestc0 :: VarBindingModify String Int
+filtertestc0 = makeVarFilterModify $
+        makeVarTestFilter (swishName "filtertestc0") (==0) "c"
+vbc0 :: [VarBinding String Int]
+vbc0 = map makeVarBinding
+    [ [ ("a",1), ("b",2), ("c",0) ]
+    , [ ("a",0), ("b",2), ("c",0) ]
+    ]
+
+filtercompabeq :: VarBindingModify String Int
+filtercompabeq = makeVarFilterModify $ varFilterEQ "a" "b"
+vbabeq :: [VarBinding String Int]
+vbabeq = map makeVarBinding
+    [ ]
+
+filtercompaceq :: VarBindingModify String Int
+filtercompaceq = makeVarFilterModify $ varFilterEQ "a" "c"
+vbaceq :: [VarBinding String Int]
+vbaceq = map makeVarBinding
+    [ [ ("a",0), ("b",2), ("c",0) ]
+    , [ ("a",4), ("b",2), ("c",4) ]
+    ]
+
+filtercompbceq :: VarBindingModify String Int
+filtercompbceq = makeVarFilterModify $ varFilterEQ "b" "c"
+vbbceq :: [VarBinding String Int]
+vbbceq = map makeVarBinding
+    [ [ ("a",0), ("b",2), ("c",2) ]
+    , [ ("a",1), ("b",2), ("c",2) ]
+    ]
+
+filtercompbcne :: VarBindingModify String Int
+filtercompbcne = makeVarFilterModify $ varFilterNE "b" "c"
+vbbcne :: [VarBinding String Int]
+vbbcne = map makeVarBinding
+    [ [ ("a",0), ("b",2), ("c",3) ]
+    , [ ("a",1), ("b",2), ("c",3) ]
+    , [ ("a",1), ("b",2), ("c",0) ]
+    , [ ("a",0), ("b",2), ("c",0) ]
+    , [ ("a",4), ("b",2), ("c",4) ]
+    ]
+
+filterdisjunct :: VarBindingModify String Int
+filterdisjunct = makeVarFilterModify $
+                 varFilterDisjunction
+                    [ makeVarTestFilter (swishName "isZero") (==0) "a"
+                    , varFilterEQ "a" "c"]
+vbdisj = vbaceq `union` vba0
+
+filterconjunct :: VarBindingModify String Int
+filterconjunct = makeVarFilterModify $
+                 varFilterConjunction
+                    [ makeVarTestFilter (swishName "isZero") (==0) "a"
+                    , varFilterEQ "a" "c"]
+vbconj = vbaceq `intersect` vba0
+
+testFilterName01 = testEq "testFilterName01" (swishName "filtertesta0") $
+                    vbmName filtertesta0
+testFilterName02 = testEq "testFilterName02" (swishName "filtertestc0") $
+                    vbmName filtertestc0
+testFilterName03 = testEq "testFilterName03" (swishName "varFilterEQ") $
+                    vbmName filtercompabeq
+testFilterName04 = testEq "testFilterName04" (swishName "varFilterNE") $
+                    vbmName filtercompbcne
+testFilterName05 = testEq "testFilterName05" (swishName "varFilterDisjunction") $
+                    vbmName filterdisjunct
+testFilterName06 = testEq "testFilterName06" (swishName "varFilterConjunction") $
+                    vbmName filterconjunct
+
+testFilter01 = testEqv "testFilter01" vba0   $ vbmApply filtertesta0   testFilterBindings
+testFilter02 = testEqv "testFilter02" vbc0   $ vbmApply filtertestc0   testFilterBindings
+testFilter03 = testEqv "testFilter03" vbabeq $ vbmApply filtercompabeq testFilterBindings
+testFilter04 = testEqv "testFilter04" vbaceq $ vbmApply filtercompaceq testFilterBindings
+testFilter05 = testEqv "testFilter05" vbbceq $ vbmApply filtercompbceq testFilterBindings
+testFilter06 = testEqv "testFilter06" vbbcne $ vbmApply filtercompbcne testFilterBindings
+testFilter07 = testEqv "testFilter07" vbdisj $ vbmApply filterdisjunct testFilterBindings
+testFilter08 = testEqv "testFilter08" vbconj $ vbmApply filterconjunct testFilterBindings
+
+testFilter10 = testEqv "testFilter10" testFilterBindings $
+                vbmApply varBindingId testFilterBindings
+
+testFilterSuite = TestList
+    [ testFilterName01, testFilterName02, testFilterName03
+    , testFilterName04, testFilterName05, testFilterName06
+    , testFilter01, testFilter02, testFilter03, testFilter04
+    , testFilter05, testFilter06, testFilter07, testFilter08
+    , testFilter10
+    ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+    [ testVarBindingSuite
+    , testVarModifySuite
+    , testVarComposeSuite
+    , testFindCompSuite
+    , testFilterSuite
+    ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/VarBindingTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.6 $
+-- $Log: VarBindingTest.hs,v $
+-- Revision 1.6  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.5  2003/12/08 16:58:27  graham
+-- Add name to variable binding modifiers and filters.
+-- Add namespace for Swish-defined names.
+--
+-- Revision 1.4  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.3  2003/10/15 16:40:52  graham
+-- Reworked RDFQuery to use new query binding framework.
+-- (Note: still uses VarBindingFilter rather than VarBindingModify.
+-- The intent is to incorproate the VarBindingModify logic into RDFProof,
+-- displaying the existing use of BindingFilter.)
+--
+-- Revision 1.2  2003/10/15 00:07:01  graham
+-- Added variable binding filter structures, and some common filters
+--
+-- Revision 1.1  2003/10/14 20:30:58  graham
+-- Add separate module for generic variable binding functions.
+--

+ Swish/HaskellRDF/Vocabulary.hs view
@@ -0,0 +1,314 @@+--------------------------------------------------------------------------------
+--  $Id: Vocabulary.hs,v 1.7 2004/01/07 19:49:13 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Vocabulary
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines some commonly used vocabulary terms,
+--  using the Namespace and ScopedName data types.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellRDF.Vocabulary
+    ( namespaceNull
+    , namespaceRDF
+    , namespaceRDFS
+    , namespaceRDFD
+    , namespaceRDFC
+    , namespaceRDFO
+    , namespaceOWL
+    , namespaceXSD
+    , namespaceXsdType
+    , namespaceMATH
+    , namespaceLOG
+    , namespaceDAML
+    , namespaceDefault
+    , namespaceSwish, swishName
+    , namespaceLang,  langName, langTag, isLang
+    , scopeRDF
+    , scopeRDFS
+    , scopeRDFD
+    , rdf_datatype, rdf_resource, rdf_about, rdf_ID
+    , rdf_type
+    , rdf_first, rdf_rest, rdf_nil, rdf_XMLLiteral
+    , rdfs_member
+    , rdfd_GeneralRestriction
+    , rdfd_onProperties, rdfd_constraint, rdfd_maxCardinality
+    , owl_sameAs
+    , xsd_type, xsd_string, xsd_boolean
+    , xsd_decimal, xsd_integer
+    , xsd_nonneg_integer, xsd_nonpos_integer, xsd_pos_integer, xsd_neg_integer
+    , xsd_float, xsd_double
+    , operator_plus, operator_minus, operator_slash, operator_star
+    , default_base
+    )
+where
+
+import Swish.HaskellUtils.Namespace
+    ( Namespace(..), ScopedName(..) )
+
+import Swish.HaskellUtils.MiscHelpers
+    ( lower )
+
+------------------------------------------------------------
+--  Define some common namespace values
+------------------------------------------------------------
+
+namespaceNull :: Namespace+namespaceNull
+    = Namespace "" ""
+
+namespaceRDF :: Namespace+namespaceRDF    =
+    Namespace   "rdf"   "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+
+namespaceRDFS :: Namespace+namespaceRDFS   =
+    Namespace   "rdfs"  "http://www.w3.org/2000/01/rdf-schema#"
+
+namespaceRDFD :: Namespace+namespaceRDFD   =
+    Namespace   "rdfd"  "http://id.ninebynine.org/2003/rdfext/rdfd#"
+
+namespaceRDFC :: Namespace+namespaceRDFC   =
+    Namespace   "rdfc"  "http://id.ninebynine.org/2003/rdfext/rdfc#"
+
+namespaceRDFO :: Namespace+namespaceRDFO   =
+    Namespace   "rdfo"  "http://id.ninebynine.org/2003/rdfext/rdfo#"
+
+namespaceOWL :: Namespace+namespaceOWL    =
+    Namespace   "owl"   "http://www.w3.org/2002/07/owl#"
+
+namespaceXSD :: Namespace+namespaceXSD    =
+    Namespace   "xsd"   "http://www.w3.org/2001/XMLSchema#"
+
+namespaceXsdType :: String -> Namespace+namespaceXsdType dtname =
+    Namespace   ("xsd_"++dtname)
+                ("http://id.ninebynine.org/2003/XMLSchema/"++dtname++"#")
+
+namespaceMATH :: Namespace+namespaceMATH   =
+    Namespace   "math"  "http://www.w3.org/2000/10/swap/math#"
+
+namespaceLOG :: Namespace+namespaceLOG    =
+    Namespace   "log"   "http://www.w3.org/2000/10/swap/log.n3#"
+
+namespaceDAML :: Namespace+namespaceDAML   =
+    Namespace   "daml"  "http://www.daml.org/2000/10/daml-ont#"
+
+namespaceDefault :: Namespace+namespaceDefault
+    = Namespace "default" "http://id.ninebynine.org/default/"
+
+namespaceSwish :: Namespace+namespaceSwish
+    = Namespace "swish" "http://id.ninebynine.org/2003/Swish/"
+
+swishName :: String -> ScopedName
+swishName local = ScopedName namespaceSwish local
+
+-----------------------------------------------------------
+--  Language tags
+------------------------------------------------------------
+--
+--  Note:  simple language tag URIs may be abbreviated as lang:tag,
+--  but if the tag contains ahyphen, this would not be valid QName
+--  form in Notation3, even though it is a valid QName component.
+--  Fortunately, they do not currently need to appear in Notation3 as
+--  distinct labels (but future developments m,ay change that).
+
+namespaceLang :: Namespace
+namespaceLang
+    = Namespace "lang" "http://id.ninebynine.org/2003/Swish/Lang/"
+    -- To be replaced by urn:ietf:params:lang?
+
+langName :: String -> ScopedName
+langName tag = ScopedName namespaceLang (lower tag)
+
+langTag :: ScopedName -> String
+langTag sname = snLocal sname
+
+isLang :: ScopedName -> Bool
+isLang sname = snScope sname == namespaceLang
+
+------------------------------------------------------------
+--  Define namespaces for RDF rules, axioms, etc
+------------------------------------------------------------
+
+scopeRDF :: Namespace+scopeRDF        =
+    Namespace   "rs_rdf"   "http://id.ninebynine.org/2003/Ruleset/rdf#"
+
+scopeRDFS :: Namespace+scopeRDFS       =
+    Namespace   "rs_rdfs"  "http://id.ninebynine.org/2003/Ruleset/rdfs#"
+
+scopeRDFD :: Namespace+scopeRDFD       =
+    Namespace   "rs_rdfd"  "http://id.ninebynine.org/2003/Ruleset/rdfd#"
+
+------------------------------------------------------------
+--  Define some common vocabulary terms
+------------------------------------------------------------
+
+rdf_datatype            :: ScopedName+rdf_datatype            = ScopedName namespaceRDF  "datatype"
++rdf_resource            :: ScopedName+rdf_resource            = ScopedName namespaceRDF  "resource"
++rdf_about               :: ScopedName+rdf_about               = ScopedName namespaceRDF  "about"
++rdf_ID                  :: ScopedName+rdf_ID                  = ScopedName namespaceRDF  "ID"
+
+rdf_type                :: ScopedName+rdf_type                = ScopedName namespaceRDF  "type"
++rdf_first               :: ScopedName+rdf_first               = ScopedName namespaceRDF  "first"
++rdf_rest                :: ScopedName+rdf_rest                = ScopedName namespaceRDF  "rest"
++rdf_nil                 :: ScopedName+rdf_nil                 = ScopedName namespaceRDF  "nil"
++rdf_XMLLiteral          :: ScopedName+rdf_XMLLiteral          = ScopedName namespaceRDF  "XMLLiteral"
+
+rdfs_member             :: ScopedName+rdfs_member             = ScopedName namespaceRDFS "member"
+
+rdfd_GeneralRestriction :: ScopedName+rdfd_GeneralRestriction = ScopedName namespaceRDFD "GeneralRestriction"
++rdfd_onProperties       :: ScopedName+rdfd_onProperties       = ScopedName namespaceRDFD "onProperties"
++rdfd_constraint         :: ScopedName+rdfd_constraint         = ScopedName namespaceRDFD "constraint"
++rdfd_maxCardinality     :: ScopedName+rdfd_maxCardinality     = ScopedName namespaceRDFD "maxCardinality"
+
+xsd_type                :: String -> ScopedName+xsd_type typnam         = ScopedName namespaceXSD  typnam
++xsd_string              :: ScopedName+xsd_string              = xsd_type "string"
++xsd_boolean             :: ScopedName+xsd_boolean             = xsd_type "boolean"
++xsd_decimal             :: ScopedName+xsd_decimal             = xsd_type "decimal"
++xsd_integer             :: ScopedName+xsd_integer             = xsd_type "integer"
++xsd_nonneg_integer      :: ScopedName+xsd_nonneg_integer      = xsd_type "nonNegativeInteger"
++xsd_nonpos_integer      :: ScopedName+xsd_nonpos_integer      = xsd_type "nonPositiveInteger"
++xsd_pos_integer         :: ScopedName+xsd_pos_integer         = xsd_type "positiveInteger"
++xsd_neg_integer         :: ScopedName+xsd_neg_integer         = xsd_type "negativeInteger"
++xsd_float               :: ScopedName+xsd_float               = xsd_type "float"
++xsd_double              :: ScopedName+xsd_double              = xsd_type "double"
+
+owl_sameAs              :: ScopedName+owl_sameAs              = ScopedName namespaceOWL  "sameAs"
+
+operator_plus           :: ScopedName+operator_plus           = ScopedName namespaceRDFO "plus"
++operator_minus          :: ScopedName+operator_minus          = ScopedName namespaceRDFO "minus"
++operator_slash          :: ScopedName+operator_slash          = ScopedName namespaceRDFO "slash"
++operator_star           :: ScopedName+operator_star           = ScopedName namespaceRDFO "star"
+
+default_base            :: ScopedName+default_base            = ScopedName namespaceDefault "base"
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellRDF/Vocabulary.hs,v $
+-- $Author: graham $
+-- $Revision: 1.7 $
+-- $Log: Vocabulary.hs,v $
+-- Revision 1.7  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.6  2004/01/06 16:29:56  graham
+-- Fix up module exports to avoid GHC warnings
+--
+-- Revision 1.5  2003/12/16 07:05:37  graham
+-- Working on updated RDFProofContext
+--
+-- Revision 1.4  2003/12/11 19:11:07  graham
+-- Script processor passes all initial tests.
+--
+-- Revision 1.3  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.2  2003/12/08 16:58:27  graham
+-- Add name to variable binding modifiers and filters.
+-- Add namespace for Swish-defined names.
+--
+-- Revision 1.1  2003/11/24 17:20:35  graham
+-- Separate module Vocabulary from module Namespace.
+--

+ Swish/HaskellUtils/AccumulateM.hs view
@@ -0,0 +1,143 @@+{-# OPTIONS -XMultiParamTypeClasses #-}+{-# OPTIONS -XFunctionalDependencies #-}+{-# OPTIONS -XFlexibleInstances #-}++--------------------------------------------------------------------------------
+--  $Id: AccumulateM.hs,v 1.3 2004/01/22 19:53:46 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  AccummulateM
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a monadic accumulator type.  The plan is that it be
+--  used in conjunction with FunctorM and similar constructs to accumulate
+--  some or all of the values visited.
+--
+--  Using a monad of type Accumulator, which wraps some type 'c' and is
+--  also declared to be an instance of MonadAccum Accumulator c e, for some e,
+--  then foldM can be used to accumulate values of type e with an initial
+--  value of type c with the instance-supplied growVal method.
+--
+--  This module also declares accumulator instances for Int, Integer and list
+--  datatypes.
+--
+--  This is all very well, but rather unnecessary:  it is just as easy, and
+--  more standard (hence easier for other Haskell programmers to follow),
+--  to use a state monad with a nullary return type; e.g.
+--     execsState (stateMonadExpr) initialState
+--  which returns the final state value.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.AccumulateM
+    ( Accumulator(..) )
+where
+
+import Control.Monad
+    ( foldM )
+
++class (Monad m) => MonadAccum m c e | m c -> e where
+    growVal :: c -> e -> m c
+    reapVal :: m c -> c
+
+data Accumulator c = Accumulator c deriving (Eq, Show)
+
+instance Monad Accumulator where
+    (Accumulator v) >>= k  = k v
+    return v               = Accumulator v
+
+instance MonadAccum Accumulator Int Int where
+    growVal n m             = Accumulator (n+m)
+    reapVal (Accumulator n) = n
+
+instance MonadAccum Accumulator Integer Integer where
+    growVal n m             = Accumulator (n+m)
+    reapVal (Accumulator n) = n
+
+instance MonadAccum Accumulator [v] v where
+    growVal vs v             = Accumulator (v:vs)
+    reapVal (Accumulator vs) = vs
+
+
+--  Tests
+addVal :: Int -> Int -> (Accumulator Int)
+addVal m n = Accumulator (n+m)
+
+testList  = [1,2,3,4,5,6] :: [Int]
+testList1 = [1,2,3,4,5,6] :: [Integer]
+testList2 = "plugh"
+
+test1 = foldM addVal 0 testList
+test2 = Accumulator 0
+test3 = (Accumulator 0) >>= addVal 1
+test4 = (Accumulator 5) >>= addVal 5
+test5 = (growVal 3 :: Int -> Accumulator Int) 20
+test6 = foldM growVal 0 testList  :: Accumulator Int
+test7 = foldM growVal 0 testList1 :: Accumulator Integer
+test8 = reapVal (foldM growVal 0  testList  :: Accumulator Int)
+test9 = reapVal (foldM growVal [] testList2 :: Accumulator [Char])
+
+test = and
+    [ test1 == Accumulator 21
+    , test2 == Accumulator 0
+    , test3 == Accumulator 1
+    , test4 == Accumulator 10
+    , test5 == Accumulator 23
+    , test6 == Accumulator 21
+    , test7 == Accumulator 21
+    , test8 == 21
+    , test9 == "hgulp"
+    ]
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/AccumulateM.hs,v $
+-- $Author: graham $
+-- $Revision: 1.3 $
+-- $Log: AccumulateM.hs,v $
+-- Revision 1.3  2004/01/22 19:53:46  graham
+-- Sync.
+--
+-- Revision 1.2  2004/01/13 17:12:08  graham
+-- Complete functionality of AccumulateM, using functional dependencies
+-- in the MonadAccum type class.
+--
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.2  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.1  2003/06/12 00:49:04  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--
+ Swish/HaskellUtils/DateTime.hs view
@@ -0,0 +1,391 @@+--------------------------------------------------------------------------------
+--  $Id: DateTime.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  DateTime
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This Module defines a collection of date/time manipulation functions.
+--
+--  Date/time value manipulation.
+--
+--  Date/time can be date-only or time-only
+--
+--  type DateTime is an instance of built-in classes Eq and Show
+--  type DateTime has a constructor that accepts a string in the format
+--      defined by RFC 3339.
+--      Timezone interpretation is per RFC3339.
+--
+--------------------------------------------------------------------------------
+--
+--            year,month,day,hour,min,sec,millisec,timezone
+--class (Show a,Eq a) => DateTimeClass a where
+--  newDateTime  :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> a
+--  toString     :: a -> String
+--  size         :: a -> Int
+--  toDateTime   :: String -> a
+--  toDate       :: String -> a
+--  toTime       :: String -> a
+--  (==)         :: a -> a -> Bool   -- same date/time
+--  (<)        :: a -> a -> Bool   -- first precedes second
+--  (+)        :: a -> a -> a  -- advance by time
+--  (-)        :: a -> a -> a  -- difference between times
+--  dtShow     :: a -> String             -- return string form
+--  dtYear       :: a -> Int
+--  dtMonth      :: a -> Int
+--  dtDay        :: a -> Int
+--  dtHour       :: a -> Int
+--  dtMinute     :: a -> Int
+--  dtSecond     :: a -> Int
+--  dtMillisecs  :: a -> Int
+--  dtTimezone   :: a -> Int                -- time zone offset in minutes
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.DateTime where
+
+data DateTime
+  = DateTime Int Int Int Int Int Int Int Int
+
+instance Eq DateTime where
+  d1 == d2 = simpleEq ( normTZ d1 ) ( normTZ d2 )
+
+instance Show DateTime where
+  show dt = dtShow dt
+
+instance Ord DateTime where
+  dt1 <  dt2  = simpleLT ( normTZ dt1 ) ( normTZ dt2 )
+  dt1 >  dt2  = dt2 < dt1
+  dt1 <= dt2  = (dt1 < dt2)||(dt1==dt2)
+  dt1 >= dt2  = (dt2 < dt1)||(dt1==dt2)
+
+leapYear :: Int -> Bool
+leapYear year
+  | ( year `mod` 4 == 0 ) &&
+    not ( ( year `mod` 100 == 0 ) &&
+          not ( year `mod` 400 == 0 ) ) = True
+  | otherwise                           = False
+
+daysInMonth :: Int -> Int -> Int
+daysInMonth month year
+  | month==1   = 31  --Jan
+  | month==2   = if leapYear year then 29 else 28 --Feb
+  | month==3   = 31  --Mar
+  | month==4   = 30  --Apr
+  | month==5   = 31  --May
+  | month==6   = 30  --Jun
+  | month==7   = 31  --Jul
+  | month==8   = 31  --Aug
+  | month==9   = 30  --Sep
+  | month==10  = 31  --Oct
+  | month==11  = 30  --Nov
+  | month==12  = 31  --Dec
+  | otherwise  = 0
+
+validJulianDate :: Int -> Int -> Int -> Bool
+validJulianDate yr mo da
+  | yr < 1900                = False
+  | mo > 12                  = False
+  | da > (daysInMonth mo yr) = False
+  | otherwise                = True
+
+toJulianDate1 :: DateTime -> Int
+toJulianDate1 (DateTime y m d _ _ _ _ _) = toJulianDate y m d
+
+toJulianDate :: Int -> Int -> Int -> Int
+toJulianDate year month day
+--  | not (validJulianDate year month day) = -1
+  | year==1900 && month<=2               = if month==2 then day + 30 else day - 1
+  | month>=3                             = toJD1 (year-1900) (month-3) (day)
+  | otherwise                            = toJD1 (year-1901) (month+9) (day)
+  where
+    toJD1 :: Int -> Int -> Int -> Int
+    toJD1 year month day
+      = ( (1461*year) `div` 4 ) -
+        (year `div` 100) +
+        ((year+300) `div` 400) +
+        ( ( (153*month) + 2 ) `div` 5 ) +
+        day + 58
+
+fromJulianDate:: Int -> DateTime
+fromJulianDate jdate
+  | jdate <= 58 = fromJD1 jdate
+  | otherwise   = fromJD2 jdate
+  where
+    fromJD1 :: Int -> DateTime
+    fromJD1 jdate
+      | jdate<=30 = (DateTime 1900 1 (jdate+1 ) 0 0 0 0 0)
+      | otherwise = (DateTime 1900 2 (jdate-30) 0 0 0 0 0)
+
+    fromJD2 :: Int -> DateTime
+    fromJD2 j
+      = DateTime y2 m2 d1 0 0 0 0 0
+      where
+--          t1 = (400*(j+((j+36467)`div`36525)-((j+109517)`div`dc))) - 23638 -- 1/400-days from 1900-02-28 [t]
+          t1 = (400*
+                    (j
+               +((4*(j+36465))`div`146097)
+                  -((j+109513)`div`146097))) - 23638 -- 1/400-days from 1900-02-28 [t]
+          dc = 146100                                -- days in cycle period (400 years) = 1/400-days in year
+          t2 = ( ( t1 `mod` dc ) `div` 400 )*5 + 2   -- fifth-days into year, +2                      [j3]
+          d1 = ( t2 `mod` 153 ) `div` 5 + 1          -- day of month (magic number 153)               [d]
+          m1 = t2 `div` 153                          -- month Mar=0 -> Feb=11                         [j4]
+          m2 = if m1 <= 9 then m1+3 else m1-9        -- correct month to Jan=1 -> Dec=12              [m]
+          y1 = t1 `div` dc + 1900                    -- year from 1900-02-28
+          y2 = if m1 <= 9 then y1   else y1+1        -- correct year for month wrap-around
+          -- 36525  = days/century, not counting century adjustments
+          -- 109517 = 146100 * (1900-1600)/400 - 58
+          -- 23238  = 58*400 + 38  ???   38=152/4 ??
+
+{-          -- this code works for dates before 2100 only
+          t1 = (4*j) - 233                           -- quarter-days from 1900-02-28
+          dc = 1461                                  -- days in cycle period (4 years) = quarter-days in year
+          t2 = ( ( t1 `mod` dc ) `div` 4 )*5 + 2     -- fifth-days into year, +2
+          d1 = ( t2 `mod` 153 ) `div` 5 + 1          -- day of month (magic number 153)
+          m1 = t2 `div` 153                          -- month Mar=0 -> Feb=11
+          m2 = if m1 <= 9 then m1+3 else m1-9        -- correct month to Jan=1 -> Dec=12
+          y1 = t1 `div` dc + 1900                    -- year from 1900-02-28
+          y2 = if m1 <= 9 then y1   else y1+1        -- correct year for month wrap-around
+-}
+
+date :: Int -> Int -> Int -> DateTime
+date y m d = DateTime y m d 0 0 0 0 0
+
+time :: Int -> Int -> Int -> Int -> Int -> DateTime
+time h m s ms z = DateTime 0 0 0 h m s ms z
+
+dtYear       :: DateTime -> Int
+dtMonth      :: DateTime -> Int
+dtDay        :: DateTime -> Int
+dtHour       :: DateTime -> Int
+dtMinute     :: DateTime -> Int
+dtSecond     :: DateTime -> Int
+dtMillisecs  :: DateTime -> Int
+dtTimezone   :: DateTime -> Int                -- time zone offset in minutes
+dtYear      ( DateTime x _ _ _ _ _ _ _ ) = x
+dtMonth     ( DateTime _ x _ _ _ _ _ _ ) = x
+dtDay       ( DateTime _ _ x _ _ _ _ _ ) = x
+dtHour      ( DateTime _ _ _ x _ _ _ _ ) = x
+dtMinute    ( DateTime _ _ _ _ x _ _ _ ) = x
+dtSecond    ( DateTime _ _ _ _ _ x _ _ ) = x
+dtMillisecs ( DateTime _ _ _ _ _ _ x _ ) = x
+dtTimezone  ( DateTime _ _ _ _ _ _ _ x ) = x
+
+lenFix     :: String -> Int -> String
+lenFix inStr newLen
+  | length inStr >= newLen  = inStr
+  | otherwise               = lenFix ('0':inStr) newLen
+
+showTZ     :: Int -> String
+showTZ tz
+  | tz<0         = "-" ++ showTZabs ( -tz )
+  | tz==0        = showTZabs ( tz )
+  | otherwise    = "+" ++ showTZabs ( tz )
+
+showTZabs  :: Int -> String
+showTZabs tz
+  | tz==0        = "Z"
+  | otherwise    = lenFix ( show ( tz `div` 60 ) ) 2 ++  ":" ++
+                   lenFix ( show ( tz `mod` 60 ) ) 2
+
+showTime :: DateTime -> String
+showTime ( DateTime yr mo da hr mi se ms tz )
+  | ms==0     = lenFix ( show hr ) 2 ++  ":" ++
+                lenFix ( show mi ) 2 ++  ":" ++
+                lenFix ( show se ) 2
+  | otherwise = lenFix ( show hr ) 2 ++ ":" ++
+                lenFix ( show mi ) 2 ++ ":" ++
+                lenFix ( show se ) 2 ++ "." ++
+                lenFix ( show ms ) 3
+
+showDate :: DateTime -> String
+showDate ( DateTime yr mo da hr mi se ms tz )
+  = lenFix ( show yr ) 4 ++ "-" ++
+    lenFix ( show mo ) 2 ++ "-" ++
+    lenFix ( show da ) 2
+
+dtShow     :: DateTime -> String             -- return string form
+dtShow ( DateTime yr mo da hr mi se ms tz )
+  = showDate ( DateTime yr mo da hr mi se ms tz ) ++ "T" ++
+    showTime ( DateTime yr mo da hr mi se ms tz ) ++ showTZ tz
+
+carryMins :: DateTime -> DateTime
+carryMins ( DateTime yr mo da hr mi se ms tz )
+  | newhrs >= 24 = carryHours ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )
+  | otherwise    = ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )
+  where
+    newhrs = (hr+(mi`div`60))
+
+carryHours :: DateTime -> DateTime
+carryHours ( DateTime yr mo da hr mi se ms tz )
+  = ( DateTime y m d (hr`mod`24) mi se ms tz )
+  where
+    (DateTime y m d _ _ _ _ _) = fromJulianDate ((toJulianDate yr mo da)+ (hr`div`24))
+
+normTZ :: DateTime -> DateTime
+normTZ ( DateTime yr mo da hr mi se ms tz )
+  = carryMins ( DateTime yr mo da hr (mi-tz) se ms 0 )
+--  = addMinutes (-tz) ( DateTime yr mo da hr mi se ms tz )
+
+{- another way -}
+
+addMilliSecs addms ( DateTime yr mo da hr mi se ms tz )
+    | totms < 1000 = DateTime yr mo da hr mi se totms tz
+    | otherwise    = addSeconds addse ( DateTime yr mo da hr mi se newms tz )
+    where
+        totms = (ms+addms)
+        newms = totms `mod` 1000
+        addse = totms `div` 1000
+
+addSeconds addse ( DateTime yr mo da hr mi se ms tz )
+    | totse < 60 = DateTime yr mo da hr mi totse ms tz
+    | otherwise  = addMinutes addmi ( DateTime yr mo da hr mi newse ms tz )
+    where
+        totse = (se+addse)
+        newse = totse `mod` 60
+        addmi = totse `div` 60
+
+addMinutes addmi ( DateTime yr mo da hr mi se ms tz )
+    | totmi < 60 = DateTime yr mo da hr totmi se ms tz
+    | otherwise  = addHours addhr ( DateTime yr mo da hr newmi se ms tz )
+    where
+        totmi = (mi+addmi)
+        newmi = totmi `mod` 60
+        addhr = totmi `div` 60
+
+addHours addhr ( DateTime yr mo da hr mi se ms tz )
+    | tothr < 24 = DateTime yr mo da tothr mi se ms tz
+    | otherwise  = addDays addda ( DateTime yr mo da newhr mi se ms tz )
+    where
+        tothr = (hr+addhr)
+        newhr = tothr `mod` 24
+        addda = tothr `div` 24
+
+addDays addda ( DateTime yr mo da hr mi se ms tz )
+    = DateTime newyr newmo newda hr mi se ms tz
+    where
+        -- newdate = fromJulianDate (toJulianDate yr mo (da+addda) )
+        -- newyr   = dtYear newdate
+        -- newmo   = dtMonth newdate
+        -- newda   = dtDay newdate
+        DateTime newyr newmo newda _ _ _ _ _ = fromJulianDate ( (toJulianDate yr mo da)+addda )
+
+{- another way -}
+
+simpleEq :: DateTime -> DateTime -> Bool
+--simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) = ( ( yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) == ( yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) )
+simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) = ( ( yr1 == yr2 ) && ( mo1 == mo2 ) && ( da1 == da2 ) && ( hr1 == hr2 ) && ( mi1 == mi2 ) && ( se1 == se2 ) && ( ms1 == ms2 ) && ( tz1 == tz2 ) )
+
+simpleLT :: DateTime -> DateTime -> Bool
+simpleLT ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 )
+  | (yr1<yr2) = True
+  | (yr1==yr2)&&(mo1<mo2) = True
+  | (yr1==yr2)&&(mo1==mo2)&&(da1<da2) = True
+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1<hr2) = True
+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1<mi2) = True
+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1<se2) = True
+  | (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1==se2)&&(ms1<ms2) = True
+  | otherwise = False
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/DateTime.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: DateTime.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.23  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.22  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.21  2003/02/21 14:35:10  ronan
+-- Minor performance tweaks.
+--
+-- Revision 1.20  2003/02/17 13:15:13  ronan
+-- fromJulianDate passed exhaustive 2299-3601
+--
+-- Revision 1.19  2003/02/15 13:44:29  graham
+-- Added test output to file.
+-- Still a bug around 2300-03-01
+--
+-- Revision 1.18  2003/02/15 12:00:30  graham
+-- Fix 400-year roll-over bug
+--
+-- Revision 1.17  2003/02/14 20:33:43  ronan
+-- fromJulianDate works.
+--
+-- Revision 1.16  2003/02/14 20:31:44  ronan
+-- fromJulianDate works.
+--
+-- Revision 1.14  2003/02/14 10:22:06  graham
+-- fromJulianDate works for dates before 2100
+--
+-- Revision 1.13  2003/02/13 13:01:55  graham
+-- Added some test cases for fromJulianDate and comparison
+-- with date rollover.  Currently not working.
+--
+-- Revision 1.12  2003/02/13 10:26:01  ronan
+-- Minor tweaks to performance. Still passes tests.
+--
+-- Revision 1.11  2003/02/12 12:26:43  ronan
+-- fromJulianDate now also working perfectly.
+--
+-- Revision 1.10  2003/02/12 11:57:02  ronan
+-- Julian date stuff PERFECT!!!
+--
+-- Revision 1.9  2003/02/11 18:08:43  graham
+-- Added loads of new test cases
+-- Moved Julian date test cases to DateTimeTest
+--
+-- Revision 1.8  2003/02/11 16:04:28  ronan
+-- Put Julian in DateTime and added normTZ functionality. Vaguely tested (2 cases).
+--
+-- Revision 1.7  2003/02/11 12:02:34  graham
+-- Minor updates
+-- Add some Julian date test cases
+--
+-- Revision 1.6  2003/02/11 10:47:17  ronan
+-- Work on DateTime. (==) works as intended. Julian date work done, needs testing.
+--
+-- Revision 1.5  2003/02/10 14:21:57  ronan
+-- Tests very bodged, but working. Show working to a good standard. (==) replaced with (===) for now. Next step: timezone correction.
+--
+-- Revision 1.2  2003/02/09 09:20:37  ronan
+-- Working on DateTime in Haskell. Not working. Yet.
+--
+-- Revision 1.1  2003/02/07 18:46:07  graham
+-- Add new date/time modules
+-- Update copyright year
+--

+ Swish/HaskellUtils/ErrorM.hs view
@@ -0,0 +1,122 @@+{-# OPTIONS -XFlexibleInstances #-}+--------------------------------------------------------------------------------
+--  $Id: ErrorM.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ErrorM
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a Monad for reporting errors.  It is conceived as a
+--  very simple extension of Maybe, except that the failure variant caries
+--  a reason for failure.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.ErrorM
+    ( ErrorM(Error,Result)
+    , eitherErrMaybe
+    )
+where
+
+import Control.Monad
+    ( MonadPlus(..) )
+
+------------------------------------------------------------
+--  ErrorM
+------------------------------------------------------------
+
+-- |Error monad.
+--
+data ErrorM a = Error String | Result a
+
+-- |Monad instance for Error
+instance Monad ErrorM where
+    (Result a) >>= f = f a
+    (Error e)  >>= _ = Error e
+    return     = Result
+    fail e     = Error e
+
+-- |MonadPlus instance for Error
+instance MonadPlus ErrorM where
+    mzero             = Error "No result"
+    mplus (Error _) r = r
+    mplus r         _ = r
+
+------------------------------------------------------------
+--  Either
+------------------------------------------------------------
+
+-- |Monad instance for (Either String b)
+instance Monad (Either String) where
+    (Left a)  >>= _ = Left a
+    (Right b) >>= f = f b
+    return          = Right
+    fail a          = Left a
+
+-- |MonadPlus instance for (Either String b)
+instance MonadPlus (Either String) where
+    mzero             = Left "No result"
+    mplus (Left _) r  = r
+    mplus b        _  = b
+
+-- |Map maybe to (Either String) error monad
+eitherErrMaybe :: String -> (a->b) -> Maybe a -> Either String b
+eitherErrMaybe err f mv = case mv of
+    Nothing -> Left  err
+    Just v  -> Right (f v)
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ErrorM.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ErrorM.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.5  2003/12/10 03:48:57  graham
+-- SwishScript nearly complete:  BwdChain and PrrofCheck to do.
+--
+-- Revision 1.4  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.3  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.2  2003/12/03 15:42:53  graham
+-- Add instance declaration for MonadPlus
+--
+-- Revision 1.1  2003/12/01 21:14:39  graham
+-- Added module ErrorM
+--

+ Swish/HaskellUtils/FunctorM.hs view
@@ -0,0 +1,105 @@+--------------------------------------------------------------------------------
+--  $Id: FunctorM.hs,v 1.2 2004/01/13 17:12:08 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  FunctorM
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a monadic functor class, that allows a monadic
+--  computation to be performed, functor-style, over some container
+--  structure.  The advantage of this compared with a normal functor
+--  is that it allows values to be accumulated from the computation
+--  (in a Monad instance) at the same time as (optionally) applying
+--  transformations to each of the contained values.
+--
+--  Acknowledgement:  based on a message by Tomasz Zielonka sent to
+--  the Haskell mailing list on 4 June 2003.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.FunctorM
+    ( FunctorM(..)
+    )
+where
+
+class FunctorM t where
+    fmapM  :: Monad m => (a -> m b) -> (t a -> m (t b))
+    -- Try to generalise accumulating values?
+    -- fmapQM :: Monad m => m b -> (b -> a -> m b) -> (t a -> m b)
+    fmapM_ :: Monad m => (a -> m b) -> (t a -> m ())
+    fmapM_ f t = fmapM f t >> return ()
+
+instance FunctorM [] where
+    fmapM  = mapM
+    fmapM_ = mapM_
+
+{-  Another example:
+
+data Arc lb = Arc { asubj, apred, aobj :: lb }
+    deriving (Eq, Show)
+
+instance Functor Arc where
+    fmap f (Arc s p o) = Arc (f s) (f p) (f o)
+
+instance FunctorM Arc where
+    -- fmapM :: (lb -> m l2) -> Arc lb -> m (Arc l2)
+    fmapM f (Arc s p o) =
+        do  { s' <- f s
+            ; p' <- f p
+            ; o' <- f o
+            ; return $ Arc s' p' o'
+            }
+
+-}
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/FunctorM.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: FunctorM.hs,v $
+-- Revision 1.2  2004/01/13 17:12:08  graham
+-- Complete functionality of AccumulateM, using functional dependencies
+-- in the MonadAccum type class.
+--
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.3  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.2  2003/06/12 00:49:04  graham
+-- Basic query processor runs test cases OK.
+-- Proof framework compiles, not yet tested.
+--
+-- Revision 1.1  2003/06/10 17:34:29  graham
+-- Create FunctorM module
+--
+ Swish/HaskellUtils/ListHelpers.hs view
@@ -0,0 +1,495 @@+--------------------------------------------------------------------------------
+--  $Id: ListHelpers.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ListHelpers
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines some generic list and related helper functions.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.ListHelpers
+      ( select, mapset, deleteIndex
+      , subset, equiv, hasPartitions, addSetElem
+      , headOrNothing
+      , pairUngroup, pairsUngroup, pairSort, pairGroup
+      , breakAll
+      , powerSet, combinations
+      , permutations, listProduct
+      , powerSequences, powerSequences_len, powerSequences_inf
+      , flist, ffold, allf, anyf, allp, anyp )
+where
+
+import Data.List( union, intersect, sortBy, groupBy )
+
+------------------------------------------------------------
+--  Generic helpers
+------------------------------------------------------------
+
+-- |Select is like filter, except that it tests one list to select
+--  elements from a second list.
+select :: ( a -> Bool ) -> [a] -> [b] -> [b]
+select _ [] []           = []
+select f (e1:l1) (e2:l2)
+    | f e1      = e2:(select f l1 l2)
+    | otherwise = (select f l1 l2)
+select _ _ _    = error "select supplied with different length lists"
+
+-- |Collect set of values from list under supplied mapping function
+mapset :: Eq b => ( a -> b ) -> [a] -> [b]
+mapset _ []    = []
+mapset f (e:l) = [f e] `union` (mapset f l)
+
+-- |Delete the n'th element of a list, returning the result
+--
+--  If the list doesn't have an n'th element, return the list unchanged.
+--
+deleteIndex :: [a] -> Int -> [a]
+deleteIndex [] _ = []
+deleteIndex xxs@(x:xs) n
+    | n <  0    = xxs
+    | n == 0    = xs
+    | otherwise = x:deleteIndex xs (n-1)
+
+{-
+testdi1 = deleteIndex [1,2,3,4] 0    == [2,3,4]
+testdi2 = deleteIndex [1,2,3,4] 1    == [1,3,4]
+testdi3 = deleteIndex [1,2,3,4] 2    == [1,2,4]
+testdi4 = deleteIndex [1,2,3,4] 3    == [1,2,3]
+testdi5 = deleteIndex [1,2,3,4] 4    == [1,2,3,4]
+testdi6 = deleteIndex [1,2,3,4] (-1) == [1,2,3,4]
+testdi = and
+    [ testdi1, testdi2, testdi3, testdi4, testdi5, testdi6 ]
+-}
+
+------------------------------------------------------------
+--  Set functions
+------------------------------------------------------------
+
+-- |Subset test
+
+subset          :: (Eq a) => [a] -> [a] -> Bool
+a `subset` b    = and [ ma `elem` b | ma <- a ]
+
+-- |Set equivalence test
+
+equiv           :: (Eq a) => [a] -> [a] -> Bool
+a `equiv` b     = (a `subset` b) && (b `subset` a)
+
+-- |Set partition test
+--
+--  Is it possible to be more efficient here?
+--  Maybe something like sort/merge/compare?
+hasPartitions   :: (Eq a) => [a] -> ([a],[a]) -> Bool
+a `hasPartitions` (b1,b2) =
+    (null (b1 `intersect` b2)) && (a `equiv` (b1 `union` b2))
+
+-- |Add element to set
+
+addSetElem :: (Eq a) => a -> [a] -> [a]
+addSetElem e es = if e `elem` es then es else e:es
+
+------------------------------------------------------------
+--  Lists and Maybes
+------------------------------------------------------------
+
+-- |Return head of a list of Maybe's, or Nothing if list is empty
+--
+--  Use with 'filter isJust' to select a non-Nothing value from a
+--  list when such a value is present.
+--
+headOrNothing :: [Maybe a] -> Maybe a
+headOrNothing []    = Nothing
+headOrNothing (a:_) = a
+
+------------------------------------------------------------
+--  Filter, ungroup, sort and group pairs by first member
+------------------------------------------------------------
+
+pairSelect :: ((a,b) -> Bool) -> ((a,b) -> c) -> [(a,b)] -> [c]
+pairSelect p f as = map f (filter p as)
+
+pairUngroup :: (a,[b]) -> [(a,b)]
+pairUngroup (a,bs) = [ (a,b) | b <- bs ]
+
+pairsUngroup :: [(a,[b])] -> [(a,b)]
+pairsUngroup ps = [ (a,b) | (a,bs) <- ps, b <- bs ]
+
+pairSort :: (Ord a) => [(a,b)] -> [(a,b)]
+pairSort ps = sortBy compareFirst ps
+    where
+        compareFirst (a1,_) (a2,_) = compare a1 a2
+
+pairGroup :: (Ord a) => [(a,b)] -> [(a,[b])]
+pairGroup ps = map (factor . unzip) $ groupBy eqFirst $ pairSort ps
+    where
+        factor ((a:_),bs)     = (a,bs)
+        eqFirst (a1,_) (a2,_) = a1 == a2
+
+------------------------------------------------------------
+--  Separate list into sublists
+------------------------------------------------------------
+
+-- |Break list into a list of sublists, separated by element
+--  satisfying supplied condition.
+breakAll :: (a -> Bool) -> [a] -> [[a]]
+breakAll _ [] = []
+breakAll p s  = let (h,s') = break p s
+                    in h : breakAll p (drop 1 s')
+
+------------------------------------------------------------
+--  Powerset
+------------------------------------------------------------
+
+--  [[[TBD... there's a much better implementation in my email,
+--     from Christopher Hendrie.  This is the raw code.]]]
+{-
+>ranked_powerset :: [a] -> [[[a]]]
+>ranked_powerset = takeWhile (not . null) . foldr next_powerset ([[]] :
+repeat [])
+>
+>next_powerset :: a -> [[[a]]] -> [[[a]]]
+>next_powerset x r = zipWith (++) ([] : map (map (x:)) r) r
+>
+>powerset :: [a] -> [[a]]
+>powerset = tail . concat . ranked_powerset
+-}
+
+-- |Powerset of a list, in ascending order of size.
+--  Assumes the supplied list has no duplicate elements.
+powerSet :: [a] -> [[a]]
+powerSet as =
+    concatMap (flip combinations as) [1..length as]
+
+-- |Combinations of n elements from a list, each being returned in the
+--  order that they appear in the list.
+combinations :: Int -> [a] -> [[a]]
+combinations _ []       = []        -- Don't include empty combinations
+combinations n as@(ah:at)
+    | n <= 0            = [[]]
+    | n >  length as    = []
+    | n == length as    = [as]
+    | otherwise         = (map (ah:) $ combinations (n-1) at) ++
+                          (combinations n at)
+
+{-
+-- |Return list of integers from lo to hi.
+intRange :: Int -> Int -> [Int]
+intRange lo hi = take (hi-lo+1) (iterate (+1) 1)
+-}
+
+{-
+-- Tests
+testcomb0 = combinations 0 "abcd" -- []
+testcomb1 = combinations 1 "abcd" -- ["a","b","c","d"]
+testcomb2 = combinations 2 "abcd" -- ["ab","ac","ad","bc","bd","cd"]
+testcomb3 = combinations 3 "abcd" -- ["abc","abd","acd","bcd"]
+testcomb4 = combinations 4 "abcd" -- ["abcd"]
+testcomb5 = combinations 5 "abcd" -- []
+testpower = powerSet "abc"        -- ["a","b","c","ab","ac","bc","abc"]
+-}
+
+------------------------------------------------------------
+--  Permutations of a list
+------------------------------------------------------------
+
+--  This algorithm is copied from an email by S.D.Mechveliani
+--  http://www.dcs.gla.ac.uk/mail-www/haskell/msg01936.html
+permutations :: [a] -> [[a]]
+permutations    []     = [[]]
+permutations    (j:js) = addOne $ permutations js
+    where
+        addOne []       = []
+        addOne (ks:pms) = (ao ks)++(addOne pms)
+        ao []           = [[j]]
+        ao (k:ks)       = (j:k:ks):(map (k:) $ ao ks)
+
+{-
+testperm = permutations [1,2,3] ==
+    [[1,2,3],[2,1,3],[2,3,1],[1,3,2],[3,1,2],[3,2,1]]
+-}
+
+------------------------------------------------------------
+--  List product
+------------------------------------------------------------
+
+-- |Given a list of lists, construct a new list of lists where
+--  each member of the new list is the same length as the original
+--  list, and each member corresponds to a different choice of
+--  one element from each of the original members in the
+--  corresponding position.  Thus:
+--
+--  listProduct [[a1,a2],[b1],[c1,c2]] =
+--       [ [a1,b1,c1], [a1,b1,c2], [a2,b1,c1], [a2,b1,c2] ]
+--
+--  Note:  The length of the resulting list is the prodicty of
+--  lengths of the components of the original list.  Thus, if
+--  any member of the original list is empty then so is the
+--  resulting list:
+--
+--  listProduct [[a1,a2],[],[c1,c2]] = []
+--
+--  NOTE:  this is subsumed by 'sequence'
+--
+listProduct :: [[a]] -> [[a]]
+listProduct []       = [[]]
+listProduct (as:ass) = concat [ map (a:) (listProduct ass) | a <- as ]
+
+{-
+test1 = listProduct [["a1","a2"],["b1"],["c1","c2"]]
+test2 = listProduct [["a1","a2"],[],["c1","c2"]]
+
+lp []       = [[]]
+lp (as:ass) = concatMap (\a -> (map (a:) (lp ass))) as
+-}
+
+------------------------------------------------------------
+--  Powersequence (?) -- all sequences from some base values
+------------------------------------------------------------
+
+-- |Function to choose all sequences of any length
+--  from a supplied set of values, returned in
+--  increasing length.
+powerSequences :: [a] -> [[a]]
+powerSequences rs = concat $ powerSeq_bylen rs [[]]
+
+-- |Construct list of lists of sequences of increasing length
+powerSeq_bylen :: [a] -> [[a]] -> [[[a]]]
+powerSeq_bylen rs ps = (ps:powerSeq_bylen rs ns) where ns = powerSeq_next rs ps
+
+-- |Return sequences of length n+1 given original sequence
+--  and list of all sequences of length n
+powerSeq_next :: [a] -> [[a]] -> [[a]]
+powerSeq_next rs rss = [ h:t | t <- rss, h <- rs ]
+
+-- |Return all powersequences of a given length
+powerSequences_len :: Int -> [a] -> [[a]]
+powerSequences_len len rs = head $ drop len $ powerSeq_bylen rs [[]]
+
+-- |Return all powersequences of indefinite length
+--  Observe that any such powersequence will consist of a sequence
+--  of a finite length sequence followed by an indefinite number of
+--  copies of the head of the base set.  To prevent duplicates, the
+--  generator constructs only sequences that do not end in the first
+--  member of the base set.
+powerSequences_inf :: [a] -> [[a]]
+powerSequences_inf rs =
+    map (++pst) $ []:(concat $ powerSeq_bylen rs psh)
+    where
+        psh = map (:[]) (tail rs)
+        pst = repeat $ head rs
+
+{- Powersequence tests
+t0 = [1,2,3,4,5,6]
+t1 = powerSequences t0
+t2 = take 15 t1
+t3 = powerSequences_len 3 t0
+t4 = powerSequences_inf t0
+t5 = map (take 6) $ take 15 t4
+t6 = take 15 (powerSequences_len 6 t0)
+t7 = t5 == t6
+t8 = powerSequences_len1 3 t0
+t9 = t8 == t3
+-}
+
+------------------------------------------------------------
+--  Functions, lists and monads
+------------------------------------------------------------
+
+-- |Apply list of functions to some value, returning list of results.
+--  It's kind of like an converse map.
+--
+--  This is similar to the 'ap' function in the Monad library.
+--
+flist :: [a->b] -> a -> [b]
+flist fs a = map ($ a) fs
+
+{-
+flisttest = flist [(1*),(2*),(3*)] 5 -- [5,10,15]
+-}
+
+-- |A more generalized form of flist that works with arbitrary Monads.
+--  (Suggested by Derek Elkin.)
+
+fmonad :: Monad m => m (a->b) -> a -> m b
+fmonad fm a =
+    do  { f <- fm
+        ; return $ f a
+        }
+
+{-
+fmonadtest = fmonad [(1*),(2*),(3*)] 3 -- [3,6,9]
+-}
+
+-- |Fold result from list of functions applied to some value,
+--  returning the result of the fold.
+--
+--  This is similar to the 'ap' function in the Monad library.
+--
+ffold :: (b->c->c) -> c -> [a->b] -> a -> c
+ffold rf ri fs v = foldr rf ri (flist fs v)
+
+{-
+ffoldtest0 = ffold ge4and True [(1+),(2+),(3+)] 0     -- False
+ffoldtest1 = ffold ge4and True [(1+),(2+),(3+)] 1     -- False
+ffoldtest2 = ffold ge4and True [(1+),(2+),(3+)] 2     -- False
+ffoldtest3 = ffold ge4and True [(1+),(2+),(3+)] 3     -- True
+ge4and v b = (v>=4 && b)
+ffoldtest  = and [not ffoldtest0,not ffoldtest1,not ffoldtest2,ffoldtest3]
+-}
+
+-- |Test if application of all functions in list to a given value
+--  satisfies a given condition
+--
+allf :: (b->Bool)  -> [a->b] -> a -> Bool
+allf pf fs a = all pf (flist fs a)
+
+{-
+allftest0 = allf (>=4) [(1+),(2+),(3+)] 0     -- False
+allftest1 = allf (>=4) [(1+),(2+),(3+)] 1     -- False
+allftest2 = allf (>=4) [(1+),(2+),(3+)] 2     -- False
+allftest3 = allf (>=4) [(1+),(2+),(3+)] 3     -- True
+allftest  = and [not allftest0,not allftest1,not allftest2,allftest3]
+-}
+
+-- |Test if application of any functions in list to a given value
+--  satisfies a given condition
+--
+anyf :: (b->Bool)  -> [a->b] -> a -> Bool
+anyf pf fs a = any pf (flist fs a)
+
+{-
+anyftest0 = anyf (>=4) [(1+),(2+),(3+)] 0     -- False
+anyftest1 = anyf (>=4) [(1+),(2+),(3+)] 1     -- True
+anyftest2 = anyf (>=4) [(1+),(2+),(3+)] 2     -- True
+anyftest3 = anyf (>=4) [(1+),(2+),(3+)] 3     -- True
+anyftest  = and [not anyftest0,anyftest1,anyftest2,anyftest3]
+-}
+
+-- |Test if a value satisfies all predicates in a list
+--
+allp :: [a->Bool] -> a -> Bool
+allp ps a = and (flist ps a)
+
+{-
+allptest0 = allp [(>=1),(>=2),(>=3)] 0     -- False
+allptest1 = allp [(>=1),(>=2),(>=3)] 1     -- False
+allptest2 = allp [(>=1),(>=2),(>=3)] 2     -- False
+allptest3 = allp [(>=1),(>=2),(>=3)] 3     -- True
+allptest  = and [not allptest0,not allptest1,not allptest2,allptest3]
+-}
+
+-- |Test if a value satisfies any predicate in a list
+--
+anyp :: [a->Bool] -> a -> Bool
+anyp ps a = or (flist ps a)
+
+{-
+anyptest0 = anyp [(>=1),(>=2),(>=3)] 0     -- False
+anyptest1 = anyp [(>=1),(>=2),(>=3)] 1     -- True
+anyptest2 = anyp [(>=1),(>=2),(>=3)] 2     -- True
+anyptest3 = anyp [(>=1),(>=2),(>=3)] 3     -- True
+anyptest  = and [not anyptest0,anyptest1,anyptest2,anyptest3]
+-}
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ListHelpers.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ListHelpers.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.16  2003/11/28 00:17:55  graham
+-- Datatype constraint test cases all passed.
+--
+-- Revision 1.15  2003/11/07 21:45:47  graham
+-- Started rework of datatype to use new DatatypeRel structure.
+--
+-- Revision 1.14  2003/10/24 21:05:09  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.13  2003/10/16 16:01:49  graham
+-- Reworked RDFProof and RDFProofContext to use new query binding
+-- framework.  Also fixed a bug in the variable binding filter code that
+-- caused failures when a variable used was not bound.
+--
+-- Revision 1.12  2003/10/14 20:31:21  graham
+-- Add separate module for generic variable binding functions.
+--
+-- Revision 1.11  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.10  2003/06/27 20:46:00  graham
+-- Coded initial version of RDF simple entailment rule.
+-- New rule still needs testing, but other test cases still OK.
+--
+-- Revision 1.9  2003/06/18 14:59:27  graham
+-- Augmented query variable binding structure.
+-- RDFQuery tests OK.
+--
+-- Revision 1.8  2003/06/18 01:29:29  graham
+-- Fixed up some problems with backward chaining queries.
+-- Query test cases still to complete.
+-- Proof incomplete.
+--
+-- Revision 1.7  2003/06/10 01:04:46  graham
+-- Proof framework in progress;  compiles, incomplete
+--
+-- Revision 1.6  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.5  2003/05/29 00:57:37  graham
+-- Resolved swish performance problem, which turned out to an inefficient
+-- method used by the parser to add arcs to a graph.
+--
+-- Revision 1.4  2003/05/20 17:28:51  graham
+-- Added 'breakAll' function
+--
+-- Revision 1.3  2003/05/14 02:01:59  graham
+-- GraphMatch recoded and almost working, but
+-- there are a couple of
+-- obscure bugs that are proving rather stubborn to squash.
+--
+-- Revision 1.2  2003/05/09 00:28:48  graham
+-- Added partitionBy to ListHelpers (may want to remove since
+-- it's also in the standard List module).
+-- Added mapSelect and mapMerge to LookupMap, and test cases.
+--
+-- Revision 1.1  2003/04/11 18:12:10  graham
+-- Renamed GraphHelpers to ListHelpers
+-- LookupMapTest, GraphTest, RDFGraphTest all run OK
+--

+ Swish/HaskellUtils/LookupMap.hs view
@@ -0,0 +1,564 @@+{-# OPTIONS -XMultiParamTypeClasses #-}+{-# OPTIONS  -XFunctionalDependencies #-}+{-# OPTIONS  -XFlexibleContexts #-}+{-# OPTIONS  -XFlexibleInstances #-}+{-# OPTIONS  -XTypeSynonymInstances  #-}+--------------------------------------------------------------------------------
+--  $Id: LookupMap.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  LookupMap
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98, class dependencies
+--
+--  This module defines a lookup table format and associated functions
+--  used by the graph matching code.
+--
+--------------------------------------------------------------------------------
+
+------------------------------------------------------------
+--  Generic list-of-pairs lookup functions
+------------------------------------------------------------
+
+module Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , emptyLookupMap, makeLookupMap, listLookupMap
+    , reverseLookupMap
+    , keyOrder
+    , mapFind, mapFindMaybe, mapContains
+    , mapReplace, mapReplaceOrAdd, mapReplaceAll, mapReplaceMap
+    , mapAdd, mapAddIfNew
+    , mapDelete, mapDeleteAll
+    , mapApplyToAll, mapTranslate
+    , mapEq, mapKeys, mapVals
+    , mapSelect, mapMerge
+    , mapSortByKey, mapSortByVal
+    , mapTranslateKeys, mapTranslateVals
+    , mapTranslateEntries, mapTranslateEntriesM
+    )
+where
+
+import Data.List( nub, sortBy )
++import Swish.HaskellUtils.ListHelpers ( equiv )
+
+------------------------------------------------------------
+--  Class for lookup map entries
+------------------------------------------------------------
+
+-- |LookupEntryClass defines essential functions of any datatype
+--  that can be used to make a LookupMap.
+--
+--  Minimal definition: newEntry and keyVal
+--
+class (Eq k, Show k) => LookupEntryClass a k v | a -> k, a -> v
+    where
+        newEntry    :: (k,v) -> a
+        keyVal      :: a -> (k,v)
+        entryKey    :: a -> k
+        entryKey e = k where (k,_) = keyVal e
+        entryVal    :: a -> v
+        entryVal e = v where (_,v) = keyVal e
+        entryEq     :: (Eq v) => a -> a -> Bool
+        entryEq e1 e2 = (keyVal e1) == (keyVal e2)
+        entryShow   :: (Show v) => a -> String
+        entryShow e = (show k)++":"++(show v) where (k,v) = keyVal e
+        kmap :: (LookupEntryClass a2 k2 v) => (k -> k2) -> a -> a2
+        kmap f e    = newEntry (f $ entryKey e,entryVal e)
+        vmap :: (LookupEntryClass a2 k v2) => (v -> v2) -> a -> a2
+        vmap f e    = newEntry (entryKey e,f $ entryVal e)
+
+-- |Predefine a pair of appropriate values as a valid lookup table entry
+--  (i.e. an instance of LookupEntryClass).
+--
+instance (Eq k, Show k) => LookupEntryClass (k,v) k v where
+    newEntry = id
+    keyVal   = id
+
+-- |Define a lookup map based on a list of values.
+--
+--  Note:  the class constraint that a is an instance of LookupEntryClass
+--  is not defined here, for good reasons (which I forget right now, but
+--  something to do with the method disctionary being superfluous on
+--  an algebraic data type).
+--
+data LookupMap a = LookupMap [a]
+
+-- |Define eqiality of LookupMap values based on equality of entries.
+--
+--  (This is possibly a poor definition, as it is dependent on ordering
+--  of list members.  But it passes all current test cases, and is used
+--  only for testing.)
+--
+--  See also mapEq
+--  (why not just use that here?  I don't know:  it's probably historic.)
+--
+instance (Eq a) => Eq (LookupMap a) where
+    LookupMap es1 == LookupMap es2 = es1 == es2
+
+-- |Define Show instance for LookupMap based on Showing the
+-- list of entries.
+--
+instance (Show a ) => Show (LookupMap a) where
+    show (LookupMap es) = "LookupMap " ++ show es
+
+-- |Empty lookup map of arbitrary (i.e. polymorphic) type.
+--
+emptyLookupMap :: (LookupEntryClass a k v) => LookupMap a
+emptyLookupMap = LookupMap []
+
+-- |Function to create a LookupMap from a list of entries.
+--
+--  Currently, this is trivial but future versions could be
+--  more substantial.
+--
+makeLookupMap :: (LookupEntryClass a k v) => [a] -> LookupMap a
+makeLookupMap es = LookupMap es
+
+-- |Return list of lookup map entries.
+--
+--  Currently, this is trivial but future versions could be
+--  more substantial.
+--
+listLookupMap :: (LookupEntryClass a k v) => LookupMap a -> [a]
+listLookupMap (LookupMap es) = es
+
+-- |Given a lookup map entry, return a new entry that can be used
+--  in the reverse direction of lookup.  This is used to construct
+--  a reverse LookupMap.
+--
+reverseEntry :: (LookupEntryClass a1 k v, LookupEntryClass a2 v k)
+    => a1 -> a2
+reverseEntry e = newEntry (v,k) where (k,v) = keyVal e
+
+-- |Given a lookup map, return a new map that can be used
+--  in the opposite direction of lookup.
+--
+reverseLookupMap :: (LookupEntryClass a1 b c, LookupEntryClass a2 c b)
+    => LookupMap a1 -> LookupMap a2
+reverseLookupMap (LookupMap es) = LookupMap (map reverseEntry es)
+
+-- |Given a pair of lookup entry values, return the ordering of their
+--  key values.
+--
+keyOrder :: (LookupEntryClass a k v, Ord k)
+    =>  a -> a -> Ordering
+keyOrder e1 e2 = compare k1 k2
+    where
+        (k1,_) = keyVal e1
+        (k2,_) = keyVal e2
+
+--  Local helper function to build a new LookupMap from
+--  a new entry and an exiting map.
+--
+mapCons :: (LookupEntryClass a k v) =>
+    a -> LookupMap a -> LookupMap a
+mapCons e (LookupMap es) = LookupMap (e:es)
+
+-- |Find key in lookup map and return corresponding value,
+--  otherwise return default supplied.
+--
+mapFind :: (LookupEntryClass a k v) => v -> k -> LookupMap a -> v
+mapFind def key (LookupMap es) = foldr match def es where
+    match ent alt
+        | key == (entryKey ent) = entryVal ent
+        | otherwise             = alt
+
+-- |Find key in lookup map and return Just the corresponding value,
+--  otherwise return Nothing.
+--
+mapFindMaybe :: (LookupEntryClass a k v) => k -> LookupMap a -> Maybe v
+mapFindMaybe key (LookupMap es) = foldr match Nothing es where
+    match ent alt
+        | key == (entryKey ent) = Just (entryVal ent)
+        | otherwise             = alt
+
+-- |Test to see if key is present in the supplied map
+--
+mapContains :: (LookupEntryClass a k v) =>
+    LookupMap a -> k -> Bool
+mapContains (LookupMap es) key  = or (map match es) where
+    match ent = key == (entryKey ent)
+
+-- |Replace an existing occurrence of a key a with a new key-value pair
+--  The resulting lookup map has the same form as the original in all
+--  other respects.  Assumes exactly one occurrence of the supplied key.
+--
+mapReplace :: (LookupEntryClass a k v) =>
+    LookupMap a -> a -> LookupMap a
+mapReplace (LookupMap (e:es)) newe
+    | (entryKey e) == (entryKey newe)   = LookupMap (newe:es)
+    | otherwise                         = mapAdd more e where
+        more = mapReplace (LookupMap es) newe
+mapReplace _ newe =
+    error ("mapReplace: Key value not found in lookup table: "++
+           (Prelude.show (entryKey newe)))
+
+-- |Replace an existing occurrence of a key a with a new key-value pair,
+--  or add a new key-value pair if the supplied key is not already present.
+--
+mapReplaceOrAdd :: (LookupEntryClass a k v) =>
+    a -> LookupMap a -> LookupMap a
+mapReplaceOrAdd newe (LookupMap (e:es))
+    | (entryKey e) == (entryKey newe)   = LookupMap (newe:es)
+    | otherwise                         = mapCons e more where
+        more = mapReplaceOrAdd newe (LookupMap es)
+mapReplaceOrAdd newe (LookupMap [])     = LookupMap [newe]
+
+-- |Replace any occurrence of a key a with a new key-value pair
+--  The resulting lookup map has the same form as the original in all
+--  other respects.
+--
+mapReplaceAll :: (LookupEntryClass a k v) =>
+    LookupMap a -> a -> LookupMap a
+mapReplaceAll (LookupMap (e:es)) newe   = mapCons e' more where
+    more = mapReplaceAll (LookupMap es) newe
+    e'   = if (entryKey e) == (entryKey newe) then newe else e
+mapReplaceAll (LookupMap []) _          = (LookupMap [])
+
+-- |Replace any occurrence of a key in the first argument with a
+--  corresponding key-value pair from the second argument, if present.
+--
+--  This could be implemented by multiple applications of mapReplaceAll,
+--  but is arranged differently so that only one new LookupMap value is
+--  created.
+--
+--  Note:  keys in the new map that are not present in the old map
+--  are not included in the result map
+--
+mapReplaceMap :: (LookupEntryClass a k v) =>
+    LookupMap a -> LookupMap a -> LookupMap a
+mapReplaceMap (LookupMap (e:es)) newmap = mapCons e' more where
+    more  = mapReplaceMap (LookupMap es) newmap
+    e'    = newEntry (k,mapFind v k newmap)
+    (k,v) = keyVal e
+mapReplaceMap (LookupMap []) _ = (LookupMap [])
+
+-- |Add supplied key-value pair to the lookup map.
+--
+--  This is effectively an optimized case of MapReplaceOrAdd or mapAddIfNew,
+--  where the caller guarantees to avoid duplicate key values.
+--
+mapAdd :: (LookupEntryClass a k v) =>
+    LookupMap a -> a -> LookupMap a
+mapAdd emap e = mapCons e emap
+
+-- |Add supplied key-value pair to the lookup map,
+--  only if the key value is not already present.
+--
+mapAddIfNew :: (LookupEntryClass a k v) =>
+    LookupMap a -> a -> LookupMap a
+mapAddIfNew emap e = if mapContains emap (entryKey e)
+                        then emap
+                        else mapCons e emap
+
+-- ADelete supplied key value from the lookup map.
+--  This function assumes exactly one occurrence.
+--
+mapDelete :: (LookupEntryClass a k v) =>
+    LookupMap a -> k -> LookupMap a
+mapDelete (LookupMap (e:es)) k
+    | k == (entryKey e) = LookupMap es
+    | otherwise         = mapCons e more where
+        more = mapDelete (LookupMap es) k
+mapDelete _ k =
+    error ("mapDelete: Key value not found in lookup table: "++(Prelude.show k))
+
+-- |Delete any occurrence of a supplied key value from the lookup map.
+--
+mapDeleteAll :: (LookupEntryClass a k v) =>
+    LookupMap a -> k -> LookupMap a
+mapDeleteAll (LookupMap (e:es)) k =
+    if (entryKey e) == k then more else mapCons e more where
+        more = mapDeleteAll (LookupMap es) k
+mapDeleteAll (LookupMap []) _ = (LookupMap [])
+
+-- |Return a list of values obtained by applying a function to each key
+--  in the map.  Creates an alternative set of values that can be
+--  retrieved using mapTranslate.
+--
+mapApplyToAll :: (LookupEntryClass a k v) =>
+    LookupMap a -> (k -> w) -> [w]
+mapApplyToAll (LookupMap es) f = [ f (entryKey e) | e <- es ]
+
+-- |Find a node in a lookup map list, and returns the
+--  corresponding value from a supplied list.  The appropriate ordering
+--  of the list is not specified here, but an appropriately ordered list
+--  may be obtained by mapApplyToAll.
+--
+mapTranslate :: (LookupEntryClass a k v) =>
+    LookupMap a -> [w] -> k -> w -> w
+mapTranslate (LookupMap (e:es)) (w:ws) k def
+    | k == (entryKey e) = w
+    | otherwise         = mapTranslate (LookupMap es) ws k def
+mapTranslate _ _ _ def = def
+
+-- |Compare two lookup maps for equality.
+--
+--  Two maps are equal if they have the same set of keys, and if
+--  each key maps to an equivalent value.
+--
+mapEq :: (LookupEntryClass a k v, Eq v) =>
+    LookupMap a -> LookupMap a -> Bool
+mapEq es1 es2 =
+    ( ks1 `equiv` ks2 ) &&
+    and [ (mapFindMaybe k es1) == (mapFindMaybe k es2) | k <- ks1 ]
+    where
+        ks1 = mapKeys es1
+        ks2 = mapKeys es2
+
+-- |Return the list of keys in a supplied LookupMap
+--
+mapKeys :: (LookupEntryClass a k v) =>
+    LookupMap a -> [k]
+mapKeys (LookupMap es) = nub $ map (fst . keyVal) es
+
+-- |Return list of distinct values in a supplied LookupMap
+--
+mapVals :: (Eq v, LookupEntryClass a k v) =>
+    LookupMap a -> [v]
+mapVals (LookupMap es) = nub $ map (snd . keyVal) es
+
+-- |Select portion of a lookup map that corresponds to
+--  a supplied list of keys
+--
+mapSelect :: (LookupEntryClass a k v) =>
+    LookupMap a -> [k] -> LookupMap a
+mapSelect (LookupMap es) ks =
+    LookupMap $ filter (keyIn ks) es
+    where
+        keyIn ks e = k `elem` ks where (k,_) = keyVal e
+
+-- |Merge two lookup maps, ensuring that if the same key appears
+--  in both maps it is associated with the same value.
+--
+mapMerge :: (LookupEntryClass a k v, Eq a, Show a, Ord k) =>
+    LookupMap a -> LookupMap a -> LookupMap a
+mapMerge (LookupMap es1) (LookupMap es2) =
+    LookupMap $ merge (sortBy keyOrder es1) (sortBy keyOrder es2)
+    where
+        merge es1 [] = es1
+        merge [] es2 = es2
+        merge es1@(e1:et1) es2@(e2:et2) =
+            case keyOrder e1 e2 of
+                LT -> e1:(merge et1 es2)
+                GT -> e2:(merge es1 et2)
+                EQ -> if e1 /= e2
+                        then error ("mapMerge key conflict: " ++ (show e1)
+                                    ++ " with " ++ (show e2))
+                        else e1:(merge et1 et2)
+
+-- |Creates a new map that is the same as the supplied map, except
+--  that its entries are sorted by key value.
+--
+--  (What's this used for?  It should be redundant.)
+--
+mapSortByKey :: (LookupEntryClass a k v, Ord k) =>
+    LookupMap a -> LookupMap a
+mapSortByKey (LookupMap es) =
+    LookupMap $ sortBy keyCompare es
+    where
+        keyCompare e1 e2 = compare (entryKey e1) (entryKey e2)
+
+-- |Creates a new map that is the same as the supplied map, except
+--  that its entries are sorted by key value.
+--
+--  (What's this used for?  It should be redundant.)
+--
+mapSortByVal :: (LookupEntryClass a k v, Ord v) =>
+    LookupMap a -> LookupMap a
+mapSortByVal (LookupMap es) =
+    LookupMap $ sortBy valCompare es
+    where
+        valCompare e1 e2 = compare (entryVal e1) (entryVal e2)
+
+-- |An fmap-like function that returns a new lookup map that is a
+--  copy of the supplied map with entry keys replaced according to
+--  a supplied function.
+--
+mapTranslateKeys :: (LookupEntryClass a1 k1 v, LookupEntryClass a2 k2 v) =>
+    (k1 -> k2) -> LookupMap a1 -> LookupMap a2
+mapTranslateKeys f (LookupMap es) =
+    LookupMap $ map (kmap f) es
+
+-- |An fmap-like function that returns a new lookup map that is a
+--  copy of the supplied map with entry values replaced according to
+--  a supplied function.
+--
+mapTranslateVals :: (LookupEntryClass a1 k v1, LookupEntryClass a2 k v2) =>
+    (v1 -> v2) -> LookupMap a1 -> LookupMap a2
+mapTranslateVals f = mapTranslateEntries (vmap f)
+
+-- |A function that returns a new lookup map that is a copy of the
+--  supplied map with complete entries replaced according to
+--  a supplied function.
+--
+mapTranslateEntries ::
+    (a1 -> a2) -> LookupMap a1 -> LookupMap a2
+mapTranslateEntries f (LookupMap es) =
+    LookupMap $ map f es
+
+-- |A monadic form of mapTranslateEntries
+--
+mapTranslateEntriesM :: (Monad m)
+    => (a1 -> m (a2)) -> LookupMap a1 -> m (LookupMap a2)
+mapTranslateEntriesM f (LookupMap es) =
+    do  { m2 <- mapM f es
+        ; return $ LookupMap m2
+        }
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/LookupMap.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: LookupMap.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.29  2003/12/07 19:10:35  graham
+-- Cleaned up LookupMap code comments.
+--
+-- Revision 1.28  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.27  2003/12/03 22:04:00  graham
+-- Re-ordered mapFind (again), to simplify currying of default value.
+--
+-- Revision 1.26  2003/12/03 22:02:09  graham
+-- Re-ordered mapFind, to simplify currying of default value.
+--
+-- Revision 1.25  2003/11/24 15:46:03  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.24  2003/11/13 01:13:48  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.23  2003/10/24 21:02:42  graham
+-- Changed kind-structure of LookupMap type classes.
+--
+-- Revision 1.22  2003/10/23 18:54:00  graham
+-- Moved context requirements for using LookupMap.
+-- Some context requirements are now applied to individual
+-- LoopkupMap routines that depend upon them.
+--
+-- Revision 1.21  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.20  2003/06/30 19:07:00  graham
+-- Instance entailment, subgraph entailment and simple entailment
+-- tests now working.
+--
+-- Revision 1.19  2003/06/13 21:40:08  graham
+-- Graph closure forward chaining works.
+-- Backward chaining generates existentials.
+-- Some problems with query logic for backward chaining.
+--
+-- Revision 1.18  2003/06/11 14:07:53  graham
+-- Added mapTranslateEntriesM, which performs monadic translation of
+-- LookupMap entries.  (Tested using Maybe monad.)
+--
+-- Revision 1.17  2003/06/10 17:38:34  graham
+-- Remove some unneeded calss constraints from data type declarations
+-- Reworked NSGraph to be an instance of Functor, replacing function
+-- gmap with fmap.  Graph formulae are still not handled well:  the data types
+-- will need re-working so that a "Formula lb" type constructor can be
+-- introduced having the correct (* -> *) kind to be a Functor.
+--
+-- Revision 1.16  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.15  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.14  2003/05/23 19:33:36  graham
+-- Added and tested RDF graph label translation functions
+--
+-- Revision 1.13  2003/05/14 19:38:32  graham
+-- Simple formatter tests all working with reworked graph and lookup structures.
+-- More complex formatter tests still to be coded.
+--
+-- Revision 1.12  2003/05/14 02:01:59  graham
+-- GraphMatch recoded and almost working, but
+-- there are a couple of
+-- obscure bugs that are proving rather stubborn to squash.
+--
+-- Revision 1.11  2003/05/09 00:28:48  graham
+-- Added partitionBy to ListHelpers (may want to remove since
+-- it's also in the standard List module).
+-- Added mapSelect and mapMerge to LookupMap, and test cases.
+--
+-- Revision 1.10  2003/05/07 23:58:09  graham
+-- More restructuring.
+-- RDFGraphTest runs OK.
+-- N3ParserTest needs to be updated to use new structure for formulae.
+--
+-- Revision 1.9  2003/05/07 19:25:26  graham
+-- Added mapFindMaybe to LookupMap export list
+--
+-- Revision 1.8  2003/05/07 18:50:38  graham
+-- Add LookupMap functions: mapFindMaybe, mapKeys, mapEq
+--
+-- Revision 1.7  2003/05/01 23:15:44  graham
+-- GraphTest passes all tests using refactored LookupMap
+-- Extensive changes to GraphMatch were required.
+--
+-- Revision 1.6  2003/05/01 19:14:26  graham
+-- LookupMap refactored to use class for entry, so that it can be
+-- applied to a variety of different types with identifiable key and value
+-- components.  All tests pass.
+--
+-- Revision 1.5  2003/05/01 00:21:41  graham
+-- Started refactoring LookupMap.
+-- Revised module compiles OK.
+-- Working on test module.
+--
+-- Revision 1.4  2003/04/29 22:07:10  graham
+-- Some refactoring of N3 formatter.
+-- N3 formatter now handles trivial cases.
+-- More complex formatter test cases still to be developed.
+--
+-- Revision 1.3  2003/04/24 23:41:39  graham
+-- Added Ord class membership to graph nodes
+-- Added empty lookup table definition
+-- Started on N3 formatter module
+--
+-- Revision 1.2  2003/04/11 18:04:49  graham
+-- Rename GraphLookupMap to LookupMap:
+-- GraphTest runs OK.
+--
+-- Revision 1.1  2003/04/11 17:38:33  graham
+-- Rename GraphLookupMap to LookupMap
+--
+ Swish/HaskellUtils/LookupMapTest.hs view
@@ -0,0 +1,660 @@+{-# OPTIONS -XFlexibleInstances #-}
+{-# OPTIONS -XMultiParamTypeClasses #-}
+
+--------------------------------------------------------------------------------
+--  $Id: LookupMapTest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  LookupMapTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+-- This Module defines test cases for module Parse parsing functions.
+--
+--------------------------------------------------------------------------------
+
+--   WNH RIP OUT module Swish.HaskellUtils.LookupMapTest where
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..), LookupMap(..)
+    , emptyLookupMap, makeLookupMap, listLookupMap
+    , reverseLookupMap
+    , keyOrder
+    , mapFind, mapFindMaybe, mapContains
+    , mapReplace, mapReplaceOrAdd, mapReplaceAll, mapReplaceMap
+    , mapAdd, mapAddIfNew
+    , mapDelete, mapDeleteAll
+    , mapApplyToAll, mapTranslate
+    , mapEq, mapKeys, mapVals
+    , mapSelect, mapMerge
+    , mapSortByKey, mapSortByVal
+    , mapTranslateKeys, mapTranslateVals
+    , mapTranslateEntries, mapTranslateEntriesM
+    )
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Data.List ( sort )
+
+import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertEqual, runTestTT, runTestText, putTextToHandle )
+
+------------------------------------------------------------
+--  Declare lookup entry for testing
+------------------------------------------------------------
+
+data GenMapEntry a b = E a b
+
+instance (Eq a, Show a, Eq b, Show b)
+    => LookupEntryClass (GenMapEntry a b) a b
+    where
+        keyVal   (E k v) = (k,v)
+        newEntry (k,v)   = (E k v)
+
+instance (Eq a, Show a, Eq b, Show b) => Show (GenMapEntry a b) where
+    show = entryShow
+
+instance (Eq a, Show a, Eq b, Show b) => Eq (GenMapEntry a b) where
+    (==) = entryEq
+
+type TestEntry  = GenMapEntry Int String
+type TestMap    = LookupMap (GenMapEntry Int String)
+type RevTestMap = LookupMap (GenMapEntry String Int)
+type MayTestMap = Maybe RevTestMap
+type StrTestMap = LookupMap (GenMapEntry String String)
+
+------------------------------------------------------------
+--  Test class helper
+------------------------------------------------------------
+
+testeq :: (Show a, Eq a) => String -> a -> a -> Test
+testeq lab req got =
+    TestCase ( assertEqual ("test"++lab) req got )
+
+testeqv :: (Show a, Eq a) => String -> [a] -> [a] -> Test
+testeqv lab req got =
+    TestCase ( assertEqual ("test"++lab) True (req `equiv` got) )
+
+------------------------------------------------------------
+--  LookupMap functions
+------------------------------------------------------------
+
+newMap :: [(Int,String)] -> TestMap
+newMap es = makeLookupMap (map newEntry es)
+
+testLookupMap :: String -> TestMap -> [(Int,String)] -> Test
+testLookupMap lab m1 m2 = testeq ("LookupMap"++lab ) (newMap m2) m1
+
+testLookupMapFind :: String -> TestMap -> Int -> String -> Test
+testLookupMapFind lab lm k res =
+    testeq ("LookupMapFind"++lab ) res (mapFind "" k lm)
+
+lm00 = newMap []
+testLookupMap00     = testLookupMap     "00" lm00 []
+testLookupMapFind00 = testLookupMapFind "00" lm00 2 ""
+
+lm01 = mapAdd lm00 $ newEntry (1,"aaa")
+testLookupMap01     = testLookupMap     "01" lm01 [(1,"aaa")]
+testLookupMapFind01 = testLookupMapFind "01" lm01 2 ""
+
+lm02 = mapAdd lm01 $ newEntry (2,"bbb")
+testLookupMap02     = testLookupMap     "02" lm02 [(2,"bbb"),(1,"aaa")]
+testLookupMapFind02 = testLookupMapFind "02" lm02 2 "bbb"
+
+lm03 = mapAdd lm02 $ newEntry (3,"ccc")
+testLookupMap03     = testLookupMap     "03" lm03 [(3,"ccc"),(2,"bbb"),(1,"aaa")]
+testLookupMapFind03 = testLookupMapFind "03" lm03 2 "bbb"
+
+lm04 = mapAdd lm03 $ newEntry (2,"bbb")
+testLookupMap04     = testLookupMap     "04" lm04 [(2,"bbb"),(3,"ccc"),(2,"bbb"),(1,"aaa")]
+testLookupMapFind04 = testLookupMapFind "04" lm04 2 "bbb"
+
+lm05 = mapReplaceAll lm04 $ newEntry (2,"bbb1")
+testLookupMap05     = testLookupMap     "05" lm05 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
+testLookupMapFind05 = testLookupMapFind "05" lm05 2 "bbb1"
+
+lm06 = mapReplaceAll lm05 $ newEntry (9,"zzzz")
+testLookupMap06     = testLookupMap     "06" lm06 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
+testLookupMapFind06 = testLookupMapFind "06" lm06 2 "bbb1"
+
+lm07 = mapReplace lm06 $ newEntry (2,"bbb")
+testLookupMap07     = testLookupMap     "07" lm07 [(2,"bbb"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
+testLookupMapFind07 = testLookupMapFind "07" lm07 2 "bbb"
+testLookupMapFind0x = testLookupMapFind "0x" lm07 9 ""
+
+lm08 = mapDelete lm07 3
+testLookupMap08     = testLookupMap     "08" lm08 [(2,"bbb"),(2,"bbb1"),(1,"aaa")]
+testLookupMapFind08 = testLookupMapFind "08" lm08 2 "bbb"
+
+lm09 = mapDeleteAll lm08 2
+testLookupMap09     = testLookupMap     "09" lm09 [(1,"aaa")]
+testLookupMapFind09 = testLookupMapFind "09" lm09 2 ""
+
+la10 = mapApplyToAll lm03 (flip replicate '*')
+testLookupMapApp10  = testeq "LookupMapApplyToAll10" ["***","**","*"] la10
+
+lt11 = mapTranslate lm03 la10 1 "****"
+testLookupMapTran11  = testeq "LookupMapTranslate11" "*"   lt11
+
+lt12 = mapTranslate lm03 la10 2 "****"
+testLookupMapTran12  = testeq "LookupMapTranslate12" "**"  lt12
+
+lt13 = mapTranslate lm03 la10 3 "****"
+testLookupMapTran13  = testeq "LookupMapTranslate13" "***" lt13
+
+lt14 = mapTranslate lm03 la10 4 "****"
+testLookupMapTran14  = testeq "LookupMapTranslate14" "****" lt14
+
+lm20 = mapReplaceMap lm05 $ newMap [(2,"bbb20"),(3,"ccc20")]
+testLookupMap20     = testLookupMap     "20" lm20 [(2,"bbb20"),(3,"ccc20"),(2,"bbb20"),(1,"aaa")]
+testLookupMapFind20 = testLookupMapFind "20" lm20 2 "bbb20"
+
+lm21 = mapReplaceMap lm05 $ newMap []
+testLookupMap21     = testLookupMap     "21" lm21 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa")]
+testLookupMapFind21 = testLookupMapFind "21" lm21 2 "bbb1"
+
+lm22 = mapReplaceMap lm05 $ newMap [(9,"zzz22"),(1,"aaa22")]
+testLookupMap22     = testLookupMap     "22" lm22 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]
+testLookupMapFind22 = testLookupMapFind "22" lm22 1 "aaa22"
+
+testLookupContains31 = testeq "LookupContains31" True  (mapContains lm22 2)
+testLookupContains32 = testeq "LookupContains32" False (mapContains lm22 9)
+
+lm33 = mapAddIfNew lm22 $ newEntry (1,"aaa33")
+testLookupMap33      = testLookupMap      "33" lm33 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]
+testLookupMapFind33a = testLookupMapFind "33a" lm33 1 "aaa22"
+testLookupMapFind33b = testLookupMapFind "33b" lm33 4 ""
+
+lm34 = mapAddIfNew lm22 $ newEntry (4,"ddd34")
+testLookupMap34      = testLookupMap      "34" lm34 [(4,"ddd34"),(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22")]
+testLookupMapFind34a = testLookupMapFind "34a" lm34 1 "aaa22"
+testLookupMapFind34b = testLookupMapFind "34b" lm34 4 "ddd34"
+
+lm35 = mapReplaceOrAdd (newEntry (1,"aaa35")) lm22
+testLookupMap35      = testLookupMap      "35" lm35 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa35")]
+testLookupMapFind35a = testLookupMapFind "35a" lm35 1 "aaa35"
+testLookupMapFind35b = testLookupMapFind "35b" lm35 4 ""
+
+lm36 = mapReplaceOrAdd (newEntry (4,"ddd36")) lm22
+testLookupMap36      = testLookupMap      "36" lm36 [(2,"bbb1"),(3,"ccc"),(2,"bbb1"),(1,"aaa22"),(4,"ddd36")]
+testLookupMapFind36a = testLookupMapFind "36a" lm36 1 "aaa22"
+testLookupMapFind36b = testLookupMapFind "36b" lm36 4 "ddd36"
+
+testLookupMapSuite = TestList
+    [
+    testLookupMap01, testLookupMapFind01,
+    testLookupMap02, testLookupMapFind02,
+    testLookupMap03, testLookupMapFind03,
+    testLookupMap04, testLookupMapFind04,
+    testLookupMap05, testLookupMapFind05,
+    testLookupMap06, testLookupMapFind06,
+    testLookupMap07, testLookupMapFind07, testLookupMapFind0x,
+    testLookupMap08, testLookupMapFind08,
+    testLookupMap09, testLookupMapFind09,
+    testLookupMapApp10,
+    testLookupMapTran11, testLookupMapTran12,
+    testLookupMapTran13, testLookupMapTran14,
+    testLookupMap20, testLookupMapFind20,
+    testLookupMap21, testLookupMapFind21,
+    testLookupMap22, testLookupMapFind22,
+    testLookupContains31,
+    testLookupContains32,
+    testLookupMap33, testLookupMapFind33a, testLookupMapFind33b,
+    testLookupMap34, testLookupMapFind34a, testLookupMapFind34b,
+    testLookupMap35, testLookupMapFind35a, testLookupMapFind35b,
+    testLookupMap36, testLookupMapFind36a, testLookupMapFind36b
+    ]
+
+------------------------------------------------------------
+--  Reverse lookup map test tests
+------------------------------------------------------------
+
+revdef = -1 :: Int
+
+newRevMap :: [(String,Int)] -> RevTestMap
+newRevMap es = makeLookupMap (map newEntry es)
+
+testRevLookupMap :: String -> RevTestMap -> [(String,Int)] -> Test
+testRevLookupMap lab m1 m2 =
+    testeq ("RevLookupMap"++lab) (newRevMap m2) m1
+
+testRevLookupMapFind :: String -> RevTestMap -> String -> Int -> Test
+testRevLookupMapFind lab lm k res =
+    testeq ("RevLookupMapFind"++lab) res (mapFind revdef k lm)
+
+rlm00 :: RevTestMap
+rlm00 = reverseLookupMap lm00
+testRevLookupMap00     = testRevLookupMap     "00" rlm00 []
+testRevLookupMapFind00 = testRevLookupMapFind "00" rlm00 "" revdef
+
+rlm01 :: RevTestMap
+rlm01 = reverseLookupMap lm01
+testRevLookupMap01     = testRevLookupMap     "01" rlm01 [("aaa",1)]
+testRevLookupMapFind01 = testRevLookupMapFind "01" rlm01 "bbb" revdef
+
+rlm02 :: RevTestMap
+rlm02 = reverseLookupMap lm02
+testRevLookupMap02     = testRevLookupMap     "02" rlm02 [("bbb",2),("aaa",1)]
+testRevLookupMapFind02 = testRevLookupMapFind "02" rlm02 "bbb" 2
+
+rlm03 :: RevTestMap
+rlm03 = reverseLookupMap lm03
+testRevLookupMap03     = testRevLookupMap     "03" rlm03 [("ccc",3),("bbb",2),("aaa",1)]
+testRevLookupMapFind03 = testRevLookupMapFind "03" rlm03 "bbb" 2
+
+rlm04 :: RevTestMap
+rlm04 = reverseLookupMap lm04
+testRevLookupMap04     = testRevLookupMap     "04" rlm04 [("bbb",2),("ccc",3),("bbb",2),("aaa",1)]
+testRevLookupMapFind04 = testRevLookupMapFind "04" rlm04 "bbb" 2
+
+rlm05 :: RevTestMap
+rlm05 = reverseLookupMap lm05
+testRevLookupMap05     = testRevLookupMap     "05" rlm05 [("bbb1",2),("ccc",3),("bbb1",2),("aaa",1)]
+testRevLookupMapFind05 = testRevLookupMapFind "05" rlm05 "bbb1" 2
+
+rlm06 :: RevTestMap
+rlm06 = reverseLookupMap lm06
+testRevLookupMap06     = testRevLookupMap     "06" rlm06 [("bbb1",2),("ccc",3),("bbb1",2),("aaa",1)]
+testRevLookupMapFind06 = testRevLookupMapFind "06" rlm06 "bbb1" 2
+
+rlm07 :: RevTestMap
+rlm07 = reverseLookupMap lm07
+testRevLookupMap07     = testRevLookupMap     "07" rlm07 [("bbb",2),("ccc",3),("bbb1",2),("aaa",1)]
+testRevLookupMapFind07 = testRevLookupMapFind "07" rlm07 "bbb" 2
+testRevLookupMapFind0w = testRevLookupMapFind "07" rlm07 "bbb1" 2
+testRevLookupMapFind0x = testRevLookupMapFind "0x" rlm07 "*" revdef
+
+rlm08 :: RevTestMap
+rlm08 = reverseLookupMap lm08
+testRevLookupMap08     = testRevLookupMap     "08" rlm08 [("bbb",2),("bbb1",2),("aaa",1)]
+testRevLookupMapFind08 = testRevLookupMapFind "08" rlm08 "bbb" 2
+
+rlm09 :: RevTestMap
+rlm09 = reverseLookupMap lm09
+testRevLookupMap09     = testRevLookupMap     "09" rlm09 [("aaa",1)]
+testRevLookupMapFind09 = testRevLookupMapFind "09" rlm09 "" revdef
+
+testRevLookupMapSuite = TestList
+    [
+    testRevLookupMap01, testRevLookupMapFind01,
+    testRevLookupMap02, testRevLookupMapFind02,
+    testRevLookupMap03, testRevLookupMapFind03,
+    testRevLookupMap04, testRevLookupMapFind04,
+    testRevLookupMap05, testRevLookupMapFind05,
+    testRevLookupMap06, testRevLookupMapFind06,
+    testRevLookupMap07, testRevLookupMapFind07,
+                        testRevLookupMapFind0w,
+                        testRevLookupMapFind0x,
+    testRevLookupMap08, testRevLookupMapFind08,
+    testRevLookupMap09, testRevLookupMapFind09
+    ]
+
+------------------------------------------------------------
+--  mapKeys
+------------------------------------------------------------
+
+testMapKeys :: String -> TestMap -> [Int] -> Test
+testMapKeys lab m1 mk =
+    testeq ("testMapKeys:"++lab) mk (sort $ mapKeys m1)
+
+testMapKeys00 = testMapKeys "00" lm00 []
+testMapKeys01 = testMapKeys "01" lm01 [1]
+testMapKeys02 = testMapKeys "02" lm02 [1,2]
+testMapKeys03 = testMapKeys "03" lm03 [1,2,3]
+testMapKeys04 = testMapKeys "04" lm04 [1,2,3]
+testMapKeys05 = testMapKeys "05" lm05 [1,2,3]
+testMapKeys06 = testMapKeys "06" lm06 [1,2,3]
+testMapKeys07 = testMapKeys "07" lm07 [1,2,3]
+testMapKeys08 = testMapKeys "08" lm08 [1,2]
+testMapKeys09 = testMapKeys "09" lm09 [1]
+
+testMapKeysSuite = TestList
+    [ testMapKeys00
+    , testMapKeys01
+    , testMapKeys02
+    , testMapKeys03
+    , testMapKeys04
+    , testMapKeys05
+    , testMapKeys06
+    , testMapKeys07
+    , testMapKeys08
+    , testMapKeys09
+    ]
+
+------------------------------------------------------------
+--  mapVals
+------------------------------------------------------------
+
+testMapVals :: String -> TestMap -> [String] -> Test
+testMapVals lab m1 mv =
+    testeq ("MapVals:"++lab) mv (sort $ mapVals m1)
+
+testMapVals00 = testMapVals "00" lm00 []
+testMapVals01 = testMapVals "01" lm01 ["aaa"]
+testMapVals02 = testMapVals "02" lm02 ["aaa","bbb"]
+testMapVals03 = testMapVals "03" lm03 ["aaa","bbb","ccc"]
+testMapVals04 = testMapVals "04" lm04 ["aaa","bbb","ccc"]
+testMapVals05 = testMapVals "05" lm05 ["aaa","bbb1","ccc"]
+testMapVals06 = testMapVals "06" lm06 ["aaa","bbb1","ccc"]
+testMapVals07 = testMapVals "07" lm07 ["aaa","bbb","bbb1","ccc"]
+testMapVals08 = testMapVals "08" lm08 ["aaa","bbb","bbb1"]
+testMapVals09 = testMapVals "09" lm09 ["aaa"]
+
+testMapValsSuite = TestList
+    [ testMapVals00
+    , testMapVals01
+    , testMapVals02
+    , testMapVals03
+    , testMapVals04
+    , testMapVals05
+    , testMapVals06
+    , testMapVals07
+    , testMapVals08
+    , testMapVals09
+    ]
+
+------------------------------------------------------------
+--  mapEq
+------------------------------------------------------------
+
+maplist =
+  [ ("lm00",lm00)
+  , ("lm01",lm01)
+  , ("lm02",lm02)
+  , ("lm03",lm03)
+  , ("lm04",lm04)
+  , ("lm05",lm05)
+  , ("lm06",lm06)
+  , ("lm07",lm07)
+  , ("lm08",lm08)
+  , ("lm09",lm09)
+  ]
+
+mapeqlist =
+  [ ("lm01","lm09")
+  , ("lm02","lm08")
+  , ("lm03","lm04")
+  , ("lm03","lm07")
+  , ("lm04","lm07")
+  , ("lm05","lm06")
+  ]
+
+testMapEq :: String -> Bool -> TestMap -> TestMap -> Test
+testMapEq lab eq m1 m2 =
+    testeq ("testMapEq:"++lab) eq (mapEq m1 m2)
+
+testMapEqSuite = TestList
+  [ testMapEq (testLab l1 l2) (testEq l1 l2) m1 m2
+      | (l1,m1) <- maplist , (l2,m2) <- maplist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)       ||
+            (l1,l2) `elem` mapeqlist ||
+            (l2,l1) `elem` mapeqlist
+
+------------------------------------------------------------
+--  mapSelect and mapMerge
+------------------------------------------------------------
+
+lm101 = mapAdd lm03 $ newEntry (4,"ddd")
+testLookupMap101 = testLookupMap "101" lm101 [(4,"ddd"),(3,"ccc"),(2,"bbb"),(1,"aaa")]
+
+lm102 = mapSelect lm101 [1,3]
+testLookupMap102 = testLookupMap "102" lm102 [(3,"ccc"),(1,"aaa")]
+
+lm103 = mapSelect lm101 [2,4]
+testLookupMap103 = testLookupMap "103" lm103 [(4,"ddd"),(2,"bbb")]
+
+lm104 = mapSelect lm101 [2,3]
+testLookupMap104 = testLookupMap "104" lm104 [(3,"ccc"),(2,"bbb")]
+
+mapSelectSuite = TestList
+    [ testLookupMap101
+    , testLookupMap102
+    , testLookupMap103
+    , testLookupMap104
+    ]
+
+lm105 = mapMerge lm102 lm103
+testLookupMap105 = testLookupMap "105" lm105 [(1,"aaa"),(2,"bbb"),(3,"ccc"),(4,"ddd")]
+
+lm106 = mapMerge lm102 lm104
+testLookupMap106 = testLookupMap "106" lm106 [(1,"aaa"),(2,"bbb"),(3,"ccc")]
+
+lm107 = mapMerge lm103 lm104
+testLookupMap107 = testLookupMap "107" lm107 [(2,"bbb"),(3,"ccc"),(4,"ddd")]
+
+lm108 = mapMerge lm101 lm102
+testLookupMap108 = testLookupMap "108" lm108 [(1,"aaa"),(2,"bbb"),(3,"ccc"),(4,"ddd")]
+
+mapMergeSuite = TestList
+    [ testLookupMap105
+    , testLookupMap106
+    , testLookupMap107
+    , testLookupMap108
+    ]
+
+------------------------------------------------------------
+--  Tranlation tests
+------------------------------------------------------------
+
+-- Rather late in the day, generic versions of the testing functions used earlier
+type TestMapG a b = LookupMap (GenMapEntry a b)
+newMapG :: (Eq a, Show a, Eq b, Show b) => [(a,b)] -> (TestMapG a b)
+newMapG es = makeLookupMap (map newEntry es)
+testLookupMapG :: (Eq a, Show a, Eq b, Show b) => String -> (TestMapG a b) -> [(a,b)] -> Test
+testLookupMapG lab m1 m2 = testeq ("LookupMapG"++lab ) (newMapG m2) m1
+testLookupMapM ::
+    (Eq a, Show a, Eq b, Show b, Monad m,
+     Eq (m (TestMapG a b)), Show (m (TestMapG a b)))
+    => String -> m (TestMapG a b) -> m (TestMapG a b) -> Test
+testLookupMapM lab m1 m2 = testeq ("LookupMapM"++lab ) m2 m1
+
+tm101               = newMap [(1,"a"),(2,"bb"),(3,"ccc"),(4,"dddd")]
+testTranslateMap101 = testLookupMapG "tm101" tm101 [(1,"a"),(2,"bb"),(3,"ccc"),(4,"dddd")]
+
+tf102 = (flip replicate '*') :: Int -> String
+tm102 :: StrTestMap
+tm102 = mapTranslateKeys tf102 tm101
+testTranslateMap102 = testLookupMapG "tm102" tm102 [("*","a"),("**","bb"),("***","ccc"),("****","dddd")]
+
+tf103 = length
+tm103 :: RevTestMap
+tm103 = mapTranslateVals tf103 tm102
+testTranslateMap103 = testLookupMapG "tm103" tm103 [("*",1),("**",2),("***",3),("****",4)]
+
+tf104 e = newEntry ( (flip replicate '#') k, 5-(length v) ) where (k,v) = keyVal e
+tm104 :: RevTestMap
+tm104 = mapTranslateEntries tf104 tm101
+testTranslateMap104 = testLookupMapG "tm104" tm104 [("#",4),("##",3),("###",2),("####",1)]
+
+-- Test monadic translation, using Maybe monad
+-- (Note that if Nothing is generated at any step,
+-- it propagates to the result)
+tf105 e = Just $ tf104 e
+tm105 :: MayTestMap
+tm105 = mapTranslateEntriesM tf105 tm101
+testTranslateMap105 = testLookupMapM "tm105" tm105 (Just tm104)
+
+tf106 e = if k == 2 then Nothing else tf105 e where (k,_) = keyVal e
+tm106 :: MayTestMap
+tm106 = mapTranslateEntriesM tf106 tm101
+testTranslateMap106 = testLookupMapM "tm106" tm106 Nothing
+
+mapTranslateSuite = TestList
+    [ testTranslateMap101
+    , testTranslateMap102
+    , testTranslateMap103
+    , testTranslateMap104
+    , testTranslateMap105
+    , testTranslateMap106
+    ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ testLookupMapSuite
+  , testRevLookupMapSuite
+  , testMapKeysSuite
+  , testMapValsSuite
+  , testMapEqSuite
+  , mapSelectSuite
+  , mapMergeSuite
+  , mapTranslateSuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/LookupMapTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: LookupMapTest.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.20  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.19  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.18  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.17  2003/12/03 22:04:00  graham
+-- Re-ordered mapFind (again), to simplify currying of default value.
+--
+-- Revision 1.16  2003/12/03 22:02:09  graham
+-- Re-ordered mapFind, to simplify currying of default value.
+--
+-- Revision 1.15  2003/10/24 21:02:42  graham
+-- Changed kind-structure of LookupMap type classes.
+--
+-- Revision 1.14  2003/10/14 20:31:21  graham
+-- Add separate module for generic variable binding functions.
+--
+-- Revision 1.13  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.12  2003/06/11 14:07:53  graham
+-- Added mapTranslateEntriesM, which performs monadic translation of
+-- LookupMap entries.  (Tested using Maybe monad.)
+--
+-- Revision 1.11  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.10  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.9  2003/05/26 22:30:36  graham
+-- Working on graph merge.
+-- Added methods to Graph class for manipulating variable node.
+-- Need to get RDFGraph to compile.  And test.
+--
+-- Revision 1.8  2003/05/23 19:33:36  graham
+-- Added and tested RDF graph label translation functions
+--
+-- Revision 1.7  2003/05/09 00:28:48  graham
+-- Added partitionBy to ListHelpers (may want to remove since
+-- it's also in the standard List module).
+-- Added mapSelect and mapMerge to LookupMap, and test cases.
+--
+-- Revision 1.6  2003/05/07 18:50:38  graham
+-- Add LookupMap functions: mapFindMaybe, mapKeys, mapEq
+--
+-- Revision 1.5  2003/05/01 23:15:44  graham
+-- GraphTest passes all tests using refactored LookupMap
+-- Extensive changes to GraphMatch were required.
+--
+-- Revision 1.4  2003/05/01 19:14:26  graham
+-- LookupMap refactored to use class for entry, so that it can be
+-- applied to a variety of different types with identifiable key and value
+-- components.  All tests pass.
+--
+-- Revision 1.3  2003/05/01 00:21:41  graham
+-- Started refactoring LookupMap.
+-- Revised module compiles OK.
+-- Working on test module.
+--
+-- Revision 1.2  2003/04/11 18:12:10  graham
+-- Renamed GraphHelpers to ListHelpers
+-- LookupMapTest, GraphTest, RDFGraphTest all run OK
+--
+-- Revision 1.1  2003/04/11 18:05:57  graham
+-- Add separate LookupMap test harness
+-- Added mapReplaceOrAdd function
+-- LookupMapTest runs OK
+--
+-- Revision 1.7  2003/04/10 13:41:22  graham
+-- More graph code tidying
+-- Graph test cases still run OK
+--
+-- Revision 1.6  2003/04/10 13:35:34  graham
+-- Separated GraphMatch logic from GraphMem
+--
+-- Revision 1.5  2003/04/10 08:36:06  graham
+-- Graph matching passes battery of new tests
+-- Started work on RDF graph
+--
+-- Revision 1.4  2003/03/31 22:18:08  graham
+-- Simple graph equality tests all pass
+--
+-- Revision 1.3  2003/03/31 20:52:23  graham
+-- Restructure graph matching to deal with same unbound node names in
+-- different graphs.  It shows signs that it might be working now.
+-- More testing is needed.
+--
+-- Revision 1.2  2003/03/28 21:50:22  graham
+-- Graph equality coded and nearly working
+--
+-- Revision 1.1  2003/03/12 23:00:43  graham
+-- Graph model coded and working, except for graph isomorphism test.
+--

+ Swish/HaskellUtils/MiscHelpers.hs view
@@ -0,0 +1,137 @@+--------------------------------------------------------------------------------
+--  $Id: MiscHelpers.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  MiscHelpers
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines some generic list and related helper functions
+--  used by the graph handling code.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.MiscHelpers
+      ( assert, lower, stricmp, quote, hash, hashModulus )
+where
+
+import Data.Char
+    ( toLower )
+
+------------------------------------------------------------
+--  assert test
+------------------------------------------------------------
+
+assert :: Bool -> String -> a -> a
+assert cond msg expr = if not cond then error msg else expr
+
+------------------------------------------------------------
+--  Generate lowercase form of supplied string
+------------------------------------------------------------
+
+lower (c:st)   = (toLower c):(lower st)
+lower []       = ""
+
+------------------------------------------------------------
+--  Case insensitive compare.
+------------------------------------------------------------
+--
+--  Should be used only for values using just the US ASCII
+--  character set.  Use with richer character sets can yield
+--  surprising results.
+
+stricmp :: String -> String -> Bool
+stricmp (c1:s1) (c2:s2) = (toLower c1) == (toLower c2) && (stricmp s1 s2)
+stricmp []      []      = True
+stricmp _       _       = False
+
+------------------------------------------------------------
+--  Generate quoted form of supplied string:
+------------------------------------------------------------
+--
+--  [[[TODO: The list of quoting options here is incomplete]]]
+
+quote  st = ['"'] ++ (quote1 st) ++ ['"']
+quote1 ('"': st)    = '\\':'"' :(quote1 st)
+quote1 ('\\':st)    = '\\':'\\':(quote1 st)
+quote1 ('\n':st)    = '\\':'n':(quote1 st)
+quote1 ('\r':st)    = '\\':'r':(quote1 st)
+quote1 (c:st)       = c:(quote1 st)
+quote1 []           = ""
+
+------------------------------------------------------------
+--  Hash function and values
+------------------------------------------------------------
+--
+--  Simple hash function based on Sedgewick, Algorithms in C, p 233
+--  (choose mx*cm+255 < maxBound)
+--  'seed' is an additional parameter that allows the function
+--  to be varied for re-hashing.
+
+hashModulus = 16000001::Int
+
+hash :: Int -> String -> Int
+hash seed str = hash1 seed (64+seed) hashModulus str
+
+hash1 :: Int -> Int -> Int -> String -> Int
+hash1 sofar cm mx (c:str) = hash1 (( (sofar*cm) + (fromEnum c) ) `rem` mx) cm mx str
+hash1 sofar _ _ []        = sofar
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/MiscHelpers.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: MiscHelpers.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.6  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.5  2004/01/07 14:29:15  graham
+-- Move stricmp to MiscHelpers
+--
+-- Revision 1.4  2003/12/04 02:53:27  graham
+-- More changes to LookupMap functions.
+-- SwishScript logic part complete, type-checks OK.
+--
+-- Revision 1.3  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.2  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.1  2003/05/20 17:29:44  graham
+-- Split original helper functions module into ListHelpers and MiscHelpers
+--
+ Swish/HaskellUtils/Namespace.hs view
@@ -0,0 +1,244 @@+{-# OPTIONS -XTypeSynonymInstances #-}+{-# OPTIONS -XMultiParamTypeClasses #-}+--------------------------------------------------------------------------------
+--  $Id: Namespace.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Namespace
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines algebraic datatypes for namespaces and scoped names.
+--
+--  For these purposes, a namespace is a prefix and URI used to identify
+--  a namespace (cf. XML namespaces), and a scoped name is a name that
+--  is scoped by a specified namespace.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.Namespace
+    ( Namespace(..)
+    , makeNamespaceQName
+    , nullNamespace
+    , ScopedName(..)
+    , getScopePrefix, getScopeURI
+    , getQName, getScopedNameURI
+    , matchName
+    , makeScopedName, makeQNameScopedName, makeUriScopedName
+    , nullScopedName
+    )
+where
+
+import Swish.HaskellUtils.QName
+    ( QName(..), getQNameURI )
+
+import Swish.HaskellUtils.LookupMap
+    ( LookupEntryClass(..) )
+
+{- in Prelude???+import Maybe
+    ( Maybe(..), fromJust )
+-}+
+------------------------------------------------------------
+--  Namespace, having a prefix and a URI
+------------------------------------------------------------
+
+-- |A NameSpace value consists of a prefix and a corresponding URI.
+--  The prefix may be Nothing, in which case it is assumed to be inknown.
+--
+data Namespace = Namespace { nsPrefix :: String, nsURI :: String }
+
+{-
+getNamespacePrefix :: Namespace -> String
+getNamespacePrefix = nsPrefix
+
+getNamespaceURI    :: Namespace -> String
+getNamespaceURI    = nsURI
+-}
+
+instance Eq Namespace where
+    (==) = nsEq
+
+instance Show Namespace where
+    show (Namespace p u) =
+        (if p == "?" then "" else p ++ ":") ++ "<" ++ u ++ ">"
+
+instance LookupEntryClass Namespace String String where
+    keyVal   (Namespace pre uri) = (pre,uri)
+    newEntry (pre,uri)           = (Namespace pre uri)
+
+nsEq :: Namespace -> Namespace -> Bool
+nsEq (Namespace _ u1) (Namespace _ u2) = u1 == u2
+
+makeNamespaceQName :: Namespace -> String -> QName
+makeNamespaceQName ns loc = QName (nsURI ns) loc
+
+nullNamespace :: Namespace
+nullNamespace = Namespace "?" ""
+
+------------------------------------------------------------
+--  ScopedName, made from a namespace and a local name
+------------------------------------------------------------
+
+-- |A full ScopedName value has a QName prefix, namespace URI
+--  and a local part.  ScopedName values may omit the prefix
+--  (see Namespace) or the local part.
+--
+--  Some applications may handle null namespace URIs as meaning
+--  the local part is relative to some base URI.
+--
+data ScopedName = ScopedName { snScope :: Namespace, snLocal :: String }
+
+getScopePrefix :: ScopedName -> String
+getScopePrefix = nsPrefix . snScope
+
+getScopeURI :: ScopedName -> String
+getScopeURI = nsURI . snScope
+
+instance Eq ScopedName where
+    (==) = snEq
+
+instance Ord ScopedName where
+    (<=) = snLe
+
+instance Show ScopedName where
+    show (ScopedName n l) =
+        if pre == "?" then "<"++uri++l++">" else pre++":"++l
+        where
+            pre = nsPrefix n
+            uri = nsURI n
+
+--  Scoped names are equal of ther corresponding QNames are equal
+snEq :: ScopedName -> ScopedName -> Bool
+snEq s1 s2 = (getQName s1) == (getQName s2)
+
+--  Scoped names are ordered by their QNames
+snLe :: ScopedName -> ScopedName -> Bool
+snLe s1 s2 = (getQName s1) <= (getQName s2)
+
+-- |Get QName corresponding to a scoped name
+getQName :: ScopedName -> QName
+getQName n = QName (getScopeURI n) (snLocal n)
+
+-- |Get URI corresponding to a scoped name (using RDF conventions)
+getScopedNameURI :: ScopedName -> String
+getScopedNameURI = getQNameURI . getQName
+
+-- |Test if supplied string matches the display form of a
+--  scoped name.
+matchName :: String -> ScopedName -> Bool
+matchName str nam = str == show nam
+
+-- |Construct a ScopedName from prefix, URI and local name
+makeScopedName :: String -> String -> String -> ScopedName
+makeScopedName pre nsuri loc =
+    ScopedName (Namespace pre nsuri) loc
+
+-- |Construct a ScopedName from a QName
+makeQNameScopedName :: QName -> ScopedName
+makeQNameScopedName (QName u l) = makeScopedName "?" u l
+
+-- |Construct a ScopedName for a bare URI
+makeUriScopedName :: String -> ScopedName
+makeUriScopedName u = makeScopedName "?" u ""
+
+-- |Null scoped name:  this should never appear as a valid name
+nullScopedName :: ScopedName
+nullScopedName = makeScopedName "?" "" ""
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/Namespace.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: Namespace.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.13  2004/01/07 19:49:12  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.12  2003/12/08 23:55:36  graham
+-- Various enhancements to variable bindings and proof structure.
+-- New module BuiltInMap coded and tested.
+-- Script processor is yet to be completed.
+--
+-- Revision 1.11  2003/12/03 17:07:24  graham
+-- Replace occurrences of QName in N3Parser with ScopedName.
+--
+-- Revision 1.10  2003/11/24 17:20:34  graham
+-- Separate module Vocabulary from module Namespace.
+--
+-- Revision 1.9  2003/11/24 15:46:03  graham
+-- Rationalize N3Parser and N3Formatter to use revised vocabulary
+-- terms defined in Namespace.hs
+--
+-- Revision 1.8  2003/11/14 21:48:35  graham
+-- First cut cardinality-checked datatype-constraint rules to pass test cases.
+-- Backward chaining is still to do.
+--
+-- Revision 1.7  2003/11/13 01:13:47  graham
+-- Reworked ruleset to use ScopedName lookup.
+-- Various minor fixes.
+--
+-- Revision 1.6  2003/11/12 20:44:24  graham
+-- Added some vocabulary to Namespace.
+-- Enhaced ScopedName to allow null namespace prefixes,
+-- following N3 display conventions.
+--
+-- Revision 1.5  2003/10/24 21:05:08  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.4  2003/10/22 16:18:37  graham
+-- Move common namespace definitions into Namespace module
+-- (May later move these into separate modules.)
+--
+-- Revision 1.3  2003/10/02 13:41:26  graham
+-- Supporting changes for RDF axioms and rules defined as Rulesets,
+-- and moved out of module RDFProofCheck.
+-- Datatype named using ScopedName rather than QName
+-- (Datatype framework is still work in progress).
+--
+-- Revision 1.2  2003/09/30 20:02:40  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.1  2003/09/24 18:51:36  graham
+-- Add module Namespace and test cases.
+--
+-- Revision 1.1  2003/09/24 12:51:00  graham
+-- Add separate QName module and test suite
+--

+ Swish/HaskellUtils/Network/URI.hs view
@@ -0,0 +1,754 @@+--------------------------------------------------------------------------------
+--  $Id: URI.hs,v 1.2 2004/02/02 14:00:39 graham Exp $
+--
+--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Network.URI
+--  Copyright   :  (c) 2004, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--
+--  This module defines functions for handling URIs.  It presents the same
+--  interface as the GHC Network.URI module, but is implemented using Parsec
+--  rather than a Regex library that is not available with Hugs.
+--
+--  In addition, four methods are provided for classifying different
+--  kinds of URI string (as noted in RFC2396bis):
+--      isURI
+--      isURIReference
+--      isRelativeURI
+--      isAbsoluteURI
+--
+--  The current official reference for URI handling is RFC2396 [1],
+--  as updated by RFC 2732 [2].
+--
+--  These are being merged into RFC2396bis [3], a work-in-progress copy of
+--  which is available at the URI indicated.  This document has been used
+--  as the primary reference for constructing the URI parser implemented
+--  here, and it is intended that there is a direct relationship between
+--  the syntax definition in that document and the parser implementation.
+--
+--  [1] http://www.ietf.org/rfc/rfc2396.txt
+--  [2] http://www.ietf.org/rfc/rfc2732.txt
+--  [3] http://gbiv.com/protocols/uri/rev-2002/rfc2396bis.html
+--      (This implementation based on a version dated Sep-2003,
+--      also available as CVS revision 1.64 from
+--      http://cvs.apache.org/viewcvs.cgi/ietf-uri/rev-2002/)
+--
+--  Some of the code has been copied from the GHC implementation, but
+--  the parser is replaced with one that performs more complete
+--  syntax checking of the URI itself, according to RFC2396bis [3].
+--
+--------------------------------------------------------------------------------
+
+module {-Network.-} Swish.HaskellUtils.Network.URI
+    ( -- * The @URI@ type
+      URI(..)
+      -- * Parsing a @URI@
+    , parseURI                  -- :: String -> Maybe URI
+      -- * Testing URI categories
+    , isURI, isURIReference, isRelativeURI, isAbsoluteURI
+    , isIPv6address, isIPv4address
+    , testURIReference
+      -- * Computing relative @URI@s
+    , relativeTo                -- :: URI -> URI -> Maybe URI
+      -- * Operations on @URI@ strings
+      -- | support for putting strings into URI-friendly
+      -- escaped format and getting them back again.
+      -- This can't be done transparently, because certain characters
+      -- have different meanings in different kinds of URI.
+    , reserved, unreserved
+    , isAllowedInURI, unescapedInURI    -- :: Char -> Bool
+    , escapeChar                -- :: (Char->Bool) -> Char -> String
+    , escapeString              -- :: String -> (Char->Bool) -> String
+    , unEscapeString            -- :: String -> String
+    )
+where
+
+import Numeric( showIntAtBase )
+
+import Data.Char( ord, chr, isHexDigit, isSpace )
+
+{- in Prelude???+import Text.Parsec
+    ( GenParser(..), ParseError(..)
+    , parse, (<|>), (<?>), try
+    , option, many, count, notFollowedBy, lookAhead
+    , char, satisfy, oneOf, string, letter, digit, hexDigit, eof
+    )
+-}+import Text.ParserCombinators.Parsec+
+------------------------------------------------------------
+--  The URI datatype
+------------------------------------------------------------
+
+-- |Represents a general universal resource identifier using
+--  its component parts.
+--
+--  For example, for the URI
+--
+--  >   http://www.haskell.org/ghc?query#frag
+--
+--  the components are:
+--
+data URI = URI
+    { scheme    :: String   -- ^ @http@
+    , authority :: String   -- ^ @www.haskell.org@
+    , path      :: String   -- ^ @\/ghc@
+    , query     :: String   -- ^ @query@
+    , fragment  :: String   -- ^ @frag@
+    }
+
+instance Show URI where
+    showsPrec _ uri = uriToString uri
+
+------------------------------------------------------------
+--  Parse a URI
+------------------------------------------------------------
+
+-- |Turn a string into a @URI@.
+--  Returns @Nothing@ if the string is not a valid URI.
+--
+parseURI :: String -> Maybe URI
+parseURI uristr = case parseAll uriReference "" uristr of
+        Left  _ -> Nothing
+        Right u -> Just u
+
+isURI :: String -> Bool
+isURI = isValidParse uri
+
+isURIReference :: String -> Bool
+isURIReference = isValidParse uriReference
+
+isRelativeURI :: String -> Bool
+isRelativeURI = isValidParse relativeUri
+
+isAbsoluteURI :: String -> Bool
+isAbsoluteURI = isValidParse absoluteUri
+
+isIPv6address :: String -> Bool
+isIPv6address = isValidParse ipv6address
+
+isIPv4address :: String -> Bool
+isIPv4address = isValidParse ipv4address
+
+isValidParse :: UriParser a -> String -> Bool
+isValidParse parser uristr = case parseAll parser "" uristr of
+        -- Left  e -> error (show e)
+        Left  _ -> False
+        Right u -> True
+
+testURIReference :: String -> String
+testURIReference uristr = show (parseAll uriReference "" uristr)
+
+parseAll :: UriParser a -> String -> String -> Either ParseError a
+parseAll parser filename uristr = parse newparser filename uristr
+    where
+        newparser =
+            do  { res <- parser
+                ; eof
+                ; return res
+                }
+
+------------------------------------------------------------
+--  URI parser body based on Parsec elements and combinators
+------------------------------------------------------------
+
+--  Parser parser type.
+--  Currently
+type UriParser a = GenParser Char () a
+
+--  Relative and absolute forms
+--
+--  (Note, per RFC2396bis, fragment id is part of the full URI form)
+--
+--  RFC2396bis, section 4.1
+
+uriReference :: UriParser URI
+uriReference = uri <|> relativeUri
+
+--  RFC2396bis, section 4.2
+
+relativeUri :: UriParser URI
+relativeUri =
+    do  { (ua,up) <- hierPart
+        ; uq <- option "" ( do { string "?" ; uquery    } )
+        ; uf <- option "" ( do { string "#" ; ufragment } )
+        ; return $ URI
+            { scheme    = ""
+            , authority = ua
+            , path      = up
+            , query     = uq
+            , fragment  = uf
+            }
+        }
+
+--  RFC2396bis, section 4.3
+
+absoluteUri :: UriParser URI
+absoluteUri =
+    do  { us <- uscheme
+        ; (ua,up) <- hierPart
+        ; uq <- option "" ( do { string "?" ; uquery    } )
+        ; return $ URI
+            { scheme    = us
+            , authority = ua
+            , path      = up
+            , query     = uq
+            , fragment  = ""
+            }
+        }
+
+--  RFC2396bis, section 3
+
+uri :: UriParser URI
+uri =
+    do  { us <- try uscheme
+        ; (ua,up) <- hierPart
+        ; uq <- option "" ( do { string "?" ; uquery    } )
+        ; uf <- option "" ( do { string "#" ; ufragment } )
+        ; return $ URI
+            { scheme    = us
+            , authority = ua
+            , path      = up
+            , query     = uq
+            , fragment  = uf
+            }
+        }
+
+hierPart :: UriParser (String,String)
+hierPart = netPath <|> absPath <|> relPath
+
+netPath :: UriParser (String,String)
+netPath =
+    do  { try (string "//")
+        ; ua <- uauthority
+        ; (_,up) <- option ("","") absPath
+        ; return (ua,up)
+        }
+
+absPath :: UriParser (String,String)
+absPath =
+    do  { char '/'
+        ; up <- pathSegments
+        ; return ("",'/':up)
+        }
+
+relPath :: UriParser (String,String)
+relPath =
+        do  { try uscheme               -- RFC2356bis, section 4.1
+            ; fail "Scheme name in relative path"
+            }
+    <|>
+        do  { up <- pathSegments
+            ; return ("",up)
+            }
+
+--  RFC2396bis, section 3.1
+
+uscheme :: UriParser String
+uscheme =
+    do  { s <- oneThenMany uriAlphaChar (alphanum <|> oneOf "+-.")
+        ; char ':'
+        ; return s
+        }
+
+--  RFC2396bis, section 3.2
+
+uauthority :: UriParser String
+uauthority =
+    do  { uu <- option "" (try userinfo)
+        ; uh <- option "" host
+        ; up <- option "" port
+        ; return $ uu++uh++up
+        }
+
+userinfo :: UriParser String
+userinfo =
+    do  { uu <- many (uchar ";:&=+$,")
+        ; char '@'
+        ; return (concat uu ++"@")
+        }
+
+host :: UriParser String
+host = ipv6reference <|> try ipv4address <|> hostname
+
+ipv6reference :: UriParser String
+ipv6reference =
+    do  { char '['
+        ; ua <- ipv6address
+        ; char ']'
+        ; return $ "[" ++ ua ++ "]"
+        }
+
+ipv6address :: UriParser String
+ipv6address =
+        try ( do
+                { a2 <- count 6 h4c
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ concat a2 ++ a3
+                } )
+    <|> try ( do
+                { string "::"
+                ; a2 <- count 5 h4c
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ "::" ++ concat a2 ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 0
+                ; string "::"
+                ; a2 <- count 4 h4c
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::" ++ concat a2 ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 1
+                ; string "::"
+                ; a2 <- count 3 h4c
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::" ++ concat a2 ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 2
+                ; string "::"
+                ; a2 <- count 2 h4c
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::" ++ concat a2 ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 3
+                ; string "::"
+                ; a2 <- h4c
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::" ++ a2 ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 4
+                ; string "::"
+                ; a3 <- ls32
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::" ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 5
+                ; string "::"
+                ; a3 <- h4
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::" ++ a3
+                } )
+    <|> try ( do
+                { a1 <- opt_n_h4c_h4 6
+                ; string "::"
+                -- ; lookAhead $ char ']'
+                ; return $ a1 ++ "::"
+                } )
+    <?> "IPv6 address"
+
+opt_n_h4c_h4 :: Int -> UriParser String
+opt_n_h4c_h4 n = option "" $
+    do  { a1 <- countMinMax 0 n h4c
+        ; a2 <- h4
+        ; return $ concat a1 ++ a2
+        }
+
+ls32 :: UriParser String
+ls32 =  try ( do
+                { a1 <- h4c
+                ; a2 <- h4
+                ; return (a1++a2)
+                } )
+    <|> ipv4address
+
+h4c :: UriParser String
+h4c = try $
+    do  { a1 <- h4
+        ; char ':'
+        ; notFollowedBy (char ':')
+        ; return $ a1 ++ ":"
+        }
+
+h4 :: UriParser String
+h4 = countMinMax 1 4 uriHexDigitChar
+
+ipv4address :: UriParser String
+ipv4address =
+    do  { a1 <- decOctet ; char '.'
+        ; a2 <- decOctet ; char '.'
+        ; a3 <- decOctet ; char '.'
+        ; a4 <- decOctet
+        ; return $ a1++"."++a2++"."++a3++"."++a4
+        }
+
+decOctet :: UriParser String
+decOctet =
+    do  { a1 <- countMinMax 1 3 uriDigitChar
+        ; if read a1 > 255 then
+            fail "Decimal octet value too large"
+          else
+            return a1
+        }
+
+hostname :: UriParser String
+hostname =
+    do  { a1 <- domainlabel
+        ; a2 <- dqualified
+        ; return $ a1 ++ a2
+        }
+
+dqualified :: UriParser String
+dqualified =
+    do  { a1 <- many $ try (
+            do  { char '.'
+                ; a2 <- domainlabel
+                ; return ('.':a2)
+                } )
+        ; a3 <- option "" (string ".")
+        ; return $ concat a1 ++ a3
+        }
+
+domainlabel :: UriParser String
+domainlabel =
+    do  { a1 <- alphanum
+        ; a2 <- countMinMax 0 62 (alphanum <|> char '-')
+        ; if (not $ null a2) && (last a2 == '-') then
+            fail "Domain label ends with '-'"
+          else
+            return $ a1:a2
+        }
+    <?> "Domain label"
+
+alphanum :: UriParser Char
+alphanum = uriAlphaChar <|> uriDigitChar
+
+port :: UriParser String
+port =
+    do  { char ':'
+        ; p <- many uriDigitChar
+        ; return (':':p)
+        }
+
+--  RFC2396bis, section 3.3
+
+pathSegments :: UriParser String
+pathSegments =
+    do  { s1 <- segment
+        ; s2 <- many $
+            do  { char '/'
+                ; s3 <- segment
+                ; return ('/':s3)
+                }
+        ; return $ s1 ++ concat s2
+        }
+
+segment :: UriParser String
+segment =
+    do  { ps <- many pchar
+        ; return $ concat ps
+        }
+
+pchar :: UriParser String
+pchar = uchar ";:@&=+$,"
+
+-- helper function for pchar and friends
+uchar :: String -> UriParser String
+uchar extras =
+        do { c <- satisfy unreserved ; return [c] }
+    <|> escaped
+    <|> do { c <- oneOf extras ; return [c] }
+
+
+--  RFC2396bis, section 3.4
+
+uquery :: UriParser String
+uquery =
+    do  { ss <- many $ uchar (";:@&=+$,"++"/?")
+        ; return $ concat ss
+        }
+
+--  RFC2396bis, section 3.5
+
+ufragment :: UriParser String
+ufragment =
+    do  { ss <- many $ uchar (";:@&=+$,"++"/?")
+        ; return $ concat ss
+        }
+
+--  RFC2396bis, section 2.4.1
+
+escaped :: UriParser String
+escaped =
+    do  { char '%'
+        ; h1 <- uriHexDigitChar
+        ; h2 <- uriHexDigitChar
+        ; return $ ['%',h1,h2]
+        }
+
+--  Imports from RFC 2234
+
+uriAlphaChar :: UriParser Char
+uriAlphaChar = letter
+
+uriDigitChar :: UriParser Char
+uriDigitChar = digit
+
+uriHexDigitChar :: UriParser Char
+uriHexDigitChar = hexDigit
+
+--  Additional parser combinators for common patterns
+
+oneThenMany :: GenParser t s a -> GenParser t s a -> GenParser t s [a]
+oneThenMany p1 pr =
+    do  { a1 <- p1
+        ; ar <- many pr
+        ; return (a1:ar)
+        }
+
+countMinMax :: Int -> Int -> GenParser t s a -> GenParser t s [a]
+countMinMax m n p | m > 0 =
+    do  { a1 <- p
+        ; ar <- countMinMax (m-1) (n-1) p
+        ; return (a1:ar)
+        }
+countMinMax _ n _ | n <= 0 = return []
+countMinMax _ n p = option [] $
+    do  { a1 <- p
+        ; ar <- countMinMax 0 (n-1) p
+        ; return (a1:ar)
+        }
+
+------------------------------------------------------------
+--  Reconstruct a URI string
+------------------------------------------------------------
+--
+--  Turn a URI into a string.
+--
+--  Algorithm from part 7, sec 5.2, RFC 2396
+--
+uriToString :: URI -> ShowS
+uriToString URI { scheme=scheme
+                , authority=authority
+                , path=path
+                , query=query
+                , fragment=fragment
+                } =
+    append  ":"  scheme    .
+    prepend "//" authority .
+    append  ""   path      .
+    prepend "?"  query     .
+    prepend "#"  fragment
+    where
+        prepend pre  "" rest = rest
+        prepend pre  s  rest = pre ++ s ++ rest
+        append  post "" rest = rest
+        append  post s  rest = s ++ post ++ rest
+
+------------------------------------------------------------
+--  Character classes
+------------------------------------------------------------
+
+-- |Returns 'True' if the character is a \"reserved\" character in a
+--  URI.  To include a literal instance of one of these characters in a
+--  component of a URI, it must be escaped.
+--
+--  RDF2396bis: section 2.2
+--
+reserved :: Char -> Bool
+reserved c = c `elem` "/?#[];:@&=+$,"
+
+-- |Returns 'True' if the character is an \"unreserved\" character in
+--  a URI.  These characters do not need to be escaped in a URI.  The
+--  only characters allowed in a URI are either 'reserved',
+--  'unreserved', or an escape sequence (@%@ followed by two hex digits).
+--
+--  RDF2396bis: section 2.3
+--
+unreserved :: Char -> Bool
+unreserved c = (c >= 'A' && c <= 'Z')
+        || (c >= 'a' && c <= 'z')
+        || (c >= '0' && c <= '9')
+        || mark c
+    -- NOTE: can't use isAlphaNum etc. because these deal with ISO 8859
+    -- (and possibly Unicode!) chars.
+    -- [[[Above was a comment originally in GHC Network/URI.hs:
+    --    when IRIs are introduced then most codepoints above 128(?) should
+    --    be treated as unreserved, and higher codepoints for letters should
+    --    certainly be allowed.
+    -- ]]]
+
+-- |Returns 'True' if the character is a \"mark\" character.
+--
+--  RDF2396bis: section 2.3
+--
+mark :: Char -> Bool
+mark c = c `elem` "-_.!~*'()"
+
+-- | Returns 'True' if the character is allowed in a URI.
+--
+isAllowedInURI :: Char -> Bool
+isAllowedInURI c = reserved c || unreserved c || c == '%' -- escape char
+
+-- | Returns 'True' if the character is allowed unescaped in a URI.
+--
+unescapedInURI :: Char -> Bool
+unescapedInURI c = reserved c || unreserved c
+
+------------------------------------------------------------
+--  Escape sequence handling
+------------------------------------------------------------
+
+-- |Escape character if supplied predicate is not satisfied,
+--  otherwise return character as singleton string.
+--
+escapeChar :: (Char->Bool) -> Char -> String
+escapeChar p c
+    | p c       = [c]
+    | otherwise = '%' : myShowHex (ord c) ""
+    where
+        myShowHex :: Int -> ShowS
+        myShowHex n r =  case showIntAtBase 16 (toChrHex) n r of
+            []  -> "00"
+            [c] -> ['0',c]
+            cs  -> cs
+        toChrHex d
+            | d < 10    = chr (ord '0' + fromIntegral d)
+            | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+
+-- |Can be used to make a string valid for use in a URI.
+--
+escapeString
+    :: String           -- ^ the string to process
+    -> (Char->Bool)     -- ^ a predicate which returns 'False'
+                        --   if the character should be escaped
+    -> String           -- the resulting URI string
+escapeString s p = concatMap (escapeChar p) s
+
+-- |Turns all instances of escaped characters in the string back
+--  into literal characters.
+unEscapeString :: String -> String
+unEscapeString [] = ""
+unEscapeString ('%':x1:x2:s) | isHexDigit x1 && isHexDigit x2 =
+    chr (hexDigit x1 * 16 + hexDigit x2) : unEscapeString s
+    where
+        hexDigit c
+            | c >= 'A' && c <= 'F' = ord c - ord 'A' + 10
+            | c >= 'a' && c <= 'f' = ord c - ord 'a' + 10
+            | otherwise            = ord c - ord '0'
+unEscapeString (c:s) = c : unEscapeString s
+
+------------------------------------------------------------
+-- Resolving a relative URI relative to a base URI
+------------------------------------------------------------
+
+-- |Returns a new @URI@ which represents the value of the
+--  first @URI@ interpreted as relative to the second @URI@.
+--  For example:
+--
+--  > "foo" `relativeTo` "http://bar.org/" = "http://bar.org/foo"
+--
+--  Algorithm from sec 5.2, RFC 2396
+--
+relativeTo :: URI -> URI -> Maybe URI
+ref `relativeTo` base =
+  -- ref has a scheme name, use it in its entirety.  Otherwise inherit
+  -- the scheme name from base.
+  if ref_scheme    /= ""  then Just ref else
+
+  -- ref has an authority - we're done.  Otherwise inherit the authority.
+  if ref_authority /= ""  then Just ref{scheme = base_scheme} else
+
+  -- ref has an absolute path, we're done.
+  if not (null ref_path) && head ref_path == '/'
+        then Just ref{scheme = base_scheme,
+                      authority = base_authority} else
+
+  -- relative path...
+  let new_path = munge (dropLastComponent base_path ++ ref_path) []
+  in if isErrorPath new_path
+        then Nothing
+        else Just ref{scheme = base_scheme,
+                      authority = base_authority,
+                      path = new_path}
+  where
+        URI{
+          scheme    = ref_scheme,
+          authority = ref_authority,
+          path      = ref_path,
+          query     = _ref_query,
+          fragment  = _ref_fragment
+         } = ref
+
+        URI{
+          scheme    = base_scheme,
+          authority = base_authority,
+          path      = base_path,
+          query     = _base_query,
+          fragment  = _base_fragment
+         } = base
+
+        munge [] [] = ""
+        munge [] ps = concat (reverse ps)
+        munge ('.':'/':s)     ps     = munge s ps
+        munge ['.']           ps     = munge [] ps
+        munge ('.':'.':'/':s) (p:ps) | p /= "/" = munge s ps
+        munge ['.','.']       (p:ps) = munge [] ps
+        munge s               ps     = munge rest' (p':ps)
+                where (p,rest) = break (=='/') s
+                      (p',rest') = case rest of
+                                        '/':r -> (p++"/",r)
+                                        r     -> (p,r)
+
+        dropLastComponent = reverse . dropWhile (/= '/') . reverse
+
+        isErrorPath ('/':'.':'.':'/':_) = True
+        isErrorPath _ = False
+
+stripLeadingWS, stripTrailingWS, stripWS :: String -> String
+stripLeadingWS  = dropWhile isSpace
+stripTrailingWS = reverse . stripLeadingWS . reverse
+stripWS         = stripLeadingWS . stripTrailingWS
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2004, G. KLYNE.  All rights reserved.
+--
+--  This is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this software; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/Network/URI.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: URI.hs,v $
+-- Revision 1.2  2004/02/02 14:00:39  graham
+-- Fix optional host name in URI.  Add test cases.
+--
+-- Revision 1.1  2004/01/27 21:13:45  graham
+-- New URI module and test suite added,
+-- implementing the GHC Network.URI interface.
+--
+--

+ Swish/HaskellUtils/Parse.hs view
@@ -0,0 +1,249 @@+--------------------------------------------------------------------------------
+--  $Id: Parse.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  Parse
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This Module defines a collection of parsing functions.
+--
+--  The approach used is based on that in Simon Thompson's book
+--  The Craft of Functional Programming, pages 354 et seq.
+--
+--  The function type for a parser is given by Parser a b (see below)
+--  where a is the type of token to be parsed (e.g. Char), and the
+--  result is a list of pairs (b,[a]), each corresponding to possible parse,
+--  where the first memeber of the pair is the value parsed, and the
+--  second is the remaining input sequence following the parsed value.
+--
+--  A successful parse will generally return a list of one, and an
+--  unsuccessful parse returns an empty list.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.Parse
+      ( module Swish.HaskellUtils.Parse, isSpace, isAlpha, isDigit, isAlphaNum, isHexDigit )
+where
+
+import Data.Char
+      ( isSpace, isAlpha, isDigit, isAlphaNum, isHexDigit )
+
+type Parser a b = [a] -> [(b,[a])] -- e.g. [Char] -> [(Result,[Char])]
+
+alpha :: String+alpha    = ['a'..'z']++['A'..'Z']
++digit :: String+digit    = ['0'..'9']
++alphanum :: String+alphanum = alpha++digit
++hexdigit :: String+hexdigit = digit++['a'..'f']++['A'..'F']
+
+isOneOf :: Eq a => [a] -> a -> Bool
+isOneOf s c = c `elem` s
+
+-- Assemble alternative parses
+parseAlt :: Parser a b -> Parser a b -> Parser a b
+parseAlt p1 p2 input = p1 input ++ p2 input
+
+
+-- Select one of two parses, prefering the first.
+parseOne :: Parser a b -> Parser a b -> Parser a b
+parseOne p1 p2 input
+    | not (null first) = first
+    | otherwise        = p2 input
+    where first = p1 input
+
+-- Parse optional item returning single list, or empty list if absent
+parseOptional :: Parser a [b] -> Parser a [b]
+parseOptional p1 = parseOne p1 ( parseReturn [] )
+
+-- Parse sequence of values, returning list of pairs
+infixr 5 >*>
+(>*>) :: Parser a b -> Parser a c -> Parser a (b,c)
+(>*>) p1 p2 input =
+  [ ((val1,val2),rem2) | (val1,rem1) <- p1 input, (val2,rem2) <- p2 rem1 ]
+
+-- Apply function to raw result of parse to get required value
+-- The supplied function must take account of all the possible parse values
+parseApply :: Parser a b -> ( b -> c ) -> Parser a c
+parseApply p f input = [ (f val,rem) | (val,rem) <- p input ]
+
+-- Function used with parseApply to flatten the pairs returned by
+-- >*> into a list
+-- e.g. toList (item,list) = item:list
+toList :: (a,[a]) -> [a]
+toList = uncurry (:)
+
+-- Function used with parseApply to return a value as a singleton list
+-- e.g. makeList item = [item]
+makeList :: a -> [a]
+makeList x = [x]
+
+-- Function used with parseApply to return a value that is a
+-- concatenation of the members of a list.
+-- e.g. catList ["ab","cd","ef"] = "abcdef"
+catList :: [[a]] -> [a]
+catList = foldl (++) []
+
+-- Indicate completion of expression (or sub-expression),
+-- returning given value
+parseReturn :: b -> Parser a b
+parseReturn value input = [(value,input)]
+
+-- Parse any number of tokens matching a supplied parse,
+-- returning a list of values parsed
+-- type Parser a b = [a] -> [(b,[a])] -- e.g. [Char] -> [(Result,[Char])]
+parseMany   :: Parser a b -> Parser a [b]
+parseMany p =
+    parseOne ( ( p >*> (parseMany p) ) `parseApply` toList )
+             ( parseReturn [] )
+
+-- Parse a sequence of a token matching t1 followed by
+-- any number of tokens matching t2, returning a list of
+-- tokens thus matched
+parseSequence :: ( a -> Bool , a -> Bool) -> Parser a [a]
+parseSequence ( t1, t2 ) =
+    ( parseItem t1 >*> parseMany ( parseItem t2 ) )
+    `parseApply` toList
+
+-- Parse a single token matching selector t, returning that value
+parseItem   :: ( a -> Bool ) -> Parser a a
+parseItem t (next:more)
+    | t next    = [(next,more)]
+    | otherwise = []
+parseItem t []  = []
+
+parseWS :: Parser Char String
+parseWS = parseMany (parseItem isSpace)
+
+parseAlpha :: Parser Char Char
+parseAlpha  =  parseItem isAlpha
+
+parseDigit :: Parser Char Char
+parseDigit  =  parseItem isDigit
+
+parseAlphaNum :: Parser Char Char
+parseAlphaNum  =  parseItem isAlphaNum
+
+parseHexDigit :: Parser Char Char
+parseHexDigit  =  parseItem isHexDigit
+
+-- Parse input, returning list of values (all parsers must be same type)
+infixr 5 >:>
+(>:>) :: Parser a b -> Parser a [b] -> Parser a [b]
+(p1 >:> p2) input =
+  [ (val1:val2,rem2) | (val1,rem1) <- p1 input, (val2,rem2) <- p2 rem1 ]
+
+-- concatenate lists returned by parsers p1 p2
+infixr 5 >++>
+(>++>) :: Parser a [b] -> Parser a [b] -> Parser a [b]
+(p1 >++> p2) input =
+  [ (val1++val2,rem2) | (val1,rem1) <- p1 input, (val2,rem2) <- p2 rem1 ]
+
+-- skip token matching p1, then use supplied parser p2
+skipToken :: Parser a b -> Parser a c -> Parser a c
+skipToken p1 p2 input =
+  [ res | (_,rem1) <- p1 input, res <- p2 rem1 ]
+
+-- Fail if end of input not here, otherwise return supplied value
+parseEnd :: b -> Parser a b
+parseEnd v [] = ( parseReturn v ) []
+parseEnd _ _  = []
+
+-- Match null input (returning value ())
+parseNull :: Parser a ()
+parseNull [] = [((),[])]
+parseNull _  = []
+
+-- Test if supplied string matches given parser
+isValid :: Parser a b -> [a] -> Bool
+isValid parser input =
+    not ( null ( ( parser >*> parseNull ) input ) )
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/Parse.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: Parse.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.14  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.13  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.12  2003/05/20 23:35:28  graham
+-- Modified code to compile with GHC hierarchical libraries
+--
+-- Revision 1.11  2003/03/28 21:50:22  graham
+-- Graph equality coded and nearly working
+--
+-- Revision 1.10  2003/02/27 13:54:30  graham
+-- ParseURI module passes unit test
+--
+-- Revision 1.9  2003/02/27 00:29:53  graham
+-- Add additional parse functions for lists of values
+--
+-- Revision 1.8  2003/02/20 19:44:37  graham
+-- Added isValid and parseNull to Pase module.
+-- All tests pass.
+--
+-- Revision 1.7  2003/02/19 20:20:50  graham
+-- Some small parser enhancements
+--
+-- Revision 1.6  2003/02/19 18:45:00  graham
+-- Parser unit tests done.
+-- Worked out some details for simplified parser construction.
+--
+-- Revision 1.5  2003/02/13 16:14:14  graham
+-- >*> function works
+--
+-- Revision 1.4  2003/02/13 15:09:47  graham
+-- Initial parser tests all pass.
+--
+-- Revision 1.3  2003/02/13 11:31:18  graham
+-- Separate parser tests from parser code
+--
+-- Revision 1.2  2003/02/07 18:46:07  graham
+-- Add new date/time modules
+-- Update copyright year
+--
+-- Revision 1.1  2003/02/02 15:11:15  graham
+-- Created new Parsing module
+--
+--

+ Swish/HaskellUtils/ParseTest.hs view
@@ -0,0 +1,309 @@+--------------------------------------------------------------------------------
+--  $Id: ParseTest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ParseTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+-- This module contains test cases for module Parse functions.
+--
+--------------------------------------------------------------------------------
+
+-- WNH RIP OUT module Swish.HaskellUtils.ParseTest where
+
+import Test.HUnit
++import Swish.HaskellUtils.Parse
+
+testParser :: ( Show a, Show b, Eq a, Eq b ) => String -> Parser a b -> [a] -> [(b,[a])] -> Test
+testParser s p i r =
+    TestCase ( assertEqual s r ( p i ) )
+
+noResult :: [ ( (),[Char] ) ]
+noResult = []
+
+testParseReturn1 = testParser "parseReturn1" (parseReturn "FOO") ""   [("FOO","")]
+testParseReturn2 = testParser "parseReturn2" (parseReturn "BAR") "**" [("BAR","**")]
+
+testParseItem1 = testParser "parseItem1" (parseItem (=='1')) "2"   []
+testParseItem2 = testParser "parseItem2" (parseItem (=='2')) "abc" []
+testParseItem3 = testParser "parseItem3" (parseItem (=='3')) "3"   [('3',"")]
+testParseItem4 = testParser "parseItem4" (parseItem (=='4')) "456" [('4',"56")]
+testParseItem5 = testParser "parseItem5" (parseItem (=='5')) ""    []
+
+testParseAlpha1 = testParser "parseAlpha1" parseAlpha "123" []
+testParseAlpha2 = testParser "parseAlpha2" parseAlpha "a**" [('a',"**")]
+testParseAlpha3 = testParser "parseAlpha3" parseAlpha "z//" [('z',"//")]
+testParseAlpha4 = testParser "parseAlpha4" parseAlpha "Abc" [('A',"bc")]
+testParseAlpha5 = testParser "parseAlpha5" parseAlpha "Zyx" [('Z',"yx")]
+
+testParseDigit1 = testParser "parseDigit1" parseDigit "ab"   []
+testParseDigit2 = testParser "parseDigit2" parseDigit "1ab"  [('1',"ab")]
+testParseDigit3 = testParser "parseDigit3" parseDigit "9ab"  [('9',"ab")]
+testParseDigit4 = testParser "parseDigit4" parseDigit "55ab" [('5',"5ab")]
+
+testParseAlphaNum1 = testParser "parseAlphaNum1" parseAlphaNum "..." []
+testParseAlphaNum2 = testParser "parseAlphaNum2" parseAlphaNum "a**" [('a',"**")]
+testParseAlphaNum3 = testParser "parseAlphaNum3" parseAlphaNum "z//" [('z',"//")]
+testParseAlphaNum4 = testParser "parseAlphaNum4" parseAlphaNum "Abc" [('A',"bc")]
+testParseAlphaNum5 = testParser "parseAlphaNum5" parseAlphaNum "Zyx" [('Z',"yx")]
+testParseAlphaNum6 = testParser "parseAlphaNum6" parseAlphaNum "123" [('1',"23")]
+testParseAlphaNum7 = testParser "parseAlphaNum7" parseAlphaNum "987" [('9',"87")]
+
+parseAltParser = parseAlt parseDigit parseAlpha
+testParseAlt1 = testParser "parseAlt1" parseAltParser "..." []
+testParseAlt2 = testParser "parseAlt2" parseAltParser "123" [('1',"23")]
+testParseAlt3 = testParser "parseAlt3" parseAltParser "ABC" [('A',"BC")]
+
+parseOneParser = parseOne parseDigit parseAlpha
+testParseOne1 = testParser "parseOne1" parseOneParser "###" []
+testParseOne2 = testParser "parseOne2" parseOneParser "123" [('1',"23")]
+testParseOne3 = testParser "parseOne3" parseOneParser "ABC" [('A',"BC")]
+
+parseOptParser = parseOptional ( parseDigit `parseApply` makeList )
+testParseOpt1 = testParser "parseOpt1" parseOptParser "###" [([],"###")]
+testParseOpt2 = testParser "parseOpt2" parseOptParser "123" [(['1'],"23")]
+testParseOpt3 = testParser "parseOpt3" parseOptParser "ABC" [([],"ABC")]
+
+parseSeqParser
+  = ( parseAlpha >*> p1 ) `parseApply` toList
+    where
+    p1 = ( ( parseItem (== '-') ) >*> p2 )   `parseApply` toList
+    p2 = ( parseDigit >*> (parseReturn []) ) `parseApply` toList
+
+testParseSeq1 = testParser "parseSeq1" parseSeqParser "???"    []
+testParseSeq2 = testParser "parseSeq2" parseSeqParser "A-1>>>" [("A-1",">>>")]
+testParseSeq3 = testParser "parseSeq3" parseSeqParser "Z-9"    [("Z-9","")]
+testParseSeq4 = testParser "parseSeq4" parseSeqParser "1-A>>>" []
+testParseSeq5 = testParser "parseSeq5" parseSeqParser "A#1>>>" []
+
+-- parseMany   :: Parser a b -> Parser a [b]
+parseManyParser = parseMany parseDigit
+
+testParseMany1 = testParser "parseMany1" parseManyParser "ab"      [("","ab")]
+testParseMany2 = testParser "parseMany2" parseManyParser "2ab"     [("2","ab")]
+testParseMany3 = testParser "parseMany3" parseManyParser "3"       [("3","")]
+testParseMany4 = testParser "parseMany4" parseManyParser "444"     [("444","")]
+testParseMany5 = testParser "parseMany5" parseManyParser "54321ab" [("54321","ab")]
+testParseMany6 = testParser "parseMany6" parseManyParser ""        [("","")]
+
+-- parseSequence :: ( a -> Bool , a -> Bool) -> Parser a [a]
+parseIdParser = parseSequence ( isAlpha, isAlphaNum )
+
+testParseId1 = testParser "parseId1" parseIdParser "123"     []
+testParseId2 = testParser "parseId2" parseIdParser "b2z9"    [("b2z9","")]
+testParseId3 = testParser "parseId3" parseIdParser "c"       [("c","")]
+testParseId4 = testParser "parseId4" parseIdParser "d444**"  [("d444","**")]
+testParseId5 = testParser "parseId5" parseIdParser "efg55.6" [("efg55",".6")]
+testParseId6 = testParser "parseId6" parseIdParser ""        []
+
+-- infixr 5 >:>
+-- (>:>) :: Parser a b -> Parser a [b] -> Parser a [b]
+
+-- skip whitespace then use supplied parser
+skipWS :: Parser Char a -> Parser Char a
+skipWS = skipToken parseWS
+
+parseIdent :: Parser Char String
+parseIdent = parseSequence ( isAlpha, isAlphaNum )
+
+parseNumber :: Parser Char String
+parseNumber = parseSequence ( isDigit, isDigit )
+
+-- type Parser a b = [a] -> [(b,[a])] -- e.g. [Char] -> [(Result,[Char])]
+parseOp :: String -> Parser Char String
+parseOp op = foldr (>:>) (parseReturn "") [ parseItem (==c) | c <- op ]
+
+parseExprParser = (skipWS parseIdent)     >:>
+                  (skipWS (parseOp ":=")) >:>
+                  (skipWS parseNumber)    >:>
+                  (skipWS (parseOp "+"))  >:>
+                  (skipWS parseNumber )   >:>
+                  (skipWS (parseOp ";"))  >:>
+                  (skipWS (parseReturn []))
+
+testParseExpr1 = testParser "parseExpr1" parseExprParser "// yyy" []
+testParseExpr2 = testParser "parseExpr2" parseExprParser "A:=1+1;"
+                            [(["A",":=","1","+","1",";"],"")]
+testParseExpr3 = testParser "parseExpr3" parseExprParser " B := 2 + 2 ; "
+                            [(["B",":=","2","+","2",";"],"")]
+testParseExpr4 = testParser "parseExpr4" parseExprParser "CCC := 33+34 ; // xxx"
+                            [(["CCC",":=","33","+","34",";"],"// xxx")]
+testParseExpr5 = testParser "parseExpr5" parseExprParser "D5 := 5 + 55 ;//yyy"
+                            [(["D5",":=","5","+","55",";"],"//yyy")]
+testParseExpr6 = testParser "parseExpr6" parseExprParser "D5 :* 5 + 55 ;//yyy" []
+testParseExpr7 = testParser "parseExpr7" parseExprParser "" []
+
+parseExprLstParser = (skipWS parseIdent)     >++>
+                     (skipWS (parseOp ":=")) >++>
+                     (skipWS parseNumber)    >++>
+                     (skipWS (parseOp "+"))  >++>
+                     (skipWS parseNumber )   >++>
+                     (skipWS (parseOp ";"))  >++>
+                     (skipWS (parseReturn []))
+
+testParseExprLst1 = testParser "parseExprLst1" parseExprLstParser
+                            "// yyy"
+                            []
+testParseExprLst2 = testParser "parseExprLst2" parseExprLstParser
+                            "A:=1+1;"
+                            [("A:=1+1;","")]
+testParseExprLst3 = testParser "parseExprLst3" parseExprLstParser
+                            " B := 2 + 2 ; "
+                            [("B:=2+2;","")]
+testParseExprLst4 = testParser "parseExprLst4" parseExprLstParser
+                            "CCC := 33+34 ; // xxx"
+                            [("CCC:=33+34;","// xxx")]
+testParseExprLst5 = testParser "parseExprLst5" parseExprLstParser
+                            "D5 := 5 + 55 ;//yyy"
+                            [("D5:=5+55;","//yyy")]
+testParseExprLst6 = testParser "parseExprLst6" parseExprLstParser
+                            "D5 :* 5 + 55 ;//yyy"
+                            []
+testParseExprLst7 = testParser "parseExprLst7" parseExprLstParser
+                            ""
+                            []
+
+makeListParser = parseManyParser `parseApply` makeList
+
+testMakeList1 = testParser "testMakeList1" makeListParser "ab"  [([""],"ab")]
+testMakeList2 = testParser "testMakeList2" makeListParser "2ab" [(["2"],"ab")]
+
+catListParser = makeListParser `parseApply` catList
+catExprParser = parseExprParser `parseApply` catList
+
+testCatList1 = testParser "testCatList1" catListParser "ab"  [("","ab")]
+testCatList2 = testParser "testCatList2" catListParser "2ab" [("2","ab")]
+testCatList3 = testParser "testCatList3" catExprParser
+                            "D5 := 5 + 55 ;//yyy"   [("D5:=5+55;","//yyy")]
+testCatList4 = testParser "testCatList4" catExprParser
+                            "D5 :* 5 + 55 ;//yyy"   []
+testCatList5 = testParser "testCatList5" catExprParser
+                            ""                      []
+
+testParseNull1 = testParser "parseNull1"
+                 parseNull "a" noResult
+testParseNull2 = testParser "parseNull2"
+                 parseNull "" [((),"")]
+
+testIsValid :: String -> Parser a b -> Bool -> [a] -> Test
+testIsValid label parser match input =
+    TestCase ( assertEqual label match ( (isValid parser) input ) )
+
+testParseEnd1   = testParser "parseEnd1" (parseEnd "") ""   [("",[])]
+testParseEnd2   = testParser "parseEnd2" (parseEnd "") "xx" []
+
+testIsValid1 = testIsValid "testIsValid1" parseExprParser False "// yyy"
+testIsValid2 = testIsValid "testIsValid2" parseExprParser True  "A:=1+1;"
+testIsValid3 = testIsValid "testIsValid3" parseExprParser True  " B := 2 + 2 ; "
+testIsValid4 = testIsValid "testIsValid4" parseExprParser False "CCC := 33+34 ; // xxx"
+testIsValid5 = testIsValid "testIsValid5" parseExprParser False "D5 := 5 + 55 ;//yyy"
+testIsValid6 = testIsValid "testIsValid6" parseExprParser False "D5 :* 5 + 55 ;//yyy"
+testIsValid7 = testIsValid "testIsValid7" parseExprParser False ""
+
+allTests = TestList
+  [ testParseReturn1, testParseReturn2,
+    testParseItem1,  testParseItem2,  testParseItem3,  testParseItem4,  testParseItem5,
+    testParseAlpha1, testParseAlpha2, testParseAlpha3, testParseAlpha4, testParseAlpha5,
+    testParseDigit1, testParseDigit2, testParseDigit3, testParseDigit4,
+    testParseAlphaNum1, testParseAlphaNum2, testParseAlphaNum3, testParseAlphaNum4,
+                        testParseAlphaNum5, testParseAlphaNum6, testParseAlphaNum7,
+    testParseAlt1, testParseAlt2, testParseAlt3,
+    testParseOne1, testParseOne2, testParseOne3,
+    testParseOpt1, testParseOpt2, testParseOpt3,
+    testParseSeq1, testParseSeq2, testParseSeq3, testParseSeq4, testParseSeq5,
+    testParseMany1, testParseMany2, testParseMany3, testParseMany4,
+                    testParseMany5, testParseMany6,
+    testParseId1,   testParseId2,   testParseId3,   testParseId4,
+                    testParseId5,   testParseId6,
+    testParseExpr1, testParseExpr2, testParseExpr3, testParseExpr4,
+                    testParseExpr5, testParseExpr6, testParseExpr7,
+    testParseExprLst1, testParseExprLst2, testParseExprLst3,
+                       testParseExprLst4, testParseExprLst5,
+                       testParseExprLst6, testParseExprLst7,
+    testMakeList1,  testMakeList2,
+    testCatList1,   testCatList2,   testCatList3,   testCatList4,
+    testCatList5,
+    testParseNull1, testParseNull2,
+    testIsValid1,   testIsValid2,   testIsValid3,   testIsValid4,
+                    testIsValid5,   testIsValid6,   testIsValid7,
+    testParseEnd1,  testParseEnd2 ]
+
+main = runTestTT allTests
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ParseTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ParseTest.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.12  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.11  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.10  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.9  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.8  2003/02/27 13:54:30  graham
+-- ParseURI module passes unit test
+--
+-- Revision 1.7  2003/02/27 00:29:53  graham
+-- Add additional parse functions for lists of values
+--
+-- Revision 1.6  2003/02/20 19:44:37  graham
+-- Added isValid and parseNull to Pase module.
+-- All tests pass.
+--
+-- Revision 1.5  2003/02/19 20:20:50  graham
+-- Some small parser enhancements
+--
+-- Revision 1.4  2003/02/19 18:45:00  graham
+-- Parser unit tests done.
+-- Worked out some details for simplified parser construction.
+--
+-- Revision 1.3  2003/02/13 16:14:14  graham
+-- >*> function works
+--
+-- Revision 1.2  2003/02/13 15:09:47  graham
+-- Initial parser tests all pass.
+--
+-- Revision 1.1  2003/02/13 11:31:18  graham
+-- Separate parser tests from parser code
+--

+ Swish/HaskellUtils/ParseURI.hs view
@@ -0,0 +1,503 @@+--------------------------------------------------------------------------------
+--  $Id: ParseURI.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ParseURI
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a collection of functions for parsing URIs.
+--
+--  These are used mainly as helper functions by the module URI.
+--
+--  The current official reference for URI handling is RFC2396 [1],
+--  as updated by RFC 2732 [2].
+--
+--  These are being merged into RFC2396bis [3], a work-in-progress copy of
+--  which is available at the URI indicated.  This document has been used
+--  as the primary reference for constructing the URI parser implemented
+--  here, and it is intended that there is a direct relationship between
+--  the syntax definition in that document and the parser implementation.
+--
+--  [1] http://www.ietf.org/rfc/rfc2396.txt
+--  [2] http://www.ietf.org/rfc/rfc2732.txt
+--  [3] http://www.apache.org/~fielding/uri/rev-2002/rfc2396bis.html
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.ParseURI
+  ( URI(URI),
+    absoluteUri, relativeUri, uriReference, absoluteUriReference,
+    uriToString,
+    hostname, ipv4address, ipv6address, relSegmentWithColon
+    ) where
+
+    -- absoluteUri :: Parser Char URI           -- no fragment
+    -- relativeUri :: Parser Char URI           -- no fragment
+    -- uriReference :: Parser Char URI          -- optional fragment
+    -- absoluteUriReference :: Parser Char URI  -- absolute with opt frag
+    -- uriToString :: URI -> String
+    -- hostname :: Parser Char String
+    -- ipv4address :: Parser Char String
+    -- ipv6address :: Parser Char String
+
+    -- Declare imports used from Parser module
+    import qualified Swish.HaskellUtils.Parse as Parse++    type Parser a b = Parse.Parser a b
++    isOneOf :: Eq a => [a] -> a -> Bool
+    isOneOf       = Parse.isOneOf
++    isAlpha       :: Char -> Bool+    isAlpha       = Parse.isAlpha
++    isDigit       :: Char -> Bool+    isDigit       = Parse.isDigit
++    isAlphaNum    :: Char -> Bool+    isAlphaNum    = Parse.isAlphaNum
++    isHexDigit    :: Char -> Bool+    isHexDigit    = Parse.isHexDigit
++    parseApply    = Parse.parseApply
+    parseReturn   = Parse.parseReturn
+    parseOne      = Parse.parseOne
+    parseAlt      = Parse.parseAlt
+    parseOptional = Parse.parseOptional
+    parseSequence = Parse.parseSequence
+    parseMany     = Parse.parseMany
+    parseItem     = Parse.parseItem
+    catList       = Parse.catList
+    makeList      = Parse.makeList
+    (>++>)        = (Parse.>++>)
+    (>:>)         = (Parse.>:>)
+    (>*>)         = (Parse.>*>)
++    alphanumCh    :: String+    alphanumCh    = Parse.alphanum
+
+    -- Generic URI parser
+    -- Each parser rule is a local function definition,
+    -- mostly based on the function type:  Parser Char String
+    -- e.g. parseURI :: Parser Char URI
+
+    -- Internal data type for URI
+    -- Components are:
+    --   scheme authority [segments] query fragment
+    --   e.g.
+    --     "http:" "//example.org" ["/","dir/","file"] "?q" "#f"
+    --     "mailto:" "" ["local@domain"] "" "#f"
+    --
+    -- Note: opaque paths are presented as an authority string with
+    --       empty list of segments and query values.  I think (?) this
+    --       yields the correct behaviour when working with relative URIs
+    -- Note: if the final path segment ends with a "/", an empty segment
+    --       is appended to the segment list.  Thus, the final element
+    --       of the list corresponds (roughly) to a filename rather than
+    --       a directory name.
+    --
+    data URI = URI String String [String] String String
+        deriving ( Eq, Show )
+    type URIPath = (String,[String],String)
+
+    makeAbsUri   (s,(a,p,q))         = URI s a p q ""
+    makeRelUri   (a,p,q)             = URI "" a p q ""
+    setFragment  (URI s a p q _, f1) = URI s a p q f1
+    makeHierPath ((a,p),q)           = (a,p,q)
+    makeOpaqPath s                   = (s,[],"")
++    nullURI                          :: URI+    nullURI                          = URI "" "" [] "" ""
+
+    uriToString :: URI -> String
+    uriToString (URI sch aut seg qry frag) =
+        sch++aut++(foldl (++) [] seg)++qry++frag
+
+    -- Local helper functions
+    nullStr  = parseReturn []
+    alt      = parseAlt
+    one      = parseOne
+    oneOf    = foldr1 one
+    anyOf    = foldr1 alt
+    opt p    = alt p nullStr
+    rep p    = alt ( p >++> (rep p) ) ( parseReturn [] )
+    no p inp = if null (p inp) then [([],inp)] else []
+    -- optG and repG are "greedy" versions of opt and rep
+    optG p   = one p nullStr
+    repG p   = one ( p >++> (repG p) ) ( parseReturn [] )
+
+    char c   = cclass (==c)
+    cclass t = (parseItem t ) `parseApply` makeList
+
+    count (mn,mx) p = ( ( countEq mn p ) >++> ( countMax (mx-mn) p ) )
+    countEq n p
+        | n > 0     = ( p >++> ( countEq (n-1) p ) )
+        | otherwise = parseReturn []
+    countMax n p
+        | n > 0     = opt ( p >++> ( countMax (n-1) p ) )
+        | otherwise = parseReturn []
+
+    -- Syntax copied almost verbatim from RFC2396bis:
+    -- http://www.apache.org/~fielding/uri/rev-2002/rfc2396bis.html
+
+    -- Character parsers
+
+    -- misc
+    alpha    :: String -> [(String, String)]+    alpha    = (cclass isAlpha)
++    alphanum :: String -> [(String, String)]+    alphanum = (cclass isAlphaNum)
++    alnumhyp :: String -> [(String, String)]+    alnumhyp = alt (cclass isAlphaNum) (char '-')
++    digit    :: String -> [(String, String)]+    digit    = (cclass isDigit)
++    hexdigit :: String -> [(String, String)]+    hexdigit = (cclass isHexDigit)
++    dot      :: String -> [(String, String)]+    dot      = (char '.')
++    slash    :: String -> [(String, String)]+    slash    = (char '/')
++    colon    :: String -> [(String, String)]+    colon    = (char ':')
+
++    -- sect 2
+    uric :: String -> [(String, String)]+    uric = oneOf [ reserved, unreserved, escaped ]
+
+    -- sect 3
+    uricNoSlash :: String -> [(String, String)]+    uricNoSlash = oneOf
+          [ unreserved,
+            (char '['),
+            (char ']'),
+            (char ';'),
+            (char '?'),
+            (char ':'),
+            (char '@'),
+            (char '&'),
+            (char '='),
+            (char '+'),
+            (char '$'),
+            (char ','),
+            escaped  ]
+    -- sect 2.2
+    reserved :: String -> [(String, String)]+    reserved = oneOf
+          [ (char '['),
+            (char ']'),
+            (char ';'),
+            (char '/'),
+            (char '?'),
+            (char ':'),
+            (char '@'),
+            (char '&'),
+            (char '='),
+            (char '+'),
+            (char '$'),
+            (char ',') ]
+    -- sect 2.3
+    unreserved :: String -> [(String, String)]+    unreserved = oneOf
+          [ (cclass isAlpha),
+            (cclass isDigit),
+            mark ]
+    mark :: String -> [(String, String)]+    mark = oneOf
+          [ (char '-'),
+            (char '_'),
+            (char '.'),
+            (char '!'),
+            (char '~'),
+            (char '*'),
+            (char '\''),
+            (char '('),
+            (char ')') ]
+    -- sect 2.4.1
+    escaped :: String -> [(String, String)]+    escaped = (char '%') >++> hexdigit >++> hexdigit
+    -- sect 3.3
+    pchar :: String -> [(String, String)]+    pchar = oneOf
+          [ unreserved,
+            (char ';'),
+            (char ':'),
+            (char '@'),
+            (char '&'),
+            (char '='),
+            (char '+'),
+            (char '$'),
+            (char ','),
+            escaped  ]
+
+    -- URI parser
+
+    -- sect 3  (see also section 4.3)
+    -- absoluteUri -> URI scheme: Path ""
+    absoluteUri :: Parser Char URI
+    absoluteUri = (scheme >++> colon) >*> (alt hierPart opaquePart)
+                  `parseApply` makeAbsUri
+
+    hierPart :: Parser Char URIPath
+    hierPart    = (one netPath absPath) >*> optG ((char '?') >++> query)
+                  `parseApply` makeHierPath
+    netPath :: Parser Char (String,[String])
+    netPath     = (slash >++> slash >++> authority) >*> (optG absPath1)
+    absPath :: Parser Char (String,[String])
+    absPath     = nullStr >*> absPath1
+    absPath1 :: Parser Char [String]
+    absPath1    = slash >:> pathSegments
+
+    opaquePart :: Parser Char URIPath
+    opaquePart  = uricNoSlash >++> ( repG uric )
+                  `parseApply` makeOpaqPath
+
+    -- sect 3.1
+    scheme :: Parser Char String
+    scheme = parseSequence ( isAlpha, (isOneOf (alphanumCh++"+-.")) )
+
+    -- sect 3.2
+    authority :: Parser Char String
+    authority = oneOf [ server, regName, nullStr ]
+
+    -- sect 3.2.1
+    regName :: Parser Char String
+    regName = regChar >++> ( repG regChar )
+    regChar :: String -> [(String, String)]+    regChar = oneOf
+          [ unreserved,
+            (char ';'),
+            (char ':'),
+            (char '@'),
+            (char '&'),
+            (char '='),
+            (char '+'),
+            (char '$'),
+            (char ','),
+            escaped ]
+
+    -- sect 3.2.2
+    -- NOTE: blank server option is handled by 'authority' production
+    server :: Parser Char String
+    server      = opt ( userinfo >++> (char '@') ) >++> hostport
+    userinfo    :: String -> [(String, String)]+    userinfo    = uinfoCh >++> ( repG uinfoCh )
+    uinfoCh     :: String -> [(String, String)]+    uinfoCh     = oneOf
+          [ unreserved,     -- regChar without '@'
+            (char ';'),
+            (char ':'),
+            (char '&'),
+            (char '='),
+            (char '+'),
+            (char '$'),
+            (char ','),
+            escaped ]
+    hostport    :: String -> [(String, String)]+    hostport    = host >++> ( optG ( colon >++> port ) )
+    host        :: String -> [(String, String)]+    host        = oneOf [ ipv6reference, ipv4address, hostname ]
+    port        :: String -> [(String, String)]+    port        = repG digit
+
+    hostname :: Parser Char String
+    hostname    = domainlabel >++> ( optG qualified )
+    qualified   :: String -> [(String, String)]+    qualified   = ( rep ( dot >++> domainlabel ) ) >++>
+                  ( opt ( dot >++> toplabel >++> dot >++> (no alphanum) ) ) >++>
+                  ( no dot )   -- force all available domain labels to be taken
+    domainlabel :: String -> [(String, String)]+    domainlabel = alphanum >++> morelabel
+    toplabel    :: String -> [(String, String)]+    toplabel    = alpha    >++> morelabel
+    morelabel   :: String -> [(String, String)]+    morelabel   = optG ( ( countMax 61 alnumhyp ) >++> alphanum
+                         >++> (no alnumhyp) )
+
+    ipv4address :: String -> [(String, String)]+    ipv4address = decoctet >++> dot >++> decoctet
+                           >++> dot >++> decoctet
+                           >++> dot >++> decoctet
+    decoctet    :: String -> [(String, String)]+    decoctet    = anyOf
+          [ digit,
+            digit19 >++> digit,
+            (char '1') >++> digit >++> digit,
+            (char '2') >++> digit04 >++> digit,
+            (char '2') >++> (char '5') >++> digit05 ]
+    digit19     :: String -> [(String, String)]+    digit19     = (cclass (isOneOf "123456789") )
+    digit12     :: String -> [(String, String)]+    digit12     = (cclass (isOneOf "12") )
+    digit04     :: String -> [(String, String)]+    digit04     = (cclass (isOneOf "01234") )
+    digit05     :: String -> [(String, String)]+    digit05     = (cclass (isOneOf "012345") )
+
+    ipv6reference :: String -> [(String, String)]+    ipv6reference = (char '[') >++> ipv6address >++> (char ']')
+    ipv6address :: String -> [(String, String)]+    ipv6address = anyOf
+          [                           (countEq 6 h4c) >++> ls32,
+                              cc >++> (countEq 5 h4c) >++> ls32,
+            opt h4       >++> cc >++> (countEq 4 h4c) >++> ls32,
+            (n_h4c_h4 1) >++> cc >++> (countEq 3 h4c) >++> ls32,
+            (n_h4c_h4 2) >++> cc >++> (countEq 2 h4c) >++> ls32,
+            (n_h4c_h4 3) >++> cc >++>            h4c  >++> ls32,
+            (n_h4c_h4 4) >++> cc >++>                      ls32,
+            (n_h4c_h4 5) >++> cc >++>                      h4,
+            (n_h4c_h4 5) >++> cc ]
+    h4c         = h4 >++> colon
+    n_h4c_h4 n  = opt ( (countMax n h4c) >++> h4 )
+    cc          :: String -> [(String, String)]+    cc          = colon >++> colon
+    h4          :: String -> [(String, String)]+    h4          = count (1,4) hexdigit
+    ls32          :: String -> [(String, String)]+    ls32        = alt (h4c >++> h4) ipv4address
+
+    -- sect 3.3
+    pathSegments :: Parser Char [String]
+    pathSegments = one ( (segment >++> slash) >:> pathSegments )
+                       ( segment `parseApply` makeList )+    segment      :: String -> [(String, String)]+    segment      = repG pchar
+
+    -- sect 3.4
+    query :: Parser Char String
+    query        = repG ( oneOf [ pchar, slash, (char '?') ] )
+
+    -- sect 4
+    uriReference :: Parser Char URI
+    uriReference = ( ( oneOf [ absoluteUri, relativeUri, emptyURI ] )
+                     >*> optfrag )
+                   `parseApply` setFragment
+    emptyURI     = parseReturn nullURI
+    optfrag      :: String -> [(String, String)]+    optfrag      = optG ( (char '#') >++> fragment )
+
+    absoluteUriReference :: Parser Char URI
+    absoluteUriReference = ( absoluteUri >*> optfrag )
+                           `parseApply` setFragment
+
+    -- sect 4.1
+    fragment :: Parser Char String
+    fragment     = repG ( oneOf [ pchar, slash, (char '?') ] )
+
+    -- sect 5
+    relativeUri :: Parser Char URI
+    relativeUri  = ( oneOf [ netPath, absPath, relPath, nulPath ] >*>
+                     optG ((char '?') >++> query)
+                    `parseApply` makeHierPath )
+                  `parseApply` makeRelUri
+
+    nulPath :: Parser Char (String,[String])
+    nulPath     = parseReturn ("",[])
+
+    relPath :: Parser Char (String,[String])
+--    relPath      = nullStr >*> (relSegment >:> optG absPath1)
+    relPath      = nullStr >*> one ( relSegment >++> slash >:> pathSegments )
+                                   ( relSegment `parseApply` makeList )
+                                   -- [[[TODO: factor higher order function
+                                   -- for relPath and pathSegments]]]
+
+    relSegment   :: Parser Char String
+    relSegment   = relSegCh >++> (repG relSegCh)
+    relSegCh     :: String -> [(String, String)]+    relSegCh     = oneOf
+          [ unreserved,     -- pchar without ':'
+            (char ';'),
+            (char '@'),
+            (char '&'),
+            (char '='),
+            (char '+'),
+            (char '$'),
+            (char ','),
+            escaped  ]
+
+    relSegmentWithColon :: Parser Char String
+    relSegmentWithColon = relSegment >++> colon >++> segment
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ParseURI.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ParseURI.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.11  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.10  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.9  2003/05/20 23:35:28  graham
+-- Modified code to compile with GHC hierarchical libraries
+--
+-- Revision 1.8  2003/03/05 22:16:23  graham
+-- URI code passes all unit tests
+--
+-- Revision 1.7  2003/03/05 14:47:45  graham
+-- Relative URI code complete, not tested
+-- Fixed a URI parser bug
+--
+-- Revision 1.6  2003/02/27 20:29:53  graham
+-- Fixed some more parser bugs.
+-- All parser tests pass.
+-- QName and relative path handling to do.
+--
+-- Revision 1.5  2003/02/27 18:48:05  graham
+-- Fix URI parser bug.
+-- Add more URI parser test cases.
+--
+-- Revision 1.4  2003/02/27 15:28:45  graham
+-- Updated internal structure of parsed URI.
+-- Passes parser unit tests
+--
+-- Revision 1.3  2003/02/27 13:54:30  graham
+-- ParseURI module passes unit test
+--
+-- Revision 1.2  2003/02/27 09:50:25  graham
+-- Add URI parser test cases, some name changes
+--
+-- Revision 1.1  2003/02/27 08:59:53  graham
+-- Separate URI parser from main URI module
+--

+ Swish/HaskellUtils/ParseURITest.hs view
@@ -0,0 +1,491 @@+--------------------------------------------------------------------------------
+--  $Id: ParseURITest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ParseURITest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines test cases for module ParseURI.
+--
+--  The tests here are intended to be confidence-setting rather than
+--  exhaustive:  the module URITest exercises a far wider range of
+--  URI forms, via the URI module which uses this parser to break a
+--  URI into its component parts.
+--
+--------------------------------------------------------------------------------
+
+-- WNH RIP OUT module Swish.HaskellUtils.ParseURITest where
+
+import Test.HUnit
+import Swish.HaskellUtils.Parse
+import Swish.HaskellUtils.ParseURI
+import System.IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn )
+
+testParser :: ( Show a, Show b, Eq a, Eq b ) =>
+    String -> Parser a b -> [a] -> [(b,[a])] -> Test
+testParser lab parser inp res =
+    TestCase ( assertEqual lab res (pend inp) )
+    where
+    pend = ( parser >*> (parseEnd []) ) `parseApply` fst
+
+-- hostname
+
+hostnameTest lab inp res =
+    testParser ("hostnameTest"++lab) hostname inp res
+
+hostnameTest01 = hostnameTest "01" "example.org" [ ("example.org","") ]
+
+hostnameTests = TestList
+      [ hostnameTest01 --, hostnameTest02, hostnameTest03, hostnameTest04,
+      ]
+
+-- ipv6
+
+ipv6Test lab inp res =
+    testParser ("ipv6Test"++lab) ipv6address inp res
+
+ipv6Test01 = ipv6Test "01" "FEDC:BA98:7654:3210:FEDC:BA98:7654:3210"
+                [ ("FEDC:BA98:7654:3210:FEDC:BA98:7654:3210","") ]
+
+ipv6Test02 = ipv6Test "02" "FEDC:BA98:7654:3210:FEDC:BA98:192.9.5.5"
+                [ ("FEDC:BA98:7654:3210:FEDC:BA98:192.9.5.5","") ]
+
+ipv6Test03 = ipv6Test "03" "1080:0:0:0:8:800:200C:417A"
+                [ ("1080:0:0:0:8:800:200C:417A","") ]
+
+ipv6Test04 = ipv6Test "04" "3ffe:2a00:100:7031::1"
+                [ ("3ffe:2a00:100:7031::1","") ]
+
+ipv6Test05 = ipv6Test "05" "1080::8:800:200C:417A"
+                [ ("1080::8:800:200C:417A","") ]
+
+ipv6Test06 = ipv6Test "06" "::192.9.5.5"
+                [ ("::192.9.5.5","") ]
+
+ipv6Test07 = ipv6Test "07" "::FFFF:129.144.52.38"
+                [ ("::FFFF:129.144.52.38","") ]
+
+ipv6Test08 = ipv6Test "08" "2010:836B:4179::836B:4179"
+                [ ("2010:836B:4179::836B:4179","") ]
+
+ipv6Test09 = ipv6Test "09" "::200C:417A"
+                [ ("::200C:417A","") ]
+
+ipv6Test10 = ipv6Test "10" "::417A"
+                [ ("::417A","") ]
+
+ipv6Test11 = ipv6Test "11" "3ffe:2a00::417A"
+                [ ("3ffe:2a00::417A","") ]
+
+ipv6Tests = TestList
+      [ ipv6Test01, ipv6Test02, ipv6Test03, ipv6Test04,
+        ipv6Test05, ipv6Test06, ipv6Test07, ipv6Test08,
+        ipv6Test09, ipv6Test10, ipv6Test11
+      ]
+
+-- absoluteUri :: Parser Char URI
+
+absoluteUriTest lab inp res =
+    testParser ("absoluteUriTest"++lab++": "++inp) absoluteUri inp res
+
+absoluteUriTest01 = absoluteUriTest "01"
+    "http://example.org/aaa/bbb"
+    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "" "", "" ) ]
+
+absoluteUriTest02 = absoluteUriTest "02"
+    "mailto:local@domain.org"
+    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
+
+absoluteUriTest03 = absoluteUriTest "03"
+    "mailto:local@domain.org"
+    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
+
+absoluteUriTest04 = absoluteUriTest "04"
+    "HTTP://EXAMPLE.ORG/AAA/BBB"
+    [ ( URI "HTTP:" "//EXAMPLE.ORG" ["/","AAA/","BBB"] "" "", "" ) ]
+
+absoluteUriTest05 = absoluteUriTest "05"
+    "http://example.org/aaa/bbb?qqq/rrr"
+    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "?qqq/rrr" "", "" ) ]
+
+absoluteUriTest06 = absoluteUriTest "06"
+    "//example.org/aaa/bbb"
+    []
+
+absoluteUriTest07 = absoluteUriTest "07"
+    "/aaa/bbb"
+    []
+
+absoluteUriTest08 = absoluteUriTest "08"
+    "bbb"
+    []
+
+absoluteUriTest09 = absoluteUriTest "09"
+    "#ccc"
+    []
+
+absoluteUriTest10 = absoluteUriTest "10"
+    "#"
+    []
+
+absoluteUriTest11 = absoluteUriTest "11"
+    "/"
+    []
+
+absoluteUriTest12 = absoluteUriTest "12"
+    "http://[1080::8:800:200C:417A]/foo"
+    [ ( URI "http:" "//[1080::8:800:200C:417A]" ["/","foo"] "" "", "" ) ]
+
+absoluteUriTest13 = absoluteUriTest "13"
+    "http://[::192.9.5.5]/ipng"
+    [ ( URI "http:" "//[::192.9.5.5]" ["/","ipng"] "" "", "" ) ]
+
+absoluteUriTest14 = absoluteUriTest "14"
+    "http://[1080::8:800:192.9.5.5]/foo"
+    [ ( URI "http:" "//[1080::8:800:192.9.5.5]" ["/","foo"] "" "", "" ) ]
+
+absoluteUriTest15 = absoluteUriTest "15"
+    "http://[::200C:417A]/ipng"
+    [ ( URI "http:" "//[::200C:417A]" ["/","ipng"] "" "", "" ) ]
+
+absoluteUriTest16 = absoluteUriTest "16"
+    "http://[::417A]/ipng"
+    [ ( URI "http:" "//[::417A]" ["/","ipng"] "" "", "" ) ]
+
+absoluteUriTest17 = absoluteUriTest "17"
+    "http://192.9.5.5/ipng"
+    [ ( URI "http:" "//192.9.5.5" ["/","ipng"] "" "", "" ) ]
+
+absoluteUriTest18 = absoluteUriTest "18"
+    "http://example.org:/aaa/bbb"
+    [ ( URI "http:" "//example.org:" ["/","aaa/","bbb"] "" "", "" ) ]
+
+absoluteUriTests = TestList
+      [ absoluteUriTest01, absoluteUriTest02, absoluteUriTest03,
+        absoluteUriTest04, absoluteUriTest05, absoluteUriTest06,
+        absoluteUriTest07, absoluteUriTest08, absoluteUriTest09,
+        absoluteUriTest10, absoluteUriTest11, absoluteUriTest12,
+        absoluteUriTest13, absoluteUriTest14, absoluteUriTest15,
+        absoluteUriTest16, absoluteUriTest17, absoluteUriTest18 ]
+
+-- relativeUri :: Parser Char URI
+
+relativeUriTest lab inp res =
+    testParser ("relativeUriTest"++lab) relativeUri inp res
+
+relativeUriTest01 = relativeUriTest "01"
+    "//example.org/aaa/bbb"
+    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "" "", "" ) ]
+
+relativeUriTest02 = relativeUriTest "02"
+    "local@domain.org"
+    [ ( URI "" "" ["local@domain.org"] "" "", "" ) ]
+
+relativeUriTest03 = relativeUriTest "03"
+    "mailto:local@domain.org"
+    []
+
+relativeUriTest04 = relativeUriTest "04"
+    "//EXAMPLE.ORG/AAA/BBB"
+    [ ( URI "" "//EXAMPLE.ORG" ["/","AAA/","BBB"] "" "", "" ) ]
+
+relativeUriTest05 = relativeUriTest "05"
+    "//example.org/aaa/bbb?qqq/rrr"
+    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "?qqq/rrr" "", "" ) ]
+
+relativeUriTest06 = relativeUriTest "06"
+    "//example.org/aaa/bbb"
+    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "" "", "" ) ]
+
+relativeUriTest07 = relativeUriTest "07"
+    "/aaa/bbb"
+    [ ( URI "" "" ["/","aaa/","bbb"] "" "", "" ) ]
+
+relativeUriTest08 = relativeUriTest "08"
+    "bbb"
+    [ ( URI "" "" ["bbb"] "" "", "" ) ]
+
+relativeUriTest09 = relativeUriTest "09"
+    "#ccc"
+    []
+
+relativeUriTest10 = relativeUriTest "10"
+    "#"
+    []
+
+relativeUriTest11 = relativeUriTest "11"
+    "/"
+    [ ( URI "" "" ["/",""] "" "", "" ) ]
+
+relativeUriTest12 = relativeUriTest "12"
+    "/aaa/"
+    [ ( URI "" "" ["/","aaa/",""] "" "", "" ) ]
+
+relativeUriTest13 = relativeUriTest "13"
+    "/aaa/?bbb"
+    [ ( URI "" "" ["/","aaa/",""] "?bbb" "", "" ) ]
+
+relativeUriTest14 = relativeUriTest "14"
+    "?y"
+    [ ( URI "" "" [] "?y" "", "" ) ]
+
+relativeUriTest15 = relativeUriTest "15"
+    "g?y"
+    [ ( URI "" "" ["g"] "?y" "", "" ) ]
+
+relativeUriTest16 = relativeUriTest "16"
+    "g;x?y#s"
+    []
+
+
+relativeUriTests = TestList
+      [ relativeUriTest01, relativeUriTest02, relativeUriTest03,
+        relativeUriTest04, relativeUriTest05, relativeUriTest06,
+        relativeUriTest07, relativeUriTest08, relativeUriTest09,
+        relativeUriTest10, relativeUriTest11, relativeUriTest12,
+        relativeUriTest13, relativeUriTest14, relativeUriTest15,
+        relativeUriTest16 ]
+
+
+-- uriReference :: Parser Char URI
+
+uriReferenceTest lab inp res =
+    testParser ("uriReferenceTest"++lab) uriReference inp res
+
+uriReferenceTest01 = uriReferenceTest "01"
+    "http://example.org/aaa/bbb#ccc"
+    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
+
+uriReferenceTest02 = uriReferenceTest "02"
+    "mailto:local@domain.org"
+    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
+
+uriReferenceTest03 = uriReferenceTest "03"
+    "mailto:local@domain.org#frag"
+    [ ( URI "mailto:" "local@domain.org" [] "" "#frag", "" ) ]
+
+uriReferenceTest04 = uriReferenceTest "04"
+    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
+    [ ( URI "HTTP:" "//EXAMPLE.ORG" ["/","AAA/","BBB"] "" "#CCC", "" ) ]
+
+uriReferenceTest05 = uriReferenceTest "05"
+    "http://example.org/aaa/bbb?qqq/rrr#ccc"
+    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "?qqq/rrr" "#ccc", "" ) ]
+
+uriReferenceTest06 = uriReferenceTest "06"
+    "//example.org/aaa/bbb#ccc"
+    [ ( URI "" "//example.org" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
+
+uriReferenceTest07 = uriReferenceTest "07"
+    "/aaa/bbb#ccc"
+    [ ( URI "" "" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
+
+uriReferenceTest08 = uriReferenceTest "08"
+    "bbb#ccc"
+    [ ( URI "" "" ["bbb"] "" "#ccc", "" ) ]
+
+uriReferenceTest09 = uriReferenceTest "09"
+    "#ccc"
+    [ ( URI "" "" [] "" "#ccc", "" ) ]
+
+uriReferenceTest10 = uriReferenceTest "10"
+    "#"
+    [ ( URI "" "" [] "" "#", "" ) ]
+
+uriReferenceTest11 = uriReferenceTest "11"
+    "/"
+    [ ( URI "" "" ["/",""] "" "", "" ) ]
+
+uriReferenceTest12 = uriReferenceTest "12"
+    "/aaa/#fff/ggg"
+    [ ( URI "" "" ["/","aaa/",""] "" "#fff/ggg", "" ) ]
+
+uriReferenceTest13 = uriReferenceTest "13"
+    "/aaa/?bbb/ccc#fff/ggg"
+    [ ( URI "" "" ["/","aaa/",""] "?bbb/ccc" "#fff/ggg", "" ) ]
+
+uriReferenceTest14 = uriReferenceTest "14"
+    "?y"
+    [ ( URI "" "" [] "?y" "", "" ) ]
+
+uriReferenceTest15 = uriReferenceTest "15"
+    "g?y"
+    [ ( URI "" "" ["g"] "?y" "", "" ) ]
+
+uriReferenceTest16 = uriReferenceTest "16"
+    "g;x?y#s"
+    [ ( URI "" "" ["g;x"] "?y" "#s", "" ) ]
+
+uriReferenceTest17 = uriReferenceTest "17"
+    "http://example.123./aaa/bbb#ccc"
+    [ ]
+
+uriReferenceTest18 = uriReferenceTest "18"
+    "http://example.org:/aaa/bbb#ccc"
+    [ ( URI "http:" "//example.org:" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
+
+uriReferenceTest19 = uriReferenceTest "19"
+    "http://example/Andr&#567;"
+    [ ( URI "http:" "//example" ["/","Andr&"] "" "#567;", "" ) ]
+
+uriReferenceTest20 = uriReferenceTest "20"
+    "abc/def"
+    [ ( URI "" "" ["abc/", "def"] "" "", "" ) ]
+
+uriReferenceTest21 = uriReferenceTest "21"
+    "../abc#def"
+    [ ( URI "" "" ["../","abc"] "" "#def", "" ) ]
+
+uriReferenceTest22 = uriReferenceTest "22"
+    "file://meetings.example.com/cal#m1"
+    [ ( URI "file:" "//meetings.example.com" ["/","cal"] "" "#m1", "" ) ]
+
+
+uriReferenceTests = TestList
+      [ uriReferenceTest01, uriReferenceTest02, uriReferenceTest03,
+        uriReferenceTest04, uriReferenceTest05, uriReferenceTest06,
+        uriReferenceTest07, uriReferenceTest08, uriReferenceTest09,
+        uriReferenceTest10, uriReferenceTest11, uriReferenceTest12,
+        uriReferenceTest13, uriReferenceTest14, uriReferenceTest15,
+        uriReferenceTest16, uriReferenceTest17, uriReferenceTest18,
+        uriReferenceTest19, uriReferenceTest20, uriReferenceTest21,
+        uriReferenceTest22 ]
+
+-- Check for ambiguous parse:
+-- These tests don't force end-of-input, so potential ambiguous parses can be detected,
+
+uriAmbiguousTest lab inp res =
+    TestCase ( assertEqual ("uriAmbiguousTest"++lab++": "++inp) res (uriReference inp) )
+
+uriAmbiguousTest01 = uriAmbiguousTest "01"
+    "http://example.org/aaa/bbb#ccc"
+    [ ( URI "http:" "//example.org" ["/","aaa/","bbb"] "" "#ccc", "" ) ]
+
+uriAmbiguousTest02 = uriAmbiguousTest "02"
+    "mailto:local@domain.org"
+    [ ( URI "mailto:" "local@domain.org" [] "" "", "" ) ]
+
+uriAmbiguousTest03 = uriAmbiguousTest "03"
+    "mailto:local@domain.org#frag"
+    [ ( URI "mailto:" "local@domain.org" [] "" "#frag", "" ) ]
+
+uriAmbiguousTest04 = uriAmbiguousTest "04"
+    "file://meetings.example.com/cal#m1"
+    [ ( URI "file:" "//meetings.example.com" ["/","cal"] "" "#m1", "" ) ]
+
+
+uriAmbiguousTests = TestList
+  [ uriAmbiguousTest01, uriAmbiguousTest02, uriAmbiguousTest03, uriAmbiguousTest04 ]
+
+
+-- All tests
+
+allTests = TestList
+  [ hostnameTests,
+    ipv6Tests,
+    absoluteUriTests,
+    relativeUriTests,
+    uriReferenceTests,
+    uriAmbiguousTests
+  ]
+
+main = runTestTT allTests
+
+hn     = hostnameTests
+ipv6   = ipv6Tests
+absu   = absoluteUriTests
+absu01 = absoluteUriTest01
+relu   = relativeUriTests
+uref   = uriReferenceTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+tp p s = runTestTT ( testParser "tp" p s [("<",">")] )
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ParseURITest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ParseURITest.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.13  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.12  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.11  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.10  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.9  2003/03/05 22:16:23  graham
+-- URI code passes all unit tests
+--
+-- Revision 1.8  2003/03/05 14:47:45  graham
+-- Relative URI code complete, not tested
+-- Fixed a URI parser bug
+--
+-- Revision 1.7  2003/02/28 14:02:52  graham
+-- A few new test cases
+--
+-- Revision 1.6  2003/02/27 23:33:54  graham
+-- QName splitting tested OK
+--
+-- Revision 1.5  2003/02/27 20:29:53  graham
+-- Fixed some more parser bugs.
+-- All parser tests pass.
+-- QName and relative path handling to do.
+--
+-- Revision 1.4  2003/02/27 18:48:05  graham
+-- Fix URI parser bug.
+-- Add more URI parser test cases.
+--
+-- Revision 1.3  2003/02/27 15:28:45  graham
+-- Updated internal structure of parsed URI.
+-- Passes parser unit tests
+--
+-- Revision 1.2  2003/02/27 13:54:30  graham
+-- ParseURI module passes unit test
+--
+-- Revision 1.1  2003/02/20 19:45:07  graham
+-- Add URI module and unit tests.
+-- Code incomplete.
+--

+ Swish/HaskellUtils/PartOrderedCollection.hs view
@@ -0,0 +1,392 @@+--------------------------------------------------------------------------------
+--  $Id: PartOrderedCollection.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  PartOrderedCollection
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module provides methods to support operations on partially ordered
+--  collections.  The partial ordering relationship is represented by
+--  Maybe Ordering.
+--
+--  Thanks to members of the haskell-cafe mailing list:
+--    Robert <rvollmert-lists@gmx.net>
+--    Tom Pledger <Tom.Pledger@peace.com>
+--  who suggested key ideas on which some of the code in this module is based.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.PartOrderedCollection
+    ( PartCompare
+    , minima, maxima
+    , partCompareEq, partCompareOrd, partComparePair
+    , partCompareListPartOrd, partCompareListOrd
+    , partCompareMaybe, partCompareListMaybe
+    , partCompareListSubset
+    )
+where
+
+{- in Prelude????+import Maybe
+    ( Maybe(..) )
+-}+
+------------------------------------------------------------
+--  Type of partial compare function
+------------------------------------------------------------
+
+type PartCompare a = a -> a -> Maybe Ordering
+
+------------------------------------------------------------
+--  Functions for minima and maxima of a part-ordered list
+------------------------------------------------------------
+
+-- |This function finds the maxima in a list of partially
+--  ordered values, preserving the sequence of retained
+--  values from the supplied list.
+--
+--  It returns all those values in the supplied list
+--  for which there is no larger element in the list.
+--
+maxima :: PartCompare a -> [a] -> [a]
+maxima cmp as = foldl add [] as
+    where
+        add []     e = [e]
+        add ms@(m:mr) e = case cmp m e of
+            Nothing -> m:(add mr e)
+            Just GT -> ms
+            Just EQ -> ms
+            Just LT -> add mr e
+
+-- |This function finds the minima in a list of partially
+--  ordered values, preserving the sequence of retained
+--  values from the supplied list.
+--
+--  It returns all those values in the supplied list
+--  for which there is no smaller element in the list.
+--
+minima :: PartCompare a -> [a] -> [a]
+minima cmp = maxima (flip cmp)
+
+------------------------------------------------------------
+--  Partial ordering comparison functions
+------------------------------------------------------------
+
+-- |Partial ordering for Eq values
+partCompareEq :: (Eq a) => a -> a -> Maybe Ordering
+partCompareEq a1 a2 = if a1 == a2 then Just EQ else Nothing
+
+-- |Partial ordering for Ord values
+partCompareOrd :: (Ord a) => a -> a -> Maybe Ordering
+partCompareOrd a1 a2 = Just $ compare a1 a2
+
+-- |Part-ordering comparison on pairs of values,
+--  where each has a part-ordering relationship
+partComparePair ::
+    (a->a->Maybe Ordering) -> (b->b->Maybe Ordering) -> (a,b) -> (a,b)
+    -> Maybe Ordering
+partComparePair cmpa cmpb (a1,b1) (a2,b2) = case (cmpa a1 a2,cmpb b1 b2) of
+    (_,Nothing)       -> Nothing
+    (jc1,Just EQ)     -> jc1
+    (Nothing,_)       -> Nothing
+    (Just EQ,jc2)     -> jc2
+    (Just c1,Just c2) -> if c1 == c2 then Just c1 else Nothing
+
+-- |Part-ordering comparison on lists of partially ordered values, where:
+--
+--  as==bs  if members of as are all equal to corresponding members of bs
+--  as<=bs  if members of as are all less than or equal to corresponding
+--          members of bs
+--  as>=bs  if members of as are all greater than or equal to corresponding
+--          members of bs
+--  otherwise as and bs are unrelated
+--
+partCompareListPartOrd :: PartCompare a -> [a] -> [a] -> Maybe Ordering
+partCompareListPartOrd cmp as bs = pcomp as bs EQ
+    where
+        pcomp []     []     ordp = Just ordp
+        pcomp (a:as) (b:bs) ordp = case cmp a b of
+            Just rel  -> pcomp1 as bs rel ordp
+            _         -> Nothing
+        pcomp1 as bs ordn EQ   = pcomp as bs ordn
+        pcomp1 as bs EQ   ordp = pcomp as bs ordp
+        pcomp1 as bs ordn ordp =
+            if ordn == ordp then pcomp as bs ordp else Nothing
+
+-- |Part-ordering comparison on lists of Ord values, where:
+--
+--  as==bs  if members of as are all equal to corresponding members of bs
+--  as<=bs  if members of as are all less than or equal to corresponding
+--          members of bs
+--  as>=bs  if members of as are all greater than or equal to corresponding
+--          members of bs
+--  otherwise as and bs are unrelated
+--
+partCompareListOrd :: (Ord a) => [a] -> [a] -> Maybe Ordering
+partCompareListOrd = partCompareListPartOrd (Just `c2` compare)
+    where c2 = (.) . (.)
+
+-- |Part-ordering comparison for Maybe values.
+partCompareMaybe :: (Eq a) => Maybe a -> Maybe a -> Maybe Ordering
+partCompareMaybe Nothing  Nothing  = Just EQ
+partCompareMaybe (Just _) Nothing  = Just GT
+partCompareMaybe Nothing  (Just _) = Just LT
+partCompareMaybe (Just a) (Just b) = if a == b then Just EQ else Nothing
+
+-- |Part-ordering comparison on lists of Maybe values.
+partCompareListMaybe :: (Eq a) => [Maybe a] -> [Maybe a] -> Maybe Ordering
+partCompareListMaybe = partCompareListPartOrd partCompareMaybe
+
+-- |Part-ordering comparison on lists based on subset relationship
+partCompareListSubset :: (Eq a) => [a] -> [a] -> Maybe Ordering
+partCompareListSubset a b
+    | aeqvb     = Just EQ
+    | asubb     = Just LT
+    | bsuba     = Just GT
+    | otherwise = Nothing
+    where
+        asubb = a `subset` b
+        bsuba = b `subset` a
+        aeqvb = asubb && bsuba
+        a `subset` b = and [ ma `elem` b | ma <- a ]
+
+------------------------------------------------------------
+--  Test cases
+------------------------------------------------------------
+
+{-
+
+notTrueFalse  = Nothing :: Maybe Bool
+
+-- partCompareListOrd
+test01 = partCompareListOrd [1,2,3] [1,2,3] == Just EQ
+test02 = partCompareListOrd [1,2,3] [2,3,4] == Just LT
+test03 = partCompareListOrd [1,2,4] [1,2,3] == Just GT
+test04 = partCompareListOrd [1,2,3] [2,1,3] == Nothing
+
+-- partCompareMaybe
+test11 = partCompareMaybe (Just True)  (Just True)  == Just EQ
+test12 = partCompareMaybe (Just True)  (Just False) == Nothing
+test13 = partCompareMaybe notTrueFalse (Just False) == Just LT
+test14 = partCompareMaybe (Just True)  notTrueFalse == Just GT
+test15 = partCompareMaybe notTrueFalse notTrueFalse == Just EQ
+
+-- partCompareListMaybe
+test21 = partCompareListMaybe [Just True,Just False]
+                              [Just True,Just False]
+            == Just EQ
+test22 = partCompareListMaybe [Just True,Just False]
+                              [Just True,Just True]
+            == Nothing
+test23 = partCompareListMaybe [Just False,Just True]
+                              [Just False,Just True]
+            == Just EQ
+test24 = partCompareListMaybe [Nothing,   Just True]
+                              [Just False,Just True]
+            == Just LT
+test25 = partCompareListMaybe [Just False,Just True]
+                              [Just False,Nothing]
+            == Just GT
+test26 = partCompareListMaybe [Nothing,   Just True]
+                              [Just False,Nothing]
+            == Nothing
+test27 = partCompareListMaybe [Nothing,Just True]
+                              [Nothing,Nothing]
+            == Just GT
+test28 = partCompareListMaybe [notTrueFalse,notTrueFalse]
+                              [notTrueFalse,notTrueFalse]
+            == Just EQ
+
+--  minima, maxima
+test31a = maxima partCompareListMaybe ds1a == ds1b
+test31b = minima partCompareListMaybe ds1a == ds1c
+ds1a =
+    [ [Just 'a',Just 'b',Just 'c']
+    , [Just 'a',Just 'b',Nothing ]
+    , [Just 'a',Nothing ,Just 'c']
+    , [Just 'a',Nothing ,Nothing ]
+    , [Nothing ,Just 'b',Just 'c']
+    , [Nothing ,Just 'b',Nothing ]
+    , [Nothing ,Nothing ,Just 'c']
+    , [Nothing ,Nothing ,Nothing ]
+    ]
+ds1b =
+    [ [Just 'a',Just 'b',Just 'c']
+    ]
+ds1c =
+    [ [Nothing ,Nothing ,Nothing ]
+    ]
+
+test32a = maxima partCompareListMaybe ds2a == ds2b
+test32b = minima partCompareListMaybe ds2a == ds2c
+ds2a =
+    [ [Just 'a',Just 'b',Nothing ]
+    , [Just 'a',Nothing ,Just 'c']
+    , [Just 'a',Nothing ,Nothing ]
+    , [Nothing ,Just 'b',Just 'c']
+    , [Nothing ,Just 'b',Nothing ]
+    , [Nothing ,Nothing ,Just 'c']
+    ]
+ds2b =
+    [ [Just 'a',Just 'b',Nothing ]
+    , [Just 'a',Nothing ,Just 'c']
+    , [Nothing ,Just 'b',Just 'c']
+    ]
+ds2c =
+    [ [Just 'a',Nothing ,Nothing ]
+    , [Nothing ,Just 'b',Nothing ]
+    , [Nothing ,Nothing ,Just 'c']
+    ]
+
+test33a = maxima partCompareListMaybe ds3a == ds3b
+test33b = minima partCompareListMaybe ds3a == ds3c
+ds3a =
+    [ [Just "a1",Just "b1",Just "c1"]
+    , [Just "a2",Just "b2",Nothing  ]
+    , [Just "a3",Nothing  ,Just "c3"]
+    , [Just "a4",Nothing  ,Nothing  ]
+    , [Nothing  ,Just "b5",Just "c5"]
+    , [Nothing  ,Just "b6",Nothing  ]
+    , [Nothing  ,Nothing  ,Just "c7"]
+    ]
+ds3b =
+    [ [Just "a1",Just "b1",Just "c1"]
+    , [Just "a2",Just "b2",Nothing  ]
+    , [Just "a3",Nothing  ,Just "c3"]
+    , [Just "a4",Nothing  ,Nothing  ]
+    , [Nothing  ,Just "b5",Just "c5"]
+    , [Nothing  ,Just "b6",Nothing  ]
+    , [Nothing  ,Nothing  ,Just "c7"]
+    ]
+ds3c =
+    [ [Just "a1",Just "b1",Just "c1"]
+    , [Just "a2",Just "b2",Nothing  ]
+    , [Just "a3",Nothing  ,Just "c3"]
+    , [Just "a4",Nothing  ,Nothing  ]
+    , [Nothing  ,Just "b5",Just "c5"]
+    , [Nothing  ,Just "b6",Nothing  ]
+    , [Nothing  ,Nothing  ,Just "c7"]
+    ]
+
+
+test34a = maxima partCompareListMaybe ds4a == ds4b
+test34b = minima partCompareListMaybe ds4a == ds4c
+ds4a =
+    [ [Just 1, Just 1 ]
+    , [Just 2, Nothing]
+    , [Nothing,Just 3 ]
+    , [Nothing,Nothing]
+    ]
+ds4b =
+    [ [Just 1, Just 1 ]
+    , [Just 2, Nothing]
+    , [Nothing,Just 3 ]
+    ]
+ds4c =
+    [ [Nothing,Nothing]
+    ]
+
+-- Check handling of equal values
+test35a = maxima partCompareListMaybe ds5a == ds5b
+test35b = minima partCompareListMaybe ds5a == ds5c
+ds5a =
+    [ [Just 1, Just 1 ]
+    , [Just 2, Nothing]
+    , [Nothing,Just 3 ]
+    , [Nothing,Nothing]
+    , [Just 1, Just 1 ]
+    , [Just 2, Nothing]
+    , [Nothing,Just 3 ]
+    , [Nothing,Nothing]
+    ]
+ds5b =
+    [ [Just 1, Just 1 ]
+    , [Just 2, Nothing]
+    , [Nothing,Just 3 ]
+    ]
+ds5c =
+    [ [Nothing,Nothing]
+    ]
+
+-- test case 32 with different ordering of values
+test36a = maxima partCompareListMaybe ds6a == ds6b
+test36b = minima partCompareListMaybe ds6a == ds6c
+ds6a =
+    [ [Just 'a',Just 'b',Nothing ]
+    , [Nothing ,Nothing ,Just 'c']
+    , [Nothing ,Just 'b',Nothing ]
+    , [Nothing ,Just 'b',Just 'c']
+    , [Just 'a',Nothing ,Nothing ]
+    , [Just 'a',Nothing ,Just 'c']
+    ]
+ds6b =
+    [ [Just 'a',Just 'b',Nothing ]
+    , [Nothing ,Just 'b',Just 'c']
+    , [Just 'a',Nothing ,Just 'c']
+    ]
+ds6c =
+    [ [Nothing ,Nothing ,Just 'c']
+    , [Nothing ,Just 'b',Nothing ]
+    , [Just 'a',Nothing ,Nothing ]
+    ]
+
+test = and
+    [ test01, test02, test03, test04
+    , test11, test12, test13, test14, test15
+    , test21, test22, test23, test24, test25, test26, test27, test28
+    , test31a, test31b, test32a, test32b, test33a, test33b
+    , test34a, test34b, test35a, test35b, test36a, test36b
+    ]
+
+-}
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/PartOrderedCollection.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: PartOrderedCollection.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.4  2003/11/20 18:35:59  graham
+-- Compacted maxima code by use of foldl
+-- (per further suggestion by Tom Pledger).
+--
+-- Revision 1.3  2003/11/20 17:58:09  graham
+-- Class-constraint backward chaining: all test cases passed.
+--
+-- Revision 1.2  2003/11/19 22:13:03  graham
+-- Some backward chaining tests passed
+--
+-- Revision 1.1  2003/11/19 15:21:26  graham
+-- Add PartOrderedCollection module
+--

+ Swish/HaskellUtils/ProcessURI.hs view
@@ -0,0 +1,342 @@+--------------------------------------------------------------------------------
+--  $Id: ProcessURI.hs,v 1.1 2004/01/22 19:52:27 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ProcessURI
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines a collection of functions for manipulating URIs.
+--
+--  Functions provided deal with:
+--    Validating and parsing URI syntax
+--    Separating a fragment from a URI
+--    Separating URI into QName and local name
+--    Relative URI computations
+--
+--  The primary reference for URI handling is RFC2396 [1],
+--  as updated by RFC 2732 [2].
+--  RFC 1808 [3] contains a number of test cases for relative URI handling.
+--  Dan Connolly's Python module 'uripath.py' [4] also contains useful details
+--  and test cases.
+--
+--  [1] http://www.ietf.org/rfc/rfc2396.txt
+--  [2] http://www.ietf.org/rfc/rfc2732.txt
+--  [3] http://www.ietf.org/rfc/rfc1808.txt
+--  [4] http://www.w3.org/2000/10/swap/uripath.py
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.ProcessURI
+    ( URI(URI)
+    , isValidURIRef, isAbsoluteURIRef, isAbsoluteURI
+    , parseURIRef, parseAbsoluteURIRef, parseAbsoluteURI
+    , getURIRef, normalizeURI, compareURI, normSeg, normSeg1, mergeSeg
+    , splitURIFragment, makeURIWithFragment -- , splitQName
+    , relativeRefPart, absoluteUriPart
+    )
+where
+
+import Swish.HaskellUtils.ParseURI
+import Swish.HaskellUtils.Parse
+-- type Parser a b = Parse.Parser a b
+-- isValid         = Parse.isValid
+-- parseApply      = Parse.parseApply
+
+
+-- Test supplied string for valid URI syntax
+isValidURIRef :: String -> Bool
+isValidURIRef = isValid parseURIRef
+
+-- Test supplied string for valid absolute URI reference syntax
+isAbsoluteURIRef :: String -> Bool
+isAbsoluteURIRef = isValid parseAbsoluteURIRef
+
+-- Test supplied string for valid absolute URI syntax
+isAbsoluteURI :: String -> Bool
+isAbsoluteURI = isValid parseAbsoluteURI
+
+-- URI parser (see Parse and ParseURI modules)
+parseURIRef :: Parser Char String
+parseURIRef = uriReference `parseApply` uriToString
+
+-- Absolute URI reference parser (see Parse module)
+parseAbsoluteURIRef :: Parser Char String
+parseAbsoluteURIRef = absoluteUriReference `parseApply` uriToString
+
+-- Absolute URI parser (see Parse module)
+parseAbsoluteURI :: Parser Char String
+parseAbsoluteURI = absoluteUri `parseApply` uriToString
+
+-- Parse and return URI reference as URI value
+getURIRef :: String -> URI
+getURIRef s = extractURIRef (uriReference s)
+    where
+    extractURIRef [(u,"")] = u
+    extractURIRef [(_,_)]  = ( URI "" "" ["<invalid URI>"] "" "" )
+    extractURIRef _        = ( URI "" "" ["<ambiguous URI>"] "" "" )
+
+-- Normalize URI string
+normalizeURI :: String -> String
+normalizeURI str = uriToString (URI sc au (normSeg se) qu fr)
+    where
+    URI sc au se qu fr = getURIRef str
+
+-- Compare two URIs
+-- Takes account of normalizations that can be applied to all URIs
+-- (2003-02-20, currently subject to W3C TAG debate)
+compareURI :: String -> String -> Bool
+compareURI u1 u2 = ( u1 == u2 )
+
+-- Separate URI-with-fragment into URI and fragment ID
+splitURIFragment :: String -> ( String, Maybe String )
+    -- splitURIFragment "http://example.org/aaa#bbb" =
+    --     ("http://example.org/aaa",Just "bbb")
+    -- splitURIFragment "http://example.org/aaa" =
+    --     ("http://example.org/aaa",Nothing)
+splitURIFragment inp =
+    case (uriReference inp) of
+        [(URI s a p q f,"")] -> (uriToString (URI s a p q ""),pickFrag f)
+        _ -> error ("splitURIFragment, Invalid URI: "++inp)
+    where
+        pickFrag ('#':f) = Just f
+        pickFrag _       = Nothing
+
+-- Construct URI-with-fragment using URI and supplied fragment id
+makeURIWithFragment :: String -> Maybe String -> String
+    -- makeURIWithFragment "http://example.org/aaa" (Just "fff") =
+    --     "http://example.org/aaa#fff"
+    -- makeURIWithFragment "http://example.org/aaa#bbb" (Just "fff") =
+    --     "http://example.org/aaa#fff"
+    -- makeURIWithFragment "http://example.org/aaa" Nothing
+    --     "http://example.org/aaa"
+    -- makeURIWithFragment "http://example.org/aaa#bbb" Nothing
+    --     "http://example.org/aaa"
+makeURIWithFragment base frag =
+    case frag of
+        Just f  -> b ++ "#" ++ f
+        Nothing -> b
+        where
+            (b,_) = splitURIFragment base
+
+-- Separate URI into QName URI and local name
+splitQName :: String -> ( String, String )
+    -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
+    -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
+    -- splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")
+splitQName qn = splitAt (scanQName qn (-1) 0) qn
+
+-- helper function for splitQName
+-- Takes 3 arguments:
+--   QName to scan
+--   index of last name-start char, or (-1)
+--   number of characters scanned so far
+-- Returns index of start of name, or length of list
+--
+scanQName :: String -> Int -> Int -> Int
+scanQName (nextch:more) (-1) nc
+    | isNameStartChar nextch  = scanQName more nc   (nc+1)
+    | otherwise               = scanQName more (-1) (nc+1)
+scanQName (nextch:more) ns nc
+    | not (isNameChar nextch) = scanQName more (-1) (nc+1)
+    | otherwise               = scanQName more ns   (nc+1)
+scanQName "" (-1) nc = nc
+scanQName "" ns   _  = ns
+
+-- Definitions here per XML namespaces, NCName production,
+-- restricted to characters used in URIs.
+-- cf. http://www.w3.org/TR/REC-xml-names/
+isNameStartChar c = ( isAlpha c ) || ( c == '_' )
+isNameChar      c = ( isAlpha c ) || ( isDigit c ) || ( any (==c) ".-_" )
+
+-- Get reference relative to given base
+relativeRefPart :: String -> String -> String
+    -- relativeRefPart "base:" "base:relativeRef" = "relativeRef"
+    -- relativeRefPart "base:" "another:URI"      = "another:URI"
+relativeRefPart base full =
+    uriToString ( relPartRef ( getURIRef base ) ( getURIRef full ) )
+    where
+    relPartRef u1@(URI sc1 au1 se1 _ _) u2@( URI sc2 au2 se2 qu2 fr2 )
+        | sc1 /= sc2 = URI sc2 au2 (normSeg se2) qu2 fr2    -- different schemes
+        | opaque au1 = URI "" au2 (normSeg se2) qu2 fr2     -- same scheme, base is opaque
+        | au1 /= au2 = URI "" au2 (normSeg se2) qu2 fr2     -- same scheme, different authority
+        | otherwise  = URI "" "" (relPath (normSeg se1) (normSeg se2) ) qu2 fr2
+    -- If paths share a leading segment (other than "/") then compute a path relative
+    -- to the base URI, otherwise return a root-relative path
+    relPath s1 []    = ["/"]
+    relPath [] s2    = s2
+    relPath ("/":s1h:s1t) s2@("/":s2h:s2t)
+        | s1h == s2h = relPartSeg s1t s2t
+        | otherwise  = s2
+    relPath (s1h:s1t) s2@(s2h:s2t)
+        | s1h == s2h = relPartSeg s1t s2t
+        | otherwise  = s2
+    {- relPath s1@(_:_) s2@(_:_) = relPartSeg s1 s2 [[[REDUNDANT?]]] -}
+    -- Path-segment relative to base:
+    -- (An alternative would be descendent relative to base, otherwise relative to root)
+    --   relPartSeg a/b a/c -> c        (case 1:  common leading segments)
+    --   relPartSeg a/b a/  -> ./       (case 1a: identical paths with empty name)
+    --   relPartSeg a   b/c -> b/c      (case 2:  all base path segments used)
+    --   relPartSeg b   c   -> c        (case 2)
+    --   relPartSeg a   c/  -> c/       (case 2)
+    --   relPartSeg ""  c   -> c        (case 2)
+    --   relPartSeg a ""    -> ""       (case 2)
+    --   relPartSeg a   c:d -> ./c:d    (case 2a: bare name looks like URI
+    --   relPartSeg a/b c   -> ../c     (case 3: unused base path segments)
+    --   relPartSeg a/b ""  -> ../      (case 3)
+    --   relPartSeg a/  c   -> ../c     (case 3)
+    --   relPartSeg a/  ""  -> ../      (case 3)
+    -- NOTE the last element of the path segment lists are always the "name" component,
+    -- and is present as an empty string if the path ends with a '/' character
+    relPartSeg [_] [""]    = ["./",""]                  -- Case 1a
+    relPartSeg [_] [st]
+        | looksLikeURI st  = ["./",st]                  -- Case 2a
+        | otherwise        = [st]                       -- Case 2
+    relPartSeg [_] s2      = s2                         -- Case 2
+    relPartSeg s1  [s2t]   = difPartSeg s1 [s2t]        -- Case 3  (this test should be redundant)
+    relPartSeg s1@(s1h:s1t) s2@(s2h:s2t)
+        | s1h == s2h = relPartSeg s1t s2t               -- Case 1
+        | otherwise  = difPartSeg s1 s2                 -- Case 2 or 3 ...
+    difPartSeg [_]     s2  = s2                         -- Case 2  (final base segment is ignored)
+    difPartSeg (_:s1t) s2  = "../":(difPartSeg s1t s2)  -- Case 3
+
+-- Get absolute URI given base and relative reference
+-- NOTE:  absoluteURI base (relativeRef base u) is always equivalent to u.
+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
+absoluteUriPart :: String -> String -> String
+    -- absoluteUriPart "base:" "relativeRef" = "base:relativeRef"
+    -- absoluteUriPart "base:" "another:URI" = "another:URI"
+absoluteUriPart base rel =
+    uriToString ( joinRef ( getURIRef base ) ( getURIRef rel ) )
+    where
+    joinRef u1@(URI sc1 au1 se1 _ _) u2@( URI sc2 au2 se2 qu2 fr2 )
+        -- non-validating case here?  (See RFC2396bis section 5.2)
+        | sc2 /= ""     = u2
+        | opaque au1    = URI sc1 au2 se2 qu2 fr2                       -- Base not relative
+        | au2 /= ""     = URI sc1 au2 se2 qu2 fr2
+        | se2 == []     = if qu2 == "" then URI "" "" [] "" fr2         -- Same document
+                                       else URI sc1 au1 se1 qu2 fr2     -- Base document
+        | otherwise     = URI sc1 au1 ( mergeSeg se1 se2 ) qu2 fr2
+
+-- Test authority string for opaque form (non-null and not starting with '/')
+opaque :: String -> Bool
+opaque ""      = False
+opaque ('/':_) = False
+opaque _       = True
+
+-- Merge segment se2 with base segment se1
+mergeSeg :: [String] -> [String] -> [String]
+mergeSeg _ s2@("/":se2) = normSeg s2
+mergeSeg [] se2         = normSeg ("/":se2)
+mergeSeg se1 se2        = normSeg ( (init se1) ++ se2 )
+
+-- Normalize ./ and ../ in segment list:
+-- Don't touch leading "/"
+-- Don't allow "../" to cancel another "../"
+-- Leave bare "./"
+-- Remove any trailing "./"
+normSeg :: [String] -> [String]
+normSeg ("/":st)      = "/":(normSeg1 st)
+normSeg st            = normSeg1 st
+
+normSeg1 []           = []
+normSeg1 ["./"]       = ["./"]
+normSeg1 ["."]        = ["./",""]                      -- trailing '.' is treated as './'
+normSeg1 [".."]       = ["../",""]                     -- trailing '..' is treated as '../'
+normSeg1 p@["./",st]
+    | looksLikeURI st = p
+    | otherwise       = [st]
+normSeg1 ("./":st)    = normSeg1 st
+normSeg1 (s1:st)      = normSeg2 (s1:(normSeg1 st))    -- TEST CASE:  a/b/../../c
+
+normSeg2 :: [String] -> [String]
+normSeg2 s@("../":"../":st) = s
+normSeg2 ["./","../"] = ["./"]
+normSeg2 (_:"../":st) = st
+normSeg2 [sh,"./"]    = [sh]
+normSeg2 (sh:"./":st) = sh:st
+normSeg2 ("./":st)    = st
+normSeg2 st           = st
+
+-- Test if string looks like a URI, by virtue of starting with a 'name:'
+looksLikeURI :: String -> Bool
+looksLikeURI name = not ( null ( relSegmentWithColon name ) )
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Foobar is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ProcessURI.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ProcessURI.hs,v $
+-- Revision 1.1  2004/01/22 19:52:27  graham
+-- Rename module URI to avoid awkward clash with Haskell libraries
+--
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.12  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.11  2003/09/24 13:35:44  graham
+-- QName splitting moved from URI module to QName module
+--
+-- Revision 1.10  2003/06/03 19:24:13  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.9  2003/05/28 19:57:50  graham
+-- Adjusting code to compile with GHC
+--
+-- Revision 1.8  2003/03/05 22:16:23  graham
+-- URI code passes all unit tests
+--
+-- Revision 1.7  2003/03/05 14:47:45  graham
+-- Relative URI code complete, not tested
+-- Fixed a URI parser bug
+--
+-- Revision 1.6  2003/02/28 14:02:52  graham
+-- A few new test cases
+--
+-- Revision 1.5  2003/02/27 23:33:54  graham
+-- QName splitting tested OK
+--
+-- Revision 1.4  2003/02/27 18:48:05  graham
+-- Fix URI parser bug.
+-- Add more URI parser test cases.
+--
+-- Revision 1.3  2003/02/27 08:59:53  graham
+-- Separate URI parser from main URI module
+--
+-- Revision 1.2  2003/02/27 00:30:14  graham
+-- Syntax code nearly complete, untested
+--
+-- Revision 1.1  2003/02/20 19:45:07  graham
+-- Add URI module and unit tests.
+-- Code incomplete.
+--

+ Swish/HaskellUtils/QName.hs view
@@ -0,0 +1,177 @@+--------------------------------------------------------------------------------
+--  $Id: QName.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  QName
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines an algebraic datatype for qualified names (QNames).
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.QName
+    ( QName(..) -- , maybeQnEq
+    , newQName, qnameFromPair, qnameFromURI
+    , getNamespace, getLocalName, getQNameURI
+    , splitURI
+    )
+where
+
+import Data.Char
+    ( isAlpha, isAlphaNum )
+
+------------------------------------------------------------
+--  Qualified name
+------------------------------------------------------------
+--
+--  cf. http://www.w3.org/TR/REC-xml-names/
+
+data QName = QName { qnNsuri, qnLocal :: String }
+
+newQName :: String -> String -> QName
+newQName ns ln = QName ns ln
+
+qnameFromPair :: (String,String) -> QName
+qnameFromPair (ns,ln) = QName ns ln
+
+qnameFromURI :: String -> QName
+qnameFromURI = qnameFromPair . splitURI
+
+getNamespace :: QName -> String
+getNamespace qn = qnNsuri qn
+
+getLocalName :: QName -> String
+getLocalName qn = qnLocal qn
+
+getQNameURI :: QName -> String
+getQNameURI (QName ns ln) = ns++ln
+
+instance Eq QName where
+    (==) = qnEq
+
+instance Ord QName where
+    (QName u1 l1) <= (QName u2 l2) =
+        if ( up1 /= up2) then (up1 <= up2) else ((ur1++l1) <= (ur2++l2))
+        where
+            n   = min (length u1) (length u2)
+            (up1,ur1) = splitAt n u1
+            (up2,ur2) = splitAt n u2
+
+instance Show QName where
+    show (QName ns ln) = "<" ++ ns ++ ln ++ ">"
+
+--  Original used comparison of concatenated strings,
+--  but that was very inefficient.  This version does the
+--  comparison without constructing new values
+qnEq :: QName -> QName -> Bool
+qnEq (QName ns1 ln1) (QName ns2 ln2) = qnEq1 ns1 ns2 ln1 ln2
+
+qnEq1 (c1:ns1) (c2:ns2)  ln1 ln2   = (c1==c2) && (qnEq1 ns1 ns2 ln1 ln2)
+qnEq1 []  ns2  ln1@(_:_) ln2       = qnEq1 ln1 ns2 []  ln2
+qnEq1 ns1 []   ln1       ln2@(_:_) = qnEq1 ns1 ln2 ln1 []
+qnEq1 []  []   []        []        = True
+qnEq1 _   _    _         _         = False
+
+{-
+--  Define equality of (Maybe QName)
+maybeQnEq :: (Maybe QName) -> (Maybe QName) -> Bool
+maybeQnEq Nothing   Nothing   = True
+maybeQnEq (Just q1) (Just q2) = q1 == q2
+maybeQnEq _         _         = False
+-}
+
+-- Separate URI string into namespace URI and local name
+splitURI :: String -> ( String, String )
+  -- splitQname "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
+  -- splitQname "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
+  -- splitQname "http://example.org/aaa/"    = ("http://example.org/aaa/","")
+splitURI qn = splitAt (scanURI qn (-1) 0) qn
+
+-- helper function for splitQName
+-- Takes 3 arguments:
+--   QName to scan
+--   index of last name-start char, or (-1)
+--   number of characters scanned so far
+-- Returns index of start of name, or length of list
+--
+scanURI :: String -> Int -> Int -> Int
+scanURI (nextch:more) (-1) nc
+    | isNameStartChar nextch  = scanURI more nc   (nc+1)
+    | otherwise               = scanURI more (-1) (nc+1)
+scanURI (nextch:more) ns nc
+    | not (isNameChar nextch) = scanURI more (-1) (nc+1)
+    | otherwise               = scanURI more ns   (nc+1)
+scanURI "" (-1) nc = nc
+scanURI "" ns   _  = ns
+
+
++-- Definitions here per XML namespaces, NCName production,
+-- restricted to characters used in URIs.
+-- cf. http://www.w3.org/TR/REC-xml-names/
++isNameStartChar :: Char -> Bool+isNameStartChar c = ( isAlpha c )    || ( c == '_' )
++isNameChar :: Char -> Bool+isNameChar      c = ( isAlphaNum c ) || ( any (==c) ".-_" )
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/QName.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: QName.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.5  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.4  2003/10/24 21:05:09  graham
+-- Working on datatype inference.  Most of the variable binding logic
+-- is done, but the rule structure still needs to be worked out to support
+-- forward and backward chaining through the same rule.
+--
+-- Revision 1.3  2003/09/30 20:02:40  graham
+-- Proof mechanisms now use scoped names and rulesets.
+-- Move some functionality between modules so that RDFProofCheck
+-- contains less generic code.
+--
+-- Revision 1.2  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.1  2003/09/24 12:51:00  graham
+-- Add separate QName module and test suite
+--

+ Swish/HaskellUtils/QNameTest.hs view
@@ -0,0 +1,399 @@+--------------------------------------------------------------------------------
+--  $Id: QNameTest.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  QNameTest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines test cases for QName data
+--
+--------------------------------------------------------------------------------
+
+-- WNH module Swish.HaskellUtils.QNameTest where
+
+-- module Main where++import System.IO
+    ( Handle, IOMode(WriteMode)
+    , openFile, hClose, hPutStr, hPutStrLn
+    )
+
+import Data.Maybe
+    ( fromJust )
+
+import Test.HUnit
+    ( Test(TestCase,TestList,TestLabel)
+    , assertBool, assertEqual, assertString
+    , runTestTT, runTestText, putTextToHandle
+    )
+
+import Swish.HaskellUtils.QName
+    ( QName(..)
+    , newQName, qnameFromPair, qnameFromURI
+    , getNamespace, getLocalName, getQNameURI
+    , splitURI
+    )
+
++++------------------------------------------------------------
+--  Define some common values
+------------------------------------------------------------
+
+base1  = "http://id.ninebynine.org/wip/2003/test/graph1/node#"
+base2  = "http://id.ninebynine.org/wip/2003/test/graph2/node/"
+base3  = "http://id.ninebynine.org/wip/2003/test/graph3/node"
+base4  = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase"
+base5  = "http://id.ninebynine.org/wip/2003/test/graph5/"
+
+qb1s1  = QName base1 "s1"
+qb2s2  = QName base2 "s2"
+qb3s3  = QName base3 "s3"
+qb3    = QName base3 ""
+qb3bm  = QName base3 "basemore"
+qb4m   = QName base4 "more"
+
+qb5    = QName base5 ""
+qb5s5  = QName base5 "s5"
+
+qb1st1 = QName base1 "st1"
+qb2st2 = QName base2 "st2"
+qb3st3 = QName base3 "st3"
+
+
+------------------------------------------------------------
+--  QName equality tests
+------------------------------------------------------------
+
+testQNameEq :: String -> Bool -> QName -> QName -> Test
+testQNameEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testQNameEq:"++lab) eq (n1==n2) )
+
+qnlist =
+  [ ("qb1s1", qb1s1)
+  , ("qb2s2", qb2s2)
+  , ("qb3s3", qb3s3)
+  , ("qb3",   qb3)
+  , ("qb3bm", qb3bm)
+  , ("qb4m",  qb4m)
+  , ("qb5",   qb5)
+  , ("qb5s5", qb5s5)
+  , ("qb1st1",qb1st1)
+  , ("qb2st2",qb2st2)
+  , ("qb3st3",qb3st3)
+  ]
+
+qneqlist =
+  [ ("qb3bm","qb4m")
+  ]
+
+testQNameEqSuite = TestList
+  [ testQNameEq (testLab l1 l2) (testEq  l1 l2) n1 n2
+      | (l1,n1) <- qnlist , (l2,n2) <- qnlist ]
+    where
+    testLab l1 l2 = l1 ++ "-" ++ l2
+    testEq  l1 l2 = (l1 == l2)        ||
+            (l1,l2) `elem` qneqlist ||
+            (l2,l1) `elem` qneqlist
+
+------------------------------------------------------------
+--  Alternative constructors
+------------------------------------------------------------
+
+nq1 = newQName base1 "s1"
+nq2 = newQName base1 "s2"
+
+testnq01 = testQNameEq "testnq01" True  nq1 qb1s1
+testnq02 = testQNameEq "testnq02" False nq2 qb1s1
+
+qp1 = qnameFromPair (base1,"s1")
+qp2 = qnameFromPair (base1,"s2")
+
+testqp01 = testQNameEq "testqp01" True  qp1 qb1s1
+testqp02 = testQNameEq "testqp02" False qp2 qb1s1
+
+qu1 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
+qu2 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"
+qu3 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph3/node"
+qu4 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/"
+qu5 = qnameFromURI "http://id.ninebynine.org/wip/2003/test/graph5/s5"
+
+testqu01 = testQNameEq "testqu01" True qb1s1 qu1
+testqu02 = testQNameEq "testqu02" True qb2s2 qu2
+testqu03 = testQNameEq "testqu03" True qb3   qu3
+testqu04 = testQNameEq "testqu04" True qb5   qu4
+testqu05 = testQNameEq "testqu05" True qb5s5 qu5
+
+testMakeQNameSuite = TestList
+  [ testnq01, testnq02
+  , testqp01, testqp02
+  , testqu01, testqu02, testqu03, testqu04, testqu05
+  ]
+
+
+------------------------------------------------------------
+--  Extract components
+------------------------------------------------------------
+
+testStringEq :: String -> String -> String -> Test
+testStringEq lab s1 s2 =
+    TestCase ( assertEqual ("testStringEq:"++lab) s1 s2 )
+
+testGetNamespace01 = testStringEq "testGetNamespace01"
+    "http://id.ninebynine.org/wip/2003/test/graph1/node#"
+    (getNamespace qb1s1)
+
+testGetNamespace02 = testStringEq "testGetNamespace02"
+    "http://id.ninebynine.org/wip/2003/test/graph2/node/"
+    (getNamespace qb2s2)
+
+testGetNamespace03 = testStringEq "testGetNamespace03"
+    "http://id.ninebynine.org/wip/2003/test/graph3/node"
+    (getNamespace qb3s3)
+
+testGetNamespace04 = testStringEq "testGetNamespace04"
+    "http://id.ninebynine.org/wip/2003/test/graph3/node"
+    (getNamespace qb3)
+
+testGetLocalName01 = testStringEq "testGetLocalName01"
+    "s1"
+    (getLocalName qb1s1)
+
+testGetLocalName02 = testStringEq "testGetLocalName02"
+    "s2"
+    (getLocalName qb2s2)
+
+testGetLocalName03 = testStringEq "testGetLocalName03"
+    "s3"
+    (getLocalName qb3s3)
+
+testGetLocalName04 = testStringEq "testGetLocalName04"
+    ""
+    (getLocalName qb3)
+
+testGetQNameURI01 = testStringEq "testGetQNameURI01"
+    "http://id.ninebynine.org/wip/2003/test/graph1/node#s1"
+    (getQNameURI qb1s1)
+
+testGetQNameURI02 = testStringEq "testGetQNameURI02"
+    "http://id.ninebynine.org/wip/2003/test/graph2/node/s2"
+    (getQNameURI qb2s2)
+
+testGetQNameURI03 = testStringEq "testGetQNameURI03"
+    "http://id.ninebynine.org/wip/2003/test/graph3/nodes3"
+    (getQNameURI qb3s3)
+
+testGetQNameURI04 = testStringEq "testGetQNameURI04"
+    "http://id.ninebynine.org/wip/2003/test/graph3/node"
+    (getQNameURI qb3)
+
+
+testPartQNameSuite = TestList
+  [ testGetNamespace01, testGetNamespace02, testGetNamespace03
+  , testGetNamespace04
+  , testGetLocalName01, testGetLocalName02, testGetLocalName03
+  , testGetLocalName04
+  , testGetQNameURI01,  testGetQNameURI02,  testGetQNameURI03
+  , testGetQNameURI04
+  ]
+
+------------------------------------------------------------
+--  Maybe Qname comparison
+------------------------------------------------------------
+
+testMaybeQNameEq :: String -> Bool -> (Maybe QName) -> (Maybe QName) -> Test
+testMaybeQNameEq lab eq n1 n2 =
+    TestCase ( assertEqual ("testMaybeQNameEq:"++lab) eq (n1==n2) )
+
+testMaybeQNameEq01 = testMaybeQNameEq "testMaybeQNameEq01" True
+    (Just qb1s1) (Just qb1s1)
+testMaybeQNameEq02 = testMaybeQNameEq "testMaybeQNameEq02" False
+    (Just qb1s1) (Just qb2s2)
+testMaybeQNameEq03 = testMaybeQNameEq "testMaybeQNameEq03" False
+    (Just qb1s1) Nothing
+testMaybeQNameEq04 = testMaybeQNameEq "testMaybeQNameEq04" False
+    Nothing (Just qb1s1)
+testMaybeQNameEq05 = testMaybeQNameEq "testMaybeQNameEq05" True
+    Nothing Nothing
+
+testMaybeQNameEqSuite = TestList
+  [ testMaybeQNameEq01
+  , testMaybeQNameEq02
+  , testMaybeQNameEq03
+  , testMaybeQNameEq04
+  , testMaybeQNameEq05
+  ]
+
+------------------------------------------------------------
+--  QName ordering
+------------------------------------------------------------
+
+testQNameLe :: String -> Bool -> QName -> QName -> Test
+testQNameLe lab le n1 n2 =
+    TestCase ( assertEqual ("testQNameLe:"++lab) le (n1<=n2) )
+
+testQNameLe01 = testQNameLe "testQNameLe01" True  qb3bm qb4m
+testQNameLe02 = testQNameLe "testQNameLe02" True  qb4m  qb3bm
+testQNameLe03 = testQNameLe "testQNameLe03" True  qb1s1 qb2s2
+testQNameLe04 = testQNameLe "testQNameLe04" False qb2s2 qb1s1
+
+testQNameLeSuite = TestList
+  [ testQNameLe01
+  , testQNameLe02
+  , testQNameLe03
+  , testQNameLe04
+  ]
+
+------------------------------------------------------------
+--  Show QName
+------------------------------------------------------------
+
+testShowQName01 = testStringEq "testShowQName01"
+    "<http://id.ninebynine.org/wip/2003/test/graph1/node#s1>"
+    (show qb1s1)
+
+testShowQName02 = testStringEq "testShowQName02"
+    "<http://id.ninebynine.org/wip/2003/test/graph2/node/s2>"
+    (show qb2s2)
+
+testShowQName03 = testStringEq "testShowQName03"
+    "<http://id.ninebynine.org/wip/2003/test/graph3/node>"
+    (show qb3)
+
+testShowQName04 = testStringEq "testShowQName04"
+    "<http://id.ninebynine.org/wip/2003/test/graph5/>"
+    (show qb5)
+
+testShowQNameSuite = TestList
+  [ testShowQName01
+  , testShowQName02
+  , testShowQName03
+  , testShowQName04
+  ]
+
+
+------------------------------------------------------------
+--  Split URI string into QName parts
+------------------------------------------------------------
+
+-- splitURI :: String -> ( String, String )
+    -- splitURI "http://example.org/aaa#bbb" = ("http://example.org/aaa#","bbb")
+    -- splitURI "http://example.org/aaa/bbb" = ("http://example.org/aaa/","bbb")
+    -- splitURI "http://example.org/aaa/"    = ("http://example.org/aaa/","")
+
+testSplitURI :: String -> String -> ( String, String ) -> Test
+testSplitURI label input ( main, local ) =
+    TestCase ( assertEqual label ( main, local ) ( splitURI input ) )
+
+testSplitURI01 = testSplitURI "testSplitURI01"
+                    "http://example.org/aaa#bbb"
+                    ( "http://example.org/aaa#", "bbb" )
+testSplitURI02 = testSplitURI "testSplitURI02"
+                    "http://example.org/aaa/bbb"
+                    ( "http://example.org/aaa/", "bbb" )
+testSplitURI03 = testSplitURI "testSplitURI03"
+                    "http://example.org/aaa#"
+                    ( "http://example.org/aaa#", "" )
+testSplitURI04 = testSplitURI "testSplitURI04"
+                    "http://example.org/aaa/"
+                    ( "http://example.org/aaa/", "" )
+testSplitURI05 = testSplitURI "testSplitURI05"
+                    "//example.org/aaa#bbb"
+                    ( "//example.org/aaa#", "bbb" )
+testSplitURI06 = testSplitURI "testSplitURI06"
+                    "aaa/bbb"
+                    ( "aaa/", "bbb" )
+testSplitURI07 = testSplitURI "testSplitURI07"
+                    "aaa/bbb/"
+                    ( "aaa/bbb/", "" )
+-- Thanks to Ian Dickinson of the HP Jena team for spotting this one:
+-- So what *is* the correct split here?
+testSplitURI08 = testSplitURI "testSplitURI08"
+                    "mortal"
+                    ( "", "mortal" )
+
+testSplitURISuite = TestList
+  [
+    testSplitURI01, testSplitURI02, testSplitURI03, testSplitURI04,
+    testSplitURI05, testSplitURI06, testSplitURI07, testSplitURI08
+  ]
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allTests = TestList
+  [ testQNameEqSuite
+  , testMakeQNameSuite
+  , testPartQNameSuite
+  , testMaybeQNameEqSuite
+  , testQNameLeSuite
+  , testShowQNameSuite
+  , testSplitURISuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/QNameTest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: QNameTest.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.5  2004/01/07 19:49:13  graham
+-- Reorganized RDFLabel details to eliminate separate language field,
+-- and to use ScopedName rather than QName.
+-- Removed some duplicated functions from module Namespace.
+--
+-- Revision 1.4  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.3  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.2  2003/09/24 13:36:42  graham
+-- QName handling separated from RDFGraph module, and
+-- QName splitting moved from URI module to QName module.
+--
+-- Revision 1.1  2003/09/24 12:51:00  graham
+-- Add separate QName module and test suite
+--

+ Swish/HaskellUtils/ShowM.hs view
@@ -0,0 +1,95 @@+--------------------------------------------------------------------------------
+--  $Id: ShowM.hs,v 1.1 2004/02/11 16:31:01 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  ShowM
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module defines an extension of the Show class for displaying
+--  multi-line values.  It serves the following purposes:
+--  (1) provides a method with greater layout control of multiline values,
+--  (2) provides a possibility to override the default Show behaviour
+--      for programs that use the extended ShowM interface, and
+--  (3) uses a ShowS intermediate value to avoid unnecessary
+--      concatenation of long strings.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.ShowM
+    ( ShowM(..), showm
+    )
+where
+
+------------------------------------------------------------
+--  ShowM framework
+------------------------------------------------------------
+
+-- |ShowM is a type class for values that may be formatted in
+--  multi-line displays.
+class (Show sh) => ShowM sh where
+    -- |Multi-line value display method
+    --  Create a multiline displayable form of a value, returned
+    --  as a ShowS value.  The default implementation behaves just
+    --  like a normal instance of Show.
+    --
+    --  This function is intended to allow the calling function some control
+    --  of multiline displays by providing:
+    --  (1) the first line of the value is not preceded by any text, so
+    --      it may be appended to some preceding text on the same line,
+    --  (2) the supplied line break string is used to separate lines of the
+    --      formatted text, and may include any desired indentation, and
+    --  (3) no newline is output following the final line of text.
+    showms :: String -> sh -> ShowS
+    showms linebreak val = shows val
+
+-- |showm
+--  Return a string representation of a ShowM value.
+showm :: (ShowM sh) => String -> sh -> String
+showm linebreak val = showms linebreak val ""
+
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/ShowM.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: ShowM.hs,v $
+-- Revision 1.1  2004/02/11 16:31:01  graham
+-- Move ShowM to HaskellUtils directory.
+--
+-- Revision 1.2  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.1  2003/06/25 21:20:12  graham
+-- Add ShowM class and RDF graph instance to CVS.
+-- This is part of reworking N3 formatting logic to support proof display,
+-- and other multiline display requirements.
+--

+ Swish/HaskellUtils/TestHelpers.hs view
@@ -0,0 +1,223 @@+--------------------------------------------------------------------------------
+--  $Id: TestHelpers.hs,v 1.2 2004/01/13 12:18:34 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  TestHelpers
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module contains test case helper functions, providing a range of
+--  commonly-used test cases.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.TestHelpers
+    ( test, testEq, testLe, testGe, testElem
+    , testJust, testNothing
+    , testEqv, testEqv2, testHasEqv, testMaybeEqv
+    )
+where
+
+import Swish.HaskellUtils.ListHelpers
+    ( equiv )
+
+import Test.HUnit
+    ( Test(TestCase,TestList)
+    , Assertion
+    , assertBool, assertEqual, assertFailure
+    , runTestTT
+    )
+
+import Control.Monad
+    ( unless )
+
+import Data.Maybe
+    ( isJust )
+
+
+------------------------------------------------------------
+--  Test case helpers
+------------------------------------------------------------
+
+assertMember :: (Eq a, Show a) => String -> a -> [a] -> Assertion
+assertMember preface item list =
+  unless (item `elem` list) (assertFailure msg)
+  where msg = (if null preface then "" else preface ++ "\n") ++
+             "expected: " ++ show item ++ "\nin list: " ++ show list
+
+test :: String -> Bool -> Test
+test lab bv =
+    TestCase ( assertBool ("test:"++lab) bv )
+
+testEq :: (Eq a, Show a) => String -> a -> a -> Test
+testEq lab a1 a2 =
+    TestCase ( assertEqual ("testEq:"++lab) a1 a2 )
+
+testLe :: (Ord a, Show a) => String -> a -> a -> Test
+testLe lab a1 a2 =
+    TestCase ( assertBool ("testLe:"++lab++vals) (a1<=a2) )
+    where
+        vals = ", fail: "++show a1++" <= "++show a2
+
+testGe :: (Ord a, Show a) => String -> a -> a -> Test
+testGe lab a1 a2 =
+    TestCase ( assertBool ("testGe:"++lab++vals) (a1>=a2) )
+    where
+        vals = ", fail: "++show a1++" >= "++show a2
+
+-- Test for Just x or Nothing
+
+testJust :: String -> Maybe a -> Test
+testJust lab av =
+    TestCase ( assertBool ("testJust:"++lab) (isJust av) )
+
+testNothing :: String -> Maybe a -> Test
+testNothing lab av =
+    TestCase ( assertBool ("testJust:"++lab) (not $ isJust av) )
+
+-- Test for list membership
+
+testElem :: (Eq a, Show a) => String -> a -> [a] -> Test
+testElem lab a1 as =
+    TestCase ( assertMember ("testElem:"++lab) a1 as )
+
+-- Compare lists and lists of lists and Maybe lists for set equivalence:
+
+data ListTest a = ListTest [a]
+
+instance (Eq a) => Eq (ListTest a) where
+    (ListTest a1) == (ListTest a2) = a1 `equiv` a2
+
+instance (Show a) => Show (ListTest a) where
+    show (ListTest a) = show a
+
+data MaybeListTest a = MaybeListTest (Maybe [a])
+
+instance (Eq a) => Eq (MaybeListTest a) where
+    MaybeListTest (Just a1) == MaybeListTest (Just a2) = a1 `equiv` a2
+    MaybeListTest Nothing   == MaybeListTest Nothing   = True
+    _                       == _                       = False
+
+instance (Show a) => Show (MaybeListTest a) where
+    show (MaybeListTest a) = show a
+
+testEqv :: (Eq a, Show a) => String -> [a] -> [a] -> Test
+testEqv lab a1 a2 =
+    TestCase ( assertEqual ("testEqv:"++lab) (ListTest a1) (ListTest a2) )
+
+testEqv2 :: (Eq a, Show a) => String -> [[a]] -> [[a]] -> Test
+testEqv2 lab a1 a2 =
+    TestCase ( assertEqual ("testEqv2:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest $ map ListTest a1
+        ma2 = ListTest $ map ListTest a2
+
+testHasEqv :: (Eq a, Show a) => String -> [a] -> [[a]] -> Test
+testHasEqv lab a1 a2 =
+    TestCase ( assertMember ("testHasEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = ListTest a1
+        ma2 = map ListTest a2
+
+testMaybeEqv :: (Eq a, Show a) => String -> Maybe [a] -> Maybe [a] -> Test
+testMaybeEqv lab a1 a2 =
+    TestCase ( assertEqual ("testMaybeEqv:"++lab) ma1 ma2 )
+    where
+        ma1 = (MaybeListTest a1)
+        ma2 = (MaybeListTest a2)
+
+------------------------------------------------------------
+--  Test suites for the above
+------------------------------------------------------------
+
+testSuccessSuite = TestList
+    [ test          "01" True
+    , testEq        "02" 2 2
+    , testLe        "03" 1 2
+    , testLe        "04" 2 2
+    , testGe        "05" 3 2
+    , testGe        "07" 2 2
+    , testJust      "08" (Just "08")
+    , testNothing   "09" (Nothing :: Maybe String)
+    , testElem      "10" 'b' "abc"
+    , testEqv       "11" "abc" "bca"
+    , testEqv       "12" "abc" "bbccaa"
+    , testEqv2      "13" ["abc","def","ghi"] ["fed","ghi","bca"]
+    , testHasEqv    "14" "abc"               ["fed","ghi","bca"]
+    , testHasEqv    "15" "ghi"               ["fed","ghi","bca"]
+    , testHasEqv    "16" "def"               ["fed","ghi","bca"]
+    , testMaybeEqv  "17" (Just "abc") (Just "bca")
+    , testMaybeEqv  "18" Nothing      (Nothing :: Maybe String)
+    ]
+
+-- All of these tests should be failures:
+-- Look for number of failures == total number of tests
+testFailureSuite = TestList
+    [ test          "01" False
+    , testEq        "02" 2 22
+    , testLe        "03" 2 1
+    , testGe        "04" 2 3
+    , testJust      "05" (Nothing :: Maybe String)
+    , testNothing   "06" (Just "09")
+    , testElem      "07" 'd' "abc"
+    , testEqv       "08" "abd" "bca"
+    , testEqv2      "09" ["abd","def","ghi"] ["fed","ghi","bca"]
+    , testHasEqv    "10" "abd"               ["fed","ghi","bca"]
+    , testMaybeEqv  "11" (Just "abc") (Just "bda")
+    , testMaybeEqv  "12" Nothing      (Just "bda")
+    ]
+
+
+------------------------------------------------------------
+--  All tests
+------------------------------------------------------------
+
+allSuccessTests = TestList
+    [ testSuccessSuite
+    ]
+
+allFailureTests = TestList
+    [ testFailureSuite
+    ]
+
+mainS = runTestTT allSuccessTests
+mainF = runTestTT allFailureTests
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/TestHelpers.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: TestHelpers.hs,v $
+-- Revision 1.2  2004/01/13 12:18:34  graham
+-- Clean up test case helpers module.
+--
+-- Revision 1.1.1.1  2004/01/13 12:15:56  graham
+-- Fix up name of HaskellUtils project

+ Swish/HaskellUtils/TraceHelpers.hs view
@@ -0,0 +1,71 @@+--------------------------------------------------------------------------------
+--  $Id: TraceHelpers.hs,v 1.1 2004/01/13 12:31:24 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  TraceHelpers
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98
+--
+--  This module provides access to tracing functions from the pre-2003
+--  Hugs trace module.  Over time, it may accumulate other tracing
+--  functions that I find useful.
+--
+--------------------------------------------------------------------------------
+
+module Swish.HaskellUtils.TraceHelpers
+    ( trace, traceShow
+    )
+where
+
+import Debug.Trace
+    ( trace )
+
+------------------------------------------------------------
+--  traceShow function from older Hugs trace module
+------------------------------------------------------------
+
+traceShow :: Show a => String -> a -> a
+traceShow msg x = trace (msg ++ show x) x
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/TraceHelpers.hs,v $
+-- $Author: graham $
+-- $Revision: 1.1 $
+-- $Log: TraceHelpers.hs,v $
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.1  2003/12/20 12:02:08  graham
+-- Introduced new TraceHelpers module for Hugs-2003 compatibility.
+--
+-- Revision 1.3  2003/12/18 18:29:03  graham
+-- ??????
+--

+ Swish/HaskellUtils/URITest.hs view
@@ -0,0 +1,1092 @@+--------------------------------------------------------------------------------
+--  $Id: URITest.hs,v 1.2 2004/01/22 19:52:27 graham Exp $
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--  See end of this file for licence information.
+--------------------------------------------------------------------------------
+-- |
+--  Module      :  URITest
+--  Copyright   :  (c) 2003, Graham Klyne
+--  License     :  GPL V2
+--
+--  Maintainer  :  Graham Klyne
+--  Stability   :  provisional
+--  Portability :  H98 + multi-parameter classes
+--
+-- This Module contains test cases for module URI.
+--
+--------------------------------------------------------------------------------
+
+-- WNH RIP OUT module Swish.HaskellUtils.URITest where
+
+import Test.HUnit
+import Swish.HaskellUtils.Parse
+import Swish.HaskellUtils.ProcessURI
+import System.IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn )
+
+-- Test supplied string for valid URI reference syntax
+--   isValidURIRef :: String -> Bool
+-- Test supplied string for valid absolute URI reference syntax
+--   isAbsoluteURIRef :: String -> Bool
+-- Test supplied string for valid absolute URI syntax
+--   isAbsoluteURI :: String -> Bool
+
+data URIType = AbsId    -- URI form (absolute, no fragment)
+             | AbsRf    -- Absolute URI reference
+             | RelRf    -- Relative URI reference
+             | InvRf    -- Invalid URI reference
+isValidT :: URIType -> Bool
+isValidT InvRf = False
+isValidT _     = True
+
+isAbsRfT :: URIType -> Bool
+isAbsRfT AbsId = True
+isAbsRfT AbsRf = True
+isAbsRfT _     = False
+
+isAbsIdT :: URIType -> Bool
+isAbsIdT AbsId = True
+isAbsIdT _     = False
+
+testURIRef :: URIType -> String -> Test
+testURIRef t u = TestList
+  [
+    TestCase ( assertEqual ("testValidURIRef:"++u)    (isValidT t) (isValidURIRef    u) ),
+    TestCase ( assertEqual ("testAbsoluteURIRef:"++u) (isAbsRfT t) (isAbsoluteURIRef u) ),
+    TestCase ( assertEqual ("testAbsoluteURI:"++u)    (isAbsIdT t) (isAbsoluteURI    u) )
+  ]
+
+testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc"
+testURIRef002 = testURIRef AbsId "mailto:local@domain.org"
+testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag"
+testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
+testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc"
+testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc"
+testURIRef007 = testURIRef RelRf "bbb#ccc"
+testURIRef008 = testURIRef RelRf "#ccc"
+testURIRef009 = testURIRef RelRf "#"
+testURIRef010 = testURIRef RelRf "/"
+-- escapes
+testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc"
+testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc"
+testURIRef013 = testURIRef RelRf "%2F"
+testURIRef014 = testURIRef RelRf "aaa%2Fbbb"
+-- ports
+testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc"
+testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc"
+testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc"
+testURIRef018 = testURIRef InvRf "http://example.123./aaa/bbb#ccc"
+-- IPv6 literals (from RFC2732):
+testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html"
+testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html"
+testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]"
+testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo"
+testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng"
+testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html"
+testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]"
+testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]"
+testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]"
+-- RFC2396 test cases
+testURIRef031 = testURIRef RelRf "./aaa"
+testURIRef032 = testURIRef RelRf "../aaa"
+testURIRef033 = testURIRef AbsId "g:h"
+testURIRef034 = testURIRef RelRf "g"
+testURIRef035 = testURIRef RelRf "./g"
+testURIRef036 = testURIRef RelRf "g/"
+testURIRef037 = testURIRef RelRf "/g"
+testURIRef038 = testURIRef RelRf "//g"
+testURIRef039 = testURIRef RelRf "?y"
+testURIRef040 = testURIRef RelRf "g?y"
+testURIRef041 = testURIRef RelRf "#s"
+testURIRef042 = testURIRef RelRf "g#s"
+testURIRef043 = testURIRef RelRf "g?y#s"
+testURIRef044 = testURIRef RelRf ";x"
+testURIRef045 = testURIRef RelRf "g;x"
+testURIRef046 = testURIRef RelRf "g;x?y#s"
+testURIRef047 = testURIRef RelRf "."
+testURIRef048 = testURIRef RelRf "./"
+testURIRef049 = testURIRef RelRf ".."
+testURIRef050 = testURIRef RelRf "../"
+testURIRef051 = testURIRef RelRf "../g"
+testURIRef052 = testURIRef RelRf "../.."
+testURIRef053 = testURIRef RelRf "../../"
+testURIRef054 = testURIRef RelRf "../../g"
+testURIRef055 = testURIRef RelRf "../../../g"
+testURIRef056 = testURIRef RelRf "../../../../g"
+testURIRef057 = testURIRef RelRf "/./g"
+testURIRef058 = testURIRef RelRf "/../g"
+testURIRef059 = testURIRef RelRf "g."
+testURIRef060 = testURIRef RelRf ".g"
+testURIRef061 = testURIRef RelRf "g.."
+testURIRef062 = testURIRef RelRf "..g"
+testURIRef063 = testURIRef RelRf "./../g"
+testURIRef064 = testURIRef RelRf "./g/."
+testURIRef065 = testURIRef RelRf "g/./h"
+testURIRef066 = testURIRef RelRf "g/../h"
+testURIRef067 = testURIRef RelRf "g;x=1/./y"
+testURIRef068 = testURIRef RelRf "g;x=1/../y"
+testURIRef069 = testURIRef RelRf "g?y/./x"
+testURIRef070 = testURIRef RelRf "g?y/../x"
+testURIRef071 = testURIRef RelRf "g#s/./x"
+testURIRef072 = testURIRef RelRf "g#s/../x"
+-- Invalid
+testURIRef081 = testURIRef RelRf ""
+testURIRef082 = testURIRef InvRf " "
+testURIRef083 = testURIRef InvRf "%"
+testURIRef084 = testURIRef InvRf "A%Z"
+testURIRef085 = testURIRef InvRf "%ZZ"
+testURIRef086 = testURIRef InvRf "%AZ"
+testURIRef087 = testURIRef InvRf "A C"
+testURIRef088 = testURIRef InvRf "A\"C"
+testURIRef089 = testURIRef RelRf "A'C"
+testURIRef090 = testURIRef InvRf "A\"C"
+testURIRef091 = testURIRef InvRf "A`C"
+testURIRef092 = testURIRef InvRf "A<C"
+testURIRef093 = testURIRef InvRf "A>C"
+testURIRef094 = testURIRef InvRf "A^C"
+testURIRef095 = testURIRef InvRf "A\\C"
+testURIRef096 = testURIRef InvRf "A{C"
+testURIRef097 = testURIRef InvRf "A|C"
+testURIRef098 = testURIRef InvRf "A}C"
+-- From RFC2396:
+-- rel_segment   = 1*( unreserved | escaped |
+--                     ";" | "@" | "&" | "=" | "+" | "$" | "," )
+-- unreserved    = alphanum | mark
+-- mark          = "-" | "_" | "." | "!" | "~" | "*" | "'" |
+--                 "(" | ")"
+-- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals,
+-- or does it?
+testURIRef101 = testURIRef InvRf "A[C"
+testURIRef102 = testURIRef InvRf "A]C"
+testURIRef103 = testURIRef InvRf "A[**]C"
+testURIRef104 = testURIRef InvRf "http://[xyz]/"
+testURIRef105 = testURIRef InvRf "http://]/"
+testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]"
+testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]"
+testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]"
+-- Random other things that crop up
+testURIRef111 = testURIRef AbsRf "http://example/Andr&#567;"
+
+testURIRefSuite = TestLabel "Test URIrefs" testURIRefList
+testURIRefList = TestList
+  [
+    testURIRef001, testURIRef002, testURIRef003, testURIRef004,
+    testURIRef005, testURIRef006, testURIRef007, testURIRef008,
+    testURIRef009, testURIRef010,
+    --
+    testURIRef011, testURIRef012, testURIRef013, testURIRef014,
+    testURIRef015, testURIRef016, testURIRef017, testURIRef018,
+    --
+    testURIRef021, testURIRef022, testURIRef023, testURIRef024,
+    testURIRef025, testURIRef026, testURIRef027, testURIRef028,
+    testURIRef029,
+    --
+    testURIRef031, testURIRef032, testURIRef033, testURIRef034,
+    testURIRef035, testURIRef036, testURIRef037, testURIRef038,
+    testURIRef039,
+    testURIRef040, testURIRef041, testURIRef042, testURIRef043,
+    testURIRef044, testURIRef045, testURIRef046, testURIRef047,
+    testURIRef048, testURIRef049,
+    testURIRef050, testURIRef051, testURIRef052, testURIRef053,
+    testURIRef054, testURIRef055, testURIRef056, testURIRef057,
+    testURIRef058, testURIRef059,
+    testURIRef060, testURIRef061, testURIRef062, testURIRef063,
+    testURIRef064, testURIRef065, testURIRef066, testURIRef067,
+    testURIRef068, testURIRef069,
+    testURIRef070, testURIRef071, testURIRef072,
+    --
+    testURIRef081, testURIRef082, testURIRef083, testURIRef084,
+    testURIRef085, testURIRef086, testURIRef087, testURIRef088,
+    testURIRef089,
+    testURIRef090, testURIRef091, testURIRef092, testURIRef093,
+    testURIRef094, testURIRef095, testURIRef096, testURIRef097,
+    testURIRef098, -- testURIRef099,
+    --
+    testURIRef101, testURIRef102, testURIRef103, testURIRef104,
+    testURIRef105, testURIRef106, testURIRef107, testURIRef108,
+    --
+    testURIRef111
+  ]
+
+-- Parser tests:  these are fairtly cursory, as the validating tests above
+-- are assumed to be conducted using the parser logic.
+
+testParser :: ( Show a, Show b, Eq a, Eq b ) =>
+              String -> Parser a b -> [a] -> [(b,[a])] -> Test
+testParser label parser input result =
+    TestCase ( assertEqual label result ( parser input ) )
+
+noResult :: [ ( String,[Char] ) ]
+noResult = []
+
+-- URI parser (see Parse module)
+--   parseURIRef :: Parser Char String
+
+testParseRef01 = testParser "testParseRef01" parseURIRef "http://example.org/aaa/bbb#ccc"
+                    [("http://example.org/aaa/bbb#ccc","")]
+testParseRef02 = testParser "testParseRef02" parseURIRef "mailto:local@domain.org ****"
+                    [("mailto:local@domain.org"," ****")]
+testParseRef03 = testParser "testParseRef03" parseURIRef "mailto:local@domain.org#frag|****"
+                    [("mailto:local@domain.org#frag","|****")]
+testParseRef04 = testParser "testParseRef04" parseURIRef "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
+                    [("HTTP://EXAMPLE.ORG/AAA/BBB#CCC","")]
+testParseRef05 = testParser "testParseRef05" parseURIRef "//example.org/aaa/bbb#ccc"
+                    [("//example.org/aaa/bbb#ccc","")]
+testParseRef06 = testParser "testParseRef06" parseURIRef "/aaa/bbb#ccc"
+                    [("/aaa/bbb#ccc","")]
+testParseRef07 = testParser "testParseRef07" parseURIRef "bbb#c%aac"    [("bbb#c%aac","")]
+testParseRef08 = testParser "testParseRef08" parseURIRef "#ccc"       [("#ccc","")]
+testParseRef09 = testParser "testParseRef09" parseURIRef "#"          [("#","")]
+testParseRef10 = testParser "testParseRef10" parseURIRef "/"          [("/","")]
+testParseRef11 = testParser "testParseRef11" parseURIRef "A^C"        [("A","^C")]
+testParseRef12 = testParser "testParseRef12" parseURIRef "bbb#ccc%z"  [("bbb#ccc","%z")]
+testParseRef13 = testParser "testParseRef13" parseURIRef "bbb?ccc"    [("bbb?ccc","")]
+testParseRef14 = testParser "testParseRef14" parseURIRef "?ccc"       [("?ccc","")]
+
+testParseRefSuite = TestLabel "Test parseURIRef" testParseRefList
+testParseRefList  = TestList
+  [
+    testParseRef01, testParseRef02, testParseRef03, testParseRef04,
+    testParseRef05, testParseRef06, testParseRef07, testParseRef08,
+    testParseRef09,
+    testParseRef10, testParseRef11, testParseRef12, testParseRef13,
+    testParseRef14
+  ]
+
+-- Absolute URI reference parser (see Parse module)
+--   parseAbsoluteURIRef :: Parser Char String
+
+testParseAbs01 = testParser "testParseAbs01" parseAbsoluteURIRef
+                    "http://example.org/aaa/bbb#ccc"
+                    [("http://example.org/aaa/bbb#ccc","")]
+testParseAbs02 = testParser "testParseAbs02" parseAbsoluteURIRef
+                    "mailto:local@domain.org ****"
+                    [("mailto:local@domain.org"," ****")]
+testParseAbs03 = testParser "testParseAbs03" parseAbsoluteURIRef
+                    "mailto:local@domain.org#frag|****"
+                    [("mailto:local@domain.org#frag","|****")]
+testParseAbs04 = testParser "testParseAbs04" parseAbsoluteURIRef
+                    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
+                    [("HTTP://EXAMPLE.ORG/AAA/BBB#CCC","")]
+testParseAbs05 = testParser "testParseAbs05" parseAbsoluteURIRef
+                    "//example.org/aaa/bbb#ccc"
+                    noResult
+testParseAbs06 = testParser "testParseAbs06" parseAbsoluteURIRef
+                    "/aaa/bbb#ccc"
+                    noResult
+testParseAbs07 = testParser "testParseAbs07" parseAbsoluteURIRef
+                    "bbb#c%aac"
+                    noResult
+testParseAbs08 = testParser "testParseAbs08" parseAbsoluteURIRef
+                    "#ccc"
+                    noResult
+testParseAbs09 = testParser "testParseAbs09" parseAbsoluteURIRef
+                    "#"
+                    noResult
+testParseAbs10 = testParser "testParseAbs10" parseAbsoluteURIRef
+                    "/"
+                    noResult
+testParseAbs11 = testParser "testParseAbs11" parseAbsoluteURIRef
+                    "A'C"
+                    noResult
+testParseAbs12 = testParser "testParseAbs12" parseAbsoluteURIRef
+                    "bbb#ccc%z"
+                    noResult
+
+testParseAbsSuite = TestLabel "Test parseAbsoluteURIRef" testParseAbsList
+testParseAbsList  = TestList
+  [
+    testParseAbs01, testParseAbs02, testParseAbs03, testParseAbs04,
+    testParseAbs05, testParseAbs06, testParseAbs07, testParseAbs08,
+    testParseAbs09,
+    testParseAbs10, testParseAbs11, testParseAbs12
+  ]
+
+-- Absolute URI parser (see Parse module)
+--  parseAbsoluteURI :: Parser Char String
+
+testParseURI01 = testParser "testParseURI01" parseAbsoluteURI
+                    "http://example.org/aaa/bbb#ccc"
+                    [("http://example.org/aaa/bbb","#ccc")]
+testParseURI02 = testParser "testParseURI02" parseAbsoluteURI
+                    "mailto:local@domain.org ****"
+                    [("mailto:local@domain.org"," ****")]
+testParseURI03 = testParser "testParseURI03" parseAbsoluteURI
+                    "mailto:local@domain.org#frag|****"
+                    [("mailto:local@domain.org","#frag|****")]
+testParseURI04 = testParser "testParseURI04" parseAbsoluteURI
+                    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
+                    [("HTTP://EXAMPLE.ORG/AAA/BBB","#CCC")]
+testParseURI05 = testParser "testParseURI05" parseAbsoluteURI
+                    "//example.org/aaa/bbb#ccc"
+                    noResult
+testParseURI06 = testParser "testParseURI06" parseAbsoluteURI
+                    "/aaa/bbb#ccc"
+                    noResult
+testParseURI07 = testParser "testParseURI07" parseAbsoluteURI
+                    "bbb#c%aac"
+                    noResult
+testParseURI08 = testParser "testParseURI08" parseAbsoluteURI
+                    "#ccc"
+                    noResult
+testParseURI09 = testParser "testParseURI09" parseAbsoluteURI
+                    "#"
+                    noResult
+testParseURI10 = testParser "testParseURI10" parseAbsoluteURI
+                    "/"
+                    noResult
+testParseURI11 = testParser "testParseURI11" parseAbsoluteURI
+                    "A'C"
+                    noResult
+testParseURI12 = testParser "testParseURI12" parseAbsoluteURI
+                    "bbb#ccc%z"
+                    noResult
+
+testParseURISuite = TestLabel "Test parseAbsoluteURI" testParseURIList
+testParseURIList  = TestList
+  [
+    testParseURI01, testParseURI02, testParseURI03, testParseURI04,
+    testParseURI05, testParseURI06, testParseURI07, testParseURI08,
+    testParseURI09,
+    testParseURI10, testParseURI11, testParseURI12
+  ]
+
+-- Compare two URIs
+-- Takes account of normalizations that can be applied to all URIs
+-- (2003-02-20, currently subject to W3C TAG debate)
+--   compareURI :: String -> String -> Bool
+
+testCompare :: String -> Bool -> String -> String  -> Test
+testCompare label eq uri1 uri2 =
+    TestCase ( assertEqual label eq ( compareURI uri1 uri2 ) )
+
+testCompare01 = testCompare "testCompare01" True
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://example.org/aaa/bbb#ccc"
+testCompare02 = testCompare "testCompare02" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "HTTP://example.org/aaa/bbb#ccc"
+testCompare03 = testCompare "testCompare03" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://EXAMPLE.ORG/aaa/bbb#ccc"
+testCompare04 = testCompare "testCompare04" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://example.org/AAA/bbb#ccc"
+testCompare05 = testCompare "testCompare05" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://example.org/a%61a/bbb#ccc"
+testCompare06 = testCompare "testCompare06" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://example.org/aaa/b%62b#ccc"
+testCompare07 = testCompare "testCompare07" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://example.org/aaa/bbb#c%63c"
+testCompare08 = testCompare "testCompare08" False
+                    "mailto:local@example.org"
+                    "mailto:local@ex%61mple.org"
+testCompare09 = testCompare "testCompare09" False
+                    "http://example.org/aaa/bbb#ccc"
+                    "http://example.org/aaa%2Fbbb#ccc"
+testCompare10 = testCompare "testCompare10" False
+                    "http://example.org/aaa%2fbbb#ccc"
+                    "http://example.org/aaa%2Fbbb#ccc"
+
+testCompareSuite = TestLabel "Test compareURI" testCompareList
+testCompareList  = TestList
+  [
+    testCompare01, testCompare02, testCompare03, testCompare04,
+    testCompare05, testCompare06, testCompare07, testCompare08,
+    testCompare09,
+    testCompare10 -- , testCompare11, testCompare12
+  ]
+
+-- Separate URI-with-fragment into URI and fragment ID
+--   splitURIFragment :: String -> ( String, Maybe String )
+-- Construct URI-with-fragment using URI and supplied fragment id
+--   makeURIWithFragment :: String -> Maybe String -> String
+
+testSplitFrag :: String -> String -> ( String, Maybe String ) -> Test
+testSplitFrag label input ( main, frag ) = TestList
+    [
+    TestCase ( assertEqual (label++"(split)") ( main, frag ) ( splitURIFragment input ) ),
+    TestCase ( assertEqual (label++"(make)")  input          ( makeURIWithFragment main frag ) )
+    ]
+
+testSplitFrag01 = testSplitFrag "testSplitFrag01"
+                    "http://example.org/aaa/bbb#ccc"
+                    ( "http://example.org/aaa/bbb", Just "ccc" )
+testSplitFrag02 = testSplitFrag "testSplitFrag02"
+                    "mailto:local@domain.org"
+                    ( "mailto:local@domain.org", Nothing )
+testSplitFrag03 = testSplitFrag "testSplitFrag03"
+                    "mailto:local@domain.org#frag"
+                    ( "mailto:local@domain.org", Just "frag" )
+testSplitFrag04 = testSplitFrag "testSplitFrag04"
+                    "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"
+                    ( "HTTP://EXAMPLE.ORG/AAA/BBB", Just "CCC" )
+testSplitFrag05 = testSplitFrag "testSplitFrag05"
+                    "//example.org/aaa/bbb#ccc"
+                    ( "//example.org/aaa/bbb", Just "ccc" )
+testSplitFrag06 = testSplitFrag "testSplitFrag06"
+                    "/aaa/bbb#ccc"
+                    ( "/aaa/bbb", Just "ccc" )
+testSplitFrag07 = testSplitFrag "testSplitFrag07"
+                    "bbb#ccc"
+                    ( "bbb", Just "ccc" )
+testSplitFrag08 = testSplitFrag "testSplitFrag08"
+                    "#ccc"
+                    ( "", Just "ccc" )
+testSplitFrag09 = testSplitFrag "testSplitFrag09"
+                    "#"
+                    ( "", Just "" )
+testSplitFrag10 = testSplitFrag "testSplitFrag10"
+                    "/"
+                    ( "/", Nothing )
+testSplitFrag11 = testSplitFrag "testSplitFrag11"
+                    "aaa%12ccc"
+                    ( "aaa%12ccc", Nothing )
+testSplitFrag12 = testSplitFrag "testSplitFrag12"
+                    "aaa%23ccc"                     -- %23 = '#'
+                    ( "aaa%23ccc", Nothing )
+testSplitFrag13 = testSplitFrag "testSplitFrag13"
+                    "http://example.org/aaa/bbb#"
+                    ( "http://example.org/aaa/bbb", Just "" )
+testSplitFrag14 = testSplitFrag "testSplitFrag14"
+                    ""
+                    ( "", Nothing )
+testSplitFrag15 = testSplitFrag "testSplitFrag15"
+                    "abc"
+                    ( "abc", Nothing )
+testSplitFrag16 = testSplitFrag "testSplitFrag16"
+                    "abc#de:f"
+                    ( "abc", Just "de:f" )
+testSplitFrag17 = testSplitFrag "testSplitFrag17"
+                    "abc#de?f"
+                    ( "abc", Just "de?f" )
+testSplitFrag18 = testSplitFrag "testSplitFrag18"
+                    "abc#de/f"
+                    ( "abc", Just "de/f" )
+
+testSplitFragSuite = TestLabel "Test splitURIFragment" testSplitFragList
+testSplitFragList  = TestList
+  [
+    testSplitFrag01, testSplitFrag02, testSplitFrag03, testSplitFrag04,
+    testSplitFrag05, testSplitFrag06, testSplitFrag07, testSplitFrag08,
+    testSplitFrag09,
+    testSplitFrag10, testSplitFrag11, testSplitFrag12, testSplitFrag13,
+    testSplitFrag14, testSplitFrag15, testSplitFrag16, testSplitFrag17,
+    testSplitFrag18
+  ]
+
+
+-- Above tests most cases of makeURIWithFragment,
+-- but a couple of extra tests are needed for when the main URI already
+-- has a fragment:
+testOverrideFrag label ( main, frag ) result =
+    TestCase ( assertEqual label result ( makeURIWithFragment main frag ) )
+
+testOverrideFrag01 = testOverrideFrag "testOverrideFrag01"
+                        ( "http://example.org/aaa#bbb", (Just "fff") )
+                        "http://example.org/aaa#fff"
+testOverrideFrag02 = testOverrideFrag "testOverrideFrag02"
+                        ( "http://example.org/aaa#bbb", Nothing )
+                        "http://example.org/aaa"
+testOverrideFrag03 = testOverrideFrag "testOverrideFrag03"
+                        ( "http://example.org/aaa#bbb", Just "" )
+                        "http://example.org/aaa#"
+
+testOverrideFragSuite = TestLabel "Test Override Fragment" testOverrideFragList
+testOverrideFragList  = TestList
+  [
+    testOverrideFrag01, testOverrideFrag02, testOverrideFrag03
+  ]
+
+-- test getURIRef function
+testGetURIRef :: String -> String -> URI -> Test
+testGetURIRef label strval urival =
+    TestCase ( assertEqual label urival ( getURIRef strval ) )
+
+
+testGetURIRef01 = testGetURIRef "testGetURIRef01"
+                    "foo:xyz"
+                    (URI "foo:" "xyz" [] "" "")
+testGetURIRef02 = testGetURIRef "testGetURIRef02"
+                    "http://example/x/y/z"
+                    (URI "http:" "//example" ["/","x/","y/","z"] "" "")
+testGetURIRef03 = testGetURIRef "testGetURIRef03"
+                    "../abc"
+                    (URI "" "" ["../","abc"] "" "")
+testGetURIRef04 = testGetURIRef "testGetURIRef04"
+                    "http://example/a/b/../../c"
+                    (URI "http:" "//example" ["/","a/","b/","../","../","c"] "" "")
+testGetURIRef05 = testGetURIRef "testGetURIRef04"
+                    "http://example/a/./b/./../c/"
+                    (URI "http:" "//example" ["/","a/","./","b/","./","../","c/",""] "" "")
+
+
+testGetURIRefSuite = TestLabel "Test getURIReg" testGetURIRefList
+testGetURIRefList  = TestList
+  [
+    testGetURIRef01, testGetURIRef02, testGetURIRef03, testGetURIRef04, testGetURIRef05
+  ]
+
+-- test normalizeURI function
+testNormalizeURI :: String -> String -> String -> Test
+testNormalizeURI label strval normval =
+    TestCase ( assertEqual (label++": "++strval) normval ( normalizeURI strval ) )
+
+
+testNormalizeURI01 = testNormalizeURI "testNormalizeURI01"
+                    "../abc"
+                    "../abc"
+testNormalizeURI02 = testNormalizeURI "testNormalizeURI02"
+                    "http://example/x/y/z"
+                    "http://example/x/y/z"
+testNormalizeURI03 = testNormalizeURI "testNormalizeURI03"
+                    "http://example/a/b/../../c"
+                    "http://example/c"
+testNormalizeURI04 = testNormalizeURI "testNormalizeURI04"
+                    "http://example/a/b/c/../../"
+                    "http://example/a/"
+testNormalizeURI05 = testNormalizeURI "testNormalizeURI05"
+                    "http://example/a/b/c/./"
+                    "http://example/a/b/c/"
+testNormalizeURI06 = testNormalizeURI "testNormalizeURI06"
+                    "http://example/a/b/c/.././"
+                    "http://example/a/b/"
+testNormalizeURI07 = testNormalizeURI "testNormalizeURI07"
+                    "http://example/a/b/c/d/../../../../e"
+                    "http://example/e"
+testNormalizeURI08 = testNormalizeURI "testNormalizeURI08"
+                    "http://example/a/b/c/d/../.././../../e"
+                    "http://example/e"
+
+testNormalizeURISuite = TestLabel "Test normalizeURI" testNormalizeURIList
+testNormalizeURIList  = TestList
+  [
+    testNormalizeURI01, testNormalizeURI02, testNormalizeURI03, testNormalizeURI04,
+    testNormalizeURI05, testNormalizeURI06, testNormalizeURI07, testNormalizeURI08
+  ]
+
+-- Get reference relative to given base
+--   relativeRef :: String -> String -> String
+-- Get absolute URI given base and relative reference
+--   absoluteURI :: String -> String -> String
+--
+-- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py
+-- (Thanks, Dan Connolly)
+--
+-- NOTE:  absoluteURI base (relativeRef base u) is always equivalent to u.
+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
+
+testRelSplit :: String -> String -> String -> String -> Test
+testRelSplit label base uabs urel =
+    TestCase ( assertEqual label urel ( relativeRefPart base uabs ) )
+
+testRelJoin  :: String -> String -> String -> String -> Test
+testRelJoin label base urel uabs =
+    TestCase ( assertEqual label uabs ( absoluteUriPart base urel ) )
+
+testRelative :: String -> String -> String -> String -> Test
+testRelative label base uabs urel = TestList
+    [
+    (testRelSplit (label++"(rel)") base uabs urel),
+    (testRelJoin  (label++"(abs)") base urel (normalizeURI uabs))
+    ]
+
+testRelative01 = testRelative "testRelative01"
+                    "foo:xyz" "bar:abc" "bar:abc"
+testRelative02 = testRelative "testRelative02"
+                    "http://example/x/y/z" "http://example/x/abc" "../abc"
+testRelative03 = testRelative "testRelative03"
+                    "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc"
+                    -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc"
+testRelative04 = testRelative "testRelative04"
+                    "http://ex/x/y/z" "http://ex/x/r" "../r"
+testRelative05 = testRelative "testRelative05"
+                    "http://ex/x/y/z" "http://ex/r" "/r"
+                    -- "http://ex/x/y/z" "http://ex/r" "../../r"
+testRelative06 = testRelative "testRelative06"
+                    "http://ex/x/y" "http://ex/x/q/r" "q/r"
+testRelative07 = testRelative "testRelative07"
+                    "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s"
+testRelative08 = testRelative "testRelative08"
+                    "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t"
+testRelative09 = testRelative "testRelative09"
+                    "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"
+testRelative10 = testRelative "testRelative10"
+                    "http://ex/x/y" "http://ex/x/y" "y"
+                    -- "http://ex/x/y" "http://ex/x/y" ""
+testRelative11 = testRelative "testRelative11"
+                    "http://ex/x/y/" "http://ex/x/y/" "./"
+                    -- "http://ex/x/y/" "http://ex/x/y/" ""
+testRelative12 = testRelative "testRelative12"
+                    "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq"
+                    -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" ""
+testRelative13 = testRelative "testRelative13"
+                    "http://ex/x/y/" "http://ex/x/y/z/" "z/"
+testRelative14 = testRelative "testRelative14"
+                    "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal"
+testRelative15 = testRelative "testRelative15"
+                    "file:/e/x/y/z" "file:/e/x/abc" "../abc"
+testRelative16 = testRelative "testRelative16"
+                    "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc"
+testRelative17 = testRelative "testRelative17"
+                    "file:/ex/x/y/z" "file:/ex/x/r" "../r"
+testRelative18 = testRelative "testRelative18"
+                    "file:/ex/x/y/z" "file:/r" "/r"
+testRelative19 = testRelative "testRelative19"
+                    "file:/ex/x/y" "file:/ex/x/q/r" "q/r"
+testRelative20 = testRelative "testRelative20"
+                    "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s"
+testRelative21 = testRelative "testRelative21"
+                    "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#"
+testRelative22 = testRelative "testRelative22"
+                    "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t"
+testRelative23 = testRelative "testRelative23"
+                    "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"
+testRelative24 = testRelative "testRelative24"
+                    "file:/ex/x/y" "file:/ex/x/y" "y"
+                    -- "file:/ex/x/y" "file:/ex/x/y" ""
+testRelative25 = testRelative "testRelative25"
+                    "file:/ex/x/y/" "file:/ex/x/y/" "./"
+                    -- "file:/ex/x/y/" "file:/ex/x/y/" ""
+testRelative26 = testRelative "testRelative26"
+                    "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq"
+                    -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" ""
+testRelative27 = testRelative "testRelative27"
+                    "file:/ex/x/y/" "file:/ex/x/y/z/" "z/"
+testRelative28 = testRelative "testRelative28"
+                    "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"
+                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"
+                    -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"
+                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"
+testRelative29 = testRelative "testRelative29"
+                    "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"
+                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"
+                    -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"
+                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"
+testRelative30 = testRelative "testRelative30"
+                    "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"
+testRelative31 = testRelative "testRelative31"
+                    "file:/some/dir/foo" "file:/some/dir/#" "./#"
+testRelative32 = testRelative "testRelative32"
+                    "http://ex/x/y" "http://ex/x/q:r" "./q:r"
+                    -- see RFC2396bis, section 5       ^^
+testRelative33 = testRelative "testRelative33"
+                    "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r"
+                    -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r"
+testRelative34 = testRelative "testRelative34"
+                    "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "y?pp/rr"
+testRelative35 = testRelative "testRelative35"
+                    "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z"
+testRelative36 = testRelative "testRelative36"
+                    "mailto:local"
+                    "mailto:local/qual@domain.org#frag"
+                    "local/qual@domain.org#frag"
+-- relativeRefPart "mailto:local/qual@domain.org" "mailto:local/qual@domain.org#frag"
+testRelative37 = testRelative "testRelative37"
+                    "mailto:local/qual@domain.org"
+                    "mailto:local/qual@domain.org#frag"
+                    "local/qual@domain.org#frag"
+testRelative38 = testRelative "testRelative38"
+                    "http://ex/x/y?q" "http://ex/x/y?q" "y?q"
+testRelative39 = testRelative "testRelative39"
+                    "http://ex?p" "http://ex/x/y?q" "/x/y?q"
+
+-- add escape tests
+testRelative40 = testRelative "testRelative40"
+                    "http://example/x/y%2Fz" "http://example/x/abc" "abc"
+testRelative41 = testRelative "testRelative41"
+                    "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc"
+testRelative42 = testRelative "testRelative42"
+                    "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc"
+testRelative43 = testRelative "testRelative43"
+                    "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc"
+testRelative44 = testRelative "testRelative44"
+                    "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar"
+testRelative45 = testRelative "testRelative45"
+                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"
+-- Apparently, TimBL prefers the following way to 41, 42 above
+-- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html
+-- He also notes that there may be different relative fuctions
+-- that satisfy the basic equivalence axiom:
+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html
+testRelative46 = testRelative "testRelative46"
+                    "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc"
+testRelative47 = testRelative "testRelative47"
+                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"
+
+-- Other oddball tests
+    -- Check segment normalization code:
+testRelative50 = testRelative "testRelative50"
+                    "ftp://example/x/y" "http://example/a/b/../../c"  "http://example/c"
+testRelative51 = testRelative "testRelative51"
+                    "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/"
+testRelative52 = testRelative "testRelative52"
+                    "ftp://example/x/y" "http://example/a/b/c/./"     "http://example/a/b/c/"
+testRelative53 = testRelative "testRelative53"
+                    "ftp://example/x/y" "http://example/a/b/c/.././"  "http://example/a/b/"
+testRelative54 = testRelative "testRelative54"
+                    "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e"
+testRelative55 = testRelative "testRelative55"
+                    "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e"
+    -- Check handling of queries and fragments with non-relative paths
+testRelative60 = testRelative "testRelative60"
+                    "mailto:local1@domain1?query1" "mailto:local2@domain2"
+                    "local2@domain2"
+testRelative61 = testRelative "testRelative61"
+                    "mailto:local1@domain1" "mailto:local2@domain2?query2"
+                    "local2@domain2?query2"
+testRelative62 = testRelative "testRelative62"
+                    "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"
+                    "local2@domain2?query2"
+testRelative63 = testRelative "testRelative63"
+                    "mailto:local@domain?query1" "mailto:local@domain?query2"
+                    "local@domain?query2"
+testRelative64 = testRelative "testRelative64"
+                    "mailto:?query1" "mailto:local@domain?query2"
+                    "local@domain?query2"
+testRelative65 = testRelative "testRelative65"
+                    "mailto:local@domain?query1" "mailto:?query2"
+                    "?query2"
+
+-- testRelative  base abs rel
+-- testRelSplit  base abs rel
+-- testRelJoin   base rel abs
+testRelative70 = testRelative "testRelative70"
+                    "http://example.org/base/uri" "http:this"
+                    "this"  -- no round-tripping this case
+testRelative71 = testRelSplit "testRelative71"
+                    "http://example.org/base/uri" "http:this"
+                    "this"
+testRelative72 = testRelJoin "testRelative72"
+                    "http://example.org/base/uri" "http:this"
+                    "http:this"
+testRelative73 = testRelJoin "testRelative73"
+                    "http:base" "http:this"
+                    "http:this"
+testRelative74 = testRelJoin "testRelative74"
+                    "f:/a" ".//g"
+                    "f://g"
+testRelative75 = testRelJoin "testRelative74"
+                    "f://example.org/base/a" "b/c//d/e"
+                    "f://example.org/base/b/c//d/e"
+testRelative76 = testRelJoin "testRelative74"
+                    "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org"
+                    "mid:m2@example.ord/c2@example.org"
+
+
+testRelativeSuite = TestLabel "Test Relative URIs" testRelativeList
+testRelativeList  = TestList
+  [ testRelative01, testRelative02, testRelative03, testRelative04
+  , testRelative05, testRelative06, testRelative07, testRelative08
+  , testRelative09
+  , testRelative10, testRelative11, testRelative12, testRelative13
+  , testRelative14, testRelative15, testRelative16, testRelative17
+  , testRelative18, testRelative19
+  , testRelative21, testRelative21, testRelative22, testRelative23
+  , testRelative24, testRelative25, testRelative26, testRelative27
+  , testRelative28, testRelative29
+  , testRelative30, testRelative31, testRelative32, testRelative33
+  , testRelative34, testRelative35, testRelative36, testRelative37
+    --
+  , testRelative40, testRelative41, testRelative42, testRelative43
+  , testRelative44, testRelative45, testRelative46, testRelative47
+    --
+  , testRelative50, testRelative51, testRelative52, testRelative53
+  , testRelative54, testRelative55
+    --
+  , testRelative60, testRelative61, testRelative62, testRelative63
+  , testRelative64, testRelative65
+    --
+  -- , testRelative70
+  , testRelative71, testRelative72, testRelative73
+  , testRelative74, testRelative75, testRelative76
+  ]
+
+-- RFC2396 relative-to-absolute URI tests
+
+rfcbase  = "http://a/b/c/d;p?q"
+-- normal cases, RFC2396 C.1
+testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h"
+testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g"
+testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g"
+testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/"
+testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g"
+testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g"
+testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y"
+testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y"
+testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s"
+testRFC10 = testRelJoin "testRFC10" rfcbase "g#s" "http://a/b/c/g#s"
+testRFC11 = testRelJoin "testRFC11" rfcbase "g?y#s" "http://a/b/c/g?y#s"
+testRFC12 = testRelJoin "testRFC12" rfcbase ";x" "http://a/b/c/;x"
+testRFC13 = testRelJoin "testRFC13" rfcbase "g;x" "http://a/b/c/g;x"
+testRFC14 = testRelJoin "testRFC14" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s"
+testRFC15 = testRelJoin "testRFC15" rfcbase "." "http://a/b/c/"
+testRFC16 = testRelJoin "testRFC16" rfcbase "./" "http://a/b/c/"
+testRFC17 = testRelJoin "testRFC17" rfcbase ".." "http://a/b/"
+testRFC18 = testRelJoin "testRFC18" rfcbase "../" "http://a/b/"
+testRFC19 = testRelJoin "testRFC19" rfcbase "../g" "http://a/b/g"
+testRFC20 = testRelJoin "testRFC20" rfcbase "../.." "http://a/"
+testRFC21 = testRelJoin "testRFC21" rfcbase "../../" "http://a/"
+testRFC22 = testRelJoin "testRFC22" rfcbase "../../g" "http://a/g"
+testRFC23 = testRelJoin "testRFC23" rfcbase "#s" "#s"   -- current document
+testRFC24 = testRelJoin "testRFC24" rfcbase "" ""       -- current document
+-- abnormal cases, RFC2396 C.2
+testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase
+testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/../g"
+testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/../../g"
+testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g"
+--testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/./g"  -- RFC2396 says don't remove '.'
+testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/../g"
+testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g."
+testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g"
+testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.."
+testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g"
+testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g"
+testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/"
+testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h"
+testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h"
+testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y"
+testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y"
+testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x"
+testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x"
+testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x"
+testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x"
+testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x"
+
+-- Null path tests
+-- See RFC2396bis, section 5.2,
+-- "If the base URI's path component is the empty string, then a single
+--  slash character is copied to the buffer"
+testRFC60 = testRelative "testRFC60" "http://ex"     "http://ex/x/y?q" "/x/y?q"
+testRFC61 = testRelJoin  "testRFC61" "http://ex"     "x/y?q"           "http://ex/x/y?q"
+testRFC62 = testRelative "testRFC62" "http://ex?p"   "http://ex/x/y?q" "/x/y?q"
+testRFC63 = testRelJoin  "testRFC63" "http://ex?p"   "x/y?q"           "http://ex/x/y?q"
+testRFC64 = testRelative "testRFC64" "http://ex#f"   "http://ex/x/y?q" "/x/y?q"
+testRFC65 = testRelJoin  "testRFC65" "http://ex#f"   "x/y?q"           "http://ex/x/y?q"
+testRFC66 = testRelative "testRFC66" "http://ex?p"   "http://ex/x/y#g" "/x/y#g"
+testRFC67 = testRelJoin  "testRFC67" "http://ex?p"   "x/y#g"           "http://ex/x/y#g"
+testRFC68 = testRelative "testRFC68" "http://ex"     "http://ex/"      "/"
+testRFC69 = testRelJoin  "testRFC69" "http://ex"     "./"              "http://ex/"
+testRFC70 = testRelative "testRFC70" "http://ex"     "http://ex/a/b"   "/a/b"
+testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex"       "./"
+
+testRFC2396Suite = TestLabel "Test RFC2396 examples" testRFC2396List
+testRFC2396List  = TestList
+  [
+    testRFC01, testRFC02, testRFC03, testRFC04,
+    testRFC05, testRFC06, testRFC07, testRFC08,
+    testRFC09,
+    testRFC10, testRFC11, testRFC12, testRFC13,
+    testRFC14, testRFC15, testRFC16, testRFC17,
+    testRFC18, testRFC19,
+    testRFC20, testRFC21, testRFC22, testRFC23,
+    testRFC24,
+    -- testRFC30,
+    testRFC31, testRFC32, testRFC33,
+    testRFC34, testRFC35, testRFC36, testRFC37,
+    testRFC38, testRFC39,
+    testRFC40, testRFC41, testRFC42, testRFC43,
+    testRFC44, testRFC45, testRFC46, testRFC47,
+    testRFC48, testRFC49,
+    testRFC50,
+    --
+    testRFC60, testRFC61, testRFC62, testRFC63,
+    testRFC64, testRFC65, testRFC66, testRFC67,
+    testRFC68, testRFC69,
+    testRFC70
+  ]
+
+-- And some other oddballs:
+mailbase = "mailto:local/option@domain.org?notaquery#frag"
+testMail01 = testRelJoin "testMail01"
+            mailbase "local@domain"
+            "mailto:local@domain"
+testMail02 = testRelJoin "testMail02"
+            mailbase "#newfrag"
+            "mailto:#newfrag"
+            -- "mailto:local/option@domain.org?notaquery#newfrag"
+testMail03 = testRelJoin "testMail03"
+            mailbase "l1/q1@domain"
+            "mailto:l1/q1@domain"
+
+testMail11 = testRelJoin "testMail11"
+             "mailto:local1@domain1?query1" "mailto:local2@domain2"
+             "mailto:local2@domain2"
+testMail12 = testRelJoin "testMail12"
+             "mailto:local1@domain1" "mailto:local2@domain2?query2"
+             "mailto:local2@domain2?query2"
+testMail13 = testRelJoin "testMail13"
+             "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"
+             "mailto:local2@domain2?query2"
+testMail14 = testRelJoin "testMail14"
+             "mailto:local@domain?query1" "mailto:local@domain?query2"
+             "mailto:local@domain?query2"
+testMail15 = testRelJoin "testMail15"
+             "mailto:?query1" "mailto:local@domain?query2"
+             "mailto:local@domain?query2"
+testMail16 = testRelJoin "testMail16"
+             "mailto:local@domain?query1" "?query2"
+             "mailto:?query2"
+testInfo17 = testRelJoin "testInfo17"
+             "info:name/1234/../567" "name/9876/../543"
+             "info:name/9876/../543"
+testInfo18 = testRelJoin "testInfo18"
+             "info:/name/1234/../567" "name/9876/../543"
+             "info:/name/name/543"
+
+testOddballSuite = TestLabel "Test oddball examples" testOddballList
+testOddballList  = TestList
+  [ testMail01, testMail02, testMail03
+  , testMail11, testMail12, testMail13, testMail14, testMail15, testMail16
+  , testInfo17
+  ]
+
+-- Full test suite
+allTests = TestList
+  [ testURIRefSuite,
+    testParseRefSuite,
+    testParseAbsSuite,
+    testParseURISuite,
+    testCompareSuite,
+    testSplitFragSuite,
+    testOverrideFragSuite,
+    testGetURIRefSuite,
+    testNormalizeURIList,
+    testRelativeSuite,
+    testRFC2396Suite,
+    testOddballSuite
+  ]
+
+main = runTestTT allTests
+
+runTestFile t = do
+    h <- openFile "a.tmp" WriteMode
+    runTestText (putTextToHandle h False) t
+    hClose h
+tf = runTestFile
+tt = runTestTT
+
+uref = testURIRefSuite
+pref = testParseRefSuite
+pabs = testParseAbsSuite
+puri = testParseURISuite
+comp = testCompareSuite
+frag = testSplitFragSuite
+over = testOverrideFragSuite
+guri = testGetURIRefSuite
+nuri = testNormalizeURIList
+tr01 = testRelative01
+tr02 = testRelative02
+tr03 = testRelative03
+tr04 = testRelative04
+rel  = testRelativeSuite
+rfc  = testRFC2396Suite
+oddb = testOddballSuite
+
+--------------------------------------------------------------------------------
+--
+--  Copyright (c) 2003, G. KLYNE.  All rights reserved.
+--
+--  This file is part of Swish.
+--
+--  Swish is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  Swish is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with Swish; if not, write to:
+--    The Free Software Foundation, Inc.,
+--    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+--
+--------------------------------------------------------------------------------
+-- $Source: /file/cvsdev/HaskellUtils/URITest.hs,v $
+-- $Author: graham $
+-- $Revision: 1.2 $
+-- $Log: URITest.hs,v $
+-- Revision 1.2  2004/01/22 19:52:27  graham
+-- Rename module URI to avoid awkward clash with Haskell libraries
+--
+-- Revision 1.1  2004/01/13 12:31:24  graham
+-- Move modules from HaskellRDF to HaskellUtils project
+--
+-- Revision 1.21  2004/01/06 13:53:10  graham
+-- Created consolidated test harness (SwishTestAll.hs)
+--
+-- Revision 1.20  2003/11/07 21:45:47  graham
+-- Started rework of datatype to use new DatatypeRel structure.
+--
+-- Revision 1.19  2003/09/24 18:50:52  graham
+-- Revised module format to be Haddock compatible.
+--
+-- Revision 1.18  2003/09/24 13:35:43  graham
+-- QName splitting moved from URI module to QName module
+--
+-- Revision 1.17  2003/06/24 19:55:50  graham
+-- Another test case added
+--
+-- Revision 1.16  2003/06/18 23:37:09  graham
+-- Another test case.
+--
+-- Revision 1.15  2003/06/17 15:42:36  graham
+-- Misc updates
+--
+-- Revision 1.14  2003/06/10 01:04:46  graham
+-- Proof framework in progress;  compiles, incomplete
+--
+-- Revision 1.13  2003/06/03 19:24:14  graham
+-- Updated all source modules to cite GNU Public Licence
+--
+-- Revision 1.12  2003/05/29 13:04:42  graham
+-- All tests now compile and pass as stand-alone programs compiled
+-- using GHC.  Added batch files to compile programs and run tests.
+--
+-- Revision 1.11  2003/04/17 00:35:39  graham
+-- Added module N3ParserTest
+-- N3parser is mostly working
+-- Formulae remain to test
+--
+-- Revision 1.10  2003/03/05 22:16:24  graham
+-- URI code passes all unit tests
+--
+-- Revision 1.9  2003/03/05 14:47:45  graham
+-- Relative URI code complete, not tested
+-- Fixed a URI parser bug
+--
+-- Revision 1.8  2003/02/28 14:02:52  graham
+-- A few new test cases
+--
+-- Revision 1.7  2003/02/27 23:33:54  graham
+-- QName splitting tested OK
+--
+-- Revision 1.6  2003/02/27 20:29:53  graham
+-- Fixed some more parser bugs.
+-- All parser tests pass.
+-- QName and relative path handling to do.
+--
+-- Revision 1.5  2003/02/27 18:48:05  graham
+-- Fix URI parser bug.
+-- Add more URI parser test cases.
+--
+-- Revision 1.4  2003/02/27 15:28:45  graham
+-- Updated internal structure of parsed URI.
+-- Passes parser unit tests
+--
+-- Revision 1.3  2003/02/27 09:50:25  graham
+-- Add URI parser test cases, some name changes
+--
+-- Revision 1.2  2003/02/27 00:30:14  graham
+-- Syntax code nearly complete, untested
+--
+-- Revision 1.1  2003/02/20 19:45:07  graham
+-- Add URI module and unit tests.
+-- Code incomplete.
+--

+ swish.cabal view
@@ -0,0 +1,360 @@+Name:                swish+Version:             0.2.1+License:             LGPL+License-file:        LICENSE +Author:              Graham Klyne - GK@ninebynine.org+Maintainer:          Vasili I Galchin (William Halchin) - vigalchin@gmail.com ++Category:            Semantic Web+Synopsis:            A semantic web toolkit. +Description:        Swish is a framework, written in the purely functional +                    programming language Haskell, for performing deductions in +                    RDF data using a variety of techniques. Swish is conceived +                    as a toolkit for experimenting with RDF inference, and for +                    implementing stand-alone RDF file processors (usable in +                    similar style to CWM, but with a view to being extensible +                    in declarative style through added Haskell function and data+                    value declarations). It explores Haskell as "a scripting +                    language for the Semantic Web".++                    Swish is a work-in-progress, and currently incorporates:++                    * Notation3 input and output.+                    * RDF graph isomorphism testing and merging.+                    * Display of differences between RDF graphs.+                    * Inference operations in forward chaining, backward chaining and proof-checking modes.+                    * Simple Horn-style rule implementations, extendable through variable binding modifiers and filters.+                    * Class restriction rule implementation, primarily for datatype inferences.+                    * RDF formal semantics entailment rule implementation.+                    * Complete, ready-to-run, command-line and script-driven programs.++                    References++                    1) http://www.ninebynine.org/RDFNotes/Swish/Intro.html++                    2) http://www.ninebynine.org/Software/swish-0.2.1.html++Tested-With:         GHC>=6.8.2+Build-Type:          Simple+Data-Files:          README++Cabal-Version:       >= 1.2++Library+   Build-Depends:       base>3 && <4, binary, bytestring, containers, array, parallel, parsec, random, old-time, mtl, HUnit+   Exposed-modules:     Swish.HaskellRDF.BuiltInDatatypes,+                        Swish.HaskellRDF.BuiltInMap,+                        Swish.HaskellRDF.BuiltInRules,+                        Swish.HaskellRDF.ClassRestrictionRule,+                        Swish.HaskellRDF.Dfa.Dfa+                        Swish.HaskellRDF.Datatype,+                        Swish.HaskellRDF.GraphClass+                        Swish.HaskellRDF.GraphMatch,+                        Swish.HaskellRDF.GraphMem,+                        Swish.HaskellRDF.GraphPartition,+                        Swish.HaskellRDF.MapXsdInteger,+                        Swish.HaskellRDF.N3Formatter,+                        Swish.HaskellRDF.N3Parser,+                        Swish.HaskellRDF.ParsecLanguage,+ -- YOH ADRIAN GHC EXTENSION??                       Swish.HaskellRDF.OwlAbstractSyntax,+                        Swish.HaskellRDF.Proof,+                        Swish.HaskellRDF.RDFDatatype,+                        Swish.HaskellRDF.RDFDatatypeXsdInteger,+                        Swish.HaskellRDF.RDFDatatypeXsdString,+                        Swish.HaskellRDF.RDFGraph,+                        Swish.HaskellRDF.RDFGraphShowM,+                        Swish.HaskellRDF.RDFProofContext,+                        Swish.HaskellRDF.RDFProof,+                        Swish.HaskellRDF.RDFQuery,+                        Swish.HaskellRDF.RDFRuleset,+                        Swish.HaskellRDF.Ruleset+                        Swish.HaskellRDF.SwishCommands+                        Swish.HaskellRDF.SwishMain+                        Swish.HaskellRDF.SwishMonad+                        Swish.HaskellRDF.SwishScript+                        Swish.HaskellRDF.VarBinding+                        Swish.HaskellRDF.Vocabulary+                        Swish.HaskellRDF.Sort.AdaptiveHeapSort+-- WNH                         Swish.HaskellRDF.Sort.Benchmark+                        Swish.HaskellRDF.Sort.BraunHeap+                        Swish.HaskellRDF.Sort.CartesianTree+                        Swish.HaskellRDF.Sort.DigitalSort+                        Swish.HaskellRDF.Sort.FingerSearchtree+                        Swish.HaskellRDF.Sort.Force+                        Swish.HaskellRDF.Sort.HeapSort+-- WNH                        Swish.HaskellRDF.Sort.Killer+                        Swish.HaskellRDF.Sort.LibBase+                        Swish.HaskellRDF.Sort.ListLib+-- WNH                        Swish.HaskellRDF.Sort.Main   +                        Swish.HaskellRDF.Sort.MargeSort+                        Swish.HaskellRDF.Sort.MergeSort+                        Swish.HaskellRDF.Sort.PairingHeap+-- WNH                       Swish.HaskellRDF.Sort.QuickSortInPlace+                        Swish.HaskellRDF.Sort.QuickSort+-- WNH                        Swish.HaskellRDF.Sort.RandomLib+--                        Swish.HaskellRDF.Sort.RandomMonad+                        Swish.HaskellRDF.Sort.RedBlackTree+                        Swish.HaskellRDF.Sort.SplaySort+                        Swish.HaskellRDF.Sort.Squiggol+                        Swish.HaskellRDF.Sort.Stable+-- WNH same prob QuickSortInPlace                        Swish.HaskellRDF.Sort.SuffixArrays+-- WNH                         Swish.HaskellRDF.Sort.TestData+                        Swish.HaskellUtils.AccumulateM+                        Swish.HaskellUtils.DateTime+                        Swish.HaskellUtils.ErrorM+                        Swish.HaskellUtils.FunctorM+                        Swish.HaskellUtils.ListHelpers+                        Swish.HaskellUtils.LookupMap+                        Swish.HaskellUtils.MiscHelpers+                        Swish.HaskellUtils.Namespace+                        Swish.HaskellUtils.Parse+                        Swish.HaskellUtils.ParseURI+                        Swish.HaskellUtils.PartOrderedCollection+                        Swish.HaskellUtils.ProcessURI+                        Swish.HaskellUtils.QName+--   COMEBCK!!!!                     Swish.HaskellUtils.RegexParser+                        Swish.HaskellUtils.ShowM+                        Swish.HaskellUtils.TestHelpers+                        Swish.HaskellUtils.TraceHelpers+                         Swish.HaskellUtils.Network.URI++   extensions:          CPP, ParallelListComp+   ghc-options:         -Wall -fexcess-precision -funbox-strict-fields -auto-all++++Executable         BuiltInMapTest+   Main-Is:        Swish/HaskellRDF/BuiltInMapTest.hs+   Other-Modules:  Swish.HaskellRDF.BuiltInMap+                   Swish.HaskellRDF.RDFDatatypeXsdInteger+                   Swish.HaskellRDF.Ruleset+                   Swish.HaskellUtils.Namespace+                   Swish.HaskellRDF.Vocabulary+                   Swish.HaskellUtils.LookupMap+                   Swish.HaskellUtils.ListHelpers+++--   YOH ADRIAN QNAME ISSUES Executable         ClassRestrictionRuleTest+--   YOH ADRIAN QNAME ISSUES    Main-Is:        Swish/HaskellRDF/ClassRestrictionRuleTest.hs+--   YOH ADRIAN QNAME ISSUES    Other_Modules:  Swish.HaskellRDF.ClassRestrictionRule+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.RDFGraph+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.RDFRuleset+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Ruleset+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Rule+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.RDFDatatype+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Datatype+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellUtils.Namespace+--   YOH ADRIAN QNAME ISSUES                    Swish.HaskellRDF.Dfa++++Executable         GraphPartitionTest+   Main-Is:        Swish/HaskellRDF/GraphPartitionTest.hs+   Other-Modules:  Swish.HaskellRDF.GraphPartition+                   Swish.HaskellRDF.GraphClass+                   Swish.HaskellUtils.TestHelpers+                   Swish.HaskellUtils.ListHelpers++++Executable         GraphTest+   Main-Is:        Swish/HaskellRDF/GraphTest.hs+   Other-Modules:  Swish.HaskellUtils.ListHelpers+                   Swish.HaskellUtils.MiscHelpers+                   Swish.HaskellUtils.LookupMap+                   Swish.HaskellRDF.GraphClass+                   Swish.HaskellRDF.GraphMem+                   Swish.HaskellRDF.GraphMatch++++Executable         N3ParserTest+   Main-Is:        Swish/HaskellRDF/N3ParserTest.hs+   Other-Modules:  Swish.HaskellRDF.N3Parser+                   Swish.HaskellRDF.RDFGraph+                   Swish.HaskellUtils.QName+                   Swish.HaskellRDF.Vocabulary+                   Swish.HaskellUtils.LookupMap+                   Swish.HaskellRDF.GraphClass++++Executable         N3FormatterTest+   Main-Is:        Swish/HaskellRDF/N3FormatterTest.hs+   Other-Modules:  Swish.HaskellRDF.N3Formatter+                   Swish.HaskellRDF.N3Parser+                   Swish.HaskellRDF.RDFGraph+                   Swish.HaskellUtils.Namespace+                   Swish.HaskellRDF.Vocabulary+                   Swish.HaskellUtils.QName+                   Swish.HaskellUtils.LookupMap+                   Swish.HaskellRDF.GraphClass+                   Swish.HaskellUtils.ErrorM++++Executable         RDFDatatypeXsdIntegerTest+   Main-Is:        Swish/HaskellRDF/RDFDatatypeXsdIntegerTest.hs+   Other-Modules:  Swish.HaskellRDF.RDFDatatypeXsdInteger+                   Swish.HaskellRDF.RDFRuleset+                   Swish.HaskellRDF.RDFVarBinding+                   Swish.HaskellRDF.RDFDatatype+                   Swish.HaskellRDF.RDFGraph+                   Swish.HaskellRDF.ClassRestrictionRule+                   Swish.HaskellRDF.MapXsdInteger+                   Swish.HaskellRDF.Datatype+                   Swish.HaskellRDF.Ruleset+                   Swish.HaskellRDF.Rule+                   Swish.HaskellUtils.Namespace+                   Swish.HaskellRDF.Vocabulary +                   Swish.HaskellRDF.VarBinding++++Executable         RDFGraphTest+   Main-Is:        Swish/HaskellRDF/RDFGraphTest.hs+   Other-Modules:  Swish.HaskellUtils.FunctorM+                   Swish.HaskellUtils.LookupMap+                   Swish.HaskellUtils.ListHelpers+                   Swish.HaskellRDF.GraphClass+                   Swish.HaskellUtils.Namespace+                   Swish.HaskellUtils.QName+                   Swish.HaskellRDF.RDFGraph  +                   Swish.HaskellRDF.Vocabulary  ++++Executable         RDFProofContextTest+   Main-Is:        Swish/HaskellRDF/RDFProofContextTest.hs+   Other-Modules:  Swish.HaskellRDF.BuiltInMap+                   Swish.HaskellRDF.RDFProofContext+                   Swish.HaskellRDF.RDFProof+                   Swish.HaskellRDF.RDFRuleset+                   Swish.HaskellRDF.RDFGraph+                   Swish.HaskellRDF.RDFGraphShowM+                   Swish.HaskellRDF.Proof+                   Swish.HaskellRDF.Ruleset+                   Swish.HaskellRDF.Rule+                   Swish.HaskellUtils.Namespace+                   Swish.HaskellUtils.LookupMap+                   Swish.HaskellRDF.Vocabulary+                    +++Executable         RDFProofText+   Main-Is:        Swish/HaskellRDF/RDFProofTest.hs+   Other-Modules:  Swish.HaskellRDF.RDFProof+                   Swish.HaskellRDF.RDFQuery+                   Swish.HaskellRDF.RDFVarBinding+                   Swish.HaskellRDF.RDFRuleset+                   Swish.HaskellRDF.RDFGraph+                   Swish.HaskellRDF.VarBinding+                   Swish.HaskellRDF.Rule+                   Swish.HaskellUtils.Namespace+                     +++Executable         RDFQueryTest+   Main-Is:        Swish/HaskellRDF/RDFQueryTest.hs+   Other-Modules:  Swish.HaskellRDF.RDFQuery+                   Swish.HaskellRDF.RDFVarBinding+                   Swish.HaskellRDF.RDFGraph +                   Swish.HaskellUtils.Namespace+                   Swish.HaskellRDF.Vocabulary+                   Swish.HaskellRDF.N3Parser+                   Swish.HaskellUtils.QName+                   Swish.HaskellUtils.ListHelpers+                   Swish.HaskellUtils.ErrorM++++Executable         RDFRulesetTest+   Main-Is:        Swish/HaskellRDF/RDFRulesetTest.hs+   Other-Modules:  Swish.HaskellRDF.RDFRuleset+                   Swish.HaskellRDF.RDFQuery+                   Swish.HaskellRDF.RDFVarBinding+                   Swish.HaskellRDF.RDFGraph+                   Swish.HaskellRDF.Ruleset+                   Swish.HaskellRDF.Rule+                   Swish.HaskellUtils.Namespace+                   Swish.HaskellRDF.Vocabulary+                   Swish.HaskellUtils.QName++++Executable         VarBindingTest+   Main-Is:        Swish/HaskellRDF/VarBindingTest.hs+   Other-Modules:  Swish.HaskellRDF.VarBinding+                   Swish.HaskellRDF.Vocabulary+                   Swish.HaskellUtils.ListHelpers++++Executable         LookupMapTest+   Main-Is:        Swish/HaskellUtils/LookupMapTest.hs+   Other-Modules:  Swish.HaskellUtils.LookupMap+                   Swish.HaskellUtils.ListHelpers++++Executable         ParseTest+   Main-Is:        Swish/HaskellUtils/ParseTest.hs+   Other-Modules:  Swish.HaskellUtils.Parse++++Executable         ParseURITest+   Main-Is:        Swish/HaskellUtils/ParseURITest.hs+   Other-Modules:  Swish.HaskellUtils.ParseURITest+                   Swish.HaskellUtils.Parse++++Executable         QNameTest+   Main-Is:        Swish/HaskellUtils/QNameTest.hs+   Other-Modules:  Swish.HaskellUtils.QName++++Executable         URITest +   Main-Is:        Swish/HaskellUtils/URITest.hs+   Other-Modules:  Swish.HaskellUtils.Parse+                   Swish.HaskellUtils.ProcessURI++++Executable         SwishTest+   Main-Is:        Swish/HaskellRDF/SwishTest.hs+   Other-Modules:  Swish.HaskellRDF.SwishMain++++ Executable         SwishTestAll+    Main-Is:        Swish/HaskellRDF/SwishTestAll.hs+    Other-Modules:  Swish.HaskellUtils.DateTimeTest+                    Swish.HaskellUtils.ParseTest+                    Swish.HaskellUtils.LookupMapTest+                    Swish.HaskellUtils.NamespaceTest+                    Swish.HaskellUtils.URITest+                    Swish.HaskellUtils.ParseURITest+                    Swish.HaskellRDF.GraphTest+                    Swish.HaskellRDF.VarBindingTest+                    Swish.HaskellRDF.RDFGraphTest+                    Swish.HaskellRDF.RDFQueryTest+                    Swish.HaskellRDF.RDFProofTest+                    Swish.HaskellRDF.RDFRulesetTest+                    Swish.HaskellRDF.RDFProofContextTest+                    Swish.HaskellRDF.RDFDatatypeXsdIntegerTest+                    Swish.HaskellRDF.ClassRestrictionRuleTest+                    Swish.HaskellRDF.N3FormatterTest+                    Swish.HaskellRDF.N3ParserTest+                    Swish.HaskellRDF.BuiltInMapTest+                    Swish.HaskellRDF.SwishTest++++Executable         Swish+   Main-Is:        Swish/HaskellRDF/Swish.hs+   Other-Modules:  Swish.HaskellRDF.SwishMain++