packages feed

plugins (empty) → 1.0

raw patch · 477 files changed

+25292/−0 lines, 477 filesdep +Cabaldep +basedep +haskell-srcbuild-type:Customsetup-changedbinary-added

Dependencies added: Cabal, base, haskell-src

Files

+ AUTHORS view
@@ -0,0 +1,5 @@++Don Stewart 	<http://www.cse.unsw.edu.au/~dons>+Sean Seefried	<http://www.cse.unsw.edu.au/~sseefried>+Andre Pang      <http://www.algorithm.com.au>+
+ LICENSE view
@@ -0,0 +1,504 @@+		  GNU LESSER GENERAL PUBLIC LICENSE+		       Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+     59 Temple Place, Suite 330, Boston, MA  02111-1307  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  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!++
+ Makefile view
@@ -0,0 +1,44 @@+# Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+# LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)++#+# regress check. TODO check expected output+# +check:+	@( d=/tmp/plugins.tmp.$$$$ ; mkdir $$d ; export TMPDIR=$$d ;\+	   for i in `find testsuite ! -name CVS -type d -maxdepth 2 -mindepth 2 | sort` ; do \+		printf "=== testing %-50s ... " "$$i" ;	\+		( cd $$i ; if [ -f dont_test ] ; then \+		 	echo "ignored."	;\+		  else ${MAKE} -sk && ${MAKE} -ksi check |\+			sed '/^Compil/d;/^Load/d;/Read/d;/Expan/d;/Savi/d;/Writ/d' ;\+		       ${MAKE} -sk clean ;\+		  fi ) 2> /dev/null ;\+	   done ; rm -rf $$d )+	+#+# making clean+#++CLEAN_FILES += *.conf.*.old *~++EXTRA_CLEANS+=*.conf.inplace* *.conf.in *.h autom4te.cache \+	      config.h config.mk config.log config.status++clean:+	cd docs && $(MAKE) clean+	runhaskell Setup.lhs clean 2> /dev/null || true+	rm -rf $(CLEAN_FILES)+	find testsuite -name '*.a' -exec rm {} \;+	find testsuite -name '*~' -exec rm {} \;+	find testsuite -name 'a.out' -exec rm {} \;+	find testsuite -name '*.hi' -exec rm {} \;+	find testsuite -name '*.o' -exec rm {} \;+	find testsuite -name '*.core' -exec rm {} \;+	find testsuite -name 'package.conf' -exec rm {} \;+	rm -f testsuite/makewith/io/TestIO.conf+	rm -f testsuite/makewith/unsafeio/Unsafe.conf+	rm -rf testsuite/plugs/plugs/plugs+	rm -rf testsuite/plugs/plugs/runplugs+	rm -rf $(EXTRA_CLEANS)+
+ README view
@@ -0,0 +1,111 @@++------------------------------------------------------------------------+                            hs-plugins+------------------------------------------------------------------------++Compiler and tool support for compiling and loading, and evaluating+Haskell at runtime. ++The library provides a convenient interface to GHC's runtime loader+and linker, letting you load compiled Haskell code. ++It also provides a `make' system for compiling plugin source+automagically and for combining the user's .hs file with a stub of+standard declarations and syntax, saving the user from having to write+standard code themselves.++It provides an `eval' function, for generating new, well-typed, compiled+code from a Haskell source string.++It also provides a new variation of printf for Haskell-- a runtime+generated, dynamically-typed printf.++Read the documentation in doc/ for more.++------------------------------------------------------------------------++BUILDING:+        $ chmod +x Setup.lhs configure+        $ ./Setup.lhs configure --prefix=/usr/local+        $ ./Setup.lhs build+        $ ./Setup.lhs install++------------------------------------------------------------------------++DEPENDENCIES:++* Requires GHC >= 6.4+* Requires Cabal++------------------------------------------------------------------------++* Optional:+   If you are doing a lot of `merge'-related operations, and require+   an extended haskell parser, you can compile hs-plugins to use +   HSX, Niklas Broberg's Haskell parser library, available at:++    darcs get http://www.cs.chalmers.se/~d00nibro/haskell-src-exts++   To get hs-plugins to use HSX, use: ++        $ mv plugins.cabal.hsx plugins.cabal+        $ ./Setup.lhs configure --enable-hsx++   Make sure to install HSX first though :)++------------------------------------------------------------------------++* On cygwin/windows you (a) make sure the cygwin "find" is before the+  windows "find" on your PATH, and (b) to give the windows-style path+  (e.g., "c:/cygwin/usr/local") in the ./configure --prefix=foo/bar+  step++* 'plugs' requires a working readline library.++* If you wish to use TH in plugins, or to run load()-programs in GHCi,+  you require a patch to GHC's linker, that was committed into ghc+  6.3, and ghc 6.2 -stable branch, and is available from 6.2.2 onwards.++* If you need to regenerate ./configure you need >= autoreconf-2.53++* The documentation relies on haddock, latex, dvips, tex2page:++        $ cd doc && make++------------------------------------------------------------------------++EXAMPLES:++Have a look in the testsuite/ directory for many examples of how to+arrange your code.++LICENSE:++This library is distributed under the terms of the LGPL. The runtime+loader code is based on code written by André Pang, and others, and is+distributed under the BSD-style Glasgow University license.++PORTABILITY:++Requires GHC 6.4 or greater, though most testing has be done on 6.4.+The dynamic loader requires a functional GHCi implementation.++---------------------+--------------------------------------------------+  Platform           |  Works   Should work*    Unknown    Won't work+---------------------+--------------------------------------------------+i386-*-linux         |    X+i386-*-freebsd       |    X+i386-*-openbsd       |    X           +powerpc-apple-darwin |    X            +powerpc-*-linux      |    X            +sparc-*-solaris2     |    X            +ia64-*-linux         |    #+i386-*-solaris2      |                X+sparc-*-linux        |                X+sparc-*-openbsd      |                X+i386-*-netbsd        |                              X +amd64-*-openbsd      |                              X+mips64-sgi-irix      |                                         X+---------------------+--------------------------------------------------++# .hi file parsing is currently broken
+ Setup.lhs view
@@ -0,0 +1,5 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMainWithHooks defaultUserHooks
+ TODO view
@@ -0,0 +1,18 @@+For 1.0+----------+++ hs-plugins doesn't know to look for packages in the user packages,+only in the global packages+++ version numbers in package loads are annyoing+++ .hi file parser is broken on Itanium, again.+++ build way=p and way=''++Cabal+--------++What we'd like is a cabalMake version of make, so rather than just+compiling simple plugins, we let cabalMake rebuild whole Haskell apps --+like Yi!
+ config.guess view
@@ -0,0 +1,1354 @@+#! /bin/sh+# Attempt to guess a canonical system name.+#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,+#   2000, 2001, 2002 Free Software Foundation, Inc.++timestamp='2002-07-23'++# This file 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.+#+# This program 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 program; if not, write to the Free Software+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+#+# As a special exception to the GNU General Public License, if you+# distribute this file as part of a program that contains a+# configuration script generated by Autoconf, you may include it under+# the same distribution terms that you use for the rest of that program.++# Originally written by Per Bothner <per@bothner.com>.+# Please send patches to <config-patches@gnu.org>.  Submit a context+# diff and a properly formatted ChangeLog entry.+#+# This script attempts to guess a canonical system name similar to+# config.sub.  If it succeeds, it prints the system name on stdout, and+# exits with 0.  Otherwise, it exits with 1.+#+# The plan is that this can be called by configure scripts if you+# don't specify an explicit build system type.++me=`echo "$0" | sed -e 's,.*/,,'`++usage="\+Usage: $0 [OPTION]++Output the configuration name of the system \`$me' is run on.++Operation modes:+  -h, --help         print this help, then exit+  -t, --time-stamp   print date of last modification, then exit+  -v, --version      print version number, then exit++Report bugs and patches to <config-patches@gnu.org>."++version="\+GNU config.guess ($timestamp)++Originally written by Per Bothner.+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001+Free Software Foundation, Inc.++This is free software; see the source for copying conditions.  There is NO+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."++help="+Try \`$me --help' for more information."++# Parse command line+while test $# -gt 0 ; do+  case $1 in+    --time-stamp | --time* | -t )+       echo "$timestamp" ; exit 0 ;;+    --version | -v )+       echo "$version" ; exit 0 ;;+    --help | --h* | -h )+       echo "$usage"; exit 0 ;;+    -- )     # Stop option processing+       shift; break ;;+    - )	# Use stdin as input.+       break ;;+    -* )+       echo "$me: invalid option $1$help" >&2+       exit 1 ;;+    * )+       break ;;+  esac+done++if test $# != 0; then+  echo "$me: too many arguments$help" >&2+  exit 1+fi++trap 'exit 1' 1 2 15++# CC_FOR_BUILD -- compiler used by this script. Note that the use of a+# compiler to aid in system detection is discouraged as it requires+# temporary files to be created and, as you can see below, it is a+# headache to deal with in a portable fashion.++# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still+# use `HOST_CC' if defined, but it is deprecated.++# This shell variable is my proudest work .. or something. --bje++set_cc_for_build='tmpdir=${TMPDIR-/tmp}/config-guess-$$ ;+(old=`umask` && umask 077 && mkdir $tmpdir && umask $old && unset old)+   || (echo "$me: cannot create $tmpdir" >&2 && exit 1) ;+dummy=$tmpdir/dummy ;+files="$dummy.c $dummy.o $dummy.rel $dummy" ;+trap '"'"'rm -f $files; rmdir $tmpdir; exit 1'"'"' 1 2 15 ;+case $CC_FOR_BUILD,$HOST_CC,$CC in+ ,,)    echo "int x;" > $dummy.c ;+	for c in cc gcc c89 c99 ; do+	  if ($c $dummy.c -c -o $dummy.o) >/dev/null 2>&1 ; then+	     CC_FOR_BUILD="$c"; break ;+	  fi ;+	done ;+	rm -f $files ;+	if test x"$CC_FOR_BUILD" = x ; then+	  CC_FOR_BUILD=no_compiler_found ;+	fi+	;;+ ,,*)   CC_FOR_BUILD=$CC ;;+ ,*,*)  CC_FOR_BUILD=$HOST_CC ;;+esac ;+unset files'++# This is needed to find uname on a Pyramid OSx when run in the BSD universe.+# (ghazi@noc.rutgers.edu 1994-08-24)+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then+	PATH=$PATH:/.attbin ; export PATH+fi++UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown+UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown++# Note: order is significant - the case branches are not exclusive.++case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in+    *:NetBSD:*:*)+	# NetBSD (nbsd) targets should (where applicable) match one or+	# more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,+	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently+	# switched to ELF, *-*-netbsd* would select the old+	# object file format.  This provides both forward+	# compatibility and a consistent mechanism for selecting the+	# object file format.+	#+	# Note: NetBSD doesn't particularly care about the vendor+	# portion of the name.  We always set it to "unknown".+	sysctl="sysctl -n hw.machine_arch"+	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \+	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`+	case "${UNAME_MACHINE_ARCH}" in+	    armeb) machine=armeb-unknown ;;+	    arm*) machine=arm-unknown ;;+	    sh3el) machine=shl-unknown ;;+	    sh3eb) machine=sh-unknown ;;+	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;+	esac+	# The Operating System including object format, if it has switched+	# to ELF recently, or will in the future.+	case "${UNAME_MACHINE_ARCH}" in+	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)+		eval $set_cc_for_build+		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \+			| grep __ELF__ >/dev/null+		then+		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).+		    # Return netbsd for either.  FIX?+		    os=netbsd+		else+		    os=netbsdelf+		fi+		;;+	    *)+	        os=netbsd+		;;+	esac+	# The OS release+	release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`+	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:+	# contains redundant information, the shorter form:+	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.+	echo "${machine}-${os}${release}"+	exit 0 ;;+    amiga:OpenBSD:*:*)+	echo m68k-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    arc:OpenBSD:*:*)+	echo mipsel-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    hp300:OpenBSD:*:*)+	echo m68k-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    mac68k:OpenBSD:*:*)+	echo m68k-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    macppc:OpenBSD:*:*)+	echo powerpc-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    mvme68k:OpenBSD:*:*)+	echo m68k-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    mvme88k:OpenBSD:*:*)+	echo m88k-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    mvmeppc:OpenBSD:*:*)+	echo powerpc-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    pmax:OpenBSD:*:*)+	echo mipsel-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    sgi:OpenBSD:*:*)+	echo mipseb-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    sun3:OpenBSD:*:*)+	echo m68k-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    wgrisc:OpenBSD:*:*)+	echo mipsel-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    *:OpenBSD:*:*)+	echo ${UNAME_MACHINE}-unknown-openbsd${UNAME_RELEASE}+	exit 0 ;;+    alpha:OSF1:*:*)+	if test $UNAME_RELEASE = "V4.0"; then+		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`+	fi+	# A Vn.n version is a released version.+	# A Tn.n version is a released field test version.+	# A Xn.n version is an unreleased experimental baselevel.+	# 1.2 uses "1.2" for uname -r.+	eval $set_cc_for_build+	cat <<EOF >$dummy.s+	.data+\$Lformat:+	.byte 37,100,45,37,120,10,0	# "%d-%x\n"++	.text+	.globl main+	.align 4+	.ent main+main:+	.frame \$30,16,\$26,0+	ldgp \$29,0(\$27)+	.prologue 1+	.long 0x47e03d80 # implver \$0+	lda \$2,-1+	.long 0x47e20c21 # amask \$2,\$1+	lda \$16,\$Lformat+	mov \$0,\$17+	not \$1,\$18+	jsr \$26,printf+	ldgp \$29,0(\$26)+	mov 0,\$16+	jsr \$26,exit+	.end main+EOF+	$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null+	if test "$?" = 0 ; then+		case `$dummy` in+			0-0)+				UNAME_MACHINE="alpha"+				;;+			1-0)+				UNAME_MACHINE="alphaev5"+				;;+			1-1)+				UNAME_MACHINE="alphaev56"+				;;+			1-101)+				UNAME_MACHINE="alphapca56"+				;;+			2-303)+				UNAME_MACHINE="alphaev6"+				;;+			2-307)+				UNAME_MACHINE="alphaev67"+				;;+			2-1307)+				UNAME_MACHINE="alphaev68"+				;;+			3-1307)+				UNAME_MACHINE="alphaev7"+				;;+		esac+	fi+	rm -f $dummy.s $dummy && rmdir $tmpdir+	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`+	exit 0 ;;+    Alpha\ *:Windows_NT*:*)+	# How do we know it's Interix rather than the generic POSIX subsystem?+	# Should we change UNAME_MACHINE based on the output of uname instead+	# of the specific Alpha model?+	echo alpha-pc-interix+	exit 0 ;;+    21064:Windows_NT:50:3)+	echo alpha-dec-winnt3.5+	exit 0 ;;+    Amiga*:UNIX_System_V:4.0:*)+	echo m68k-unknown-sysv4+	exit 0;;+    *:[Aa]miga[Oo][Ss]:*:*)+	echo ${UNAME_MACHINE}-unknown-amigaos+	exit 0 ;;+    *:[Mm]orph[Oo][Ss]:*:*)+	echo ${UNAME_MACHINE}-unknown-morphos+	exit 0 ;;+    *:OS/390:*:*)+	echo i370-ibm-openedition+	exit 0 ;;+    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)+	echo arm-acorn-riscix${UNAME_RELEASE}+	exit 0;;+    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)+	echo hppa1.1-hitachi-hiuxmpp+	exit 0;;+    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)+	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.+	if test "`(/bin/universe) 2>/dev/null`" = att ; then+		echo pyramid-pyramid-sysv3+	else+		echo pyramid-pyramid-bsd+	fi+	exit 0 ;;+    NILE*:*:*:dcosx)+	echo pyramid-pyramid-svr4+	exit 0 ;;+    DRS?6000:UNIX_SV:4.2*:7*)+	case `/usr/bin/uname -p` in+	    sparc) echo sparc-icl-nx7 && exit 0 ;;+	esac ;;+    sun4H:SunOS:5.*:*)+	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	exit 0 ;;+    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)+	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	exit 0 ;;+    i86pc:SunOS:5.*:*)+	echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	exit 0 ;;+    sun4*:SunOS:6*:*)+	# According to config.sub, this is the proper way to canonicalize+	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but+	# it's likely to be more like Solaris than SunOS4.+	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	exit 0 ;;+    sun4*:SunOS:*:*)+	case "`/usr/bin/arch -k`" in+	    Series*|S4*)+		UNAME_RELEASE=`uname -v`+		;;+	esac+	# Japanese Language versions have a version number like `4.1.3-JL'.+	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`+	exit 0 ;;+    sun3*:SunOS:*:*)+	echo m68k-sun-sunos${UNAME_RELEASE}+	exit 0 ;;+    sun*:*:4.2BSD:*)+	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`+	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3+	case "`/bin/arch`" in+	    sun3)+		echo m68k-sun-sunos${UNAME_RELEASE}+		;;+	    sun4)+		echo sparc-sun-sunos${UNAME_RELEASE}+		;;+	esac+	exit 0 ;;+    aushp:SunOS:*:*)+	echo sparc-auspex-sunos${UNAME_RELEASE}+	exit 0 ;;+    # The situation for MiNT is a little confusing.  The machine name+    # can be virtually everything (everything which is not+    # "atarist" or "atariste" at least should have a processor+    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"+    # to the lowercase version "mint" (or "freemint").  Finally+    # the system name "TOS" denotes a system which is actually not+    # MiNT.  But MiNT is downward compatible to TOS, so this should+    # be no problem.+    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)+        echo m68k-atari-mint${UNAME_RELEASE}+	exit 0 ;;+    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)+	echo m68k-atari-mint${UNAME_RELEASE}+        exit 0 ;;+    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)+        echo m68k-atari-mint${UNAME_RELEASE}+	exit 0 ;;+    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)+        echo m68k-milan-mint${UNAME_RELEASE}+        exit 0 ;;+    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)+        echo m68k-hades-mint${UNAME_RELEASE}+        exit 0 ;;+    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)+        echo m68k-unknown-mint${UNAME_RELEASE}+        exit 0 ;;+    powerpc:machten:*:*)+	echo powerpc-apple-machten${UNAME_RELEASE}+	exit 0 ;;+    RISC*:Mach:*:*)+	echo mips-dec-mach_bsd4.3+	exit 0 ;;+    RISC*:ULTRIX:*:*)+	echo mips-dec-ultrix${UNAME_RELEASE}+	exit 0 ;;+    VAX*:ULTRIX*:*:*)+	echo vax-dec-ultrix${UNAME_RELEASE}+	exit 0 ;;+    2020:CLIX:*:* | 2430:CLIX:*:*)+	echo clipper-intergraph-clix${UNAME_RELEASE}+	exit 0 ;;+    mips:*:*:UMIPS | mips:*:*:RISCos)+	eval $set_cc_for_build+	sed 's/^	//' << EOF >$dummy.c+#ifdef __cplusplus+#include <stdio.h>  /* for printf() prototype */+	int main (int argc, char *argv[]) {+#else+	int main (argc, argv) int argc; char *argv[]; {+#endif+	#if defined (host_mips) && defined (MIPSEB)+	#if defined (SYSTYPE_SYSV)+	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);+	#endif+	#if defined (SYSTYPE_SVR4)+	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);+	#endif+	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)+	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);+	#endif+	#endif+	  exit (-1);+	}+EOF+	$CC_FOR_BUILD $dummy.c -o $dummy \+	  && $dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \+	  && rm -f $dummy.c $dummy && rmdir $tmpdir && exit 0+	rm -f $dummy.c $dummy && rmdir $tmpdir+	echo mips-mips-riscos${UNAME_RELEASE}+	exit 0 ;;+    Motorola:PowerMAX_OS:*:*)+	echo powerpc-motorola-powermax+	exit 0 ;;+    Night_Hawk:*:*:PowerMAX_OS)+	echo powerpc-harris-powermax+	exit 0 ;;+    Night_Hawk:Power_UNIX:*:*)+	echo powerpc-harris-powerunix+	exit 0 ;;+    m88k:CX/UX:7*:*)+	echo m88k-harris-cxux7+	exit 0 ;;+    m88k:*:4*:R4*)+	echo m88k-motorola-sysv4+	exit 0 ;;+    m88k:*:3*:R3*)+	echo m88k-motorola-sysv3+	exit 0 ;;+    AViiON:dgux:*:*)+        # DG/UX returns AViiON for all architectures+        UNAME_PROCESSOR=`/usr/bin/uname -p`+	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]+	then+	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \+	       [ ${TARGET_BINARY_INTERFACE}x = x ]+	    then+		echo m88k-dg-dgux${UNAME_RELEASE}+	    else+		echo m88k-dg-dguxbcs${UNAME_RELEASE}+	    fi+	else+	    echo i586-dg-dgux${UNAME_RELEASE}+	fi+ 	exit 0 ;;+    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)+	echo m88k-dolphin-sysv3+	exit 0 ;;+    M88*:*:R3*:*)+	# Delta 88k system running SVR3+	echo m88k-motorola-sysv3+	exit 0 ;;+    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)+	echo m88k-tektronix-sysv3+	exit 0 ;;+    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)+	echo m68k-tektronix-bsd+	exit 0 ;;+    *:IRIX*:*:*)+	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`+	exit 0 ;;+    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.+	echo romp-ibm-aix      # uname -m gives an 8 hex-code CPU id+	exit 0 ;;              # Note that: echo "'`uname -s`'" gives 'AIX '+    i*86:AIX:*:*)+	echo i386-ibm-aix+	exit 0 ;;+    ia64:AIX:*:*)+	if [ -x /usr/bin/oslevel ] ; then+		IBM_REV=`/usr/bin/oslevel`+	else+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}+	fi+	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}+	exit 0 ;;+    *:AIX:2:3)+	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then+		eval $set_cc_for_build+		sed 's/^		//' << EOF >$dummy.c+		#include <sys/systemcfg.h>++		main()+			{+			if (!__power_pc())+				exit(1);+			puts("powerpc-ibm-aix3.2.5");+			exit(0);+			}+EOF+		$CC_FOR_BUILD $dummy.c -o $dummy && $dummy && rm -f $dummy.c $dummy && rmdir $tmpdir && exit 0+		rm -f $dummy.c $dummy && rmdir $tmpdir+		echo rs6000-ibm-aix3.2.5+	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then+		echo rs6000-ibm-aix3.2.4+	else+		echo rs6000-ibm-aix3.2+	fi+	exit 0 ;;+    *:AIX:*:[45])+	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`+	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then+		IBM_ARCH=rs6000+	else+		IBM_ARCH=powerpc+	fi+	if [ -x /usr/bin/oslevel ] ; then+		IBM_REV=`/usr/bin/oslevel`+	else+		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}+	fi+	echo ${IBM_ARCH}-ibm-aix${IBM_REV}+	exit 0 ;;+    *:AIX:*:*)+	echo rs6000-ibm-aix+	exit 0 ;;+    ibmrt:4.4BSD:*|romp-ibm:BSD:*)+	echo romp-ibm-bsd4.4+	exit 0 ;;+    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and+	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to+	exit 0 ;;                           # report: romp-ibm BSD 4.3+    *:BOSX:*:*)+	echo rs6000-bull-bosx+	exit 0 ;;+    DPX/2?00:B.O.S.:*:*)+	echo m68k-bull-sysv3+	exit 0 ;;+    9000/[34]??:4.3bsd:1.*:*)+	echo m68k-hp-bsd+	exit 0 ;;+    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)+	echo m68k-hp-bsd4.4+	exit 0 ;;+    9000/[34678]??:HP-UX:*:*)+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`+	case "${UNAME_MACHINE}" in+	    9000/31? )            HP_ARCH=m68000 ;;+	    9000/[34]?? )         HP_ARCH=m68k ;;+	    9000/[678][0-9][0-9])+		if [ -x /usr/bin/getconf ]; then+		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`+                    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`+                    case "${sc_cpu_version}" in+                      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0+                      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1+                      532)                      # CPU_PA_RISC2_0+                        case "${sc_kernel_bits}" in+                          32) HP_ARCH="hppa2.0n" ;;+                          64) HP_ARCH="hppa2.0w" ;;+			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20+                        esac ;;+                    esac+		fi+		if [ "${HP_ARCH}" = "" ]; then+		    eval $set_cc_for_build+		    sed 's/^              //' << EOF >$dummy.c++              #define _HPUX_SOURCE+              #include <stdlib.h>+              #include <unistd.h>++              int main ()+              {+              #if defined(_SC_KERNEL_BITS)+                  long bits = sysconf(_SC_KERNEL_BITS);+              #endif+                  long cpu  = sysconf (_SC_CPU_VERSION);++                  switch (cpu)+              	{+              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;+              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;+              	case CPU_PA_RISC2_0:+              #if defined(_SC_KERNEL_BITS)+              	    switch (bits)+              		{+              		case 64: puts ("hppa2.0w"); break;+              		case 32: puts ("hppa2.0n"); break;+              		default: puts ("hppa2.0"); break;+              		} break;+              #else  /* !defined(_SC_KERNEL_BITS) */+              	    puts ("hppa2.0"); break;+              #endif+              	default: puts ("hppa1.0"); break;+              	}+                  exit (0);+              }+EOF+		    (CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null) && HP_ARCH=`$dummy`+		    if test -z "$HP_ARCH"; then HP_ARCH=hppa; fi+		    rm -f $dummy.c $dummy && rmdir $tmpdir+		fi ;;+	esac+	echo ${HP_ARCH}-hp-hpux${HPUX_REV}+	exit 0 ;;+    ia64:HP-UX:*:*)+	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`+	echo ia64-hp-hpux${HPUX_REV}+	exit 0 ;;+    3050*:HI-UX:*:*)+	eval $set_cc_for_build+	sed 's/^	//' << EOF >$dummy.c+	#include <unistd.h>+	int+	main ()+	{+	  long cpu = sysconf (_SC_CPU_VERSION);+	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns+	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct+	     results, however.  */+	  if (CPU_IS_PA_RISC (cpu))+	    {+	      switch (cpu)+		{+		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;+		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;+		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;+		  default: puts ("hppa-hitachi-hiuxwe2"); break;+		}+	    }+	  else if (CPU_IS_HP_MC68K (cpu))+	    puts ("m68k-hitachi-hiuxwe2");+	  else puts ("unknown-hitachi-hiuxwe2");+	  exit (0);+	}+EOF+	$CC_FOR_BUILD $dummy.c -o $dummy && $dummy && rm -f $dummy.c $dummy && rmdir $tmpdir && exit 0+	rm -f $dummy.c $dummy && rmdir $tmpdir+	echo unknown-hitachi-hiuxwe2+	exit 0 ;;+    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )+	echo hppa1.1-hp-bsd+	exit 0 ;;+    9000/8??:4.3bsd:*:*)+	echo hppa1.0-hp-bsd+	exit 0 ;;+    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)+	echo hppa1.0-hp-mpeix+	exit 0 ;;+    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )+	echo hppa1.1-hp-osf+	exit 0 ;;+    hp8??:OSF1:*:*)+	echo hppa1.0-hp-osf+	exit 0 ;;+    i*86:OSF1:*:*)+	if [ -x /usr/sbin/sysversion ] ; then+	    echo ${UNAME_MACHINE}-unknown-osf1mk+	else+	    echo ${UNAME_MACHINE}-unknown-osf1+	fi+	exit 0 ;;+    parisc*:Lites*:*:*)+	echo hppa1.1-hp-lites+	exit 0 ;;+    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)+	echo c1-convex-bsd+        exit 0 ;;+    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)+	if getsysinfo -f scalar_acc+	then echo c32-convex-bsd+	else echo c2-convex-bsd+	fi+        exit 0 ;;+    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)+	echo c34-convex-bsd+        exit 0 ;;+    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)+	echo c38-convex-bsd+        exit 0 ;;+    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)+	echo c4-convex-bsd+        exit 0 ;;+    CRAY*Y-MP:*:*:*)+	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	exit 0 ;;+    CRAY*[A-Z]90:*:*:*)+	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \+	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \+	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \+	      -e 's/\.[^.]*$/.X/'+	exit 0 ;;+    CRAY*TS:*:*:*)+	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	exit 0 ;;+    CRAY*T3D:*:*:*)+	echo alpha-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	exit 0 ;;+    CRAY*T3E:*:*:*)+	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	exit 0 ;;+    CRAY*SV1:*:*:*)+	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'+	exit 0 ;;+    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)+	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`+        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`+        FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`+        echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"+        exit 0 ;;+    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)+	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}+	exit 0 ;;+    sparc*:BSD/OS:*:*)+	echo sparc-unknown-bsdi${UNAME_RELEASE}+	exit 0 ;;+    *:BSD/OS:*:*)+	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}+	exit 0 ;;+    *:FreeBSD:*:*)+	# Determine whether the default compiler uses glibc.+	eval $set_cc_for_build+	sed 's/^	//' << EOF >$dummy.c+	#include <features.h>+	#if __GLIBC__ >= 2+	LIBC=gnu+	#else+	LIBC=+	#endif+EOF+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=`+	rm -f $dummy.c && rmdir $tmpdir+	echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`${LIBC:+-$LIBC}+	exit 0 ;;+    i*:CYGWIN*:*)+	echo ${UNAME_MACHINE}-pc-cygwin+	exit 0 ;;+    i*:MINGW*:*)+	echo ${UNAME_MACHINE}-pc-mingw32+	exit 0 ;;+    i*:PW*:*)+	echo ${UNAME_MACHINE}-pc-pw32+	exit 0 ;;+    x86:Interix*:3*)+	echo i386-pc-interix3+	exit 0 ;;+    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)+	# How do we know it's Interix rather than the generic POSIX subsystem?+	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we+	# UNAME_MACHINE based on the output of uname instead of i386?+	echo i386-pc-interix+	exit 0 ;;+    i*:UWIN*:*)+	echo ${UNAME_MACHINE}-pc-uwin+	exit 0 ;;+    p*:CYGWIN*:*)+	echo powerpcle-unknown-cygwin+	exit 0 ;;+    prep*:SunOS:5.*:*)+	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`+	exit 0 ;;+    *:GNU:*:*)+	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`+	exit 0 ;;+    i*86:Minix:*:*)+	echo ${UNAME_MACHINE}-pc-minix+	exit 0 ;;+    arm*:Linux:*:*)+	echo ${UNAME_MACHINE}-unknown-linux-gnu+	exit 0 ;;+    ia64:Linux:*:*)+	echo ${UNAME_MACHINE}-unknown-linux-gnu+	exit 0 ;;+    m68*:Linux:*:*)+	echo ${UNAME_MACHINE}-unknown-linux-gnu+	exit 0 ;;+    mips:Linux:*:*)+	eval $set_cc_for_build+	sed 's/^	//' << EOF >$dummy.c+	#undef CPU+	#undef mips+	#undef mipsel+	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)+	CPU=mipsel+	#else+	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)+	CPU=mips+	#else+	CPU=+	#endif+	#endif+EOF+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^CPU=`+	rm -f $dummy.c && rmdir $tmpdir+	test x"${CPU}" != x && echo "${CPU}-pc-linux-gnu" && exit 0+	;;+    ppc:Linux:*:*)+	echo powerpc-unknown-linux-gnu+	exit 0 ;;+    ppc64:Linux:*:*)+	echo powerpc64-unknown-linux-gnu+	exit 0 ;;+    alpha:Linux:*:*)+	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in+	  EV5)   UNAME_MACHINE=alphaev5 ;;+	  EV56)  UNAME_MACHINE=alphaev56 ;;+	  PCA56) UNAME_MACHINE=alphapca56 ;;+	  PCA57) UNAME_MACHINE=alphapca56 ;;+	  EV6)   UNAME_MACHINE=alphaev6 ;;+	  EV67)  UNAME_MACHINE=alphaev67 ;;+	  EV68*) UNAME_MACHINE=alphaev68 ;;+        esac+	objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null+	if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi+	echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}+	exit 0 ;;+    parisc:Linux:*:* | hppa:Linux:*:*)+	# Look for CPU level+	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in+	  PA7*) echo hppa1.1-unknown-linux-gnu ;;+	  PA8*) echo hppa2.0-unknown-linux-gnu ;;+	  *)    echo hppa-unknown-linux-gnu ;;+	esac+	exit 0 ;;+    parisc64:Linux:*:* | hppa64:Linux:*:*)+	echo hppa64-unknown-linux-gnu+	exit 0 ;;+    s390:Linux:*:* | s390x:Linux:*:*)+	echo ${UNAME_MACHINE}-ibm-linux+	exit 0 ;;+    sh*:Linux:*:*)+	echo ${UNAME_MACHINE}-unknown-linux-gnu+	exit 0 ;;+    sparc:Linux:*:* | sparc64:Linux:*:*)+	echo ${UNAME_MACHINE}-unknown-linux-gnu+	exit 0 ;;+    x86_64:Linux:*:*)+	echo x86_64-unknown-linux-gnu+	exit 0 ;;+    i*86:Linux:*:*)+	# The BFD linker knows what the default object file format is, so+	# first see if it will tell us. cd to the root directory to prevent+	# problems with other programs or directories called `ld' in the path.+	# Set LC_ALL=C to ensure ld outputs messages in English.+	ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \+			 | sed -ne '/supported targets:/!d+				    s/[ 	][ 	]*/ /g+				    s/.*supported targets: *//+				    s/ .*//+				    p'`+        case "$ld_supported_targets" in+	  elf32-i386)+		TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"+		;;+	  a.out-i386-linux)+		echo "${UNAME_MACHINE}-pc-linux-gnuaout"+		exit 0 ;;+	  coff-i386)+		echo "${UNAME_MACHINE}-pc-linux-gnucoff"+		exit 0 ;;+	  "")+		# Either a pre-BFD a.out linker (linux-gnuoldld) or+		# one that does not give us useful --help.+		echo "${UNAME_MACHINE}-pc-linux-gnuoldld"+		exit 0 ;;+	esac+	# Determine whether the default compiler is a.out or elf+	eval $set_cc_for_build+	sed 's/^	//' << EOF >$dummy.c+	#include <features.h>+	#ifdef __ELF__+	# ifdef __GLIBC__+	#  if __GLIBC__ >= 2+	LIBC=gnu+	#  else+	LIBC=gnulibc1+	#  endif+	# else+	LIBC=gnulibc1+	# endif+	#else+	#ifdef __INTEL_COMPILER+	LIBC=gnu+	#else+	LIBC=gnuaout+	#endif+	#endif+EOF+	eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep ^LIBC=`+	rm -f $dummy.c && rmdir $tmpdir+	test x"${LIBC}" != x && echo "${UNAME_MACHINE}-pc-linux-${LIBC}" && exit 0+	test x"${TENTATIVE}" != x && echo "${TENTATIVE}" && exit 0+	;;+    i*86:DYNIX/ptx:4*:*)+	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.+	# earlier versions are messed up and put the nodename in both+	# sysname and nodename.+	echo i386-sequent-sysv4+	exit 0 ;;+    i*86:UNIX_SV:4.2MP:2.*)+        # Unixware is an offshoot of SVR4, but it has its own version+        # number series starting with 2...+        # I am not positive that other SVR4 systems won't match this,+	# I just have to hope.  -- rms.+        # Use sysv4.2uw... so that sysv4* matches it.+	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}+	exit 0 ;;+    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)+	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`+	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then+		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}+	else+		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}+	fi+	exit 0 ;;+    i*86:*:5:[78]*)+	case `/bin/uname -X | grep "^Machine"` in+	    *486*)	     UNAME_MACHINE=i486 ;;+	    *Pentium)	     UNAME_MACHINE=i586 ;;+	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;+	esac+	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}+	exit 0 ;;+    i*86:*:3.2:*)+	if test -f /usr/options/cb.name; then+		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`+		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL+	elif /bin/uname -X 2>/dev/null >/dev/null ; then+		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`+		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486+		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \+			&& UNAME_MACHINE=i586+		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \+			&& UNAME_MACHINE=i686+		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \+			&& UNAME_MACHINE=i686+		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL+	else+		echo ${UNAME_MACHINE}-pc-sysv32+	fi+	exit 0 ;;+    i*86:*DOS:*:*)+	echo ${UNAME_MACHINE}-pc-msdosdjgpp+	exit 0 ;;+    pc:*:*:*)+	# Left here for compatibility:+        # uname -m prints for DJGPP always 'pc', but it prints nothing about+        # the processor, so we play safe by assuming i386.+	echo i386-pc-msdosdjgpp+        exit 0 ;;+    Intel:Mach:3*:*)+	echo i386-pc-mach3+	exit 0 ;;+    paragon:*:*:*)+	echo i860-intel-osf1+	exit 0 ;;+    i860:*:4.*:*) # i860-SVR4+	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then+	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4+	else # Add other i860-SVR4 vendors below as they are discovered.+	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4+	fi+	exit 0 ;;+    mini*:CTIX:SYS*5:*)+	# "miniframe"+	echo m68010-convergent-sysv+	exit 0 ;;+    M68*:*:R3V[567]*:*)+	test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;+    3[34]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0)+	OS_REL=''+	test -r /etc/.relid \+	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`+	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \+	  && echo i486-ncr-sysv4.3${OS_REL} && exit 0+	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \+	  && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;;+    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)+        /bin/uname -p 2>/dev/null | grep 86 >/dev/null \+          && echo i486-ncr-sysv4 && exit 0 ;;+    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)+	echo m68k-unknown-lynxos${UNAME_RELEASE}+	exit 0 ;;+    mc68030:UNIX_System_V:4.*:*)+	echo m68k-atari-sysv4+	exit 0 ;;+    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)+	echo i386-unknown-lynxos${UNAME_RELEASE}+	exit 0 ;;+    TSUNAMI:LynxOS:2.*:*)+	echo sparc-unknown-lynxos${UNAME_RELEASE}+	exit 0 ;;+    rs6000:LynxOS:2.*:*)+	echo rs6000-unknown-lynxos${UNAME_RELEASE}+	exit 0 ;;+    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)+	echo powerpc-unknown-lynxos${UNAME_RELEASE}+	exit 0 ;;+    SM[BE]S:UNIX_SV:*:*)+	echo mips-dde-sysv${UNAME_RELEASE}+	exit 0 ;;+    RM*:ReliantUNIX-*:*:*)+	echo mips-sni-sysv4+	exit 0 ;;+    RM*:SINIX-*:*:*)+	echo mips-sni-sysv4+	exit 0 ;;+    *:SINIX-*:*:*)+	if uname -p 2>/dev/null >/dev/null ; then+		UNAME_MACHINE=`(uname -p) 2>/dev/null`+		echo ${UNAME_MACHINE}-sni-sysv4+	else+		echo ns32k-sni-sysv+	fi+	exit 0 ;;+    PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort+                      # says <Richard.M.Bartel@ccMail.Census.GOV>+        echo i586-unisys-sysv4+        exit 0 ;;+    *:UNIX_System_V:4*:FTX*)+	# From Gerald Hewes <hewes@openmarket.com>.+	# How about differentiating between stratus architectures? -djm+	echo hppa1.1-stratus-sysv4+	exit 0 ;;+    *:*:*:FTX*)+	# From seanf@swdc.stratus.com.+	echo i860-stratus-sysv4+	exit 0 ;;+    *:VOS:*:*)+	# From Paul.Green@stratus.com.+	echo hppa1.1-stratus-vos+	exit 0 ;;+    mc68*:A/UX:*:*)+	echo m68k-apple-aux${UNAME_RELEASE}+	exit 0 ;;+    news*:NEWS-OS:6*:*)+	echo mips-sony-newsos6+	exit 0 ;;+    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)+	if [ -d /usr/nec ]; then+	        echo mips-nec-sysv${UNAME_RELEASE}+	else+	        echo mips-unknown-sysv${UNAME_RELEASE}+	fi+        exit 0 ;;+    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.+	echo powerpc-be-beos+	exit 0 ;;+    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.+	echo powerpc-apple-beos+	exit 0 ;;+    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.+	echo i586-pc-beos+	exit 0 ;;+    SX-4:SUPER-UX:*:*)+	echo sx4-nec-superux${UNAME_RELEASE}+	exit 0 ;;+    SX-5:SUPER-UX:*:*)+	echo sx5-nec-superux${UNAME_RELEASE}+	exit 0 ;;+    Power*:Rhapsody:*:*)+	echo powerpc-apple-rhapsody${UNAME_RELEASE}+	exit 0 ;;+    *:Rhapsody:*:*)+	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}+	exit 0 ;;+    *:Darwin:*:*)+	echo `uname -p`-apple-darwin${UNAME_RELEASE}+	exit 0 ;;+    *:procnto*:*:* | *:QNX:[0123456789]*:*)+	UNAME_PROCESSOR=`uname -p`+	if test "$UNAME_PROCESSOR" = "x86"; then+		UNAME_PROCESSOR=i386+		UNAME_MACHINE=pc+	fi+	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}+	exit 0 ;;+    *:QNX:*:4*)+	echo i386-pc-qnx+	exit 0 ;;+    NSR-[GKLNPTVW]:NONSTOP_KERNEL:*:*)+	echo nsr-tandem-nsk${UNAME_RELEASE}+	exit 0 ;;+    *:NonStop-UX:*:*)+	echo mips-compaq-nonstopux+	exit 0 ;;+    BS2000:POSIX*:*:*)+	echo bs2000-siemens-sysv+	exit 0 ;;+    DS/*:UNIX_System_V:*:*)+	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}+	exit 0 ;;+    *:Plan9:*:*)+	# "uname -m" is not consistent, so use $cputype instead. 386+	# is converted to i386 for consistency with other x86+	# operating systems.+	if test "$cputype" = "386"; then+	    UNAME_MACHINE=i386+	else+	    UNAME_MACHINE="$cputype"+	fi+	echo ${UNAME_MACHINE}-unknown-plan9+	exit 0 ;;+    i*86:OS/2:*:*)+	# If we were able to find `uname', then EMX Unix compatibility+	# is probably installed.+	echo ${UNAME_MACHINE}-pc-os2-emx+	exit 0 ;;+    *:TOPS-10:*:*)+	echo pdp10-unknown-tops10+	exit 0 ;;+    *:TENEX:*:*)+	echo pdp10-unknown-tenex+	exit 0 ;;+    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)+	echo pdp10-dec-tops20+	exit 0 ;;+    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)+	echo pdp10-xkl-tops20+	exit 0 ;;+    *:TOPS-20:*:*)+	echo pdp10-unknown-tops20+	exit 0 ;;+    *:ITS:*:*)+	echo pdp10-unknown-its+	exit 0 ;;+    i*86:XTS-300:*:STOP)+	echo ${UNAME_MACHINE}-unknown-stop+	exit 0 ;;+    i*86:atheos:*:*)+	echo ${UNAME_MACHINE}-unknown-atheos+	exit 0 ;;+esac++#echo '(No uname command or uname output not recognized.)' 1>&2+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2++eval $set_cc_for_build+cat >$dummy.c <<EOF+#ifdef _SEQUENT_+# include <sys/types.h>+# include <sys/utsname.h>+#endif+main ()+{+#if defined (sony)+#if defined (MIPSEB)+  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,+     I don't know....  */+  printf ("mips-sony-bsd\n"); exit (0);+#else+#include <sys/param.h>+  printf ("m68k-sony-newsos%s\n",+#ifdef NEWSOS4+          "4"+#else+	  ""+#endif+         ); exit (0);+#endif+#endif++#if defined (__arm) && defined (__acorn) && defined (__unix)+  printf ("arm-acorn-riscix"); exit (0);+#endif++#if defined (hp300) && !defined (hpux)+  printf ("m68k-hp-bsd\n"); exit (0);+#endif++#if defined (NeXT)+#if !defined (__ARCHITECTURE__)+#define __ARCHITECTURE__ "m68k"+#endif+  int version;+  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;+  if (version < 4)+    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);+  else+    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);+  exit (0);+#endif++#if defined (MULTIMAX) || defined (n16)+#if defined (UMAXV)+  printf ("ns32k-encore-sysv\n"); exit (0);+#else+#if defined (CMU)+  printf ("ns32k-encore-mach\n"); exit (0);+#else+  printf ("ns32k-encore-bsd\n"); exit (0);+#endif+#endif+#endif++#if defined (__386BSD__)+  printf ("i386-pc-bsd\n"); exit (0);+#endif++#if defined (sequent)+#if defined (i386)+  printf ("i386-sequent-dynix\n"); exit (0);+#endif+#if defined (ns32000)+  printf ("ns32k-sequent-dynix\n"); exit (0);+#endif+#endif++#if defined (_SEQUENT_)+    struct utsname un;++    uname(&un);++    if (strncmp(un.version, "V2", 2) == 0) {+	printf ("i386-sequent-ptx2\n"); exit (0);+    }+    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */+	printf ("i386-sequent-ptx1\n"); exit (0);+    }+    printf ("i386-sequent-ptx\n"); exit (0);++#endif++#if defined (vax)+# if !defined (ultrix)+#  include <sys/param.h>+#  if defined (BSD)+#   if BSD == 43+      printf ("vax-dec-bsd4.3\n"); exit (0);+#   else+#    if BSD == 199006+      printf ("vax-dec-bsd4.3reno\n"); exit (0);+#    else+      printf ("vax-dec-bsd\n"); exit (0);+#    endif+#   endif+#  else+    printf ("vax-dec-bsd\n"); exit (0);+#  endif+# else+    printf ("vax-dec-ultrix\n"); exit (0);+# endif+#endif++#if defined (alliant) && defined (i860)+  printf ("i860-alliant-bsd\n"); exit (0);+#endif++  exit (1);+}+EOF++$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && $dummy && rm -f $dummy.c $dummy && rmdir $tmpdir && exit 0+rm -f $dummy.c $dummy && rmdir $tmpdir++# Apollos put the system type in the environment.++test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }++# Convex versions that predate uname can use getsysinfo(1)++if [ -x /usr/convex/getsysinfo ]+then+    case `getsysinfo -f cpu_type` in+    c1*)+	echo c1-convex-bsd+	exit 0 ;;+    c2*)+	if getsysinfo -f scalar_acc+	then echo c32-convex-bsd+	else echo c2-convex-bsd+	fi+	exit 0 ;;+    c34*)+	echo c34-convex-bsd+	exit 0 ;;+    c38*)+	echo c38-convex-bsd+	exit 0 ;;+    c4*)+	echo c4-convex-bsd+	exit 0 ;;+    esac+fi++cat >&2 <<EOF+$0: unable to guess system type++This script, last modified $timestamp, has failed to recognize+the operating system you are using. It is advised that you+download the most up to date version of the config scripts from++    ftp://ftp.gnu.org/pub/gnu/config/++If the version you run ($0) is already up to date, please+send the following data and any information you think might be+pertinent to <config-patches@gnu.org> in order to provide the needed+information to handle your system.++config.guess timestamp = $timestamp++uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`++hostinfo               = `(hostinfo) 2>/dev/null`+/bin/universe          = `(/bin/universe) 2>/dev/null`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`+/bin/arch              = `(/bin/arch) 2>/dev/null`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`++UNAME_MACHINE = ${UNAME_MACHINE}+UNAME_RELEASE = ${UNAME_RELEASE}+UNAME_SYSTEM  = ${UNAME_SYSTEM}+UNAME_VERSION = ${UNAME_VERSION}+EOF++exit 1++# Local variables:+# eval: (add-hook 'write-file-hooks 'time-stamp)+# time-stamp-start: "timestamp='"+# time-stamp-format: "%:y-%02m-%02d"+# time-stamp-end: "'"+# End:
+ config.h.in view
@@ -0,0 +1,46 @@+/* config.h.in.  Generated from configure.ac by autoheader.  */++/* Defined if compiling with mingw */+#undef CYGWIN++/* Defined if a debugging version is to be built */+#undef DEBUG++/* Path to ghc libraries */+#undef GHC_LIB_PATH++/* Define to 1 if you have the `arc4random' function. */+#undef HAVE_ARC4RANDOM++/* Whether symbols are prefixed with a leading underscore */+#undef LEADING_UNDERSCORE++/* Defined if compiling on the mac */+#undef MACOSX++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the version of this package. */+#undef PACKAGE_VERSION++/* Path to top of build tree */+#undef TOP++/* Which ghc to use */+#undef WITH_GHC++/* Defined if hs-plugins is to be built with Niklas Broberg's HSX parser */+#undef WITH_HSX++/* Defined if compiling with mingw */+#undef __MINGW32__
+ config.mk.in view
@@ -0,0 +1,4 @@+default: all+TOP             = @TOP@+GHC             = @GHC@+GLASGOW_HASKELL = @GLASGOW_HASKELL@
+ config.sub view
@@ -0,0 +1,1460 @@+#! /bin/sh+# Configuration validation subroutine script.+#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,+#   2000, 2001, 2002 Free Software Foundation, Inc.++timestamp='2002-07-03'++# This file is (in principle) common to ALL GNU software.+# The presence of a machine in this file suggests that SOME GNU software+# can handle that machine.  It does not imply ALL GNU software can.+#+# This file 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.+#+# This program 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 program; if not, write to the Free Software+# Foundation, Inc., 59 Temple Place - Suite 330,+# Boston, MA 02111-1307, USA.++# As a special exception to the GNU General Public License, if you+# distribute this file as part of a program that contains a+# configuration script generated by Autoconf, you may include it under+# the same distribution terms that you use for the rest of that program.++# Please send patches to <config-patches@gnu.org>.  Submit a context+# diff and a properly formatted ChangeLog entry.+#+# Configuration subroutine to validate and canonicalize a configuration type.+# Supply the specified configuration type as an argument.+# If it is invalid, we print an error message on stderr and exit with code 1.+# Otherwise, we print the canonical config type on stdout and succeed.++# This file is supposed to be the same for all GNU packages+# and recognize all the CPU types, system types and aliases+# that are meaningful with *any* GNU software.+# Each package is responsible for reporting which valid configurations+# it does not support.  The user should be able to distinguish+# a failure to support a valid configuration from a meaningless+# configuration.++# The goal of this file is to map all the various variations of a given+# machine specification into a single specification in the form:+#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM+# or in some cases, the newer four-part form:+#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM+# It is wrong to echo any other type of specification.++me=`echo "$0" | sed -e 's,.*/,,'`++usage="\+Usage: $0 [OPTION] CPU-MFR-OPSYS+       $0 [OPTION] ALIAS++Canonicalize a configuration name.++Operation modes:+  -h, --help         print this help, then exit+  -t, --time-stamp   print date of last modification, then exit+  -v, --version      print version number, then exit++Report bugs and patches to <config-patches@gnu.org>."++version="\+GNU config.sub ($timestamp)++Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001+Free Software Foundation, Inc.++This is free software; see the source for copying conditions.  There is NO+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."++help="+Try \`$me --help' for more information."++# Parse command line+while test $# -gt 0 ; do+  case $1 in+    --time-stamp | --time* | -t )+       echo "$timestamp" ; exit 0 ;;+    --version | -v )+       echo "$version" ; exit 0 ;;+    --help | --h* | -h )+       echo "$usage"; exit 0 ;;+    -- )     # Stop option processing+       shift; break ;;+    - )	# Use stdin as input.+       break ;;+    -* )+       echo "$me: invalid option $1$help"+       exit 1 ;;++    *local*)+       # First pass through any local machine types.+       echo $1+       exit 0;;++    * )+       break ;;+  esac+done++case $# in+ 0) echo "$me: missing argument$help" >&2+    exit 1;;+ 1) ;;+ *) echo "$me: too many arguments$help" >&2+    exit 1;;+esac++# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).+# Here we must recognize all the valid KERNEL-OS combinations.+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`+case $maybe_os in+  nto-qnx* | linux-gnu* | freebsd*-gnu* | storm-chaos* | os2-emx* | windows32-* | rtmk-nova*)+    os=-$maybe_os+    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`+    ;;+  *)+    basic_machine=`echo $1 | sed 's/-[^-]*$//'`+    if [ $basic_machine != $1 ]+    then os=`echo $1 | sed 's/.*-/-/'`+    else os=; fi+    ;;+esac++### Let's recognize common machines as not being operating systems so+### that things like config.sub decstation-3100 work.  We also+### recognize some manufacturers as not being operating systems, so we+### can provide default operating systems below.+case $os in+	-sun*os*)+		# Prevent following clause from handling this invalid input.+		;;+	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \+	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \+	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \+	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\+	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \+	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \+	-apple | -axis)+		os=+		basic_machine=$1+		;;+	-sim | -cisco | -oki | -wec | -winbond)+		os=+		basic_machine=$1+		;;+	-scout)+		;;+	-wrs)+		os=-vxworks+		basic_machine=$1+		;;+	-chorusos*)+		os=-chorusos+		basic_machine=$1+		;;+ 	-chorusrdb)+ 		os=-chorusrdb+		basic_machine=$1+ 		;;+	-hiux*)+		os=-hiuxwe2+		;;+	-sco5)+		os=-sco3.2v5+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-sco4)+		os=-sco3.2v4+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-sco3.2.[4-9]*)+		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-sco3.2v[4-9]*)+		# Don't forget version if it is 3.2v4 or newer.+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-sco*)+		os=-sco3.2v2+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-udk*)+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-isc)+		os=-isc2.2+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-clix*)+		basic_machine=clipper-intergraph+		;;+	-isc*)+		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`+		;;+	-lynx*)+		os=-lynxos+		;;+	-ptx*)+		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`+		;;+	-windowsnt*)+		os=`echo $os | sed -e 's/windowsnt/winnt/'`+		;;+	-psos*)+		os=-psos+		;;+	-mint | -mint[0-9]*)+		basic_machine=m68k-atari+		os=-mint+		;;+esac++# Decode aliases for certain CPU-COMPANY combinations.+case $basic_machine in+	# Recognize the basic CPU types without company name.+	# Some are omitted here because they have special meanings below.+	1750a | 580 \+	| a29k \+	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \+	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \+	| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \+	| c4x | clipper \+	| d10v | d30v | dlx | dsp16xx \+	| fr30 | frv \+	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \+	| i370 | i860 | i960 | ia64 \+	| ip2k \+	| m32r | m68000 | m68k | m88k | mcore \+	| mips | mipsbe | mipseb | mipsel | mipsle \+	| mips16 \+	| mips64 | mips64el \+	| mips64orion | mips64orionel \+	| mips64vr4100 | mips64vr4100el \+	| mips64vr4300 | mips64vr4300el \+	| mips64vr5000 | mips64vr5000el \+	| mipsisa32 | mipsisa32el \+	| mipsisa64 | mipsisa64el \+	| mipsisa64sb1 | mipsisa64sb1el \+	| mipstx39 | mipstx39el \+	| mn10200 | mn10300 \+	| ns16k | ns32k \+	| openrisc | or32 \+	| pdp10 | pdp11 | pj | pjl \+	| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \+	| pyramid \+	| sh | sh[1234] | sh3e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \+	| sh64 | sh64le \+	| sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \+	| strongarm \+	| tahoe | thumb | tic80 | tron \+	| v850 | v850e \+	| we32k \+	| x86 | xscale | xstormy16 | xtensa \+	| z8k)+		basic_machine=$basic_machine-unknown+		;;+	m6811 | m68hc11 | m6812 | m68hc12)+		# Motorola 68HC11/12.+		basic_machine=$basic_machine-unknown+		os=-none+		;;+	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)+		;;++	# We use `pc' rather than `unknown'+	# because (1) that's what they normally are, and+	# (2) the word "unknown" tends to confuse beginning users.+	i*86 | x86_64)+	  basic_machine=$basic_machine-pc+	  ;;+	# Object if more than one company name word.+	*-*-*)+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2+		exit 1+		;;+	# Recognize the basic CPU types with company name.+	580-* \+	| a29k-* \+	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \+	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \+	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \+	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \+	| avr-* \+	| bs2000-* \+	| c[123]* | c30-* | [cjt]90-* | c54x-* \+	| clipper-* | cydra-* \+	| d10v-* | d30v-* | dlx-* \+	| elxsi-* \+	| f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \+	| h8300-* | h8500-* \+	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \+	| i*86-* | i860-* | i960-* | ia64-* \+	| ip2k-* \+	| m32r-* \+	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \+	| m88110-* | m88k-* | mcore-* \+	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \+	| mips16-* \+	| mips64-* | mips64el-* \+	| mips64orion-* | mips64orionel-* \+	| mips64vr4100-* | mips64vr4100el-* \+	| mips64vr4300-* | mips64vr4300el-* \+	| mips64vr5000-* | mips64vr5000el-* \+	| mipsisa32-* | mipsisa32el-* \+	| mipsisa64-* | mipsisa64el-* \+	| mipsisa64sb1-* | mipsisa64sb1el-* \+	| mipstx39 | mipstx39el \+	| none-* | np1-* | ns16k-* | ns32k-* \+	| orion-* \+	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \+	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \+	| pyramid-* \+	| romp-* | rs6000-* \+	| sh-* | sh[1234]-* | sh3e-* | sh[34]eb-* | shbe-* \+	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \+	| sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \+	| sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \+	| tahoe-* | thumb-* | tic30-* | tic54x-* | tic80-* | tron-* \+	| v850-* | v850e-* | vax-* \+	| we32k-* \+	| x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \+	| xtensa-* \+	| ymp-* \+	| z8k-*)+		;;+	# Recognize the various machine names and aliases which stand+	# for a CPU type and a company and sometimes even an OS.+	386bsd)+		basic_machine=i386-unknown+		os=-bsd+		;;+	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)+		basic_machine=m68000-att+		;;+	3b*)+		basic_machine=we32k-att+		;;+	a29khif)+		basic_machine=a29k-amd+		os=-udi+		;;+	adobe68k)+		basic_machine=m68010-adobe+		os=-scout+		;;+	alliant | fx80)+		basic_machine=fx80-alliant+		;;+	altos | altos3068)+		basic_machine=m68k-altos+		;;+	am29k)+		basic_machine=a29k-none+		os=-bsd+		;;+	amdahl)+		basic_machine=580-amdahl+		os=-sysv+		;;+	amiga | amiga-*)+		basic_machine=m68k-unknown+		;;+	amigaos | amigados)+		basic_machine=m68k-unknown+		os=-amigaos+		;;+	amigaunix | amix)+		basic_machine=m68k-unknown+		os=-sysv4+		;;+	apollo68)+		basic_machine=m68k-apollo+		os=-sysv+		;;+	apollo68bsd)+		basic_machine=m68k-apollo+		os=-bsd+		;;+	aux)+		basic_machine=m68k-apple+		os=-aux+		;;+	balance)+		basic_machine=ns32k-sequent+		os=-dynix+		;;+	c90)+		basic_machine=c90-cray+		os=-unicos+		;;+	convex-c1)+		basic_machine=c1-convex+		os=-bsd+		;;+	convex-c2)+		basic_machine=c2-convex+		os=-bsd+		;;+	convex-c32)+		basic_machine=c32-convex+		os=-bsd+		;;+	convex-c34)+		basic_machine=c34-convex+		os=-bsd+		;;+	convex-c38)+		basic_machine=c38-convex+		os=-bsd+		;;+	cray | j90)+		basic_machine=j90-cray+		os=-unicos+		;;+	crds | unos)+		basic_machine=m68k-crds+		;;+	cris | cris-* | etrax*)+		basic_machine=cris-axis+		;;+	da30 | da30-*)+		basic_machine=m68k-da30+		;;+	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)+		basic_machine=mips-dec+		;;+	decsystem10* | dec10*)+		basic_machine=pdp10-dec+		os=-tops10+		;;+	decsystem20* | dec20*)+		basic_machine=pdp10-dec+		os=-tops20+		;;+	delta | 3300 | motorola-3300 | motorola-delta \+	      | 3300-motorola | delta-motorola)+		basic_machine=m68k-motorola+		;;+	delta88)+		basic_machine=m88k-motorola+		os=-sysv3+		;;+	dpx20 | dpx20-*)+		basic_machine=rs6000-bull+		os=-bosx+		;;+	dpx2* | dpx2*-bull)+		basic_machine=m68k-bull+		os=-sysv3+		;;+	ebmon29k)+		basic_machine=a29k-amd+		os=-ebmon+		;;+	elxsi)+		basic_machine=elxsi-elxsi+		os=-bsd+		;;+	encore | umax | mmax)+		basic_machine=ns32k-encore+		;;+	es1800 | OSE68k | ose68k | ose | OSE)+		basic_machine=m68k-ericsson+		os=-ose+		;;+	fx2800)+		basic_machine=i860-alliant+		;;+	genix)+		basic_machine=ns32k-ns+		;;+	gmicro)+		basic_machine=tron-gmicro+		os=-sysv+		;;+	go32)+		basic_machine=i386-pc+		os=-go32+		;;+	h3050r* | hiux*)+		basic_machine=hppa1.1-hitachi+		os=-hiuxwe2+		;;+	h8300hms)+		basic_machine=h8300-hitachi+		os=-hms+		;;+	h8300xray)+		basic_machine=h8300-hitachi+		os=-xray+		;;+	h8500hms)+		basic_machine=h8500-hitachi+		os=-hms+		;;+	harris)+		basic_machine=m88k-harris+		os=-sysv3+		;;+	hp300-*)+		basic_machine=m68k-hp+		;;+	hp300bsd)+		basic_machine=m68k-hp+		os=-bsd+		;;+	hp300hpux)+		basic_machine=m68k-hp+		os=-hpux+		;;+	hp3k9[0-9][0-9] | hp9[0-9][0-9])+		basic_machine=hppa1.0-hp+		;;+	hp9k2[0-9][0-9] | hp9k31[0-9])+		basic_machine=m68000-hp+		;;+	hp9k3[2-9][0-9])+		basic_machine=m68k-hp+		;;+	hp9k6[0-9][0-9] | hp6[0-9][0-9])+		basic_machine=hppa1.0-hp+		;;+	hp9k7[0-79][0-9] | hp7[0-79][0-9])+		basic_machine=hppa1.1-hp+		;;+	hp9k78[0-9] | hp78[0-9])+		# FIXME: really hppa2.0-hp+		basic_machine=hppa1.1-hp+		;;+	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)+		# FIXME: really hppa2.0-hp+		basic_machine=hppa1.1-hp+		;;+	hp9k8[0-9][13679] | hp8[0-9][13679])+		basic_machine=hppa1.1-hp+		;;+	hp9k8[0-9][0-9] | hp8[0-9][0-9])+		basic_machine=hppa1.0-hp+		;;+	hppa-next)+		os=-nextstep3+		;;+	hppaosf)+		basic_machine=hppa1.1-hp+		os=-osf+		;;+	hppro)+		basic_machine=hppa1.1-hp+		os=-proelf+		;;+	i370-ibm* | ibm*)+		basic_machine=i370-ibm+		;;+# I'm not sure what "Sysv32" means.  Should this be sysv3.2?+	i*86v32)+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`+		os=-sysv32+		;;+	i*86v4*)+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`+		os=-sysv4+		;;+	i*86v)+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`+		os=-sysv+		;;+	i*86sol2)+		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`+		os=-solaris2+		;;+	i386mach)+		basic_machine=i386-mach+		os=-mach+		;;+	i386-vsta | vsta)+		basic_machine=i386-unknown+		os=-vsta+		;;+	iris | iris4d)+		basic_machine=mips-sgi+		case $os in+		    -irix*)+			;;+		    *)+			os=-irix4+			;;+		esac+		;;+	isi68 | isi)+		basic_machine=m68k-isi+		os=-sysv+		;;+	m88k-omron*)+		basic_machine=m88k-omron+		;;+	magnum | m3230)+		basic_machine=mips-mips+		os=-sysv+		;;+	merlin)+		basic_machine=ns32k-utek+		os=-sysv+		;;+	mingw32)+		basic_machine=i386-pc+		os=-mingw32+		;;+	miniframe)+		basic_machine=m68000-convergent+		;;+	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)+		basic_machine=m68k-atari+		os=-mint+		;;+	mips3*-*)+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`+		;;+	mips3*)+		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown+		;;+	mmix*)+		basic_machine=mmix-knuth+		os=-mmixware+		;;+	monitor)+		basic_machine=m68k-rom68k+		os=-coff+		;;+	morphos)+		basic_machine=powerpc-unknown+		os=-morphos+		;;+	msdos)+		basic_machine=i386-pc+		os=-msdos+		;;+	mvs)+		basic_machine=i370-ibm+		os=-mvs+		;;+	ncr3000)+		basic_machine=i486-ncr+		os=-sysv4+		;;+	netbsd386)+		basic_machine=i386-unknown+		os=-netbsd+		;;+	netwinder)+		basic_machine=armv4l-rebel+		os=-linux+		;;+	news | news700 | news800 | news900)+		basic_machine=m68k-sony+		os=-newsos+		;;+	news1000)+		basic_machine=m68030-sony+		os=-newsos+		;;+	news-3600 | risc-news)+		basic_machine=mips-sony+		os=-newsos+		;;+	necv70)+		basic_machine=v70-nec+		os=-sysv+		;;+	next | m*-next )+		basic_machine=m68k-next+		case $os in+		    -nextstep* )+			;;+		    -ns2*)+		      os=-nextstep2+			;;+		    *)+		      os=-nextstep3+			;;+		esac+		;;+	nh3000)+		basic_machine=m68k-harris+		os=-cxux+		;;+	nh[45]000)+		basic_machine=m88k-harris+		os=-cxux+		;;+	nindy960)+		basic_machine=i960-intel+		os=-nindy+		;;+	mon960)+		basic_machine=i960-intel+		os=-mon960+		;;+	nonstopux)+		basic_machine=mips-compaq+		os=-nonstopux+		;;+	np1)+		basic_machine=np1-gould+		;;+	nsr-tandem)+		basic_machine=nsr-tandem+		;;+	op50n-* | op60c-*)+		basic_machine=hppa1.1-oki+		os=-proelf+		;;+	or32 | or32-*)+		basic_machine=or32-unknown+		os=-coff+		;;+	OSE68000 | ose68000)+		basic_machine=m68000-ericsson+		os=-ose+		;;+	os68k)+		basic_machine=m68k-none+		os=-os68k+		;;+	pa-hitachi)+		basic_machine=hppa1.1-hitachi+		os=-hiuxwe2+		;;+	paragon)+		basic_machine=i860-intel+		os=-osf+		;;+	pbd)+		basic_machine=sparc-tti+		;;+	pbb)+		basic_machine=m68k-tti+		;;+        pc532 | pc532-*)+		basic_machine=ns32k-pc532+		;;+	pentium | p5 | k5 | k6 | nexgen | viac3)+		basic_machine=i586-pc+		;;+	pentiumpro | p6 | 6x86 | athlon)+		basic_machine=i686-pc+		;;+	pentiumii | pentium2)+		basic_machine=i686-pc+		;;+	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)+		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	pentiumpro-* | p6-* | 6x86-* | athlon-*)+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	pentiumii-* | pentium2-*)+		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	pn)+		basic_machine=pn-gould+		;;+	power)	basic_machine=power-ibm+		;;+	ppc)	basic_machine=powerpc-unknown+	        ;;+	ppc-*)	basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	ppcle | powerpclittle | ppc-le | powerpc-little)+		basic_machine=powerpcle-unknown+	        ;;+	ppcle-* | powerpclittle-*)+		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	ppc64)	basic_machine=powerpc64-unknown+	        ;;+	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	ppc64le | powerpc64little | ppc64-le | powerpc64-little)+		basic_machine=powerpc64le-unknown+	        ;;+	ppc64le-* | powerpc64little-*)+		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`+		;;+	ps2)+		basic_machine=i386-ibm+		;;+	pw32)+		basic_machine=i586-unknown+		os=-pw32+		;;+	rom68k)+		basic_machine=m68k-rom68k+		os=-coff+		;;+	rm[46]00)+		basic_machine=mips-siemens+		;;+	rtpc | rtpc-*)+		basic_machine=romp-ibm+		;;+	s390 | s390-*)+		basic_machine=s390-ibm+		;;+	s390x | s390x-*)+		basic_machine=s390x-ibm+		;;+	sa29200)+		basic_machine=a29k-amd+		os=-udi+		;;+	sequent)+		basic_machine=i386-sequent+		;;+	sh)+		basic_machine=sh-hitachi+		os=-hms+		;;+	sparclite-wrs | simso-wrs)+		basic_machine=sparclite-wrs+		os=-vxworks+		;;+	sps7)+		basic_machine=m68k-bull+		os=-sysv2+		;;+	spur)+		basic_machine=spur-unknown+		;;+	st2000)+		basic_machine=m68k-tandem+		;;+	stratus)+		basic_machine=i860-stratus+		os=-sysv4+		;;+	sun2)+		basic_machine=m68000-sun+		;;+	sun2os3)+		basic_machine=m68000-sun+		os=-sunos3+		;;+	sun2os4)+		basic_machine=m68000-sun+		os=-sunos4+		;;+	sun3os3)+		basic_machine=m68k-sun+		os=-sunos3+		;;+	sun3os4)+		basic_machine=m68k-sun+		os=-sunos4+		;;+	sun4os3)+		basic_machine=sparc-sun+		os=-sunos3+		;;+	sun4os4)+		basic_machine=sparc-sun+		os=-sunos4+		;;+	sun4sol2)+		basic_machine=sparc-sun+		os=-solaris2+		;;+	sun3 | sun3-*)+		basic_machine=m68k-sun+		;;+	sun4)+		basic_machine=sparc-sun+		;;+	sun386 | sun386i | roadrunner)+		basic_machine=i386-sun+		;;+        sv1)+		basic_machine=sv1-cray+		os=-unicos+		;;+	symmetry)+		basic_machine=i386-sequent+		os=-dynix+		;;+	t3d)+		basic_machine=alpha-cray+		os=-unicos+		;;+	t3e)+		basic_machine=alphaev5-cray+		os=-unicos+		;;+	t90)+		basic_machine=t90-cray+		os=-unicos+		;;+	tic54x | c54x*)+		basic_machine=tic54x-unknown+		os=-coff+		;;+	tx39)+		basic_machine=mipstx39-unknown+		;;+	tx39el)+		basic_machine=mipstx39el-unknown+		;;+	toad1)+		basic_machine=pdp10-xkl+		os=-tops20+		;;+	tower | tower-32)+		basic_machine=m68k-ncr+		;;+	udi29k)+		basic_machine=a29k-amd+		os=-udi+		;;+	ultra3)+		basic_machine=a29k-nyu+		os=-sym1+		;;+	v810 | necv810)+		basic_machine=v810-nec+		os=-none+		;;+	vaxv)+		basic_machine=vax-dec+		os=-sysv+		;;+	vms)+		basic_machine=vax-dec+		os=-vms+		;;+	vpp*|vx|vx-*)+               basic_machine=f301-fujitsu+               ;;+	vxworks960)+		basic_machine=i960-wrs+		os=-vxworks+		;;+	vxworks68)+		basic_machine=m68k-wrs+		os=-vxworks+		;;+	vxworks29k)+		basic_machine=a29k-wrs+		os=-vxworks+		;;+	w65*)+		basic_machine=w65-wdc+		os=-none+		;;+	w89k-*)+		basic_machine=hppa1.1-winbond+		os=-proelf+		;;+	windows32)+		basic_machine=i386-pc+		os=-windows32-msvcrt+		;;+        xps | xps100)+		basic_machine=xps100-honeywell+		;;+	ymp)+		basic_machine=ymp-cray+		os=-unicos+		;;+	z8k-*-coff)+		basic_machine=z8k-unknown+		os=-sim+		;;+	none)+		basic_machine=none-none+		os=-none+		;;++# Here we handle the default manufacturer of certain CPU types.  It is in+# some cases the only manufacturer, in others, it is the most popular.+	w89k)+		basic_machine=hppa1.1-winbond+		;;+	op50n)+		basic_machine=hppa1.1-oki+		;;+	op60c)+		basic_machine=hppa1.1-oki+		;;+	romp)+		basic_machine=romp-ibm+		;;+	rs6000)+		basic_machine=rs6000-ibm+		;;+	vax)+		basic_machine=vax-dec+		;;+	pdp10)+		# there are many clones, so DEC is not a safe bet+		basic_machine=pdp10-unknown+		;;+	pdp11)+		basic_machine=pdp11-dec+		;;+	we32k)+		basic_machine=we32k-att+		;;+	sh3 | sh4 | sh3eb | sh4eb | sh[1234]le | sh3ele)+		basic_machine=sh-unknown+		;;+	sh64)+		basic_machine=sh64-unknown+		;;+	sparc | sparcv9 | sparcv9b)+		basic_machine=sparc-sun+		;;+        cydra)+		basic_machine=cydra-cydrome+		;;+	orion)+		basic_machine=orion-highlevel+		;;+	orion105)+		basic_machine=clipper-highlevel+		;;+	mac | mpw | mac-mpw)+		basic_machine=m68k-apple+		;;+	pmac | pmac-mpw)+		basic_machine=powerpc-apple+		;;+	c4x*)+		basic_machine=c4x-none+		os=-coff+		;;+	*-unknown)+		# Make sure to match an already-canonicalized machine name.+		;;+	*)+		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2+		exit 1+		;;+esac++# Here we canonicalize certain aliases for manufacturers.+case $basic_machine in+	*-digital*)+		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`+		;;+	*-commodore*)+		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`+		;;+	*)+		;;+esac++# Decode manufacturer-specific aliases for certain operating systems.++if [ x"$os" != x"" ]+then+case $os in+        # First match some system type aliases+        # that might get confused with valid system types.+	# -solaris* is a basic system type, with this one exception.+	-solaris1 | -solaris1.*)+		os=`echo $os | sed -e 's|solaris1|sunos4|'`+		;;+	-solaris)+		os=-solaris2+		;;+	-svr4*)+		os=-sysv4+		;;+	-unixware*)+		os=-sysv4.2uw+		;;+	-gnu/linux*)+		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`+		;;+	# First accept the basic system types.+	# The portable systems comes first.+	# Each alternative MUST END IN A *, to match a version number.+	# -sysv* is not here because it comes later, after sysvr4.+	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \+	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\+	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \+	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \+	      | -aos* \+	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \+	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \+	      | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \+	      | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \+	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \+	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \+	      | -chorusos* | -chorusrdb* \+	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \+	      | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \+	      | -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \+	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \+	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \+	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \+	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* | -powermax*)+	# Remember, each alternative MUST END IN *, to match a version number.+		;;+	-qnx*)+		case $basic_machine in+		    x86-* | i*86-*)+			;;+		    *)+			os=-nto$os+			;;+		esac+		;;+	-nto*)+		os=-nto-qnx+		;;+	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \+	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* \+	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)+		;;+	-mac*)+		os=`echo $os | sed -e 's|mac|macos|'`+		;;+	-linux*)+		os=`echo $os | sed -e 's|linux|linux-gnu|'`+		;;+	-sunos5*)+		os=`echo $os | sed -e 's|sunos5|solaris2|'`+		;;+	-sunos6*)+		os=`echo $os | sed -e 's|sunos6|solaris3|'`+		;;+	-opened*)+		os=-openedition+		;;+	-wince*)+		os=-wince+		;;+	-osfrose*)+		os=-osfrose+		;;+	-osf*)+		os=-osf+		;;+	-utek*)+		os=-bsd+		;;+	-dynix*)+		os=-bsd+		;;+	-acis*)+		os=-aos+		;;+	-atheos*)+		os=-atheos+		;;+	-386bsd)+		os=-bsd+		;;+	-ctix* | -uts*)+		os=-sysv+		;;+	-nova*)+		os=-rtmk-nova+		;;+	-ns2 )+	        os=-nextstep2+		;;+	-nsk*)+		os=-nsk+		;;+	# Preserve the version number of sinix5.+	-sinix5.*)+		os=`echo $os | sed -e 's|sinix|sysv|'`+		;;+	-sinix*)+		os=-sysv4+		;;+	-triton*)+		os=-sysv3+		;;+	-oss*)+		os=-sysv3+		;;+	-svr4)+		os=-sysv4+		;;+	-svr3)+		os=-sysv3+		;;+	-sysvr4)+		os=-sysv4+		;;+	# This must come after -sysvr4.+	-sysv*)+		;;+	-ose*)+		os=-ose+		;;+	-es1800*)+		os=-ose+		;;+	-xenix)+		os=-xenix+		;;+        -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)+	        os=-mint+		;;+	-none)+		;;+	*)+		# Get rid of the `-' at the beginning of $os.+		os=`echo $os | sed 's/[^-]*-//'`+		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2+		exit 1+		;;+esac+else++# Here we handle the default operating systems that come with various machines.+# The value should be what the vendor currently ships out the door with their+# machine or put another way, the most popular os provided with the machine.++# Note that if you're going to try to match "-MANUFACTURER" here (say,+# "-sun"), then you have to tell the case statement up towards the top+# that MANUFACTURER isn't an operating system.  Otherwise, code above+# will signal an error saying that MANUFACTURER isn't an operating+# system, and we'll never get to this point.++case $basic_machine in+	*-acorn)+		os=-riscix1.2+		;;+	arm*-rebel)+		os=-linux+		;;+	arm*-semi)+		os=-aout+		;;+	# This must come before the *-dec entry.+	pdp10-*)+		os=-tops20+		;;+        pdp11-*)+		os=-none+		;;+	*-dec | vax-*)+		os=-ultrix4.2+		;;+	m68*-apollo)+		os=-domain+		;;+	i386-sun)+		os=-sunos4.0.2+		;;+	m68000-sun)+		os=-sunos3+		# This also exists in the configure program, but was not the+		# default.+		# os=-sunos4+		;;+	m68*-cisco)+		os=-aout+		;;+	mips*-cisco)+		os=-elf+		;;+	mips*-*)+		os=-elf+		;;+	or32-*)+		os=-coff+		;;+	*-tti)	# must be before sparc entry or we get the wrong os.+		os=-sysv3+		;;+	sparc-* | *-sun)+		os=-sunos4.1.1+		;;+	*-be)+		os=-beos+		;;+	*-ibm)+		os=-aix+		;;+	*-wec)+		os=-proelf+		;;+	*-winbond)+		os=-proelf+		;;+	*-oki)+		os=-proelf+		;;+	*-hp)+		os=-hpux+		;;+	*-hitachi)+		os=-hiux+		;;+	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)+		os=-sysv+		;;+	*-cbm)+		os=-amigaos+		;;+	*-dg)+		os=-dgux+		;;+	*-dolphin)+		os=-sysv3+		;;+	m68k-ccur)+		os=-rtu+		;;+	m88k-omron*)+		os=-luna+		;;+	*-next )+		os=-nextstep+		;;+	*-sequent)+		os=-ptx+		;;+	*-crds)+		os=-unos+		;;+	*-ns)+		os=-genix+		;;+	i370-*)+		os=-mvs+		;;+	*-next)+		os=-nextstep3+		;;+        *-gould)+		os=-sysv+		;;+        *-highlevel)+		os=-bsd+		;;+	*-encore)+		os=-bsd+		;;+        *-sgi)+		os=-irix+		;;+        *-siemens)+		os=-sysv4+		;;+	*-masscomp)+		os=-rtu+		;;+	f30[01]-fujitsu | f700-fujitsu)+		os=-uxpv+		;;+	*-rom68k)+		os=-coff+		;;+	*-*bug)+		os=-coff+		;;+	*-apple)+		os=-macos+		;;+	*-atari*)+		os=-mint+		;;+	*)+		os=-none+		;;+esac+fi++# Here we handle the case where we know the os, and the CPU type, but not the+# manufacturer.  We pick the logical manufacturer.+vendor=unknown+case $basic_machine in+	*-unknown)+		case $os in+			-riscix*)+				vendor=acorn+				;;+			-sunos*)+				vendor=sun+				;;+			-aix*)+				vendor=ibm+				;;+			-beos*)+				vendor=be+				;;+			-hpux*)+				vendor=hp+				;;+			-mpeix*)+				vendor=hp+				;;+			-hiux*)+				vendor=hitachi+				;;+			-unos*)+				vendor=crds+				;;+			-dgux*)+				vendor=dg+				;;+			-luna*)+				vendor=omron+				;;+			-genix*)+				vendor=ns+				;;+			-mvs* | -opened*)+				vendor=ibm+				;;+			-ptx*)+				vendor=sequent+				;;+			-vxsim* | -vxworks* | -windiss*)+				vendor=wrs+				;;+			-aux*)+				vendor=apple+				;;+			-hms*)+				vendor=hitachi+				;;+			-mpw* | -macos*)+				vendor=apple+				;;+			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)+				vendor=atari+				;;+			-vos*)+				vendor=stratus+				;;+		esac+		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`+		;;+esac++echo $basic_machine$os+exit 0++# Local variables:+# eval: (add-hook 'write-file-hooks 'time-stamp)+# time-stamp-start: "timestamp='"+# time-stamp-format: "%:y-%02m-%02d"+# time-stamp-end: "'"+# End:
+ configure view
@@ -0,0 +1,3840 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.59.+#+# Copyright (C) 2003 Free Software Foundation, Inc.+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## --------------------- ##+## M4sh Initialization.  ##+## --------------------- ##++# Be Bourne compatible+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then+  emulate sh+  NULLCMD=:+  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then+  set -o posix+fi+DUALCASE=1; export DUALCASE # for MKS sh++# Support unset when possible.+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then+  as_unset=unset+else+  as_unset=false+fi+++# Work around bugs in pre-3.0 UWIN ksh.+$as_unset ENV MAIL MAILPATH+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+for as_var in \+  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \+  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \+  LC_TELEPHONE LC_TIME+do+  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then+    eval $as_var=C; export $as_var+  else+    $as_unset $as_var+  fi+done++# Required to use basename.+if expr a : '\(a\)' >/dev/null 2>&1; then+  as_expr=expr+else+  as_expr=false+fi++if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi+++# Name of the executable.+as_me=`$as_basename "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)$' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }+  	  /^X\/\(\/\/\)$/{ s//\1/; q; }+  	  /^X\/\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+++# PATH needs CR, and LINENO needs CR and PATH.+# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  echo "#! /bin/sh" >conf$$.sh+  echo  "exit 0"   >>conf$$.sh+  chmod +x conf$$.sh+  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then+    PATH_SEPARATOR=';'+  else+    PATH_SEPARATOR=:+  fi+  rm -f conf$$.sh+fi+++  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x$as_lineno_3"  = "x$as_lineno_2"  || {+  # Find who we are.  Look in the path if we contain no path at all+  # relative or not.+  case $0 in+    *[\\/]* ) as_myself=$0 ;;+    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+done++       ;;+  esac+  # We did not find ourselves, most probably we were run as `sh COMMAND'+  # in which case we are not to be found in the path.+  if test "x$as_myself" = x; then+    as_myself=$0+  fi+  if test ! -f "$as_myself"; then+    { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2+   { (exit 1); exit 1; }; }+  fi+  case $CONFIG_SHELL in+  '')+    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for as_base in sh bash ksh sh5; do+	 case $as_dir in+	 /*)+	   if ("$as_dir/$as_base" -c '+  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then+	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }+	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }+	     CONFIG_SHELL=$as_dir/$as_base+	     export CONFIG_SHELL+	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}+	   fi;;+	 esac+       done+done+;;+  esac++  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO+  # uniformly replaced by the line number.  The first 'sed' inserts a+  # line-number line before each line; the second 'sed' does the real+  # work.  The second script uses 'N' to pair each line-number line+  # with the numbered line, and appends trailing '-' during+  # substitution so that $LINENO is not a special case at line end.+  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the+  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)+  sed '=' <$as_myself |+    sed '+      N+      s,$,-,+      : loop+      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,+      t loop+      s,-$,,+      s,^['$as_cr_digits']*\n,,+    ' >$as_me.lineno &&+  chmod +x $as_me.lineno ||+    { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2+   { (exit 1); exit 1; }; }++  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensible to this).+  . ./$as_me.lineno+  # Exit status is that of the last command.+  exit+}+++case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in+  *c*,-n*) ECHO_N= ECHO_C='+' ECHO_T='	' ;;+  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;+  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;+esac++if expr a : '\(a\)' >/dev/null 2>&1; then+  as_expr=expr+else+  as_expr=false+fi++rm -f conf$$ conf$$.exe conf$$.file+echo >conf$$.file+if ln -s conf$$.file conf$$ 2>/dev/null; then+  # We could just check for DJGPP; but this test a) works b) is more generic+  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).+  if test -f conf$$.exe; then+    # Don't use ln at all; we don't have any links+    as_ln_s='cp -p'+  else+    as_ln_s='ln -s'+  fi+elif ln conf$$.file conf$$ 2>/dev/null; then+  as_ln_s=ln+else+  as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.file++if mkdir -p . 2>/dev/null; then+  as_mkdir_p=:+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++as_executable_p="test -f"++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++# IFS+# We need space, tab and new line, in precisely that order.+as_nl='+'+IFS=" 	$as_nl"++# CDPATH.+$as_unset CDPATH+++# Name of the host.+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++exec 6>&1++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_config_libobj_dir=.+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=+SHELL=${CONFIG_SHELL-/bin/sh}++# Maximum number of lines to put in a shell here document.+# This variable seems obsolete.  It should probably be removed, and+# only ac_max_sed_lines should be used.+: ${ac_max_here_lines=38}++# Identity of this package.+PACKAGE_NAME=+PACKAGE_TARNAME=+PACKAGE_VERSION=+PACKAGE_STRING=+PACKAGE_BUGREPORT=++ac_unique_file="src/System/Plugins.hs"+ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS build build_cpu build_vendor build_os PREFIX TOP GHC GLASGOW_HASKELL HASKELL_SRC TEX TEX2PAGE CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA LIBOBJS LTLIBOBJS'+ac_subst_files=''++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datadir='${prefix}/share'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+libdir='${exec_prefix}/lib'+includedir='${prefix}/include'+oldincludedir='/usr/include'+infodir='${prefix}/info'+mandir='${prefix}/man'++ac_prev=+for ac_option+do+  # If the previous option needs an argument, assign it.+  if test -n "$ac_prev"; then+    eval "$ac_prev=\$ac_option"+    ac_prev=+    continue+  fi++  ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`++  # Accept the important Cygnus configure options, so we can diagnose typos.++  case $ac_option in++  -bindir | --bindir | --bindi | --bind | --bin | --bi)+    ac_prev=bindir ;;+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+    bindir=$ac_optarg ;;++  -build | --build | --buil | --bui | --bu)+    ac_prev=build_alias ;;+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)+    build_alias=$ac_optarg ;;++  -cache-file | --cache-file | --cache-fil | --cache-fi \+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+    ac_prev=cache_file ;;+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+    cache_file=$ac_optarg ;;++  --config-cache | -C)+    cache_file=config.cache ;;++  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)+    ac_prev=datadir ;;+  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \+  | --da=*)+    datadir=$ac_optarg ;;++  -disable-* | --disable-*)+    ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&+      { echo "$as_me: error: invalid feature name: $ac_feature" >&2+   { (exit 1); exit 1; }; }+    ac_feature=`echo $ac_feature | sed 's/-/_/g'`+    eval "enable_$ac_feature=no" ;;++  -enable-* | --enable-*)+    ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&+      { echo "$as_me: error: invalid feature name: $ac_feature" >&2+   { (exit 1); exit 1; }; }+    ac_feature=`echo $ac_feature | sed 's/-/_/g'`+    case $ac_option in+      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;+      *) ac_optarg=yes ;;+    esac+    eval "enable_$ac_feature='$ac_optarg'" ;;++  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+  | --exec | --exe | --ex)+    ac_prev=exec_prefix ;;+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+  | --exec=* | --exe=* | --ex=*)+    exec_prefix=$ac_optarg ;;++  -gas | --gas | --ga | --g)+    # Obsolete; use --with-gas.+    with_gas=yes ;;++  -help | --help | --hel | --he | -h)+    ac_init_help=long ;;+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+    ac_init_help=recursive ;;+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+    ac_init_help=short ;;++  -host | --host | --hos | --ho)+    ac_prev=host_alias ;;+  -host=* | --host=* | --hos=* | --ho=*)+    host_alias=$ac_optarg ;;++  -includedir | --includedir | --includedi | --included | --include \+  | --includ | --inclu | --incl | --inc)+    ac_prev=includedir ;;+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+  | --includ=* | --inclu=* | --incl=* | --inc=*)+    includedir=$ac_optarg ;;++  -infodir | --infodir | --infodi | --infod | --info | --inf)+    ac_prev=infodir ;;+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+    infodir=$ac_optarg ;;++  -libdir | --libdir | --libdi | --libd)+    ac_prev=libdir ;;+  -libdir=* | --libdir=* | --libdi=* | --libd=*)+    libdir=$ac_optarg ;;++  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+  | --libexe | --libex | --libe)+    ac_prev=libexecdir ;;+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+  | --libexe=* | --libex=* | --libe=*)+    libexecdir=$ac_optarg ;;++  -localstatedir | --localstatedir | --localstatedi | --localstated \+  | --localstate | --localstat | --localsta | --localst \+  | --locals | --local | --loca | --loc | --lo)+    ac_prev=localstatedir ;;+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+  | --localstate=* | --localstat=* | --localsta=* | --localst=* \+  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)+    localstatedir=$ac_optarg ;;++  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+    ac_prev=mandir ;;+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+    mandir=$ac_optarg ;;++  -nfp | --nfp | --nf)+    # Obsolete; use --without-fp.+    with_fp=no ;;++  -no-create | --no-create | --no-creat | --no-crea | --no-cre \+  | --no-cr | --no-c | -n)+    no_create=yes ;;++  -no-recursion | --no-recursion | --no-recursio | --no-recursi \+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+    no_recursion=yes ;;++  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+  | --oldin | --oldi | --old | --ol | --o)+    ac_prev=oldincludedir ;;+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+    oldincludedir=$ac_optarg ;;++  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+    ac_prev=prefix ;;+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+    prefix=$ac_optarg ;;++  -program-prefix | --program-prefix | --program-prefi | --program-pref \+  | --program-pre | --program-pr | --program-p)+    ac_prev=program_prefix ;;+  -program-prefix=* | --program-prefix=* | --program-prefi=* \+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+    program_prefix=$ac_optarg ;;++  -program-suffix | --program-suffix | --program-suffi | --program-suff \+  | --program-suf | --program-su | --program-s)+    ac_prev=program_suffix ;;+  -program-suffix=* | --program-suffix=* | --program-suffi=* \+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+    program_suffix=$ac_optarg ;;++  -program-transform-name | --program-transform-name \+  | --program-transform-nam | --program-transform-na \+  | --program-transform-n | --program-transform- \+  | --program-transform | --program-transfor \+  | --program-transfo | --program-transf \+  | --program-trans | --program-tran \+  | --progr-tra | --program-tr | --program-t)+    ac_prev=program_transform_name ;;+  -program-transform-name=* | --program-transform-name=* \+  | --program-transform-nam=* | --program-transform-na=* \+  | --program-transform-n=* | --program-transform-=* \+  | --program-transform=* | --program-transfor=* \+  | --program-transfo=* | --program-transf=* \+  | --program-trans=* | --program-tran=* \+  | --progr-tra=* | --program-tr=* | --program-t=*)+    program_transform_name=$ac_optarg ;;++  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil)+    silent=yes ;;++  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+    ac_prev=sbindir ;;+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+  | --sbi=* | --sb=*)+    sbindir=$ac_optarg ;;++  -sharedstatedir | --sharedstatedir | --sharedstatedi \+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+  | --sharedst | --shareds | --shared | --share | --shar \+  | --sha | --sh)+    ac_prev=sharedstatedir ;;+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+  | --sha=* | --sh=*)+    sharedstatedir=$ac_optarg ;;++  -site | --site | --sit)+    ac_prev=site ;;+  -site=* | --site=* | --sit=*)+    site=$ac_optarg ;;++  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+    ac_prev=srcdir ;;+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+    srcdir=$ac_optarg ;;++  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+  | --syscon | --sysco | --sysc | --sys | --sy)+    ac_prev=sysconfdir ;;+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+    sysconfdir=$ac_optarg ;;++  -target | --target | --targe | --targ | --tar | --ta | --t)+    ac_prev=target_alias ;;+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+    target_alias=$ac_optarg ;;++  -v | -verbose | --verbose | --verbos | --verbo | --verb)+    verbose=yes ;;++  -version | --version | --versio | --versi | --vers | -V)+    ac_init_version=: ;;++  -with-* | --with-*)+    ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&+      { echo "$as_me: error: invalid package name: $ac_package" >&2+   { (exit 1); exit 1; }; }+    ac_package=`echo $ac_package| sed 's/-/_/g'`+    case $ac_option in+      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;+      *) ac_optarg=yes ;;+    esac+    eval "with_$ac_package='$ac_optarg'" ;;++  -without-* | --without-*)+    ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&+      { echo "$as_me: error: invalid package name: $ac_package" >&2+   { (exit 1); exit 1; }; }+    ac_package=`echo $ac_package | sed 's/-/_/g'`+    eval "with_$ac_package=no" ;;++  --x)+    # Obsolete; use --with-x.+    with_x=yes ;;++  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+  | --x-incl | --x-inc | --x-in | --x-i)+    ac_prev=x_includes ;;+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+    x_includes=$ac_optarg ;;++  -x-libraries | --x-libraries | --x-librarie | --x-librari \+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+    ac_prev=x_libraries ;;+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)+    x_libraries=$ac_optarg ;;++  -*) { echo "$as_me: error: unrecognized option: $ac_option+Try \`$0 --help' for more information." >&2+   { (exit 1); exit 1; }; }+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # Reject names that are not valid shell variable names.+    expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&+      { echo "$as_me: error: invalid variable name: $ac_envvar" >&2+   { (exit 1); exit 1; }; }+    ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`+    eval "$ac_envvar='$ac_optarg'"+    export $ac_envvar ;;++  *)+    # FIXME: should be removed in autoconf 3.0.+    echo "$as_me: WARNING: you should use --build, --host, --target" >&2+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+      echo "$as_me: WARNING: invalid host type: $ac_option" >&2+    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}+    ;;++  esac+done++if test -n "$ac_prev"; then+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`+  { echo "$as_me: error: missing argument to $ac_option" >&2+   { (exit 1); exit 1; }; }+fi++# Be sure to have absolute paths.+for ac_var in exec_prefix prefix+do+  eval ac_val=$`echo $ac_var`+  case $ac_val in+    [\\/$]* | ?:[\\/]* | NONE | '' ) ;;+    *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2+   { (exit 1); exit 1; }; };;+  esac+done++# Be sure to have absolute paths.+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \+	      localstatedir libdir includedir oldincludedir infodir mandir+do+  eval ac_val=$`echo $ac_var`+  case $ac_val in+    [\\/$]* | ?:[\\/]* ) ;;+    *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2+   { (exit 1); exit 1; }; };;+  esac+done++# There might be people who depend on the old broken behavior: `$host'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+  if test "x$build_alias" = x; then+    cross_compiling=maybe+    echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.+    If a cross compiler is detected then cross compile mode will be used." >&2+  elif test "x$build_alias" != "x$host_alias"; then+    cross_compiling=yes+  fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+  ac_srcdir_defaulted=yes+  # Try the directory containing this script, then its parent.+  ac_confdir=`(dirname "$0") 2>/dev/null ||+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$0" : 'X\(//\)[^/]' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X"$0" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }+  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }+  	  /^X\(\/\/\)$/{ s//\1/; q; }+  	  /^X\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+  srcdir=$ac_confdir+  if test ! -r $srcdir/$ac_unique_file; then+    srcdir=..+  fi+else+  ac_srcdir_defaulted=no+fi+if test ! -r $srcdir/$ac_unique_file; then+  if test "$ac_srcdir_defaulted" = yes; then+    { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2+   { (exit 1); exit 1; }; }+  else+    { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2+   { (exit 1); exit 1; }; }+  fi+fi+(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||+  { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2+   { (exit 1); exit 1; }; }+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`+ac_env_build_alias_set=${build_alias+set}+ac_env_build_alias_value=$build_alias+ac_cv_env_build_alias_set=${build_alias+set}+ac_cv_env_build_alias_value=$build_alias+ac_env_host_alias_set=${host_alias+set}+ac_env_host_alias_value=$host_alias+ac_cv_env_host_alias_set=${host_alias+set}+ac_cv_env_host_alias_value=$host_alias+ac_env_target_alias_set=${target_alias+set}+ac_env_target_alias_value=$target_alias+ac_cv_env_target_alias_set=${target_alias+set}+ac_cv_env_target_alias_value=$target_alias+ac_env_CC_set=${CC+set}+ac_env_CC_value=$CC+ac_cv_env_CC_set=${CC+set}+ac_cv_env_CC_value=$CC+ac_env_CFLAGS_set=${CFLAGS+set}+ac_env_CFLAGS_value=$CFLAGS+ac_cv_env_CFLAGS_set=${CFLAGS+set}+ac_cv_env_CFLAGS_value=$CFLAGS+ac_env_LDFLAGS_set=${LDFLAGS+set}+ac_env_LDFLAGS_value=$LDFLAGS+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}+ac_cv_env_LDFLAGS_value=$LDFLAGS+ac_env_CPPFLAGS_set=${CPPFLAGS+set}+ac_env_CPPFLAGS_value=$CPPFLAGS+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}+ac_cv_env_CPPFLAGS_value=$CPPFLAGS++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+  # Omit some internal or obsolete options to make the list less imposing.+  # This message is too long to be a string in the A/UX 3.1 sh.+  cat <<_ACEOF+\`configure' configures this package to adapt to many kinds of systems.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE.  See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+  -h, --help              display this help and exit+      --help=short        display options specific to this package+      --help=recursive    display the short help of all the included packages+  -V, --version           display version information and exit+  -q, --quiet, --silent   do not print \`checking...' messages+      --cache-file=FILE   cache test results in FILE [disabled]+  -C, --config-cache      alias for \`--cache-file=config.cache'+  -n, --no-create         do not create output files+      --srcdir=DIR        find the sources in DIR [configure dir or \`..']++_ACEOF++  cat <<_ACEOF+Installation directories:+  --prefix=PREFIX         install architecture-independent files in PREFIX+			  [$ac_default_prefix]+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX+			  [PREFIX]++By default, \`make install' will install all the files in+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than \`$ac_default_prefix' using \`--prefix',+for instance \`--prefix=\$HOME'.++For better control, use the options below.++Fine tuning of the installation directories:+  --bindir=DIR           user executables [EPREFIX/bin]+  --sbindir=DIR          system admin executables [EPREFIX/sbin]+  --libexecdir=DIR       program executables [EPREFIX/libexec]+  --datadir=DIR          read-only architecture-independent data [PREFIX/share]+  --sysconfdir=DIR       read-only single-machine data [PREFIX/etc]+  --sharedstatedir=DIR   modifiable architecture-independent data [PREFIX/com]+  --localstatedir=DIR    modifiable single-machine data [PREFIX/var]+  --libdir=DIR           object code libraries [EPREFIX/lib]+  --includedir=DIR       C header files [PREFIX/include]+  --oldincludedir=DIR    C header files for non-gcc [/usr/include]+  --infodir=DIR          info documentation [PREFIX/info]+  --mandir=DIR           man documentation [PREFIX/man]+_ACEOF++  cat <<\_ACEOF++System types:+  --build=BUILD     configure for building on BUILD [guessed]+_ACEOF+fi++if test -n "$ac_init_help"; then++  cat <<\_ACEOF++Optional Features:+  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)+  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]+  --enable-debug          Enable a debug version of hs-plugins to be built+  --enable-hsx          Enable a debug version of hs-plugins to be built++Optional Packages:+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)+  --with-ghc=<ghc>        use a specific Haskell compiler++Some influential environment variables:+  CC          C compiler command+  CFLAGS      C compiler flags+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a+              nonstandard directory <lib dir>+  CPPFLAGS    C/C++ preprocessor flags, e.g. -I<include dir> if you have+              headers in a nonstandard directory <include dir>++Use these variables to override the choices made by `configure' or to help+it to find libraries and programs with nonstandard names/locations.++_ACEOF+fi++if test "$ac_init_help" = "recursive"; then+  # If there are subdirs, report their specific --help.+  ac_popdir=`pwd`+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+    test -d $ac_dir || continue+    ac_builddir=.++if test "$ac_dir" != .; then+  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`+  # A "../" for each directory in $ac_dir_suffix.+  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`+else+  ac_dir_suffix= ac_top_builddir=+fi++case $srcdir in+  .)  # No --srcdir option.  We are building in place.+    ac_srcdir=.+    if test -z "$ac_top_builddir"; then+       ac_top_srcdir=.+    else+       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`+    fi ;;+  [\\/]* | ?:[\\/]* )  # Absolute path.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir ;;+  *) # Relative path.+    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_builddir$srcdir ;;+esac++# Do not use `cd foo && pwd` to compute absolute paths, because+# the directories may not exist.+case `pwd` in+.) ac_abs_builddir="$ac_dir";;+*)+  case "$ac_dir" in+  .) ac_abs_builddir=`pwd`;;+  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;+  *) ac_abs_builddir=`pwd`/"$ac_dir";;+  esac;;+esac+case $ac_abs_builddir in+.) ac_abs_top_builddir=${ac_top_builddir}.;;+*)+  case ${ac_top_builddir}. in+  .) ac_abs_top_builddir=$ac_abs_builddir;;+  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;+  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;+  esac;;+esac+case $ac_abs_builddir in+.) ac_abs_srcdir=$ac_srcdir;;+*)+  case $ac_srcdir in+  .) ac_abs_srcdir=$ac_abs_builddir;;+  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;+  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;+  esac;;+esac+case $ac_abs_builddir in+.) ac_abs_top_srcdir=$ac_top_srcdir;;+*)+  case $ac_top_srcdir in+  .) ac_abs_top_srcdir=$ac_abs_builddir;;+  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;+  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;+  esac;;+esac++    cd $ac_dir+    # Check for guested configure; otherwise get Cygnus style configure.+    if test -f $ac_srcdir/configure.gnu; then+      echo+      $SHELL $ac_srcdir/configure.gnu  --help=recursive+    elif test -f $ac_srcdir/configure; then+      echo+      $SHELL $ac_srcdir/configure  --help=recursive+    elif test -f $ac_srcdir/configure.ac ||+	   test -f $ac_srcdir/configure.in; then+      echo+      $ac_configure --help+    else+      echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2+    fi+    cd $ac_popdir+  done+fi++test -n "$ac_init_help" && exit 0+if $ac_init_version; then+  cat <<\_ACEOF++Copyright (C) 2003 Free Software Foundation, Inc.+This configure script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it.+_ACEOF+  exit 0+fi+exec 5>config.log+cat >&5 <<_ACEOF+This file contains any messages produced by compilers while+running configure, to aid debugging if configure makes a mistake.++It was created by $as_me, which was+generated by GNU Autoconf 2.59.  Invocation command line was++  $ $0 $@++_ACEOF+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`++/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+hostinfo               = `(hostinfo) 2>/dev/null               || echo unknown`+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  echo "PATH: $as_dir"+done++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_sep=+ac_must_keep_next=false+for ac_pass in 1 2+do+  for ac_arg+  do+    case $ac_arg in+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \+    | -silent | --silent | --silen | --sile | --sil)+      continue ;;+    *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)+      ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    case $ac_pass in+    1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;+    2)+      ac_configure_args1="$ac_configure_args1 '$ac_arg'"+      if test $ac_must_keep_next = true; then+	ac_must_keep_next=false # Got value, back to normal.+      else+	case $ac_arg in+	  *=* | --config-cache | -C | -disable-* | --disable-* \+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+	  | -with-* | --with-* | -without-* | --without-* | --x)+	    case "$ac_configure_args0 " in+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+	    esac+	    ;;+	  -* ) ac_must_keep_next=true ;;+	esac+      fi+      ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"+      # Get rid of the leading space.+      ac_sep=" "+      ;;+    esac+  done+done+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log.  We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Be sure not to use single quotes in there, as some shells,+# such as our DU 5.0 friend, will then `close' the trap.+trap 'exit_status=$?+  # Save into config.log some information that might help in debugging.+  {+    echo++    cat <<\_ASBOX+## ---------------- ##+## Cache variables. ##+## ---------------- ##+_ASBOX+    echo+    # The following way of writing the cache mishandles newlines in values,+{+  (set) 2>&1 |+    case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in+    *ac_space=\ *)+      sed -n \+	"s/'"'"'/'"'"'\\\\'"'"''"'"'/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"+      ;;+    *)+      sed -n \+	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"+      ;;+    esac;+}+    echo++    cat <<\_ASBOX+## ----------------- ##+## Output variables. ##+## ----------------- ##+_ASBOX+    echo+    for ac_var in $ac_subst_vars+    do+      eval ac_val=$`echo $ac_var`+      echo "$ac_var='"'"'$ac_val'"'"'"+    done | sort+    echo++    if test -n "$ac_subst_files"; then+      cat <<\_ASBOX+## ------------- ##+## Output files. ##+## ------------- ##+_ASBOX+      echo+      for ac_var in $ac_subst_files+      do+	eval ac_val=$`echo $ac_var`+	echo "$ac_var='"'"'$ac_val'"'"'"+      done | sort+      echo+    fi++    if test -s confdefs.h; then+      cat <<\_ASBOX+## ----------- ##+## confdefs.h. ##+## ----------- ##+_ASBOX+      echo+      sed "/^$/d" confdefs.h | sort+      echo+    fi+    test "$ac_signal" != 0 &&+      echo "$as_me: caught signal $ac_signal"+    echo "$as_me: exit $exit_status"+  } >&5+  rm -f core *.core &&+  rm -rf conftest* confdefs* conf$$* $ac_clean_files &&+    exit $exit_status+     ' 0+for ac_signal in 1 2 13 15; do+  trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -rf conftest* confdefs.h+# AIX cpp loses on an empty file, so make sure it contains at least a newline.+echo >confdefs.h++# Predefined preprocessor variables.++cat >>confdefs.h <<_ACEOF+#define PACKAGE_NAME "$PACKAGE_NAME"+_ACEOF+++cat >>confdefs.h <<_ACEOF+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"+_ACEOF+++cat >>confdefs.h <<_ACEOF+#define PACKAGE_VERSION "$PACKAGE_VERSION"+_ACEOF+++cat >>confdefs.h <<_ACEOF+#define PACKAGE_STRING "$PACKAGE_STRING"+_ACEOF+++cat >>confdefs.h <<_ACEOF+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"+_ACEOF+++# Let the site file select an alternate cache file if it wants to.+# Prefer explicitly selected file to automatically selected ones.+if test -z "$CONFIG_SITE"; then+  if test "x$prefix" != xNONE; then+    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"+  else+    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"+  fi+fi+for ac_site_file in $CONFIG_SITE; do+  if test -r "$ac_site_file"; then+    { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5+echo "$as_me: loading site script $ac_site_file" >&6;}+    sed 's/^/| /' "$ac_site_file" >&5+    . "$ac_site_file"+  fi+done++if test -r "$cache_file"; then+  # Some versions of bash will fail to source /dev/null (special+  # files actually), so we avoid doing that.+  if test -f "$cache_file"; then+    { echo "$as_me:$LINENO: loading cache $cache_file" >&5+echo "$as_me: loading cache $cache_file" >&6;}+    case $cache_file in+      [\\/]* | ?:[\\/]* ) . $cache_file;;+      *)                      . ./$cache_file;;+    esac+  fi+else+  { echo "$as_me:$LINENO: creating cache $cache_file" >&5+echo "$as_me: creating cache $cache_file" >&6;}+  >$cache_file+fi++# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in `(set) 2>&1 |+	       sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do+  eval ac_old_set=\$ac_cv_env_${ac_var}_set+  eval ac_new_set=\$ac_env_${ac_var}_set+  eval ac_old_val="\$ac_cv_env_${ac_var}_value"+  eval ac_new_val="\$ac_env_${ac_var}_value"+  case $ac_old_set,$ac_new_set in+    set,)+      { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,set)+      { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,);;+    *)+      if test "x$ac_old_val" != "x$ac_new_val"; then+	{ echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+	{ echo "$as_me:$LINENO:   former value:  $ac_old_val" >&5+echo "$as_me:   former value:  $ac_old_val" >&2;}+	{ echo "$as_me:$LINENO:   current value: $ac_new_val" >&5+echo "$as_me:   current value: $ac_new_val" >&2;}+	ac_cache_corrupted=:+      fi;;+  esac+  # Pass precious variables to config.status.+  if test "$ac_new_set" = set; then+    case $ac_new_val in+    *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)+      ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+    *) ac_arg=$ac_var=$ac_new_val ;;+    esac+    case " $ac_configure_args " in+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.+      *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;+    esac+  fi+done+if $ac_cache_corrupted; then+  { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5+echo "$as_me: error: changes in the environment can compromise the build" >&2;}+  { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}+   { (exit 1); exit 1; }; }+fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++++++++++++++++++++# Prepare to generate the config.h.in file+          ac_config_headers="$ac_config_headers config.h"+++# untested on earlier than 2.52, but it won't work anyway+++# Find out what type of system we're running on+ac_aux_dir=+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do+  if test -f $ac_dir/install-sh; then+    ac_aux_dir=$ac_dir+    ac_install_sh="$ac_aux_dir/install-sh -c"+    break+  elif test -f $ac_dir/install.sh; then+    ac_aux_dir=$ac_dir+    ac_install_sh="$ac_aux_dir/install.sh -c"+    break+  elif test -f $ac_dir/shtool; then+    ac_aux_dir=$ac_dir+    ac_install_sh="$ac_aux_dir/shtool install -c"+    break+  fi+done+if test -z "$ac_aux_dir"; then+  { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5+echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;}+   { (exit 1); exit 1; }; }+fi+ac_config_guess="$SHELL $ac_aux_dir/config.guess"+ac_config_sub="$SHELL $ac_aux_dir/config.sub"+ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.++# Make sure we can run config.sub.+$ac_config_sub sun4 >/dev/null 2>&1 ||+  { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5+echo "$as_me: error: cannot run $ac_config_sub" >&2;}+   { (exit 1); exit 1; }; }++echo "$as_me:$LINENO: checking build system type" >&5+echo $ECHO_N "checking build system type... $ECHO_C" >&6+if test "${ac_cv_build+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  ac_cv_build_alias=$build_alias+test -z "$ac_cv_build_alias" &&+  ac_cv_build_alias=`$ac_config_guess`+test -z "$ac_cv_build_alias" &&+  { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5+echo "$as_me: error: cannot guess build type; you must specify one" >&2;}+   { (exit 1); exit 1; }; }+ac_cv_build=`$ac_config_sub $ac_cv_build_alias` ||+  { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5+echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;}+   { (exit 1); exit 1; }; }++fi+echo "$as_me:$LINENO: result: $ac_cv_build" >&5+echo "${ECHO_T}$ac_cv_build" >&6+build=$ac_cv_build+build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`+build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`+build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`++++Platform="$build_cpu-$build_vendor-$build_os"++# This isn't right for msys mingw.+PREFIX="$prefix"+if test "$prefix" = "NONE"+then+  if test "$build_os" = "cygwin"+  then+    PREFIX="c:/cygwin$ac_default_prefix"+  else+    PREFIX="$ac_default_prefix"+  fi+fi+++case $Platform in+powerpc-apple-darwin*)+        MACOSX=yes++cat >>confdefs.h <<_ACEOF+#define MACOSX 1+_ACEOF++        LEADING_UNDERSCORE=1+	;;+*)+        MACOSX=no+        LEADING_UNDERSCORE=0+	;;+esac++if test "$build_os" = "mingw32"+then++cat >>confdefs.h <<\_ACEOF+#define __MINGW32__ 1+_ACEOF++  LEADING_UNDERSCORE=1+fi++if test "$build_os" = "cygwin"+then++cat >>confdefs.h <<\_ACEOF+#define CYGWIN 1+_ACEOF++  LEADING_UNDERSCORE=1+fi+++cat >>confdefs.h <<_ACEOF+#define LEADING_UNDERSCORE $LEADING_UNDERSCORE+_ACEOF+++# Find pwd, in a cygwin friendly way.+# Suggested by: http://www.haskell.org/ghc/docs/latest/html/users_guide/ch11s04.html+TOP=`echo "Directory.getCurrentDirectory >>= putStrLn.init.tail.show " | ghc --interactive -ignore-dot-ghci -v0`+++cat >>confdefs.h <<_ACEOF+#define TOP "$TOP"+_ACEOF++++# necessary tools++# allow user supplied haskell compiler++# Check whether --with-ghc or --without-ghc was given.+if test "${with_ghc+set}" = set; then+  withval="$with_ghc"+   GHC="$withval"+    if test ! -f "$GHC" ; then+       { { echo "$as_me:$LINENO: error: $GHC not found. You need GHC to build this project" >&5+echo "$as_me: error: $GHC not found. You need GHC to build this project" >&2;}+   { (exit 1); exit 1; }; }+    fi++else+   # Extract the first word of "ghc", so it can be a program name with args.+set dummy ghc; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_GHC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$GHC"; then+  ac_cv_prog_GHC="$GHC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_GHC="ghc"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+GHC=$ac_cv_prog_GHC+if test -n "$GHC"; then+  echo "$as_me:$LINENO: result: $GHC" >&5+echo "${ECHO_T}$GHC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++    if test -z "$GHC" ; then+       { { echo "$as_me:$LINENO: error: You need GHC to build this project" >&5+echo "$as_me: error: You need GHC to build this project" >&2;}+   { (exit 1); exit 1; }; }+    fi+++fi;++cat >>confdefs.h <<_ACEOF+#define WITH_GHC "$GHC"+_ACEOF++++# Work out value of __GLASGOW_HASKELL__+if test -n "$GHC" ; then+ echo "$as_me:$LINENO: checking for value of __GLASGOW_HASKELL__" >&5+echo $ECHO_N "checking for value of __GLASGOW_HASKELL__... $ECHO_C" >&6+ echo "main = print __GLASGOW_HASKELL__" > t.hs+ GLASGOW_HASKELL=`echo 'main' | "$GHC" --interactive -ignore-dot-ghci -v0 -cpp t.hs`+ rm t.hs+ echo "$as_me:$LINENO: result: $GLASGOW_HASKELL" >&5+echo "${ECHO_T}$GLASGOW_HASKELL" >&6+fi+++# find path to GHC libs, for runtime_loader+if test -n "$GHC" ; then+    echo "$as_me:$LINENO: checking for ghc library directory" >&5+echo $ECHO_N "checking for ghc library directory... $ECHO_C" >&6+    GHC_LIB_PATH=`$GHC --print-libdir`+    echo "$as_me:$LINENO: result: $GHC_LIB_PATH" >&5+echo "${ECHO_T}$GHC_LIB_PATH" >&6+fi++cat >>confdefs.h <<_ACEOF+#define GHC_LIB_PATH "$GHC_LIB_PATH"+_ACEOF+++# Allow a debugging version of hs-plugins to be built+# Check whether --enable-debug or --disable-debug was given.+if test "${enable_debug+set}" = set; then+  enableval="$enable_debug"+++cat >>confdefs.h <<_ACEOF+#define DEBUG 1+_ACEOF++else+   :+fi;++# Allow a debugging version of hs-plugins to be built+# Check whether --enable-hsx or --disable-hsx was given.+if test "${enable_hsx+set}" = set; then+  enableval="$enable_hsx"+   HASKELL_SRC=haskell-src-exts ;++cat >>confdefs.h <<_ACEOF+#define WITH_HSX 1+_ACEOF++else+   HASKELL_SRC=haskell-src+fi;++++# Extract the first word of "tex", so it can be a program name with args.+set dummy tex; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_TEX+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$TEX"; then+  ac_cv_prog_TEX="$TEX" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_TEX="tex"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+TEX=$ac_cv_prog_TEX+if test -n "$TEX"; then+  echo "$as_me:$LINENO: result: $TEX" >&5+echo "${ECHO_T}$TEX" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++if test -z "$TEX" ; then+    { echo "$as_me:$LINENO: WARNING: tex is needed to build some of the documentation" >&5+echo "$as_me: WARNING: tex is needed to build some of the documentation" >&2;}+fi+# Extract the first word of "tex2page", so it can be a program name with args.+set dummy tex2page; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_TEX2PAGE+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$TEX2PAGE"; then+  ac_cv_prog_TEX2PAGE="$TEX2PAGE" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_TEX2PAGE="tex2page"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+TEX2PAGE=$ac_cv_prog_TEX2PAGE+if test -n "$TEX2PAGE"; then+  echo "$as_me:$LINENO: result: $TEX2PAGE" >&5+echo "${ECHO_T}$TEX2PAGE" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++if test -z "$TEX2PAGE" ; then+    { echo "$as_me:$LINENO: WARNING: tex2page is needed to build some of the documentation+		    http://www.ccs.neu.edu/home/dorai/tex2page/tex2page-doc.html" >&5+echo "$as_me: WARNING: tex2page is needed to build some of the documentation+		    http://www.ccs.neu.edu/home/dorai/tex2page/tex2page-doc.html" >&2;}+fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.+set dummy ${ac_tool_prefix}gcc; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}gcc"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  echo "$as_me:$LINENO: result: $CC" >&5+echo "${ECHO_T}$CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "gcc", so it can be a program name with args.+set dummy gcc; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="gcc"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  echo "$as_me:$LINENO: result: $ac_ct_CC" >&5+echo "${ECHO_T}$ac_ct_CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++  CC=$ac_ct_CC+else+  CC="$ac_cv_prog_CC"+fi++if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.+set dummy ${ac_tool_prefix}cc; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}cc"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  echo "$as_me:$LINENO: result: $CC" >&5+echo "${ECHO_T}$CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "cc", so it can be a program name with args.+set dummy cc; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="cc"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  echo "$as_me:$LINENO: result: $ac_ct_CC" >&5+echo "${ECHO_T}$ac_ct_CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++  CC=$ac_ct_CC+else+  CC="$ac_cv_prog_CC"+fi++fi+if test -z "$CC"; then+  # Extract the first word of "cc", so it can be a program name with args.+set dummy cc; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+  ac_prog_rejected=no+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then+       ac_prog_rejected=yes+       continue+     fi+    ac_cv_prog_CC="cc"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++if test $ac_prog_rejected = yes; then+  # We found a bogon in the path, so make sure we never use it.+  set dummy $ac_cv_prog_CC+  shift+  if test $# != 0; then+    # We chose a different compiler from the bogus one.+    # However, it has the same basename, so the bogon will be chosen+    # first if we set CC to just the basename; use the full file name.+    shift+    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"+  fi+fi+fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  echo "$as_me:$LINENO: result: $CC" >&5+echo "${ECHO_T}$CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  for ac_prog in cl+  do+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.+set dummy $ac_tool_prefix$ac_prog; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  echo "$as_me:$LINENO: result: $CC" >&5+echo "${ECHO_T}$CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++    test -n "$CC" && break+  done+fi+if test -z "$CC"; then+  ac_ct_CC=$CC+  for ac_prog in cl+do+  # Extract the first word of "$ac_prog", so it can be a program name with args.+set dummy $ac_prog; ac_word=$2+echo "$as_me:$LINENO: checking for $ac_word" >&5+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  if test -n "$ac_ct_CC"; then+  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for ac_exec_ext in '' $ac_executable_extensions; do+  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="$ac_prog"+    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+done++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  echo "$as_me:$LINENO: result: $ac_ct_CC" >&5+echo "${ECHO_T}$ac_ct_CC" >&6+else+  echo "$as_me:$LINENO: result: no" >&5+echo "${ECHO_T}no" >&6+fi++  test -n "$ac_ct_CC" && break+done++  CC=$ac_ct_CC+fi++fi+++test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH+See \`config.log' for more details." >&5+echo "$as_me: error: no acceptable C compiler found in \$PATH+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }++# Provide some information about the compiler.+echo "$as_me:$LINENO:" \+     "checking for C compiler version" >&5+ac_compiler=`set X $ac_compile; echo $2`+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5+  (eval $ac_compiler --version </dev/null >&5) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5+  (eval $ac_compiler -v </dev/null >&5) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5+  (eval $ac_compiler -V </dev/null >&5) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }++cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files a.out a.exe b.out"+# Try to create an executable without -o first, disregard a.out.+# It will help us diagnose broken compilers, and finding out an intuition+# of exeext.+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5+  (eval $ac_link_default) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; then+  # Find the output, starting from the most likely.  This scheme is+# not robust to junk in `.', hence go to wildcards (a.*) only as a last+# resort.++# Be careful to initialize this variable, since it used to be cached.+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.+ac_cv_exeext=+# b.out is created by i960 compilers.+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out+do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )+	;;+    conftest.$ac_ext )+	# This is the source file.+	;;+    [ab].out )+	# We found the default executable, but exeext='' is most+	# certainly right.+	break;;+    *.* )+	ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	# FIXME: I believe we export ac_cv_exeext for Libtool,+	# but it would be cool to find out if it's true.  Does anybody+	# maintain Libtool? --akim.+	export ac_cv_exeext+	break;;+    * )+	break;;+  esac+done+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { echo "$as_me:$LINENO: error: C compiler cannot create executables+See \`config.log' for more details." >&5+echo "$as_me: error: C compiler cannot create executables+See \`config.log' for more details." >&2;}+   { (exit 77); exit 77; }; }+fi++ac_exeext=$ac_cv_exeext+echo "$as_me:$LINENO: result: $ac_file" >&5+echo "${ECHO_T}$ac_file" >&6++# Check the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+echo "$as_me:$LINENO: checking whether the C compiler works" >&5+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0+# If not cross compiling, check that we can run a simple program.+if test "$cross_compiling" != yes; then+  if { ac_try='./$ac_file'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+    cross_compiling=no+  else+    if test "$cross_compiling" = maybe; then+	cross_compiling=yes+    else+	{ { echo "$as_me:$LINENO: error: cannot run C compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details." >&5+echo "$as_me: error: cannot run C compiled programs.+If you meant to cross compile, use \`--host'.+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }+    fi+  fi+fi+echo "$as_me:$LINENO: result: yes" >&5+echo "${ECHO_T}yes" >&6++rm -f a.out a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+# Check the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6+echo "$as_me:$LINENO: result: $cross_compiling" >&5+echo "${ECHO_T}$cross_compiling" >&6++echo "$as_me:$LINENO: checking for suffix of executables" >&5+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5+  (eval $ac_link) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; then+  # If both `conftest.exe' and `conftest' are `present' (well, observable)+# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will+# work properly (i.e., refer to `conftest.exe'), while it won't with+# `rm'.+for ac_file in conftest.exe conftest conftest.*; do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	  export ac_cv_exeext+	  break;;+    * ) break;;+  esac+done+else+  { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details." >&5+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }+fi++rm -f conftest$ac_cv_exeext+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5+echo "${ECHO_T}$ac_cv_exeext" >&6++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+echo "$as_me:$LINENO: checking for suffix of object files" >&5+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6+if test "${ac_cv_objext+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+rm -f conftest.o conftest.obj+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; then+  for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`+       break;;+  esac+done+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile+See \`config.log' for more details." >&5+echo "$as_me: error: cannot compute suffix of object files: cannot compile+See \`config.log' for more details." >&2;}+   { (exit 1); exit 1; }; }+fi++rm -f conftest.$ac_cv_objext conftest.$ac_ext+fi+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5+echo "${ECHO_T}$ac_cv_objext" >&6+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6+if test "${ac_cv_c_compiler_gnu+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{+#ifndef __GNUC__+       choke me+#endif++  ;+  return 0;+}+_ACEOF+rm -f conftest.$ac_objext+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest.$ac_objext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  ac_compiler_gnu=yes+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++ac_compiler_gnu=no+fi+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext+ac_cv_c_compiler_gnu=$ac_compiler_gnu++fi+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6+GCC=`test $ac_compiler_gnu = yes && echo yes`+ac_test_CFLAGS=${CFLAGS+set}+ac_save_CFLAGS=$CFLAGS+CFLAGS="-g"+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6+if test "${ac_cv_prog_cc_g+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */++int+main ()+{++  ;+  return 0;+}+_ACEOF+rm -f conftest.$ac_objext+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest.$ac_objext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  ac_cv_prog_cc_g=yes+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++ac_cv_prog_cc_g=no+fi+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext+fi+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6+if test "$ac_test_CFLAGS" = set; then+  CFLAGS=$ac_save_CFLAGS+elif test $ac_cv_prog_cc_g = yes; then+  if test "$GCC" = yes; then+    CFLAGS="-g -O2"+  else+    CFLAGS="-g"+  fi+else+  if test "$GCC" = yes; then+    CFLAGS="-O2"+  else+    CFLAGS=+  fi+fi+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6+if test "${ac_cv_prog_cc_stdc+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  ac_cv_prog_cc_stdc=no+ac_save_CC=$CC+cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+#include <stdarg.h>+#include <stdio.h>+#include <sys/types.h>+#include <sys/stat.h>+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */+struct buf { int x; };+FILE * (*rcsopen) (struct buf *, struct stat *, int);+static char *e (p, i)+     char **p;+     int i;+{+  return p[i];+}+static char *f (char * (*g) (char **, int), char **p, ...)+{+  char *s;+  va_list v;+  va_start (v,p);+  s = g (p, va_arg (v,int));+  va_end (v);+  return s;+}++/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has+   function prototypes and stuff, but not '\xHH' hex character constants.+   These don't provoke an error unfortunately, instead are silently treated+   as 'x'.  The following induces an error, until -std1 is added to get+   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an+   array size at least.  It's necessary to write '\x00'==0 to get something+   that's true only with -std1.  */+int osf4_cc_array ['\x00' == 0 ? 1 : -1];++int test (int i, double x);+struct s1 {int (*f) (int a);};+struct s2 {int (*f) (double a);};+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);+int argc;+char **argv;+int+main ()+{+return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];+  ;+  return 0;+}+_ACEOF+# Don't try gcc -ansi; that turns off useful extensions and+# breaks some systems' header files.+# AIX			-qlanglvl=ansi+# Ultrix and OSF/1	-std1+# HP-UX 10.20 and later	-Ae+# HP-UX older versions	-Aa -D_HPUX_SOURCE+# SVR4			-Xc -D__EXTENSIONS__+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"+do+  CC="$ac_save_CC $ac_arg"+  rm -f conftest.$ac_objext+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest.$ac_objext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  ac_cv_prog_cc_stdc=$ac_arg+break+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++fi+rm -f conftest.err conftest.$ac_objext+done+rm -f conftest.$ac_ext conftest.$ac_objext+CC=$ac_save_CC++fi++case "x$ac_cv_prog_cc_stdc" in+  x|xno)+    echo "$as_me:$LINENO: result: none needed" >&5+echo "${ECHO_T}none needed" >&6 ;;+  *)+    echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6+    CC="$CC $ac_cv_prog_cc_stdc" ;;+esac++# Some people use a C++ compiler to compile C.  Since we use `exit',+# in C++ we need to declare it.  In case someone uses the same compiler+# for both compiling C and C++ we need to have the C++ compiler decide+# the declaration of exit, since it's the most demanding environment.+cat >conftest.$ac_ext <<_ACEOF+#ifndef __cplusplus+  choke me+#endif+_ACEOF+rm -f conftest.$ac_objext+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest.$ac_objext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  for ac_declaration in \+   '' \+   'extern "C" void std::exit (int) throw (); using std::exit;' \+   'extern "C" void std::exit (int); using std::exit;' \+   'extern "C" void exit (int) throw ();' \+   'extern "C" void exit (int);' \+   'void exit (int);'+do+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+$ac_declaration+#include <stdlib.h>+int+main ()+{+exit (42);+  ;+  return 0;+}+_ACEOF+rm -f conftest.$ac_objext+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest.$ac_objext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  :+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++continue+fi+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+$ac_declaration+int+main ()+{+exit (42);+  ;+  return 0;+}+_ACEOF+rm -f conftest.$ac_objext+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5+  (eval $ac_compile) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest.$ac_objext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  break+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++fi+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext+done+rm -f conftest*+if test -n "$ac_declaration"; then+  echo '#ifdef __cplusplus' >>confdefs.h+  echo $ac_declaration      >>confdefs.h+  echo '#endif'             >>confdefs.h+fi++else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++fi+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext+ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++for ac_func in arc4random+do+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`+echo "$as_me:$LINENO: checking for $ac_func" >&5+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6+if eval "test \"\${$as_ac_var+set}\" = set"; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  cat >conftest.$ac_ext <<_ACEOF+/* confdefs.h.  */+_ACEOF+cat confdefs.h >>conftest.$ac_ext+cat >>conftest.$ac_ext <<_ACEOF+/* end confdefs.h.  */+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.+   For example, HP-UX 11i <limits.h> declares gettimeofday.  */+#define $ac_func innocuous_$ac_func++/* System header to define __stub macros and hopefully few prototypes,+    which can conflict with char $ac_func (); below.+    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since+    <limits.h> exists even on freestanding compilers.  */++#ifdef __STDC__+# include <limits.h>+#else+# include <assert.h>+#endif++#undef $ac_func++/* Override any gcc2 internal prototype to avoid an error.  */+#ifdef __cplusplus+extern "C"+{+#endif+/* We use char because int might match the return type of a gcc2+   builtin and then its argument prototype would still apply.  */+char $ac_func ();+/* The GNU C library defines this for functions which it implements+    to always fail with ENOSYS.  Some functions are actually named+    something starting with __ and the normal name is an alias.  */+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)+choke me+#else+char (*f) () = $ac_func;+#endif+#ifdef __cplusplus+}+#endif++int+main ()+{+return f != $ac_func;+  ;+  return 0;+}+_ACEOF+rm -f conftest.$ac_objext conftest$ac_exeext+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5+  (eval $ac_link) 2>conftest.er1+  ac_status=$?+  grep -v '^ *+' conftest.er1 >conftest.err+  rm -f conftest.er1+  cat conftest.err >&5+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); } &&+	 { ac_try='test -z "$ac_c_werror_flag"+			 || test ! -s conftest.err'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; } &&+	 { ac_try='test -s conftest$ac_exeext'+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5+  (eval $ac_try) 2>&5+  ac_status=$?+  echo "$as_me:$LINENO: \$? = $ac_status" >&5+  (exit $ac_status); }; }; then+  eval "$as_ac_var=yes"+else+  echo "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++eval "$as_ac_var=no"+fi+rm -f conftest.err conftest.$ac_objext \+      conftest$ac_exeext conftest.$ac_ext+fi+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6+if test `eval echo '${'$as_ac_var'}'` = yes; then+  cat >>confdefs.h <<_ACEOF+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1+_ACEOF++fi+done+++# Find a good install program.  We prefer a C program (faster),+# so one script is as good as another.  But avoid the broken or+# incompatible versions:+# SysV /etc/install, /usr/sbin/install+# SunOS /usr/etc/install+# IRIX /sbin/install+# AIX /bin/install+# AmigaOS /C/install, which installs bootblocks on floppy discs+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag+# AFS /usr/afsws/bin/install, which mishandles nonexistent args+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"+# OS/2's system install, which has a completely different semantic+# ./install, which can be erroneously created by make from ./install.sh.+echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5+echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6+if test -z "$INSTALL"; then+if test "${ac_cv_path_install+set}" = set; then+  echo $ECHO_N "(cached) $ECHO_C" >&6+else+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  # Account for people who put trailing slashes in PATH elements.+case $as_dir/ in+  ./ | .// | /cC/* | \+  /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \+  ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \+  /usr/ucb/* ) ;;+  *)+    # OSF1 and SCO ODT 3.0 have their own names for install.+    # Don't use installbsd from OSF since it installs stuff as root+    # by default.+    for ac_prog in ginstall scoinst install; do+      for ac_exec_ext in '' $ac_executable_extensions; do+	if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then+	  if test $ac_prog = install &&+	    grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then+	    # AIX install.  It has an incompatible calling convention.+	    :+	  elif test $ac_prog = install &&+	    grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then+	    # program-specific install script used by HP pwplus--don't use.+	    :+	  else+	    ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"+	    break 3+	  fi+	fi+      done+    done+    ;;+esac+done+++fi+  if test "${ac_cv_path_install+set}" = set; then+    INSTALL=$ac_cv_path_install+  else+    # As a last resort, use the slow shell script.  We don't cache a+    # path for INSTALL within a source directory, because that will+    # break other packages using the cache if that directory is+    # removed, or if the path is relative.+    INSTALL=$ac_install_sh+  fi+fi+echo "$as_me:$LINENO: result: $INSTALL" >&5+echo "${ECHO_T}$INSTALL" >&6++# Use test -z because SunOS4 sh mishandles braces in ${var-val}.+# It thinks the first close brace ends the variable substitution.+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'++test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'++test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'+++# System.Process uses cmd or command.com shell on Windows, doen't use Cygwin or MSYS shell+                              ac_config_files="$ac_config_files config.mk testsuite/makewith/io/TestIO.conf testsuite/makewith/unsafeio/Unsafe.conf"++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems.  If it contains results you don't+# want to keep, you may remove or edit it.+#+# config.status only pays attention to the cache file if you give it+# the --recheck option to rerun configure.+#+# `ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* `ac_cv_foo' will be assigned the+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, don't put newlines in cache variables' values.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+{+  (set) 2>&1 |+    case `(ac_space=' '; set | grep ac_space) 2>&1` in+    *ac_space=\ *)+      # `set' does not quote correctly, so add quotes (double-quote+      # substitution turns \\\\ into \\, and sed turns \\ into \).+      sed -n \+	"s/'/'\\\\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"+      ;;+    *)+      # `set' quotes correctly as required by POSIX, so do not add quotes.+      sed -n \+	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"+      ;;+    esac;+} |+  sed '+     t clear+     : clear+     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/+     t end+     /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+     : end' >>confcache+if diff $cache_file confcache >/dev/null 2>&1; then :; else+  if test -w $cache_file; then+    test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"+    cat confcache >$cache_file+  else+    echo "not updating unwritable cache $cache_file"+  fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++# VPATH may cause trouble with some makes, so we remove $(srcdir),+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and+# trailing colons and then remove the whole line if VPATH becomes empty+# (actually we leave an empty line to preserve line numbers).+if test "x$srcdir" = x.; then+  ac_vpsub='/^[	 ]*VPATH[	 ]*=/{+s/:*\$(srcdir):*/:/;+s/:*\${srcdir}:*/:/;+s/:*@srcdir@:*/:/;+s/^\([^=]*=[	 ]*\):*/\1/;+s/:*$//;+s/^[^=]*=[	 ]*$//;+}'+fi++DEFS=-DHAVE_CONFIG_H++ac_libobjs=+ac_ltlibobjs=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+  # 1. Remove the extension, and $U if already installed.+  ac_i=`echo "$ac_i" |+	 sed 's/\$U\././;s/\.o$//;s/\.obj$//'`+  # 2. Add them.+  ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"+  ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: ${CONFIG_STATUS=./config.status}+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5+echo "$as_me: creating $CONFIG_STATUS" >&6;}+cat >$CONFIG_STATUS <<_ACEOF+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false+SHELL=\${CONFIG_SHELL-$SHELL}+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF+## --------------------- ##+## M4sh Initialization.  ##+## --------------------- ##++# Be Bourne compatible+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then+  emulate sh+  NULLCMD=:+  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then+  set -o posix+fi+DUALCASE=1; export DUALCASE # for MKS sh++# Support unset when possible.+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then+  as_unset=unset+else+  as_unset=false+fi+++# Work around bugs in pre-3.0 UWIN ksh.+$as_unset ENV MAIL MAILPATH+PS1='$ '+PS2='> '+PS4='+ '++# NLS nuisances.+for as_var in \+  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \+  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \+  LC_TELEPHONE LC_TIME+do+  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then+    eval $as_var=C; export $as_var+  else+    $as_unset $as_var+  fi+done++# Required to use basename.+if expr a : '\(a\)' >/dev/null 2>&1; then+  as_expr=expr+else+  as_expr=false+fi++if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi+++# Name of the executable.+as_me=`$as_basename "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)$' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }+  	  /^X\/\(\/\/\)$/{ s//\1/; q; }+  	  /^X\/\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+++# PATH needs CR, and LINENO needs CR and PATH.+# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits++# The user is always right.+if test "${PATH_SEPARATOR+set}" != set; then+  echo "#! /bin/sh" >conf$$.sh+  echo  "exit 0"   >>conf$$.sh+  chmod +x conf$$.sh+  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then+    PATH_SEPARATOR=';'+  else+    PATH_SEPARATOR=:+  fi+  rm -f conf$$.sh+fi+++  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x$as_lineno_3"  = "x$as_lineno_2"  || {+  # Find who we are.  Look in the path if we contain no path at all+  # relative or not.+  case $0 in+    *[\\/]* ) as_myself=$0 ;;+    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break+done++       ;;+  esac+  # We did not find ourselves, most probably we were run as `sh COMMAND'+  # in which case we are not to be found in the path.+  if test "x$as_myself" = x; then+    as_myself=$0+  fi+  if test ! -f "$as_myself"; then+    { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}+   { (exit 1); exit 1; }; }+  fi+  case $CONFIG_SHELL in+  '')+    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  test -z "$as_dir" && as_dir=.+  for as_base in sh bash ksh sh5; do+	 case $as_dir in+	 /*)+	   if ("$as_dir/$as_base" -c '+  as_lineno_1=$LINENO+  as_lineno_2=$LINENO+  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`+  test "x$as_lineno_1" != "x$as_lineno_2" &&+  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then+	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }+	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }+	     CONFIG_SHELL=$as_dir/$as_base+	     export CONFIG_SHELL+	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}+	   fi;;+	 esac+       done+done+;;+  esac++  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO+  # uniformly replaced by the line number.  The first 'sed' inserts a+  # line-number line before each line; the second 'sed' does the real+  # work.  The second script uses 'N' to pair each line-number line+  # with the numbered line, and appends trailing '-' during+  # substitution so that $LINENO is not a special case at line end.+  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the+  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)+  sed '=' <$as_myself |+    sed '+      N+      s,$,-,+      : loop+      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,+      t loop+      s,-$,,+      s,^['$as_cr_digits']*\n,,+    ' >$as_me.lineno &&+  chmod +x $as_me.lineno ||+    { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}+   { (exit 1); exit 1; }; }++  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensible to this).+  . ./$as_me.lineno+  # Exit status is that of the last command.+  exit+}+++case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in+  *c*,-n*) ECHO_N= ECHO_C='+' ECHO_T='	' ;;+  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;+  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;+esac++if expr a : '\(a\)' >/dev/null 2>&1; then+  as_expr=expr+else+  as_expr=false+fi++rm -f conf$$ conf$$.exe conf$$.file+echo >conf$$.file+if ln -s conf$$.file conf$$ 2>/dev/null; then+  # We could just check for DJGPP; but this test a) works b) is more generic+  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).+  if test -f conf$$.exe; then+    # Don't use ln at all; we don't have any links+    as_ln_s='cp -p'+  else+    as_ln_s='ln -s'+  fi+elif ln conf$$.file conf$$ 2>/dev/null; then+  as_ln_s=ln+else+  as_ln_s='cp -p'+fi+rm -f conf$$ conf$$.exe conf$$.file++if mkdir -p . 2>/dev/null; then+  as_mkdir_p=:+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++as_executable_p="test -f"++# Sed expression to map a string onto a valid CPP name.+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++# IFS+# We need space, tab and new line, in precisely that order.+as_nl='+'+IFS=" 	$as_nl"++# CDPATH.+$as_unset CDPATH++exec 6>&1++# Open the log real soon, to keep \$[0] and so on meaningful, and to+# report actual input values of CONFIG_FILES etc. instead of their+# values after options handling.  Logging --version etc. is OK.+exec 5>>config.log+{+  echo+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+} >&5+cat >&5 <<_CSEOF++This file was extended by $as_me, which was+generated by GNU Autoconf 2.59.  Invocation command line was++  CONFIG_FILES    = $CONFIG_FILES+  CONFIG_HEADERS  = $CONFIG_HEADERS+  CONFIG_LINKS    = $CONFIG_LINKS+  CONFIG_COMMANDS = $CONFIG_COMMANDS+  $ $0 $@++_CSEOF+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5+echo >&5+_ACEOF++# Files that config.status was made for.+if test -n "$ac_config_files"; then+  echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS+fi++if test -n "$ac_config_headers"; then+  echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS+fi++if test -n "$ac_config_links"; then+  echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS+fi++if test -n "$ac_config_commands"; then+  echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS+fi++cat >>$CONFIG_STATUS <<\_ACEOF++ac_cs_usage="\+\`$as_me' instantiates files from templates according to the+current configuration.++Usage: $0 [OPTIONS] [FILE]...++  -h, --help       print this help, then exit+  -V, --version    print version number, then exit+  -q, --quiet      do not print progress messages+  -d, --debug      don't remove temporary files+      --recheck    update $as_me by reconfiguring in the same conditions+  --file=FILE[:TEMPLATE]+		   instantiate the configuration file FILE+  --header=FILE[:TEMPLATE]+		   instantiate the configuration header FILE++Configuration files:+$config_files++Configuration headers:+$config_headers++Report bugs to <bug-autoconf@gnu.org>."+_ACEOF++cat >>$CONFIG_STATUS <<_ACEOF+ac_cs_version="\\+config.status+configured by $0, generated by GNU Autoconf 2.59,+  with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"++Copyright (C) 2003 Free Software Foundation, Inc.+This config.status script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it."+srcdir=$srcdir+INSTALL="$INSTALL"+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF+# If no file are specified by the user, then we need to provide default+# value.  By we need to know if files were specified by the user.+ac_need_defaults=:+while test $# != 0+do+  case $1 in+  --*=*)+    ac_option=`expr "x$1" : 'x\([^=]*\)='`+    ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`+    ac_shift=:+    ;;+  -*)+    ac_option=$1+    ac_optarg=$2+    ac_shift=shift+    ;;+  *) # This is not an option, so the user has probably given explicit+     # arguments.+     ac_option=$1+     ac_need_defaults=false;;+  esac++  case $ac_option in+  # Handling of the options.+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+    ac_cs_recheck=: ;;+  --version | --vers* | -V )+    echo "$ac_cs_version"; exit 0 ;;+  --he | --h)+    # Conflict between --help and --header+    { { echo "$as_me:$LINENO: error: ambiguous option: $1+Try \`$0 --help' for more information." >&5+echo "$as_me: error: ambiguous option: $1+Try \`$0 --help' for more information." >&2;}+   { (exit 1); exit 1; }; };;+  --help | --hel | -h )+    echo "$ac_cs_usage"; exit 0 ;;+  --debug | --d* | -d )+    debug=: ;;+  --file | --fil | --fi | --f )+    $ac_shift+    CONFIG_FILES="$CONFIG_FILES $ac_optarg"+    ac_need_defaults=false;;+  --header | --heade | --head | --hea )+    $ac_shift+    CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"+    ac_need_defaults=false;;+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil | --si | --s)+    ac_cs_silent=: ;;++  # This is an error.+  -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1+Try \`$0 --help' for more information." >&5+echo "$as_me: error: unrecognized option: $1+Try \`$0 --help' for more information." >&2;}+   { (exit 1); exit 1; }; } ;;++  *) ac_config_targets="$ac_config_targets $1" ;;++  esac+  shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+  exec 6>/dev/null+  ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF+if \$ac_cs_recheck; then+  echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6+  exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+fi++_ACEOF++++++cat >>$CONFIG_STATUS <<\_ACEOF+for ac_config_target in $ac_config_targets+do+  case "$ac_config_target" in+  # Handling of arguments.+  "config.mk" ) CONFIG_FILES="$CONFIG_FILES config.mk" ;;+  "testsuite/makewith/io/TestIO.conf" ) CONFIG_FILES="$CONFIG_FILES testsuite/makewith/io/TestIO.conf" ;;+  "testsuite/makewith/unsafeio/Unsafe.conf" ) CONFIG_FILES="$CONFIG_FILES testsuite/makewith/unsafeio/Unsafe.conf" ;;+  "config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;+  *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}+   { (exit 1); exit 1; }; };;+  esac+done++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used.  Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files+  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers+fi++# Have a temporary directory for convenience.  Make it in the build tree+# simply because there is no reason to put it here, and in addition,+# creating and moving files from /tmp can sometimes cause problems.+# Create a temporary directory, and hook for its removal unless debugging.+$debug ||+{+  trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0+  trap '{ (exit 1); exit 1; }' 1 2 13 15+}++# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&+  test -n "$tmp" && test -d "$tmp"+}  ||+{+  tmp=./confstat$$-$RANDOM+  (umask 077 && mkdir $tmp)+} ||+{+   echo "$me: cannot create a temporary directory in ." >&2+   { (exit 1); exit 1; }+}++_ACEOF++cat >>$CONFIG_STATUS <<_ACEOF++#+# CONFIG_FILES section.+#++# No need to generate the scripts if there are no CONFIG_FILES.+# This happens for instance when ./config.status config.h+if test -n "\$CONFIG_FILES"; then+  # Protect against being on the right side of a sed subst in config.status.+  sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;+   s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF+s,@SHELL@,$SHELL,;t t+s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t+s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t+s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t+s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t+s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t+s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t+s,@exec_prefix@,$exec_prefix,;t t+s,@prefix@,$prefix,;t t+s,@program_transform_name@,$program_transform_name,;t t+s,@bindir@,$bindir,;t t+s,@sbindir@,$sbindir,;t t+s,@libexecdir@,$libexecdir,;t t+s,@datadir@,$datadir,;t t+s,@sysconfdir@,$sysconfdir,;t t+s,@sharedstatedir@,$sharedstatedir,;t t+s,@localstatedir@,$localstatedir,;t t+s,@libdir@,$libdir,;t t+s,@includedir@,$includedir,;t t+s,@oldincludedir@,$oldincludedir,;t t+s,@infodir@,$infodir,;t t+s,@mandir@,$mandir,;t t+s,@build_alias@,$build_alias,;t t+s,@host_alias@,$host_alias,;t t+s,@target_alias@,$target_alias,;t t+s,@DEFS@,$DEFS,;t t+s,@ECHO_C@,$ECHO_C,;t t+s,@ECHO_N@,$ECHO_N,;t t+s,@ECHO_T@,$ECHO_T,;t t+s,@LIBS@,$LIBS,;t t+s,@build@,$build,;t t+s,@build_cpu@,$build_cpu,;t t+s,@build_vendor@,$build_vendor,;t t+s,@build_os@,$build_os,;t t+s,@PREFIX@,$PREFIX,;t t+s,@TOP@,$TOP,;t t+s,@GHC@,$GHC,;t t+s,@GLASGOW_HASKELL@,$GLASGOW_HASKELL,;t t+s,@HASKELL_SRC@,$HASKELL_SRC,;t t+s,@TEX@,$TEX,;t t+s,@TEX2PAGE@,$TEX2PAGE,;t t+s,@CC@,$CC,;t t+s,@CFLAGS@,$CFLAGS,;t t+s,@LDFLAGS@,$LDFLAGS,;t t+s,@CPPFLAGS@,$CPPFLAGS,;t t+s,@ac_ct_CC@,$ac_ct_CC,;t t+s,@EXEEXT@,$EXEEXT,;t t+s,@OBJEXT@,$OBJEXT,;t t+s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t+s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t+s,@INSTALL_DATA@,$INSTALL_DATA,;t t+s,@LIBOBJS@,$LIBOBJS,;t t+s,@LTLIBOBJS@,$LTLIBOBJS,;t t+CEOF++_ACEOF++  cat >>$CONFIG_STATUS <<\_ACEOF+  # Split the substitutions into bite-sized pieces for seds with+  # small command number limits, like on Digital OSF/1 and HP-UX.+  ac_max_sed_lines=48+  ac_sed_frag=1 # Number of current file.+  ac_beg=1 # First line for current file.+  ac_end=$ac_max_sed_lines # Line after last line for current file.+  ac_more_lines=:+  ac_sed_cmds=+  while $ac_more_lines; do+    if test $ac_beg -gt 1; then+      sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag+    else+      sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag+    fi+    if test ! -s $tmp/subs.frag; then+      ac_more_lines=false+    else+      # The purpose of the label and of the branching condition is to+      # speed up the sed processing (if there are no `@' at all, there+      # is no need to browse any of the substitutions).+      # These are the two extra sed commands mentioned above.+      (echo ':t+  /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed+      if test -z "$ac_sed_cmds"; then+	ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"+      else+	ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"+      fi+      ac_sed_frag=`expr $ac_sed_frag + 1`+      ac_beg=$ac_end+      ac_end=`expr $ac_end + $ac_max_sed_lines`+    fi+  done+  if test -z "$ac_sed_cmds"; then+    ac_sed_cmds=cat+  fi+fi # test -n "$CONFIG_FILES"++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".+  case $ac_file in+  - | *:- | *:-:* ) # input from stdin+	cat >$tmp/stdin+	ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`+	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;+  *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`+	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;+  * )   ac_file_in=$ac_file.in ;;+  esac++  # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.+  ac_dir=`(dirname "$ac_file") 2>/dev/null ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }+  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }+  	  /^X\(\/\/\)$/{ s//\1/; q; }+  	  /^X\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+  { if $as_mkdir_p; then+    mkdir -p "$ac_dir"+  else+    as_dir="$ac_dir"+    as_dirs=+    while test ! -d "$as_dir"; do+      as_dirs="$as_dir $as_dirs"+      as_dir=`(dirname "$as_dir") 2>/dev/null ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }+  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }+  	  /^X\(\/\/\)$/{ s//\1/; q; }+  	  /^X\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+    done+    test ! -n "$as_dirs" || mkdir $as_dirs+  fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}+   { (exit 1); exit 1; }; }; }++  ac_builddir=.++if test "$ac_dir" != .; then+  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`+  # A "../" for each directory in $ac_dir_suffix.+  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`+else+  ac_dir_suffix= ac_top_builddir=+fi++case $srcdir in+  .)  # No --srcdir option.  We are building in place.+    ac_srcdir=.+    if test -z "$ac_top_builddir"; then+       ac_top_srcdir=.+    else+       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`+    fi ;;+  [\\/]* | ?:[\\/]* )  # Absolute path.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir ;;+  *) # Relative path.+    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_builddir$srcdir ;;+esac++# Do not use `cd foo && pwd` to compute absolute paths, because+# the directories may not exist.+case `pwd` in+.) ac_abs_builddir="$ac_dir";;+*)+  case "$ac_dir" in+  .) ac_abs_builddir=`pwd`;;+  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;+  *) ac_abs_builddir=`pwd`/"$ac_dir";;+  esac;;+esac+case $ac_abs_builddir in+.) ac_abs_top_builddir=${ac_top_builddir}.;;+*)+  case ${ac_top_builddir}. in+  .) ac_abs_top_builddir=$ac_abs_builddir;;+  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;+  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;+  esac;;+esac+case $ac_abs_builddir in+.) ac_abs_srcdir=$ac_srcdir;;+*)+  case $ac_srcdir in+  .) ac_abs_srcdir=$ac_abs_builddir;;+  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;+  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;+  esac;;+esac+case $ac_abs_builddir in+.) ac_abs_top_srcdir=$ac_top_srcdir;;+*)+  case $ac_top_srcdir in+  .) ac_abs_top_srcdir=$ac_abs_builddir;;+  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;+  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;+  esac;;+esac+++  case $INSTALL in+  [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;+  *) ac_INSTALL=$ac_top_builddir$INSTALL ;;+  esac++  if test x"$ac_file" != x-; then+    { echo "$as_me:$LINENO: creating $ac_file" >&5+echo "$as_me: creating $ac_file" >&6;}+    rm -f "$ac_file"+  fi+  # Let's still pretend it is `configure' which instantiates (i.e., don't+  # use $as_me), people would be surprised to read:+  #    /* config.h.  Generated by config.status.  */+  if test x"$ac_file" = x-; then+    configure_input=+  else+    configure_input="$ac_file.  "+  fi+  configure_input=$configure_input"Generated from `echo $ac_file_in |+				     sed 's,.*/,,'` by configure."++  # First look for the input files in the build tree, otherwise in the+  # src tree.+  ac_file_inputs=`IFS=:+    for f in $ac_file_in; do+      case $f in+      -) echo $tmp/stdin ;;+      [\\/$]*)+	 # Absolute (can't be DOS-style, as IFS=:)+	 test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5+echo "$as_me: error: cannot find input file: $f" >&2;}+   { (exit 1); exit 1; }; }+	 echo "$f";;+      *) # Relative+	 if test -f "$f"; then+	   # Build tree+	   echo "$f"+	 elif test -f "$srcdir/$f"; then+	   # Source tree+	   echo "$srcdir/$f"+	 else+	   # /dev/null tree+	   { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5+echo "$as_me: error: cannot find input file: $f" >&2;}+   { (exit 1); exit 1; }; }+	 fi;;+      esac+    done` || { (exit 1); exit 1; }+_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF+  sed "$ac_vpsub+$extrasub+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF+:t+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b+s,@configure_input@,$configure_input,;t t+s,@srcdir@,$ac_srcdir,;t t+s,@abs_srcdir@,$ac_abs_srcdir,;t t+s,@top_srcdir@,$ac_top_srcdir,;t t+s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t+s,@builddir@,$ac_builddir,;t t+s,@abs_builddir@,$ac_abs_builddir,;t t+s,@top_builddir@,$ac_top_builddir,;t t+s,@abs_top_builddir@,$ac_abs_top_builddir,;t t+s,@INSTALL@,$ac_INSTALL,;t t+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out+  rm -f $tmp/stdin+  if test x"$ac_file" != x-; then+    mv $tmp/out $ac_file+  else+    cat $tmp/out+    rm -f $tmp/out+  fi++done+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF++#+# CONFIG_HEADER section.+#++# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where+# NAME is the cpp macro being defined and VALUE is the value it is being given.+#+# ac_d sets the value in "#define NAME VALUE" lines.+ac_dA='s,^\([	 ]*\)#\([	 ]*define[	 ][	 ]*\)'+ac_dB='[	 ].*$,\1#\2'+ac_dC=' '+ac_dD=',;t'+# ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE".+ac_uA='s,^\([	 ]*\)#\([	 ]*\)undef\([	 ][	 ]*\)'+ac_uB='$,\1#\2define\3'+ac_uC=' '+ac_uD=',;t'++for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue+  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".+  case $ac_file in+  - | *:- | *:-:* ) # input from stdin+	cat >$tmp/stdin+	ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`+	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;+  *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`+	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;+  * )   ac_file_in=$ac_file.in ;;+  esac++  test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5+echo "$as_me: creating $ac_file" >&6;}++  # First look for the input files in the build tree, otherwise in the+  # src tree.+  ac_file_inputs=`IFS=:+    for f in $ac_file_in; do+      case $f in+      -) echo $tmp/stdin ;;+      [\\/$]*)+	 # Absolute (can't be DOS-style, as IFS=:)+	 test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5+echo "$as_me: error: cannot find input file: $f" >&2;}+   { (exit 1); exit 1; }; }+	 # Do quote $f, to prevent DOS paths from being IFS'd.+	 echo "$f";;+      *) # Relative+	 if test -f "$f"; then+	   # Build tree+	   echo "$f"+	 elif test -f "$srcdir/$f"; then+	   # Source tree+	   echo "$srcdir/$f"+	 else+	   # /dev/null tree+	   { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5+echo "$as_me: error: cannot find input file: $f" >&2;}+   { (exit 1); exit 1; }; }+	 fi;;+      esac+    done` || { (exit 1); exit 1; }+  # Remove the trailing spaces.+  sed 's/[	 ]*$//' $ac_file_inputs >$tmp/in++_ACEOF++# Transform confdefs.h into two sed scripts, `conftest.defines' and+# `conftest.undefs', that substitutes the proper values into+# config.h.in to produce config.h.  The first handles `#define'+# templates, and the second `#undef' templates.+# And first: Protect against being on the right side of a sed subst in+# config.status.  Protect against being in an unquoted here document+# in config.status.+rm -f conftest.defines conftest.undefs+# Using a here document instead of a string reduces the quoting nightmare.+# Putting comments in sed scripts is not portable.+#+# `end' is used to avoid that the second main sed command (meant for+# 0-ary CPP macros) applies to n-ary macro definitions.+# See the Autoconf documentation for `clear'.+cat >confdef2sed.sed <<\_ACEOF+s/[\\&,]/\\&/g+s,[\\$`],\\&,g+t clear+: clear+s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*\)\(([^)]*)\)[	 ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp+t end+s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp+: end+_ACEOF+# If some macros were called several times there might be several times+# the same #defines, which is useless.  Nevertheless, we may not want to+# sort them, since we want the *last* AC-DEFINE to be honored.+uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines+sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs+rm -f confdef2sed.sed++# This sed command replaces #undef with comments.  This is necessary, for+# example, in the case of _POSIX_SOURCE, which is predefined and required+# on some systems where configure will not decide to define it.+cat >>conftest.undefs <<\_ACEOF+s,^[	 ]*#[	 ]*undef[	 ][	 ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */,+_ACEOF++# Break up conftest.defines because some shells have a limit on the size+# of here documents, and old seds have small limits too (100 cmds).+echo '  # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS+echo '  if grep "^[	 ]*#[	 ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS+echo '  # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS+echo '  :' >>$CONFIG_STATUS+rm -f conftest.tail+while grep . conftest.defines >/dev/null+do+  # Write a limited-size here document to $tmp/defines.sed.+  echo '  cat >$tmp/defines.sed <<CEOF' >>$CONFIG_STATUS+  # Speed up: don't consider the non `#define' lines.+  echo '/^[	 ]*#[	 ]*define/!b' >>$CONFIG_STATUS+  # Work around the forget-to-reset-the-flag bug.+  echo 't clr' >>$CONFIG_STATUS+  echo ': clr' >>$CONFIG_STATUS+  sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS+  echo 'CEOF+  sed -f $tmp/defines.sed $tmp/in >$tmp/out+  rm -f $tmp/in+  mv $tmp/out $tmp/in+' >>$CONFIG_STATUS+  sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail+  rm -f conftest.defines+  mv conftest.tail conftest.defines+done+rm -f conftest.defines+echo '  fi # grep' >>$CONFIG_STATUS+echo >>$CONFIG_STATUS++# Break up conftest.undefs because some shells have a limit on the size+# of here documents, and old seds have small limits too (100 cmds).+echo '  # Handle all the #undef templates' >>$CONFIG_STATUS+rm -f conftest.tail+while grep . conftest.undefs >/dev/null+do+  # Write a limited-size here document to $tmp/undefs.sed.+  echo '  cat >$tmp/undefs.sed <<CEOF' >>$CONFIG_STATUS+  # Speed up: don't consider the non `#undef'+  echo '/^[	 ]*#[	 ]*undef/!b' >>$CONFIG_STATUS+  # Work around the forget-to-reset-the-flag bug.+  echo 't clr' >>$CONFIG_STATUS+  echo ': clr' >>$CONFIG_STATUS+  sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS+  echo 'CEOF+  sed -f $tmp/undefs.sed $tmp/in >$tmp/out+  rm -f $tmp/in+  mv $tmp/out $tmp/in+' >>$CONFIG_STATUS+  sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail+  rm -f conftest.undefs+  mv conftest.tail conftest.undefs+done+rm -f conftest.undefs++cat >>$CONFIG_STATUS <<\_ACEOF+  # Let's still pretend it is `configure' which instantiates (i.e., don't+  # use $as_me), people would be surprised to read:+  #    /* config.h.  Generated by config.status.  */+  if test x"$ac_file" = x-; then+    echo "/* Generated by configure.  */" >$tmp/config.h+  else+    echo "/* $ac_file.  Generated by configure.  */" >$tmp/config.h+  fi+  cat $tmp/in >>$tmp/config.h+  rm -f $tmp/in+  if test x"$ac_file" != x-; then+    if diff $ac_file $tmp/config.h >/dev/null 2>&1; then+      { echo "$as_me:$LINENO: $ac_file is unchanged" >&5+echo "$as_me: $ac_file is unchanged" >&6;}+    else+      ac_dir=`(dirname "$ac_file") 2>/dev/null ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }+  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }+  	  /^X\(\/\/\)$/{ s//\1/; q; }+  	  /^X\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+      { if $as_mkdir_p; then+    mkdir -p "$ac_dir"+  else+    as_dir="$ac_dir"+    as_dirs=+    while test ! -d "$as_dir"; do+      as_dirs="$as_dir $as_dirs"+      as_dir=`(dirname "$as_dir") 2>/dev/null ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| \+	 .     : '\(.\)' 2>/dev/null ||+echo X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }+  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }+  	  /^X\(\/\/\)$/{ s//\1/; q; }+  	  /^X\(\/\).*/{ s//\1/; q; }+  	  s/.*/./; q'`+    done+    test ! -n "$as_dirs" || mkdir $as_dirs+  fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}+   { (exit 1); exit 1; }; }; }++      rm -f $ac_file+      mv $tmp/config.h $ac_file+    fi+  else+    cat $tmp/config.h+    rm -f $tmp/config.h+  fi+done+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF++{ (exit 0); exit 0; }+_ACEOF+chmod +x $CONFIG_STATUS+ac_clean_files=$ac_clean_files_save+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded.  So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status.  When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+  ac_cs_success=:+  ac_config_status_args=+  test "$silent" = yes &&+    ac_config_status_args="$ac_config_status_args --quiet"+  exec 5>/dev/null+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+  exec 5>>config.log+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which+  # would make configure fail if this is the last instruction.+  $ac_cs_success || { (exit 1); exit 1; }+fi++
+ configure.ac view
@@ -0,0 +1,142 @@+#+# Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+# LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)+#++# SUBSTs go into config.mk.in (TOP,PREFIX,GHC,INSTAlL)+# AC_DEFINES go into config.h+# only AC_DEFINES are visible in Haskell src++# sanity test+AC_INIT(src/System/Plugins.hs)++# Prepare to generate the config.h.in file+AC_CONFIG_HEADERS([config.h])++# untested on earlier than 2.52, but it won't work anyway+AC_PREREQ(2.53)++# Find out what type of system we're running on+AC_CANONICAL_BUILD++Platform="$build_cpu-$build_vendor-$build_os"++# This isn't right for msys mingw.+PREFIX="$prefix"+if test "$prefix" = "NONE"+then+  if test "$build_os" = "cygwin"+  then+    PREFIX="c:/cygwin$ac_default_prefix"+  else+    PREFIX="$ac_default_prefix"+  fi+fi+AC_SUBST(PREFIX)++case $Platform in+powerpc-apple-darwin*)+        MACOSX=yes+        AC_DEFINE_UNQUOTED(MACOSX, [1], [Defined if compiling on the mac])+        LEADING_UNDERSCORE=1+	;;+*)+        MACOSX=no+        LEADING_UNDERSCORE=0+	;;+esac++if test "$build_os" = "mingw32"+then+  AC_DEFINE(__MINGW32__,[1],[Defined if compiling with mingw])+  LEADING_UNDERSCORE=1+fi++if test "$build_os" = "cygwin"+then+  AC_DEFINE(CYGWIN,[1],[Defined if compiling with mingw])+  LEADING_UNDERSCORE=1+fi++AC_DEFINE_UNQUOTED(LEADING_UNDERSCORE, $LEADING_UNDERSCORE, +                [Whether symbols are prefixed with a leading underscore])++# Find pwd, in a cygwin friendly way. +# Suggested by: http://www.haskell.org/ghc/docs/latest/html/users_guide/ch11s04.html+TOP=`echo "Directory.getCurrentDirectory >>= putStrLn.init.tail.show " | ghc --interactive -ignore-dot-ghci -v0`++AC_DEFINE_UNQUOTED(TOP, "$TOP", [Path to top of build tree])+AC_SUBST(TOP)++# necessary tools++# allow user supplied haskell compiler+AC_ARG_WITH(ghc,+  AC_HELP_STRING([--with-ghc=<ghc>],[use a specific Haskell compiler]),+  [ GHC="$withval" +    if test ! -f "$GHC" ; then+       AC_MSG_ERROR([$GHC not found. You need GHC to build this project])+    fi+  ],+  [ AC_CHECK_PROG(GHC,ghc,ghc)+    if test -z "$GHC" ; then+       AC_MSG_ERROR([You need GHC to build this project])+    fi +  ]+  )+AC_DEFINE_UNQUOTED(WITH_GHC, "$GHC", [Which ghc to use])+AC_SUBST(GHC)++# Work out value of __GLASGOW_HASKELL__+if test -n "$GHC" ; then+ AC_MSG_CHECKING([for value of __GLASGOW_HASKELL__])+ echo "main = print __GLASGOW_HASKELL__" > t.hs+ GLASGOW_HASKELL=`echo 'main' | "$GHC" --interactive -ignore-dot-ghci -v0 -cpp t.hs`+ rm t.hs+ AC_MSG_RESULT([$GLASGOW_HASKELL])+fi+AC_SUBST(GLASGOW_HASKELL)++# find path to GHC libs, for runtime_loader+if test -n "$GHC" ; then+    AC_MSG_CHECKING([for ghc library directory])+    GHC_LIB_PATH=`$GHC --print-libdir`+    AC_MSG_RESULT([$GHC_LIB_PATH])+fi+AC_DEFINE_UNQUOTED(GHC_LIB_PATH, "$GHC_LIB_PATH", [Path to ghc libraries])++# Allow a debugging version of hs-plugins to be built+AC_ARG_ENABLE(debug,+   [  --enable-debug          Enable a debug version of hs-plugins to be built],+   [ +     AC_DEFINE_UNQUOTED(DEBUG, [1], [Defined if a debugging version is to be built]) ],+   [ : ])++# Allow a debugging version of hs-plugins to be built+AC_ARG_ENABLE(hsx,+   [  --enable-hsx          Enable a debug version of hs-plugins to be built],+   [ HASKELL_SRC=haskell-src-exts ;+     AC_DEFINE_UNQUOTED(WITH_HSX, [1], +          [Defined if hs-plugins is to be built with Niklas Broberg's HSX parser]) ],+   [ HASKELL_SRC=haskell-src ])++AC_SUBST(HASKELL_SRC)++AC_CHECK_PROG(TEX,tex,tex)+if test -z "$TEX" ; then+    AC_MSG_WARN(tex is needed to build some of the documentation)+fi+AC_CHECK_PROG(TEX2PAGE,tex2page,tex2page)+if test -z "$TEX2PAGE" ; then+    AC_MSG_WARN(tex2page is needed to build some of the documentation+		    http://www.ccs.neu.edu/home/dorai/tex2page/tex2page-doc.html)+fi++AC_CHECK_FUNCS(arc4random)++AC_PROG_INSTALL++# System.Process uses cmd or command.com shell on Windows, doen't use Cygwin or MSYS shell+AC_CONFIG_FILES([config.mk testsuite/makewith/io/TestIO.conf testsuite/makewith/unsafeio/Unsafe.conf])+AC_OUTPUT+
+ docs/Makefile view
@@ -0,0 +1,31 @@+# Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+# LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)++.PHONY: build clean html++SRC = hs-plugins++build: $(SRC).ps html++$(SRC).ps: $(SRC).dvi+	dvips -f $(SRC).dvi > $@++html: $(SRC).tex+	tex2page $(SRC)+	tex2page $(SRC)+	sed -f munge.sed < $(SRC)/$(SRC).html > tmp.out+	mv tmp.out $(SRC)/$(SRC).html+	cp $(SRC)/$(SRC).html $(SRC)/index.html+	tar czf $(SRC).html.tar.gz $(SRC)+	mv $(SRC).html.tar.gz $(SRC)/++$(SRC).dvi: $(SRC).tex+	latex $(SRC).tex && latex $(SRC).tex++CLEANS= *.{ps,dvi,aux,log} *~ hs-plugins *-Z-* *.toc++clean: +	rm -rf $(CLEANS)++all: doc+
+ docs/haskell.sty view
@@ -0,0 +1,452 @@+%%% This is a LaTeX2e style file.+%%%+%%% It supports setting functional languages like Haskell.+%%%+%%% Manuel M. T. Chakravarty <chak@cse.unsw.edu.au> [1998..2000]+%%%+%%% $Id: haskell.sty,v 1.2 2004/05/16 08:20:09 dons Exp $+%%%+%%% This file 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.+%%%+%%% This file 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.+%%%+%%% Acknowledegments ==========================================================+%%%+%%% Thanks to Gabriele Keller <keller@cs.tu-berlin.de> for beta testing and+%%% code contributions.  Thanks to the LaTeX3 project for improving the LaTeX+%%% sources (which helped me writing this code).  Furthermore, I am grateful+%%% to Martin Erwig <Martin.Erwig@FernUni-Hagen.de> for feedback and+%%% suggestions, and to Conal Elliott <conal@MICROSOFT.com> for pointing out+%%% a tricky bug.+%%%+%%% TODO ======================================================================+%%%+%%% B ~ bug; F ~ feature+%%%+%%% * F: Along the lines of the discussion with Martin Erwig add support for+%%%      keywords etc (see the emails)+%%%+%%% * B: If we have as input +%%%+%%%        \<map+%%%        g\>+%%%+%%%      there won't be a `\hsap' inserted!!  (Can this be solved by using+%%%      \obeylines in \<...\>?)+%%%+%%% * B: A \relax is needed after a & if it immediately followed by a \hsbody{}+%%%   (See TeXbook, S.240)+%%%+%%% * F: Implement a \hstext{...} as \(\text{...}\).+%%%+%%% * We would like hswhere* etc that are like haskell* (\hsalign already+%%%   supports this, ie, there is a \hsalign*).+%%%+%%% * Star-Versions of if, let etc that use a single line layout (maybe not+%%%   with star, because of the above).+%%%+%%% * Support for enforcing and prohibiting breaks in `haskell' displays.+%%%+%%% * Comments in a let-in should be aligned in the same way for the bindings+%%%   and the body.+%%%+%%% * It would be nice to have different styles (indentation after in of+%%%   let-in or not) etc; either to be set with a package option or in the+%%%   preamble (the latter probably makes more sense). +%%%+%%% * Literate programming facility: Variant of the `haskell' env (maybe+%%%   `hschunk', which is named and can be used in other chunks).  But maybe+%%%   it is not necessary to provide a chunk-based reordering mechanism,+%%%   because most of the Haskell stuff can be in any order anyway...+%%%   Important is to provide a way to define visually pleasing layout+%%%   together with the raw Haskell form for program output. (Maybe `haskell*' +%%%   as Haskell env that outputs its contents?)+%%%++%% Initialization+%% ==============++\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{haskell}[2000/10/05 v1.0e Chilli's Haskell Style]+++%% Parameters+%% ==========++\newskip\hsmargin+\hsmargin\leftmargini+++%% Main macros and environments+%% ============================++% applications+%+\newcommand{\hsap}{%                    % application by juxtaposition+  \unskip\mskip 4mu plus 1mu}           %   only the last \hsap counts++% commands to start and stop setting spaces as \hsap+%+{\obeyspaces\gdef\@hsSpaceToApp{\obeyspaces\let =\hsap}}  % spaces matter!!!+{\obeyspaces\gdef\@hsNormalSpace{\let =\space}}++% commands to start and stop treating numbers specially, ie, we don't want+% them to be affected by font changing commands in Haskell contexts as this+% would give italic numerals; the trick is to redefine their math code such+% that they go into math class 0 and thus don't change families (cf. `The+% TeXbook', Chapter 17, pp152)+%+\newcommand{\@hsRmNumbers}{%+  \mathcode`0="0030+  \mathcode`1="0031+  \mathcode`2="0032+  \mathcode`3="0033+  \mathcode`4="0034+  \mathcode`5="0035+  \mathcode`6="0036+  \mathcode`7="0037+  \mathcode`8="0038+  \mathcode`9="0039+  }+\newcommand{\@hsNormalNumbers}{%+  \mathcode`0="7030+  \mathcode`1="7031+  \mathcode`2="7032+  \mathcode`3="7033+  \mathcode`4="7034+  \mathcode`5="7035+  \mathcode`6="7036+  \mathcode`7="7037+  \mathcode`8="7038+  \mathcode`9="7039+  }++% Save the bindings of the standard math commands+%+% This is somewhat subtle as we want to able to enter the original math mode+% within Haskell mode and we have to ensure that the different opening+% commands are matched by the correct versions of the closing commands.+%+\let\@hsmathorg=\(+\let\@hsmathendorg=\)+\let\hs@crorg=\\+\newcommand{\@hsmath}{%+  \relax\hbox\bgroup+  \@hsNormalSpace+  \@hsNormalNumbers+  \let\(=\@hsmathorgx+  \let\)=\@hsmathend+  \def\\{\hs@crorg}%+  \@hsmathorg+  }+\newcommand{\@hsmathend}{%+  \@hsmathendorg+  \egroup+  }+\newcommand{\@hsmathorgx}{%+  \relax\@hsmathorg+  \let\)=\@hsmathendorg+  }++%% Typesetting of Haskell+%% ======================++% Inline Haskell phrases are delimited by `\<' and `\>'.+%+% Note: `\>' is only locally redefined.+% +\newcommand{\<}{%+  \@hsmathorg+  \mathit\bgroup+  \@hsSpaceToApp+  \@hsRmNumbers+  \let\>=\@endhs+  \let\(=\@hsmath  +  \def\\{\cr}           % for Haskell alignments+  }+\newcommand{\@endhs}{%+  \egroup+  \@hsmathendorg+  }++% Displayed Haskell (environment `haskell' and `haskell*')+%+% There are two kind of preambles for \halign: \hs@preambleNorm is for +% `amsmath' style alignments and \hs@preambleStar for `equation' style+% alignments (but with an unbound number of columns to its right)+%+% We need #### to get a ## in the \edef building the \halign command.+%+% first the preambles (also used in \hs@align below):+%+\def\hs@preambleNorm{%+  \noexpand\<####\unskip\noexpand\>\hfil&&\noexpand%+  \<{}####\unskip\noexpand\>\hfil}+\def\hs@preambleStar{%+  \noexpand\<####\unskip\noexpand\>\hfil&\hfil\noexpand%+  \<{}####\unskip{}\noexpand\>\hfil&&\noexpand\<{}####\noexpand\>\hfil}+%+% the environments:+%+\newenvironment{haskell}{%+  \@haskell\hs@preambleNorm}{%+  \@endhaskell+  }+\newenvironment{haskell*}{%+  \@haskell\hs@preambleStar}{%+  \@endhaskell+  }+%+% auxiliary definition getting the preamble as its first argument and starting +% the environment:+%+\def\@haskell#1{%+  \bgroup+  \vspace\abovedisplayskip+  \let\(=\@hsmath               % Important when `\(' occurs after `&'!  +  \edef\@preamble{%+    \halign\bgroup\hskip\hsmargin#1\cr}+  \@preamble+  }+%+% Auxiliary definition ending environment:+%+\def\@endhaskell{%+  \crcr\egroup+  \vspace\belowdisplayskip+  \egroup\noindent\ignorespaces\global\@ignoretrue%+  }++% single line comment and keyword style+%+\newcommand{\hscom}[1]{%+  \relax\(\quad\textnormal{--- #1}\)}+\newcommand{\hskwd}[1]{%+  \mathbf{#1}}++% informal description+%+\newcommand{\hsinf}[1]{%+  \(\langle\textnormal{#1}\rangle\)}++% literals and some special symbols+%+\newcommand{\hschar}[1]{\textrm'\mathrm{#1}\textrm'}  % character literals+\newcommand{\hsstr}[1]{"\mathrm{#1}"}                 % strings literals+\newcommand{\hsfrom}{\leftarrow}                      % <-++% aligned subphrases+%+% check for an optional star and combine prefix (in #1) with one of the two+% preambles (with star means to center the material between the first and+% second &) +%+\def\hs@align#1{%+  \@ifstar+    {\hs@align@pre{#1\hs@preambleStar}}%+    {\hs@align@pre{#1\hs@preambleNorm}}%+  }+%+% test for optional argument; #1: preamble+%+\def\hs@align@pre#1{%+  \@testopt{\hs@align@prealign#1}t}+%+% got all arguments, now for the real code; #1: preamble; #2: alignment; +% #3: body (the material set by the \halign)+%+\def\hs@align@prealign#1[#2]#3{%+  \relax\(+  \edef\@preamble{%+    \halign\bgroup#1\cr}+  \if #2t\vtop \else \if#2b\vbox \else \vcenter \fi\fi+  \bgroup%+    \@preamble+        #3%+    \crcr\egroup%+  \egroup\)+  }+%+% user-level command: alignment without a prefix+%+\newcommand{\hsalign}{%+  \relax+  \hs@align\relax%+  }++% subphrase breaking the surrounding alignment being flushed left+%+\newcommand{\hsnoalign}[1]{%+  \noalign{%+    \hs@align{\hskip\hsmargin}{#1}%+    }%+  }++% body expression breaking the surrounding alignment+%+% * setting \hsmargin to 0pt within the preamble (and _after_ it is used in+%   the preamble) is crucial, as we want \hsmargin only to be applied in+%   _outermost_ alignments+%+\newcommand{\hsbody}[1]{%+  {}\\+  \noalign{%+    \hs@align{\hskip\hsmargin\quad\hsmargin0pt}{#1}%+    }%+  }+++%% Defining commands for use in the Haskell mode+%% =============================================+%%+%% We use some of the low-level machinery defined in LaTeX's source file+%% `ltdefns.dtx'.+%%+%% \hscommand is similar to \newcommand, but there is no *-version.+%%+%% We use our own definitions here to insert a strategic `\relax' (see below)+%% and to obey spaces within the bodies of Haskell definitions.++\newcommand{\hscommand}[1]{\@testopt{\hs@newcommand#1}0}+\def\hs@newcommand#1[#2]{%+  \obeyspaces                           % spaces count in Haskell macros+  \@ifnextchar [{\hs@xargdef#1[#2]}%+                {\hs@argdef#1[#2]}}++% All this trouble only to be able to add the `\relax' into the expansion+% process.  If we don't that, commands without optional arguments when+% invoked after an alignment character & don't work properly (actually, the+% \obeyspaces doesn't work).  I am sure that has to do with the scanning for+% \omit etc in \halign (TeXbook, p240), but I don't understand yet why it+% is problematic in this case.+%+% Furthermore, we switch off \obeyspaces in the end.+%+\long\def\hs@argdef#1[#2]#3{%+   \@ifdefinable#1{%+     \expandafter\def\expandafter#1\expandafter{%+       \relax                % in order to stop token expansion after &+       \csname\string#1\expandafter\endcsname}%+     \expandafter\@yargdef+     \csname\string#1\endcsname+     \@ne+     {#2}%+     {#3}}%+   \catcode`\ =10%           % stop obeying spaces now+   }++% Switch off \obeyspaces in the end.+%+\long\def\hs@xargdef#1[#2][#3]#4{%+  \@ifdefinable#1{%+    \expandafter\def\expandafter#1\expandafter{%+      \expandafter+      \@protected@testopt+      \expandafter+      #1%+      \csname\string#1\expandafter\endcsname+      {#3}}%+    \expandafter\@yargdef+    \csname\string#1\endcsname+    \tw@+    {#2}%+    {#4}}%+  \catcode`\ =10%           % stop obeying spaces now+  }+++%% Abbreviations+%% =============++% infix operators+%+\newcommand{\hsapp}{\mathbin{+\mkern-7mu+}}+\newcommand{\hsifix}[1]{\mathbin{\string`#1\string`}}++% let expression+%+\hscommand{\hslet}[3][t]{%+  \hsalign[#1]{%+    \hskwd{let}\\+    \quad\hsalign{#2}\\+    \hskwd{in}\\+    #3+    }%+  }+  +% if expression+%+\hscommand{\hsif}[4][t]{%+  \hsalign[#1]{%+    \hskwd{if} #2 \hskwd{then}\\+    \quad\hsalign{#3}\\+    \hskwd{else}\\+    \quad\hsalign{#4}% +    }%+  }++% case expression+%+\hscommand{\hscase}[3][t]{%+  \hsalign[#1]{%+    \hskwd{case} #2 \hskwd{of}\\+    \quad\hsalign{#3}%+    }%+  }+  +% where clause+%+% * it is important to take the \quad into the preamble, so that nested+%   \noaligns can break it+%+\hscommand{\hswhere}[1]{%+  \hsbody{%+    \hskwd{where}\\+    \hs@align{\quad}{#1}%+    }%+  }++% do expression+%+\hscommand{\hsdo}[2][t]{%+  \hsalign[#1]{%+    \hskwd{do}\\+    \quad\hsalign{#2}\\+    }%+  }+++%% Extensions for Distributed Haskell (Goffin)+%% ===========================================+%%+%% These definitions may change in the future.++\hscommand{\hsunif}{\mathbin{:=:}}+\hscommand{\hsalias}{\mathrel{\sim}}+\hscommand{\hsoutof}{\twoheadleftarrow}+\hscommand{\hsinto}{\twoheadrightarrow}+\hscommand{\hsparc}{\binampersand}+\hscommand{\hsseq}{\Longrightarrow}+\hscommand{\hsex}[2]{{\hskwd{ex} #1 \hskwd{in} #2}}++\hscommand{\hsexin}[3][t]{%+  \hsalign[#1]{%+    \hskwd{ex} #2 \hskwd{in}\\+    \quad\hsalign{#3}\\+    }%+  }++\hscommand{\hschoice}[2][t]{%+  \hsalign[#1]{%+    \hskwd{choice}\\+    \quad\hsalign{#2}\\+    }%+  }++
+ docs/hs-plugins.1 view
@@ -0,0 +1,36 @@+.TH HS-PLUGINS 1 2005-12-27 "hs-plugins version 1.0" "User Manual"++.SH NAME+hs-plugins \- dynamic linker library for Haskell++.SH DESCRIPTION+.ds c \fIhs-plugins\fP+\*c is a library for loading code written in Haskell into an+application at runtime, in the form of plugins. It also provides a+mechanism for (re-)compiling Haskell source at runtime. Thirdly, a+combination of runtime compilation and dynamic loading provides a set+of eval functions.  Values exported by plugins are transparently+available to Haskell host applications, and bindings exist to use+Haskell plugins from at least C and Objective C programs. hs-plugins+requires GHC 6.4 or later.++.SH DOCUMENTATION+The hs-plugins user manual is distributed in html format, and may be+found at <http://www.cse.unsw.edu.au/~dons/hs-plugins/>++.SH BUGS+Bug reports, and any other feedback, should be sent to+Don Stewart <dons@cse.unsw.edu.au>+.SH COPYRIGHT+Copyright \(co 2003-2005 Don Stewart+.PP+The hs-plugins library modules are distributed under the terms of the+LGPL.+.SH "SEE ALSO"+.BR dlopen (3)++.SH AUTHOR++This manual page was written by Don Stewart, based on the man page for+cpphs (written by Ian Lynagh).+
+ docs/hs-plugins.hdir view
@@ -0,0 +1,1 @@+hs-plugins
+ docs/hs-plugins.tex view
@@ -0,0 +1,1804 @@+\documentclass{article}++\usepackage{url}+\usepackage{tex2page}++% typeset math as ascii+\htmlmathstyle{no-in-text-image no-display-image}++% something other than |+\verbescapechar\&++\cssblock +h1      {font-size: 16pt}+h2      {font-size: 15pt}+\endcssblock ++% color of verbatim elements+\cssblock+.verbatim {color: grey20}++.scheme  .variable  {color: grey20} +.scheme  .keyword   {color: navy}+.scheme  .builtin   {color: maroon}+\endcssblock++% add some extra keywords+\scmkeyword{as case class data default deriving do else hiding if}+\scmkeyword{import in infix infixl infixr instance let module newtype}+\scmkeyword{of qualified then type where forall \\ }+\scmbuiltin{: :: = -> <- @ ~ => - >>= >> }++\newcommand{\code}[1]{{\texttt{#1}}}+\newcommand{\hsplugins}{{\texttt{hs-plugins}}}++\title{hs-plugins\\+       Dynamically Loaded Haskell Modules}++\author{\urlh{http://www.cse.unsw.edu.au/~dons}{Don Stewart}}++\begin{document}++\maketitle++\medskip+%+{\htmlonly \textbf{Download \endhtmlonly +\urlh{ftp://ftp.cse.unsw.edu.au/pub/users/dons/hs-plugins/hs-plugins-1.0.tar.gz}+     {version 1.0}}+%+\medskip++\hsplugins{} is a library for loading code written in Haskell into an+application at runtime, in the form of plugins. It also provides a+mechanism for (re-)compiling Haskell source at runtime. Thirdly, a+combination of runtime compilation and dynamic loading provides a set of+\code{eval} functions-- a form of runtime metaprogramming. Values+exported by Haskell plugins are transparently available to Haskell host+applications, and bindings exist to use Haskell dynamically in C, Perl+and Objective C programs. \hsplugins{} requires GHC 6.4 or later.++\medskip++% grr. double spaced.++\tableofcontents++\newpage++\section{Download}++\begin{itemize}++\item+Download the latest stable release:\\+\url{ftp://ftp.cse.unsw.edu.au/pub/users/dons/hs-plugins/hs-plugins-1.0.tar.gz}++\item+Darcs repository of the latest code:\\+\url{darcs get http://www.cse.unsw.edu.au/~dons/code/hs-plugins}++\item+A tarball of the document you are reading:\\+\url{http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins.html.tar.gz}++\item+A postscript version of the document you are reading:\\+\url{http://www.cse.unsw.edu.au/~dons/hs-plugins/hs-plugins.ps.gz}++\item+Papers:+\begin{itemize}+\item A paper on interesting uses of \hsplugins{} to enable Haskell to be used+as an application extension language:\\+\url{http://www.cse.unsw.edu.au/~dons/papers/PSSC04.html}++\item+A paper on dynamic applications in Haskell, utilizing \hsplugins{}:\\+\url{http://www.cse.unsw.edu.au/~dons/papers/SC05.html}+\end{itemize}++\end{itemize}++It is known to run on \code{i386-\{linux,freebsd,openbsd\}},+\code{sparc-solaris2}, \code{powerpc-\{macosx,linux\}} and flavours of+Windows.++\section{History}++\begin{itemize}+        \item Jan 2006, v1.0+        \begin{itemize}+        \item Cabalised build system+        \item Behave better on 64 bit platforms+        \item Haddock documentation of the API.+        \item A couple of bug fixes+        \end{itemize}++        \item June 2005, v0.9.10+        \begin{itemize}+        \item Support for GHC 6.4, with help from Sean+                        Seefried for the package.conf parser.+        \item Ported to Windows of various flavours thanks to Vivian McPhail and Shelarcy+        \item Removed posix and unix dependencies+        \item Now uses HSX parser, thanks to Niklas Broberg+        \item Extended load interface, thanks to Lemmih+        \item Source now in a darcs repository+        \item Supports building with GNU make -jN+        \item Simplified module hierarchy, moved under System.* namespace+        \item pdynload clarifications, thanks to Alistair Bayley +        \item Miscellaneous bug fixes+        \end{itemize}++	\item February 2005, v0.9.8+        \begin{itemize}+		\item Fix bug in .hi parsing. +		\item Add reloading of packages. +		\item Fix bug in canonical module names +                      (fixing problems with "Foo.o" and "./Foo.o"+		\item Fix for hierarchical names, don't guess them,+			read them from the .hi file.+		\item Add new varients of load.+		\item Fix bug in makeAll, such that dependent module+			changes were not noticed.+		\item Add varient of eval:\code{ unsafeEval\_}, returing+			Either.+		\item Better, bigger testsuite.+		\item Better api.+	\end{itemize}++	\item September 2004.+        \begin{itemize}+		\item makeAll+		\item Better return type for make.+	\end{itemize}++	\item Mid August 2004, v0.9.6 release.+        \begin{itemize}+		\item More portable, thanks to debugging by Niklas Broberg.+		\item Other small fixes to the interfaces.+		\item Provides a runtime-generated printf.+	\end{itemize}++	\item Mid July 2004, added new pdynload strategy.++	\item Mid-June 2004, v0.9.5 release.+        \begin{itemize}+		\item dynamic typing is working++		\item static typing of interfaces is working++		\item Adds \code{eval}, and \code{hs\_eval}++		\item bugs fixed.+        \end{itemize}++        \item Early-June 2004, v0.9.4 release. +        \begin{itemize}++                \item Adds a .hi file parser. We use this to work out+                plugin dependencies directly, meaning no more+                \code{.dep} files or \code{ghcp}. ++                \item It also adds a package.conf parser, meaning we+                can properly handle packages that either aren't stored+                in the normal location, don't have a canonical name,+                or are found using a -package-conf argument. Thanks to+                Sean for this work. ++                \item the interface to load() has changed to allow a+                list of package.conf files to search for packages.++                \item the interace to make() has changed, so that you+                can get back any stderr output produced during plugin+                compilation.++                \item It solves a bug whereby a package that is+                required by another package would not be loaded unless+                the plugin itself depended on this indirect package.++                \item more stable, more examples.+        \end{itemize}++        \item May 2004, v0.9.3 released, adding support for dependency+        conflict resolution between multiple plugins.  Several plugins with+        shared dependencies can now be safely loaded at once. --prefix is now+        respected in ./configure.  Thanks to Sean for this patch.++        \item v0.9.2 change licence to LGPL++        \item v0.9.1 expand on the documentation++        \item v0.9   released, initial source release++\end{itemize}++\section{Acknowledgements}++\begin{itemize}++\item Andr\'e Pang's \code{runtime\_loader} was the inspiration and basis+of the dynamic loader (\url{http://www.algorithm.com.au}).+\hsplugins{} has benefited from many discussions with him,+particularly to do with dependency checking and dynamic typing, and+bug reports. Andr\'e wrote an objective C binding to hs-plugins, and+helped with the design of eval(). He also fixed GHC so we could load+the dynamic loader dynamically.++\item Sean Seefried (\url{http://www.cse.unsw.edu.au/~sseefried}) was+the first user of \hsplugins{} and his code and feedback have helped+make the library much more useful and powerful.++\item Manuel Chakravarty's \code{take} system provided the basis for+\code{make}, and helped with several issues to do with safety of+plugins, apis and the applications that use them.+Manuel also helped with the design of eval(), and on how to+successfully evaluate polymorphic functions using rank-N types.++\item Simon Marlow helped with several issues to do with linking and+loading static and dynamic code, and provided many useful suggestions.++\item Hampus Ram's dynamic loader+(\url{http://www.dtek.chalmers.se/~d00ram/dynamic/}) provided the+design of the state maintained by the loader, and for thread safety+issues relating to this.++\item Shae Erisson provided several insights into more powerful uses+of the library. Thanks to everyone on \#haskell who provided+discussion about the library.++\item Malcolm Wallace's \code{hmake} provided some useful insights in+how to compile Haskell source in a way that makes it appear like an+interpreter, used in the interactive environment: \code{plugs}.++\item Niklas Broberg helped a lot by testing, and providing feedback for+the new make and load API. Thanks Niklas.++\item Finally, thanks to everyone who has worked on GHC and its+libraries: for GHCi, the .hi interface parser, the package system, and+all the other code the \hsplugins{} depends on.++\end{itemize}++\newpage++\section{Overview}++\hsplugins{} is a library for compiling and loading Haskell code into a+program at runtime. It allows you to write Haskell code (which may+be spread over multiple modules), and have an application (implemented in+any language with a Haskell FFI binding, including Haskell) load and use+your code at runtime.++\hsplugins{} provides 3 major features:+%+\begin{itemize}+        \item a dynamic loader,+        \item a compilation manager, and+        \item a Haskell evaluator+\end{itemize}++The \emph{dynamic loader} loads objects into the address space of an+application, along with any dependencies the plugin may have. The+loader is a binding to the GHC runtime system's dynamic linker, which+does single object loading. GHC also performs the necessary linking of+new objects into the running process. On top of the GHC loader is a+Haskell layer that arranges for module and package dependencies to be+found prior to loading individual modules.++The \emph{compilation manager} is a \code{make}-like system for+compiling Haskell source code into a form suitable for loading.  While+plugins are normally thought of as strictly object code, there are a+variety of scenarios where it is desirable to be able to inspect the+source code of a plugin, or to be able to recompile a plugin at runtime.+The compilation manager fills this role. It is particularly useful in+the implementation of \code{eval}.++The \emph{evaluator}, \code{eval}, utilizes the loader and compilation+manager. When passed a string containing a Haskell expression, it+compiles the string to object code, loads the result, and returns a+Haskell value representing the compiled string to the caller. It can be+considered a Haskell interpreter, implemented as a library, and can be+used to embed Haskell evaluation facilities in an application.++\section{Dynamic Loader}++The interface to the \hsplugins{} library can be divided into a number+of sections representing the functional units of the library.+Additionally, depending on the level of trust the application places+in the plugins, a variety of additional checks can be made on the+plugin as it is loaded. The levels of type safety possible are+summarised at the end of Section \ref{sec:compilation-manger} section.+The dynamic loader is available by using \code{-package plugins}.++\subsection*{Interface}+%+\begin{quote}+\scm{+import System.Plugins++load :: FilePath +     -> [FilePath] +     -> [PackageConf] +     -> Symbol +     -> IO (LoadStatus a)+}++\scm{+load_ :: FilePath +      -> [FilePath] +      -> Symbol +      -> IO (LoadStatus a)+}++\scm{+data LoadStatus a+    = LoadSuccess Module a +    | LoadFailure Errors+}+\end{quote}+%+Example:+%+\begin{quote}+\scm{+do mv <- load "Plugin.o" ["api"] [] "resource"+   case mv of+	LoadFailure msg -> print msg+	LoadSuccess _ v -> return v+}+\end{quote}+%+This is the basic interface to the dynamic loader. Load the object file+specified by the first argument into the address space (the library will+preload any module or package dependencies). The second argument is an+include path to any additional objects to load (possibly the API of the+plugin). The third argument is a list of paths to any user-defined+\code{package.conf} files, specifying packages unknown to the GHC+package system. \code{Symbol} is a string specifying the symbol name you+wish to lookup. \code{load} returns a \code{LoadStatus} value representing+failure, or an abstract representation of the module (for calls to+\code{unload} or \code{reload}) with the symbol as a Haskell value. The+value returned must be given an explicit type signature, or provided+with appropriate type constraints such that GHC can determine the+expected type returned by \code{load}.++\code{load\_} is provided for the common situation where no user-defined+package.conf files are required.++\begin{quote}+\scm{+dynload :: Typeable a    +        => FilePath  +        -> [FilePath]+        -> [PackageConf]+        -> Symbol+        -> IO (LoadStatus a)+}+\end{quote}+%+Example:+%+\begin{quote}+\scm{+do mv <- dynload "Plugin.o" ["api"] ["plugins.conf.inplace"] "resource"+   case mv of+	LoadFailure msg -> print msg+	LoadSuccess _ v -> putStrLn v+}+\end{quote}+%+\code{dynload} is a safer form of \code{load}. It uses dynamic types+to perform a check on the value returned by \code{load} at runtime, to+ensure that it has the type the application expects it to have.++In order to use \code{dynload}, the symbol the plugin exports must be+of type \code{AltData.Dynamic:Dynamic}. (See the \code{AltData} library+distributed with \hsplugins{}, and the \hsplugins{}+\code{examples/dynload} directory. References to \code{Typeable} and+\code{Dynamic} refer to the \hsplugins{} reimplementation of these+libraries. \code{AltData.Dynamic} is used at the moment, as there is a+limitation in the existing Data.Dynamic library in the presence of+dynamic loading).++The value wrapped up in the \code{Dynamic} must be an instance of+\code{AltData.Typeable}. If the value exported by the plugin \emph{is}+of type \code{Dynamic}, and the value wrapped by the \code{Dynamic}+does not match the type expected of it by the application,+\code{dynload} will return \code{Nothing}, indicating that the plugin+is not typesafe with respect to the application. If the value passes+the typecheck, \code{dynload} will return \code{LoadSuccess}. If the value+exported by the plugin is \emph{not} of type \code{Dynamic},+\code{dynload} will crash---this is a limitation of the existing+\code{Dynamic} library, it can only type-check \code{Dynamic} values.+Additionally, Data.Dynamic is limited to monomorphic types, or must be+wrapped inside a rank-N type to hide the polymorphism from the+typechecker. This is a bit cumbersome. An alternative typesafe+\code{load} is available via the \code{pdynload} interface, which is+able to enforce the type of the plugin using GHC's type inference+mechanism, and is not restricted in its expressiveness (at the cost of+greater load times):++\begin{quote}+\scm{+pdynload :: FilePath+         -> [FilePath]+         -> [PackageConf]+         -> Type+         -> Symbol+         -> IO (LoadStatus a)+}++\scm{+pdynload_ :: FilePath+          -> [FilePath]+          -> [PackageConf]+          -> [Arg]+          -> Type+          -> Symbol+          -> IO (LoadStatus a)+}+\end{quote}+%+Example:+%+\begin{quote}+\scm{+do v <- pdynload "Plugin.o" ["api"] [] "API.Interface" "resource"+   case v of+	LoadSuccess _ a  -> putStrLn "yay!"+	_                -> putStrLn "type error"+}+\end{quote}+%+\code{pdynload} is a replacement for \code{dynload}, which provides a+solution to the various problems caused by the existing dynamics+library in Haskell. Rather than use normal dynamics, which constrain+us to monomorphic types only (or rank-N types), it instead uses GHC's+type inference to unify the plugin's export value with that provided+by the api (via its .hi file).  It is a form of \emph{staged type inference}+for module interfaces, allowing plugins to use any type definable in Haskell.+\code{pdynload} is like \code{dynload}, but requires a new \code{Type}+argument. This can be considered a type annotation on the value the plugin+should be constrained to.++Prior to loading the object, \code{pdynload} generates a tiny Haskell+source file containing, for example:+%+\begin{quote}+\scm{+module APITypeConstraint where+import qualified API+import qualified Plugin++_ = Plugin.resource :: API.Interface+}+\end{quote}+%+It then calls GHC's type checker on this file, which runs the full+Haskell type inference machinery. If the file typecheckes, then the+plugin type is correct, and the plugin is safe to load, otherwise it+is an error. ++Because we use the full Haskell type checker, we can have a form of+dynamic typechecking, on any type expressable in Haskell. A plugin's+value may, for example, have class constraints -- something not+checkable using the standard Dyanmic type. The cost is that+\code{pdynload} is roughly 46\% slower than an unchecked load.+ +The type of the plugin's resource field must be equivalent to the+\code{Type}. There are some restrictions on the arguments that may be+passed to pdynload. Currently, we require:+        \begin{itemize}+        \item The object name has the suffix (.o) removed and this+        becomes a qualified module name in the generated type-checker+        input file.++        \item The type name must be a single fully-qualified+        type-identifier, as the module name is stripped off (i.e.+        everything up to the last ".") and used as a qualified import.+        This means that you can't use, for example, \code{"Int ->+        String"} as a type (type synonyms are fine, though).++\end{itemize}++For example, \code{pdynload "API2.o" ["./"] [] "API.PluginAPI"+"doAction"} generates:++\begin{quote}+\scm{+module <temp-generated-name> where+import qualified API    -- comes from API.PluginAPI argument+import qualified API2   -- comes from API2.o argument+_ = API2.doAction :: API.PluginAPI+}+\end{quote}++\begin{quote}+\scm{+unload :: Module -> IO ()+}++\scm{+unloadAll :: Module -> IO ()+}+\end{quote}++Unload an object, \emph{but not its dependencies} from the address+space. \code{unloadAll} performs cascading unloading of a module+\emph{and} its dependencies.++\begin{quote}+\scm{+reload :: Module -> Symbol -> IO (LoadStatus a)+}+\end{quote}++Unload, and then reload a module that must have been previously+loaded.  Doesn't reload the dependencies. \code{reload} is useful in+conjunction with \code{make}---a call to \code{reload} can be+performed if \code{make} has recompiled the plugin source.++Additionally, some support is provided to manipulation of +libraries of Haskell modules (usually known as packages):++\begin{quote}+\scm{+loadPackage     :: String -> IO ()++unloadPackage   :: String -> IO ()++loadPackageWith :: String -> [PackageConf] -> IO ()+}+\end{quote}++\code{loadPackage} explcitly pulls in a library (which must be visible+in the current package namespace. \code{unloadPackage} unloads it.+\code{loadPackageWith} behaves like \code{loadPackage}, but you are able+to supply extra package.confs to augment the library search path.++Examples:+\begin{quote}+\scm{+do loadPackageWith "yi" ["yi.conf"]+   unloadPackage "yi-0.1"+}+\end{quote}++\newpage++\section{Compilation Manager}++The compilation manager is the system by which Haskell source code is+compiled to object code suitable for loading.++\subsection*{Interface}++\begin{quote}+\scm{+import System.Plugins++make :: FilePath +     -> [Arg] +     -> IO MakeStatus++makeAll :: FilePath +        -> [Arg] +        -> IO MakeStatus++recompileAll :: Module +             -> [Arg] +             -> IO MakeStatus++data MakeStatus +        = MakeSuccess MakeCode FilePath +        | MakeFailure Errors++data MakeCode = ReComp | NotReq+}+\end{quote}++Compile a Haskell source file to an object file, with any arguments+specified in the argument list passed through to GHC.  Returns the+build status.++\code{make} generates a GHC \code{.hi} file containing a list of+package and objects that the source depends on. Subsequent calls to+\code{load} will use this interface file to load module and library+dependencies prior to loading the object itself. \code{makeAll} also+recursively compiles any dependencies it can find using GHC's+\code{--make} flag.++\code{recompileAll} is like \code{makeAll}, but rather than relying on+\code{ghc --make}, we explicitly check a module's dependencies.++\begin{quote}+\scm{+merge   :: FilePath -> FilePath -> IO MergeStatus++mergeTo :: FilePath -> FilePath -> FilePath -> IO MergeStatus++mergeToDir :: FilePath -> FilePath -> FilePath -> IO MergeStatus++data MergeStatus +        = MergeSuccess MergeCode Args FilePath +        | MergeFailure Errors++type MergeCode = MakeCode+}+\end{quote}++The merging operation is extremely useful for providing extra default+syntax. An EDSL user then need not worry about declaring module names,+or having required imports.  In this way, the stub file can also be+used to provide syntax declarations that would be inconvenient to+require of the plugin author. \code{merge} will include any import and+export declarations written in the stub, as well as any module name,+so that plugin author's need not worry about this compulsory syntax.+Additionally, if a plugin requires some non-standard library, which+must be provided as a \code{-package} flag to GHC, they may specify+this using the non-standard \code{GLOBALOPTIONS} pragma.  Options+specified in the source this way will be added to the command line.+This is useful for users who wish to use GHC flags that cannot be+specified using the conventional \code{OPTIONS} pragma. The merging+operation uses the HSX parser library to parse Haskell source files.++\code{mergeTo} behaves like \code{merge}, but we can specify the file in+which to place output. \code{mergeToDir} lets you specify a directory in+which to place merged files.++\begin{quote}+\scm{+makeWith :: FilePath+         -> FilePath+         -> [Arg]+         -> IO MakeStatus+}+\end{quote}++This is a variety of \code{make} that first calls \code{merge} to+combine the plugin source with a syntax stub. The result is then+compiled. This is the preferred interface to EDSL authors who wish to+add extra syntax to a user's source. It is important to note that the+module and types from the second file argument are used to override+any of those that appear in the first argument. For example, consider+the following source files:++\begin{quote}+\scm{+module A where++a :: Integer+a = 1+}+\end{quote}++\begin{quote}+\scm{+module B where++a :: Int+}+\end{quote}++Calling \code{makeWith "A" "B" []} will merge the module name and types+from module B into module A, generating a third file:++\begin{quote}+\scm{+{-# LINE 1 "A.hs" #-}+module MxYz123 where++{-# LINE 3 "B.hs" #-}+a :: Int+{-# LINE 4 "A.hs" #-}+a = 1+}+\end{quote}++Leading to the desired result that we can ignore user-supplied module+names and types. Knowing the module name, in particular, is important+for dynamic loading, which requires the module name be known when+searching for symbols.++\begin{quote}+\scm{+hasChanged :: Module -> IO Bool+}+\end{quote}++\code{hasChanged} returns \code{True} if the module or any of its+dependencies have older object files than source files. Defaults to+\code{True} if some files couldn't be located.++\subsection*{Levels of Safety}++The normal dynamic loader, using \code{load} on object files only,+places full trust in the author of the plugin to provide a type-safe+object file, containing valid code. This can be mitigated somewhat via+the use of \code{make} to ensure that the plugin is at least Haskell+code that is well-typed internally (if we trust GHC to compile it+correctly). ++If we trust the user to provide an interface of \code{Dynamic} type, we+can check the plugin type at runtime, but the plugin's value must be+\code{Typeable}, which restricts it to be a monomorphic type (or to+using rank-N tricks). ++The greatest safety can be obtained by using \code{pdynload}, at the+cost of increased load times. \code{pdynload} essentially performs full+type inference on the plugin interface at runtime. The type safety of+the plugin, using \code{pdynload}, is then as safe as if the plugin was+statically compiled into the application. It does not provide any+\emph{further} safety than exists in static compilation. For example, it+does not preclude the use of (evil) \code{unsafeCoerce\#} to defeat+type-checking, either statically or at runtime. An extensive discussion+of type safe plugin loading is available in the \hsplugins{} paper+\urlh{http://www.cse.unsw.edu.au/~dons/hs-plugins/paper}{here}.++\newpage++\section{Eval.Haskell}++\code{eval}, and its siblings, provide a mechanism to compile and run+Haskell code at runtime, in the form of a String. The general framework+is that the string is used to create a plugin source file, which is+compiled and loaded, and type checked against its use. The resulting+value is returned to the caller. It resembles a runtime metaprogramming+\code{run} operator for closed code fragments.++\subsection*{Interface}++\begin{quote}+\scm{+import System.Eval.Haskell++eval :: Typeable a => String -> [Import] -> IO (Maybe a)++eval_ :: Typeable a =>+         String      -- code to compile+      -> [Import]    -- any imports+      -> [String]    -- extra ghc flags+      -> [FilePath]  -- extra package.conf files+      -> [FilePath]  -- include search paths+      -> IO (Either [String] (Maybe a))+}+\end{quote}++\code{eval} takes a string, and a list of import module names, and+returns a \code{Maybe} value. \code{Nothing} means the code did not+compile, or did not typecheck at its splice point. \code{Just v} gives+you \code{v}, the result of evaluating your code. It is interesting to+note that \code{eval} has the type of an interpreter. The+\code{Typeable} constraint is used to type check the evaluated code when+it is loaded, using \code{dynload}.  As usual, \code{eval\_} is a+version of \code{eval} that lets you pass extra flags to ghc and to the+dynamic loader.++The existing \code{Data.Dynamic} library requires that only monomorphic+values are \code{Typeable}, so in order to evaluate polymorphic+functions you need to wrap them up using rank-N types. Some examples:+%+\begin{quote}+\scm{+import System.Eval.Haskell++main = do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int)+          if isJust i then putStrLn (show (fromJust i)) else return ()+}+\end{quote}+ +When executed this program calls \code{eval} to compile and load the+simple arithmetic expression, returning the result, which is+displayed. If the value loaded is not of type \code{Int},+\code{dynload} will throw an exception.+ +The following example, due to Manuel Chakravarty, shows how to+evaluate a polymorphic function. Polymorphic values are not easily+made dynamically typeable, but this example shows how to do it. The+module \code{Poly} is imported as the second argument, providing the+type of the polymorphic function:+%+\begin{quote}+\scm{+import Poly+import System.Eval.Haskell++main = do m_f <- eval "Fn (\\x y -> x == y)" ["Poly"]+          when (isJust m_f) $ do+                let (Fn f) = fromJust m_f+                putStrLn $ show (f True True)+                putStrLn $ show (f 1 2)+}+\end{quote}+% +And the type of \code{Fn}:+%+\begin{quote}+\scm{+{-# OPTIONS -fglasgow-exts #-} +module Poly where++import AltData.Typeable++data Fn = Fn {fn :: forall t. Eq t => t -> t -> Bool}++instance Typeable Fn where+    typeOf _ = mkAppTy (mkTyCon "Poly.Fn") []+}+\end{quote}+% +When executed, this program produces:+%+\begin{quote}+\begin{verbatim}+$ ./a.out+True+False+\end{verbatim}+\end{quote}++We thus get dynamically typeable polymorphic functions.++\begin{quote}+\scm{+unsafeEval :: String -> [Import] -> IO (Maybe a)++unsafeEval_ :: String+            -> [Import]+            -> [String]+            -> [FilePath]+            -> IO (Either [String] a)+}+\end{quote}++Wrapping up polymorphic values can be annoying, so we provide a+\code{unsafeEval} function for people who like to live on the edge,+which dispenses with dynamic typing, relying instead on the+application to provide the correct type annotation on the call to+\code{eval}. If the type loaded by \code{eval} is wrong,+\code{unsafeEval} will crash. However, its lets us remove some+restrictions on what types can be evaluated, which can be useful.++{unsafeEval\_} lets the application have full control over the import+environment and load flags to the eval call, which is useful for+applications that wish to script themselves, and require specific+modules and packages to be in scope in the eval-generated module.++This example maps a \code{toUpper} over a list:+%+\begin{quote}+\scm{+import Eval.Haskell++main = do s <- unsafeEval "map toUpper \"haskell\"" ["Data.Char"]+          when (isJust s) $ putStrLn (fromJust s)+}+\end{quote}+ +And here we evaluate a lambda abstraction, applying the result to+construct a tuple. Note the type information that must be supplied in+order for Haskell to type the usage of \code{fn}:+%+\begin{quote}+\scm{+import System.Eval.Haskell++main = do fn <- unsafeEval "(\\(x::Int) -> (x,x))" [] :: IO (Maybe (Int -> (Int,Int)))+          when (isJust fn) $ putStrLn $ show $ (fromJust fn) 7+}+\end{quote}+\subsection{Utilities for use with eval}+\code{hs-plugins} proves the following utilities for use with \code{eval}:+\begin{itemize}+\item+\code{mkHsValues} is a helper function for converting \code{Data.Map}s+of names and values into Haskell code. It relies on the assumption+that the passed values' Show instances produce valid Haskell+literals (this is true for all prelude types). It's type is as follows:+\begin{quote}+\scm{+mkHsValues :: (Show a) => Data.Map String a -> String+}+\end{quote}+\end{itemize}+% \subsection{Foreign Eval}+% +% A preliminary binding to \code{eval} has been implemented to allow C+% (and Objective C) programs access to the evaluator. Foreign bindings+% to the compilation manager and dynamic loader are yet to be+% implemented, but shouldn't be too hard. An foreign binding to a+% Haskell module that wraps up calls to \code{make} and \code{load}+% would be fairly trivial.+%  +% At the moment we have an ad-hoc binding to \code{eval}, so that C+% programmers who know the type of value that will be returned by+% Haskell can call the appropriate hook into the evaluator. If they get+% the type wrong, a nullPtr will be returned (so calling Haskell is+% still typesafe). The foreign bindings to \code{eval} all return+% \code{NULL} if an error occurred, otherwise a pointer to the value is+% returned.+% +% \begin{quote}+% \scm{+% foreign export ccall hs_eval_b :: CString -> IO (Ptr CInt)+% +% foreign export ccall hs_eval_c :: CString -> IO (Ptr CChar)+%   +% foreign export ccall hs_eval_i :: CString -> IO (Ptr CInt)+% +% foreign export ccall hs_eval_s :: CString -> IO CString+% }+% \end{quote}+% +% An example C program for compiling and evaluating Haskell code at+% runtime follows. This program calculates a fibonacci number, returning+% it as a \code{CString} to the C program:+% %+% \begin{quote}+% \begin{verbatim}+% #include "EvalHaskell.h"+% #include <stdio.h>+% +% int main(int argc, char *argv[])+% {+%   char *p;+%   hs_init(&argc, &argv);+%   p = hs_eval_s("show $ let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20");+%   if (p != NULL)+%      printf("%s\n",p);+%   else+%      printf("error in code\n");+%   hs_exit();+%   return 0;+% }+% \end{verbatim}+% \end{quote}+% ++\section{RTS Binding}++The low level interface is the binding to GHC's Linker.c. Therefore,+\hsplugins{} only works on platforms with a working GHCi. This library+is based on code from André Pang's runtime loader. The low level+interface is as follows:++\begin{itemize}+      \item \code{initLinker}  \em  start the linker up +      \item \code{loadObject}  \em  load a vanilla .o+      \item \code{loadPackage} \em  load a GHC library and its cbits+      \item \code{loadShared } \em  load a .so object file+      \item \code{resolveObjs} \em  and resolve symbols+\end{itemize}++Additionally, \code{Hi.Parser} provides an interface to a GHC+\code{.hi} file parser. Currently we only parse just the dependency+information, import and export information from \code{.hi} files, but+all the code is there for an application to extract other information+from \code{.hi} files.++\newpage++\section{Dynamic Loader Implementation}++The dynamic loader is the system by which modules, and their+dependencies can be loaded, unloaded or reloaded at runtime, and+through which we access the functions we need.++At its lowest level, the \hsplugins{} loader is a binding to the GHC+runtime loader and linker. This layer is a direct reimplementation of+Andre Pang's \code{runtime\_loader} (barely any code changed). The+code at this level can only load single modules, or packages/archives+(which are just objects too). Any dependency resolution must be+performed by hand.++On top of Andre's interface is a more convenient interface through+which user's should interact with the dynamic loader.  The most+significant extension to Andre's work is the automatic calculation and+loading of a plugin's package or module dependencies via .hi file+information.  It also handles initialisation of the loader, and+retrieval of values from the plugin in a more convenient way. Some+state is also stored in the loader to keep track of which modules and+packages have been loaded, to prevent unnecessary (actually, fatal)+loading of object files and packages already loaded.  Thus you can+safely load several plugins at once, that share common dependencies,+without worrying about the dependencies being loaded multiple times.+We also store package.conf information in the state, so we can work+out where a package lives and what it depends on.++The ability to remember which packages and objects have been loaded is+based on ideas in Hampus Ram's dynamic loader, which has a more+advanced dependency tracking system, with the ability to unload the+dependencies of a plugin. \hsplugins{} doesn't provide ``cascading+unloading''. The advantage \hsplugins{} has over Hampus' loader seems+to be the automatic dependency resolution via vanilla .hi files and+the dynamic recompilation stuff.++Using \code{load}, any library packages, or any \code{.o} files, that a+plugin depends upon will be automatically loaded prior to loading the+module itself. \code{load} then looks up a symbol from the object file,+and returns the value associated with the symbol as a conventional+Haskell value. It should also be possible to load a GHCi-style \code{.o}+archive of object files this way, although there is currently no way+to extract multple plugin interfaces from a archive of objects.++The application writer is not required to recalculate dependencies if+the plugin changes, and the plugin author does not need to specify+what dependencies exist, as is required in the lower level interface.+This is achieved by using the dependency information calculated by GHC+itself, stored in .hi files, to work out which modules and packages to+load, and in what order. A plugin in \hsplugins{} is really a pair of+an object file (or archive) and a \code{.hi} file, containing package+and module dependency information.  ++The \code{.hi} file is created by GHC when the plugin is compiled,+either by hand or via \code{make}.  \code{load} uses a binary parser to+extract the relevant information from the \code{.hi} data. Because the+dependency information is stored in a separate file to the application+that loads the plugin, such information can be recalculated without+having to modify the application. Becaues of this, it was easy to+extend the load to support recompilation of module source, even if+dependencies change, because dependencies are no longer hard-coded+into the application source itself, but are specified by the plugin.++Assuming we have a plugin exporting some data, ``resource'', with a+record name \code{field :: String}, here is an example call to \code{load}:+%+\begin{quote}+\scm{+do m_v   <- load "Test.o" ["."] [] "resource"+   v <- case m_v of+          LoadSuccess _ v -> return v+          _               -> error "load failed"+   putStrLn $ field v+}+\end{quote}++This loads the object file \code{Test.o}, and any packages or objects+\code{Test.o} depends on. It resolves undefined symbols, and returns+from the object file the Haskell value named ``resource'', as the+value ``v''. This must be a value exported by the plugin. We then+retrieve the \code{field} component of \code{v}, and print it out.++This simple usage assumes that the plugin to load is in the same+directory as the application, and that the api defining the interface+between plugin and application is also in the current directory (hence+the ``.'' in the 2nd argument to \code{load}).++\subsection*{Dynamically Loading the Dynamic Loader}++It is also possible to load the \code{plugins} or \code{eval}+libraries in GHC. Here, for example, we load the \code{plugs}+interactive environment in GHCi, and evaluated some code. The source to+\code{plugs} is in Appendix+\ref{sec:plugs}.+%+\begin{quote}+\begin{verbatim}+paprika$ ghci -package-conf ../../../plugins.conf.inplace -package eval+   ___         ___ _+  / _ \ /\  /\/ __(_)+ / /_\// /_/ / /  | |      GHC Interactive, version 6.3, for Haskell 98.+/ /_\\/ __  / /___| |      http://www.haskell.org/ghc/+\____/\/ /_/\____/|_|      Type :? for help.++Loading package base ... linking ... done.+Loading package altdata ... linking ... done.+Loading package unix ... linking ... done.+Loading package mtl ... linking ... done.+Loading package lang ... linking ... done.+Loading package posix ... linking ... done.+Loading package haskell98 ... linking ... done.+Loading package haskell-src ... linking ... done.+Loading package plugins ... linking ... done.+Loading package eval ... linking ... done.+Prelude> :l Main+Skipping  Main             ( Main.hs, Main.o )+Ok, modules loaded: Main.+Prelude Main> main+Loading package readline ... linking ... done.+           __                          +    ____  / /_  ______ ______          +   / __ \/ / / / / __ `/ ___/     PLugin User's GHCi System, for Haskell 98+  / /_/ / / /_/ / /_/ (__  )      http://www.cse.unsw.edu.au/~dons/hs-plugins+ / .___/_/\__,_/\__, /____/       Type :? for help     +/_/            /____/                  ++Loading package base ... linking ... done+plugs> map (\x -> x + 1) [0..10]+[1,2,3,4,5,6,7,8,9,10,11]+plugs> :t "haskell"+"haskell" :: [Char]+plugs> :q+*** Exception: exit: ExitSuccess+Prelude Main> :q+Leaving GHCi.+\end{verbatim}+\end{quote}++\subsection*{Dynamic Typing}++Support is also provided to unwrap and check the type of dynamically+typed plugin values (those wrapper in a \code{toDyn}) via+\code{dynload}. This is the same as \code{load}, except that instead+of a returning the value it finds, it unwraps a dynamically typed+value, checks the type, and returns the unwrapped value. This is to+provide further trust that the symbol you are retrieving from the+plugin is of the type you think it is, beyond that trust you have by+knowing that the plugin was compiled against a shared API. By using+\code{dynload} it is not enough for an object file to just have the+same symbol name as the function you require, it must also carry the+\code{Data.Dynamic} representation of the type, too. \code{pdynload}+rectifies most of \code{dynload}'s limitations, but at the cost of+additional running time.++\section{Compilation Manager Implementation}++Along side the dynamic loader is the compilation manager.  This is a+\code{make}-like system for compiling Haskell source, prior to loading+it. \code{make} checks if a source file is newer than its associated+object file. If so, the source is recompiled to an object file, and a+new dependency file is created, in case the dependencies have changed+in the source. This module can then be loaded.  The idea is to allow+EDSL authors to write plugins without having to touch a compiler: it+is all transparent. It also allows us to enforce type safety in the+plugin by injecting type constraints into the plugin source, as has+been discussed eariler.++The effect is much like \emph{hi} (Hmake Interactive), funnily enough.+An application using both \code{make} and \code{load} behaves like a+Haskell interpreter, using \code{eval}.  You modify your plugin, and+the application notices the change, recompiles it (possibly issuing+type errors) and then reloads the object file, providing the+application with the latest version of the code.+ +An example:+%+\begin{quote}+\scm{+do status <- make "Plugin.hs" []+   obj    <- case status of+                MakeSuccess _ o -> return o+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"++   m_v    <- load obj ["api"] [] "resource"+   v      <- case m_v of+            	LoadSuccess _ v -> return v+            	_               -> error "load failed"+   putStrLn $ field v+}+\end{quote}++\code{make} accepts a source file as an argument, and a (usually empty)+list of GHC flags needed to compile the object file. It then checks to+see if compilation is required, and if so, it calls GHC to compile the+code, with and arguments supplied. If any errors were generated by+GHC, they are returned as the third component of the triple.++Usually it will be necessary to ensure that GHC can find the plugin+API to compile against. This can be done by either making sure the API+is in the same directory as the plugin, or by adding a \code{-i} flag to+\code{make}'s arguments. If the API is created as a ``package'' with a+package.conf file, \code{make} can be given \code{-package-conf} arguments+to the same effect.++Normally, \code{make} generates the \code{.o} and \code{.hi} files in+the same directory as the source file. This is not always desirable,+particularly for interpreter-like applications. To solve this, you can+pass \code{[''-odir'', path]} as elements of the arg list to+\code{make}, and it will respect these arguments, generating the+object and interface file in the directory specified. GHC's argument+\code{''-o''} is also respected in a similar manner, so you could also+say \code{[''-o'', obj]} for the same effect.++\code{make} is entirely optional. All user's have to do to use the+loader on its own is make sure they only load object files that also+have a \code{.hi} file. This will usually be the case if the plugin is+compiled with GHC.++\subsection*{makeWith}++\code{makeWith} merges two source files together, using the function+and value declarations from one file, with any syntax in the second,+creating a new third source file. It then compiles this source file+via \code{make}.++This function exists as a benefit to EDSL authors and is related to+the original motivation for \hsplugins{}, as a .conf file language+library. Configuration files need to be clean and simple, and you+can't rely, or trust, the user to get all the compulsory details+correct. So the solution is to factor out any compulsory syntax, such+as module names, imports, and also to provide a default instance of+the API, and store this code in a separate file provided by the+application writer, not the user.  \code{makeWith} then merges+whatever the user has written, with the syntax stub, generating a+complete Haskell plugin source, with the correct module names and+import declarations. We also ensure the plugin only exports a single+interface value while we are here.++\code{makeWith} thus requires a Haskell parser to parse two source files+and merge the results. We are merging abstract syntax here. This is+implemented using the Language.Haskell parser library. Unfortunately,+this library doesn't implement all of GHC's extensions, so if you wish+to use \code{makeWith} you can only write Haskell source that can be+parsed by this library, which is just H98 and a few extensions. This+is another short coming in the current design that will be overcome+with \code{-package ghc}. Remember, however, for normal uses of+\code{make} and \code{load} you are unrestricted in what Haskell you use.+This is the same restriction present in happy, the Haskell parser,+placed on the code you can provide in the \code{.y} source.++\code{makeWith} also makes use of line pragmas. If the merged file+fails to compile, the judicious use of line number pragmas ensure that+the user receives errors messages reported with reference to their+source file, and not line number in the merged file. This is a+property of the Language.Haskell parser that we can make use of.++An example of \code{makeWith}:+%+\begin{quote}+\scm{+do status <- makeWith "Plugin.in" "Plugin.stub" []+   obj <- case status of+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"+                MakeSuccess _ o -> return o+   m_v  <- load obj [apipath] [] "resource"+   v <- case m_v of+                LoadSuccess _ v -> return v+                _               -> error "load failed"+   putStrLn $ field v+}+\end{quote}++We combine the user's file (\code{Plugin.in}) with a stub of syntax+generating a new, third Haskell file in the default tmpdir. This is+compiled as per usual, producing object and interface files. The+object is then loaded, and we extract the value exported.++Using \code{makeWith} it is possible to write very simple, clear+Haskell plugins, that appear not to be Haskell at all. It is an easy+way to get EDSL user's writing plugins that are actually Haskell+programs, for .e.g, configuration files. See the examples that come+with the src.++\newpage++\section{An Example}++This is an introductory example.++\subsection*{API}++First we need an interface between the application and the plugin.+This module needs to be visible to both the app and the plugin, in the+interest of clear and well-defined interfaces: +%+\begin{quote}+\scm{+module StringProcAPI (Interface(..), plugin) where++data Interface = Interface {+       stringProcessor :: String -> String+}++plugin :: Interface+plugin = Interface { stringProcessor = id }+}+\end{quote}++Here we define \code{Interface} as the inteface signature for the+object passed between plugin and application. We'll use the record+syntax as it looks intuitive in the plugin. We provide a default+instance, the \code{plugin} value, that can be overwritten in the+actual plugin, ensuring sensible behaviour in the absence of any+plugins. The API should theoretically be compiled with \code{-Onot} to+avoid interface details leaking out into the \code{.hi} file.++\subsection*{The Plugin}++This is our plugin. Note that the plugin will be compiled entirely+seperately from the application. It must only rely on the API, and+nothing in the application source.+%+\begin{quote}+\scm{+module StringProcPlugin (resource) where++import StringProcAPI (plugin)++resource = plugin {+     stringProcessor = reverse +}+}+\end{quote}++Using the record syntax we overwrite the \code{function} field with our+own value, \code{reverse}. The value \code{resource} is the magic symbol+that must be defined, and which the application will use to find the+data the plugin exports.++Now, we can make this even easier on the plugin writer by the use of a+``stub'' file. \code{makeWith} lets you merge a plugin source with+another Haskell file, and compiles the result into the actual plugin+object. So the application can provide a stub file containing module+declarations and imports, and a default plugin value. Here is an+application-provided stub, factoring out compulsory syntax and type+declarations from the plugin:+%+\begin{quote}+\scm{+module StringProcPlugin ( resource ) where++import StringProcAPI++resource :: Interface+resource = plugin+}+\end{quote}++By factoring out compulsory syntax, the plugin author only has to+provide an overriding instance of the \code{resource} field. So all+the plugin actually consists of, is:+%+\begin{quote}+\scm{+resource = plugin {+      stringProcessor = reverse+}+}+\end{quote}++That is all the code we need! This file may be called anything at all.++More complex APIs may have more fields, of course. The nice thing+about this arrangement is that the user will write some simple syntax,+which will nonetheless by typechecked safely against the API. Errors+are also reported using line numbers from the source file, not the+stub, which makes things less confusing.++\subsection*{The Application}++Now we need to write an application that can use values of the kind+defined in the API, and which can compile and load plugins. The basic+mechanism to compile and load a plugin is as follows:+%+\begin{quote}+\scm{+do status <- make "StringProcPlugin.hs" []+   obj    <- case status of+                MakeSuccess _ o -> return o+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"++   m_v    <- load obj ["."] [] "resource"+   val    <- case m_v of+                LoadSuccess _ v -> return v+                _               -> error "load failed"+}+\end{quote}+%+This code calls \code{make} to compile the plugin source, yielding+wrapper around a handle to an object file. The object can then be loaded+using \code{load}, and the code associated with the symbol+\code{resource} is retrieved. ++We embed this code in a simple shell-like loop, applying the function+exported by the plugin:+%+\begin{quote}+\scm{+import System.Plugins+import StringProcessorAPI+import System.Console.Readline+import System.Exit++source = "Plugin.hs"+stub   = "Plugin.stub"+symbol = "resource"++main = do s <- makeWith source stub []+          o <- case s of+                MakeSuccess _ obj -> do+                        ls <- load obj ["."] [] symbol+                        case ls of LoadSuccess m v -> return (m,v)+                                   LoadFailure err -> error "load failed"+                MakeFailure e -> mapM_ putStrLn e >> error "compile failed"+          shell o++shell o@(m,plugin) = do +        s <- readline "> "+        cmd <- case s of +                Nothing          -> exitWith ExitSuccess+                Just (':':'q':_) -> exitWith ExitSuccess+                Just s           -> addHistory s >> return s++        s  <- makeWith source stub []   -- maybe recompile the source+        o' <- case s of+                MakeSuccess ReComp o -> do +                        ls <- reload m symbol+                        case ls of LoadSuccess m' v' -> return (m',v')+                                   LoadFailure err   -> error "reload failed"+                MakeSuccess NotReq _ -> return o+                MakeFailure e -> mapM_ putStrLn e >> shell o+        eval cmd o'+        shell o'++eval ":?" _ = putStrLn ":?\n:q\n<string>"++eval s (_,plugin) = let fn = (stringProcessor plugin) in putStrLn (fn s)+}+\end{quote}++We have to import the hs-plugins library, and the API. The main loop+proceeds by compiling and loading the plugin for the first time, and+then calls \code{shell}, the interpeter loop. This loop lets us apply+the function in the plugin to strings we supply.  We have to pass+around the \code{(Module, a)} pair we get back from \code{reload}, so+that we can pass it to \code{eval} to do the real work.  The first+\code{eval} case is where we use the record syntax to select the+\code{function} field out of \code{v}, the plugin interface object,+and we apply it to s. Try it out:+%+\begin{quote}+\begin{verbatim}+paprika$ ./a.out +Loading package base ... linking ... done+Loading objects API Plugin ... done+> :?+":?"+":q"+"<string>"+> abcdefg+gfedcba+\end{verbatim}+\end{quote}++Now, if we edit the plugin while the shell is running, the next time+we type something at the prompt the plugin will be unloaded,+recompiled and reloaded. Because the plugin is really an EDSL, we can+use any Haskell we want, so we'll change the plugin to:+%+\begin{quote}+\scm{+import Data.Char++resource = plugin {+	stringProcessor = my_fn+}++my_fn s = map toUpper (reverse s)+}+\end{quote}++Back to the shell:+%+\begin{quote}+\begin{verbatim}+> abcdefg +Compiling plugin ... done+Reloading Plugin ... done+GFEDCBA+\end{verbatim}+\end{quote}++And that's it: dynamically recompiled and reload Haskell code!++\section{Multiple Plugins}++It is quite easy to load multiple plugins, that all implement the+common plugin API, and that all export the same value (though+implemented differently). This make \hsplugins{} suitable for+applications that wish to allow an arbitrary number of plugins. The+main problem with multiple plugins is that they may share+dependencies, and if \code{load} na\"ively loaded all dependencies+found in the set of \code{.hi} files associated with all the plugins,+the GHC rts would crash. To solve this the \hsplugins{} dynamic loader+maintains state storing a list of what modules and packages have been+loaded already. If \code{load} is called on a module that is already+loaded, or dependencies are attempted to load, that have already been+loaded, the dynamic loader ignores these extra dependencies. This+makes it quite easy to write an application that will allows an+arbitrary number of plugins to be loaded. An example follows.++\subsection*{Definition}++First we need to define the API that a plugin must type check against,+in order to be valid.  +%+\begin{quote}+\scm{+module API where++data Interface = Interface { +	valueOf :: String -> String +}++plugin :: Interface +plugin = Interface { valueOf = id }+}+\end{quote}++We can then implement a number of plugins that provide values of type+"Interface". We show three plugins that export string manipulation functions:+%+\begin{quote}+\scm{+module Plugin1 where++import API+import Data.Char++resource = plugin {+	valueOf = \s -> map toUpper s+}+}+\end{quote}++\begin{quote}+\scm{+module Plugin2 where++import API+import Data.Char++resource = plugin {+	valueOf = \s -> map toLower s+}+}+\end{quote}++\begin{quote}+\scm{+module Plugin3 where++import API++resource = plugin {+	valueOf = reverse+}+}+\end{quote}++And finally we need to write an application that would use these+plugins. Remember that the application is written without knowledge of+the plugins, and the plugins are written without knowledge of the+application. They are each implemented only in terms of the API, a+shared module and \code{.hi} file. An application needs to make the+API interface available to plugin authors, by distributing the API+object file and \code{.hi} file with the application.+%+\begin{quote}+\scm{+import System.Plugins+import API++main = do+ let plist = ["Plugin1.o", "Plugin2.o", "Plugin3.o"]+ plugins <- mapM (\p -> load p ["."] [] "resource") plist+ let functions = map (valueOf . fromLoadSuc) plugins+ mapM_ (\f -> putStrLn $ f "haskell is for hackers") functions++fromLoadSuc (LoadFailure _)   = error "load failed"+fromLoadSuc (LoadSuccess _ v) = v++}+\end{quote}++This application simply loads all the plugins and retrieves the+functions they export. It then applies each of these functions to a+string, printing the result. We assume for this example that the+plugins are compiled once only, and are not compiled dynamically via+\code{make}. This implies that you have to use \code{GHC} to generate+the \code{.hi} file for each plugin. A sample Makefile to compile the+plugins, and the api:+%+\begin{quote}+\begin{verbatim}+all:+    ghc -Onot -c API.hs+    ghc -O -c Plugin1.hs+    ghc -O -c Plugin2.hs+    ghc -O -c Plugin3.hs+\end{verbatim}+\end{quote}++Ghc creates \code{.hi} files for each plugin, which can be inspected+using the \code{Plugins.BinIface.readBinIface} function. It parses the+\code{.hi} file, generating, roughly, the following:+%+\begin{quote}+\begin{verbatim}+interface "Main" Main+module dependencies: A, B+package dependencies: base, haskell98, lang, unix+\end{verbatim}+\end{quote}++which says that the plugin depends upon a variety of system packages,+and the modules A and B. All these dependencies must be loaded before+the plugin itself.++You then need to compile the application against the API, and against+the \hsplugins{} library:+%+\begin{quote}+\begin{verbatim}+ghc -O --make -package plugins Main.hs+\end{verbatim}+\end{quote}++Running the application produces the following result. Note that the+verbose output can be switched off by compiling \hsplugins{} without+the \code{-DDEBUG} flag. If you look at the \code{.hi} file, using+\code{ghc --show-iface}, you'll see that they all depend on the base+package, and on the API, but the state stored in the dynamic loader+ensures that these shared modules are only loaded once:+%+\begin{quote}+\begin{verbatim}+Loading package base ... linking ... done+Loading object API Plugin1 ... done+Loading object Plugin2 ... done+Loading object Plugin3 ... done++HASKELL IS FOR HACKERS+haskell is for hackers+srekcah rof si lleksah+\end{verbatim}+\end{quote}++Archives of plugins can be loaded in one go if they have been linked+into a .o GHCi package, see \code{loadPackage}.++\newpage++\appendix++\section{License} ++This library is distributed under the terms of the LGPL:++\begin{quote}++Copyright 2003-5, Don Stewart - \url{http://www.cse.unsw.edu.au/~dons}++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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+USA++\end{quote}++\section{Portability}++The library tries to be portable. There are two major points that+limit easy portabilty. The main issue is a dependence on the GHC dynamic+linker. \hsplugins{} is thus limited to platforms to which GHC's dyn+linker has been ported (this is essentially the same as the platforms+that can run GHCi).++\newpage++\section{A Haskell Interpreter using Plugins}+% \label{sec:plugs}++Here is a full length example of a Haskell interpreter/compiler in the+style of Malcolm Wallace's \code{hi}. Rather than compiling the+user's code to an executable, we use \hsplugins{} to instead load an+object file and execute that instead, using the \code{eval} interface.+This cuts out the linking phase from the process, making turnaround at+the prompt around twice as fast as \code{hi}.++\subsection*{Source of Plugs}++\begin{quote}+\scm{+import System.Eval.Haskell+import System.Plugins++import System.Exit              ( ExitCode(..), exitWith )+import System.IO+import System.Console.Readline  ( readline, addHistory )++symbol = "resource"++main = do+        putStrLn banner +        putStr "Loading package base" >> hFlush stdout+        loadPackage "base" +        putStr " ... linking ... " >> hFlush stdout+        resolveObjs+        putStrLn "done"++        shell []++shell :: [String] -> IO ()+shell imps = do +        s <- readline "plugs> "+        cmd <- case s of +                Nothing          -> exitWith ExitSuccess+                Just (':':'q':_) -> exitWith ExitSuccess+                Just s           -> addHistory s >> return s+        imps' <- run cmd imps+        shell imps'++run :: String -> [String] -> IO [String]+run ""   is = return is+run ":?" is = putStrLn help >> return is++run ":l" _             = return []+run (':':'l':' ':m) is = return (m:is)++run (':':'t':' ':s) is = do +        ty <- typeOf s is+        when (not $ null ty) (putStrLn $ s ++ " :: " ++ ty)+        return is++run (':':_) is = putStrLn help >> return is++run s is = do +        s <- unsafeEval ("show $ "++s) is+        when (isJust s) (putStrLn (fromJust s))+        return is++banner = "\ +\           __                          \n\+\    ____  / /_  ______ ______          \n\+\   / __ \\/ / / / / __ `/ ___/     PLugin User's GHCi System, for Haskell 98\n\+\  / /_/ / / /_/ / /_/ (__  )      http://www.cse.unsw.edu.au/~dons/hs-plugins\n\+\ / .___/_/\\__,_/\\__, /____/       Type :? for help     \n\+\/_/            /____/                  \n"++help = "\+\Commands :\n\ +\  <expr>               evaluate expression\n\ +\  :t <expr>            show type of expression (monomorphic only)\n\ +\  :l module            bring module in to scope\n\ +\  :l                   clear module list\n\ +\  :quit                quit\n\ +\  :?                   display this list of commands"+}+\end{quote}++\subsection*{A Transcript}++And a transcript:+%+\begin{quote}+\begin{verbatim}+$ ./plugs+           __                          +    ____  / /_  ______ ______          +   / __ \/ / / / / __ `/ ___/     PLugin User's GHCi System, for Haskell 98+  / /_/ / / /_/ / /_/ (__  )      http://www.cse.unsw.edu.au/~dons/hs-plugins+ / .___/_/\__,_/\__, /____/       Type :? for help     +/_/            /____/                  ++Loading package base ... linking ... done+plugs> 1+1+plugs> let x = 1 + 2 in x+3+plugs> :l Data.List+plugs> case [1,3,2] of x -> sort x+[1,2,3]+plugs> reverse [1,3,2]+[2,3,1]+plugs> map (\x -> (x,2^x)) [1,2,3,4,5,6,7,8,9,10]+[(1,2),(2,4),(3,8),(4,16),(5,32),(6,64),(7,128),(8,256),(9,512),(10,1024)]+plugs> :t "haskell"+"haskell" :: [Char]+plugs> :quit+\end{verbatim}+\end{quote}++\end{document}
+ docs/munge.sed view
@@ -0,0 +1,16 @@++# de-boldify and <p>-ify the Contents.++/Contents/ { +	:loop+	/Go to/ { +		b end+	}+	s,<p>,,+        s,<b>,,+        s,</b>,,+        s,</p>,,+	n+	b loop+}+:end
+ docs/tex2page.sty view
@@ -0,0 +1,9 @@+% tex2page.sty+% Dorai Sitaram++% Loading this file in a LaTeX document+% gives it all the macros of tex2page.tex,+% but via a more LaTeX-convenient filename.++\input{tex2page}+
+ docs/tex2page.tex view
@@ -0,0 +1,1381 @@+% tex2page.tex+% Dorai Sitaram++% TeX files using these macros+% can be converted by the program+% tex2page into HTML++\message{version 2003-10-26} % last change ++\let\texonly\relax+\let\endtexonly\relax++\texonly++\newcount\evalQauxfilecount+\evalQauxfilecount=0++\def\eval{\begingroup+  \ifx\evalfortexQport\UNDEFINED+    \expandafter\csname newwrite\endcsname+      \evalfortexQport+    \immediate\openout\evalfortexQport+      \jobname.eval4tex +    \immediate\write\evalfortexQport+      {\string\ifx\string\shipout\string\UNDEFINED+         \string\eval{(eval-for-tex-only)}%+       \string\else\string\endinput\string\fi}%+  \fi+  \global\advance\evalQauxfilecount by 1+  \edef\evalQauxfile{\jobname-Z-E-\the\evalQauxfilecount}%+  {\immediate\openin0=\evalQauxfile.tex +   \ifeof0 \immediate\closein0 +   \else \input \evalQauxfile.tex \fi}%+  \def\do##1{\catcode`##1=12 }\dospecials+  \catcode`\{=1 \catcode`\}=2 +  \catcode`\^^M=12 +  \newlinechar=`\^^M%+  \evalQii}++\def\evalQii#1{%+  \immediate\write\evalfortexQport{\string\eval{#1}}%+  \endgroup}++%\def\verbwritefile#1 {\relax}+%\let\verbwrite\gobbleencl++\def\verbwritefile{%+  \ifx\verbwritefileQport\UNDEFINED+    \expandafter\csname newwrite\endcsname\verbwritefileQport +  \else\immediate\closeout\verbwritefileQport+  \fi+  \futurelet\verbwritefileQnext\verbwritefileQcheckchar}++\def\verbwritefileQcheckchar{%+  \ifx\verbwritefileQnext\bgroup+    \let\verbwritefileQnext\verbwritefileQbracedfile+  \else+    \let\verbwritefileQnext\verbwritefileQspacedfile+  \fi\verbwritefileQnext}++\def\verbwritefileQspacedfile#1 {%+  \immediate\openout\verbwritefileQport #1+}++\def\verbwritefileQbracedfile#1{%+  \verbwritefileQspacedfile #1+}++\def\verbwrite{%+  \ifx\verbwritefileQport\UNDEFINED+    \verbwritefile \jobname.txt \fi+  \begingroup+    \def\do##1{\catcode`##1=12 }\dospecials+    \catcode`\{=1 \catcode`\}=2 +    \catcode`\^^M=12 \newlinechar=`\^^M%+    \futurelet\verbwriteQopeningchar\verbwriteQii}++\def\verbwriteQii{\ifx\verbwriteQopeningchar\bgroup+  \let\verbwriteQiii\verbwriteQbrace\else+  \let\verbwriteQiii\verbwriteQnonbrace\fi+  \verbwriteQiii}++\def\verbwriteQbrace#1{\immediate+  \write\verbwritefileQport{#1}\endgroup}++\def\verbwriteQnonbrace#1{%+  \catcode`\{12 \catcode`\}12+  \def\verbwriteQnonbraceQii##1#1{%+    \immediate\write\verbwritefileQport{##1}\endgroup}%+  \verbwriteQnonbraceQii} ++\ifx\loadonlyQevalfortex1%+  \let\maybeloadfollowing\endinput+\else+  \let\maybeloadfollowing\relax+\fi\maybeloadfollowing++\ifx\slatexignorecurrentfile\UNDEFINED\relax\fi++\edef\atcatcodebeforetiip{\the\catcode`\@ }+\catcode`\@11++% margins++\def\sidemargin{\afterassignment\sidemarginQadjustoffset+  \hoffset}++\def\sidemarginQadjustoffset{%+  \advance\hoffset -1true in+  \advance\hsize -2\hoffset}++\def\vertmargin{\afterassignment\vertmarginQadjustoffset+  \voffset}++\def\vertmarginQadjustoffset{%+  \advance\voffset -1true in+  \advance\vsize -2\voffset}++%++\def\defcsactive#1{\defnumactive{`#1}}++\def\defnumactive#1{\catcode#1\active+  \begingroup\lccode`\~#1%+    \lowercase{\endgroup\def~}}++% gobblegobblegobble++\def\gobblegroup{\bgroup+  \def\do##1{\catcode`##1=9 }\dospecials+  \catcode`\{1 \catcode`\}2 \catcode`\^^M=9+  \gobblegroupI}++\def\gobblegroupI#1{\egroup}++\def\gobbleencl{\bgroup+  \def\do##1{\catcode`##1=12 }\dospecials+  \catcode`\{1 \catcode`\}2 \catcode`\^^M=9+  \futurelet\gobbleenclnext\gobbleenclI}++\def\gobbleenclI{\ifx\gobbleenclnext\bgroup+    \let\gobbleenclnext\gobblegroupI+  \else\let\gobbleenclnext\gobbleenclII\fi+  \gobbleenclnext}++\def\gobbleenclII#1{%+  \def\gobbleenclIII##1#1{\egroup}%+  \gobbleenclIII}++% \verb+% Usage: \verb{...lines...} or \verb|...lines...|+% In the former case, | can be used as escape char within+% the verbatim text++\let\verbhook\relax++\def\verbfont{\tt}+%\hyphenchar\tentt-1++\def\verbsetup{\frenchspacing+  \def\do##1{\catcode`##1=12 }\dospecials+  \catcode`\|=12 % needed?+  \verbfont+  \edef\verbQoldhyphenchar{\the\hyphenchar\font}%+  \hyphenchar\font-1+  \def\verbQendgroup{\hyphenchar\font\verbQoldhyphenchar\endgroup}%+}++% The current font is cmtt iff fontdimen3 = 0 _and_+% fontdimen7 != 0++\def\checkifusingcmtt{\let\usingcmtt n%+  \ifdim\the\fontdimen3\the\font=0.0pt+    \ifdim\the\fontdimen7\the\font=0.0pt+    \else\let\usingcmtt y\fi\fi}++% In a nonmonospaced font, - followed by a letter+% is a regular hyphen.  Followed by anything else, it is a+% typewriter hyphen.++\def\variablelengthhyphen{\futurelet\variablelengthhyphenI+  \variablelengthhyphenII}++\def\variablelengthhyphenII{\ifcat\noexpand\variablelengthhyphenI+ a-\else{\tt\char`\-}\fi}++\def\verbavoidligs{% avoid ligatures+  \defcsactive\`{\relax\lq}%+  \defcsactive\ {\leavevmode\ }%+  \defcsactive\^^I{\leavevmode\ \ \ \ \ \ \ \ }%+  \defcsactive\^^M{\leavevmode\endgraf}%+  \checkifusingcmtt+  \ifx\usingcmtt n%+  \defcsactive\<{\relax\char`\<}%+  \defcsactive\>{\relax\char`\>}%+  \defcsactive\-{\variablelengthhyphen}%+  \fi}++\def\verbinsertskip{%+  \let\firstpar y%+  \defcsactive\^^M{\ifx\firstpar y%+    \let\firstpar n%+    \verbdisplayskip+    \parskip 0pt+    \aftergroup\verbdisplayskip+    \else\leavevmode\fi\endgraf}%+  \verbhook}++\ifx\verb\UnDeFiNeD\else+% Save LaTeX's \verb away, because+% we'll be defining our own \verb+\let\LaTeXverb\verb+\fi++%\def\verb{\begingroup+%  \verbsetup\verbI}++\def\verb{\begingroup+  \verbsetup\verbavoidligs\verbQcheckstar}++\def\verbQcheckstar{%+  \futurelet\verbQcheckstarQnext\verbQcheckstarQii}++\def\verbQcheckstarQii{%+  \if\verbQcheckstarQnext*%+    \let\verbQcheckstarQnext\verbQcheckstarQiii+  \else+    \let\verbQcheckstarQnext\verbI+  \fi+  \verbQcheckstarQnext}++\def\verbQcheckstarQiii#1{%+  \defcsactive\ {\relax\char`\ }%+  \verbI}++\def\verbc{\begingroup+  \verbsetup\afterassignment\verbcI+  \let\verbcII=}++\def\verbcI{{\verbfont\verbcII}\endgroup}++\let\E\verbc++\newcount\verbbracebalancecount++\def\verblbrace{\char`\{}+\def\verbrbrace{\char`\}}++\def\verbescapechar#1{%+  \def\escapifyverbescapechar{\catcode`#1=0 }}++\verbescapechar\|++{\catcode`\[1 \catcode`\]2+\catcode`\{12 \catcode`\}12+\gdef\verbI#1[%\verbavoidligs+  \verbinsertskip\verbhook+  %\edef\verbQoldhyphenchar{\the\hyphenchar\tentt}%+  %\hyphenchar\tentt=-1+  %\def\verbQendgroup{\hyphenchar\tentt\verbQoldhyphenchar\endgroup}%+  %\let\verbQendgroup\endgroup%+  \if#1{\escapifyverbescapechar+    \def\{[\char`\{]%+    \def\}[\char`\}]%+    \def\|[\char`\|]%+    \verbbracebalancecount0+    \defcsactive\{[\advance\verbbracebalancecount by 1+      \verblbrace]%+    \defcsactive\}[\ifnum\verbbracebalancecount=0+      \let\verbrbracenext\verbQendgroup\else+      \advance\verbbracebalancecount by -1+      \let\verbrbracenext\verbrbrace\fi+      \verbrbracenext]\else+  \defcsactive#1[\verbQendgroup]\fi+  \verbII+]]++\def\verbII{\futurelet\verbIInext\verbIII}++{\catcode`\^^M\active%+\gdef\verbIII{\ifx\verbIInext^^M\else%+  \defcsactive\^^M{\leavevmode\ }\fi}}++\let\verbdisplayskip\medbreak++% \verbatiminput FILENAME+% displays contents of file FILENAME verbatim.++%\def\verbatiminput#1 {{\verbsetup\verbavoidligs\verbhook+%  \input #1 }}++% ^ original \verbatiminput++\ifx\verbatiminput\UNDEFINED+% LaTeX's (optional) verbatim package defines a \verbatiminput --+% don't clobber it+\def\verbatiminput{%+  \futurelet\verbatiminputQnext\verbatiminputQcheckchar}%+\fi++\def\verbatiminputQcheckchar{%+  \ifx\verbatiminputQnext\bgroup+    \let\verbatiminputQnext\verbatiminputQbracedfile+  \else+    \let\verbatiminputQnext\verbatiminputQspacedfile+  \fi\verbatiminputQnext}++\def\verbatiminputQbracedfile#1{\verbatiminputQdoit{#1}}++\def\verbatiminputQspacedfile#1 {\verbatiminputQdoit{#1}}++\def\verbatiminputQdoit#1{{\verbsetup+  \verbavoidligs\verbhook+  \input #1 }}+++% \url{URL} becomes+% <a href="URL">URL</a> in HTML, and+% URL in DVI.++% A-VERY-VERY-LONG-URL in a .bib file+% could be split by BibTeX+% across a linebreak, with % before the newline.+% To accommodate this, %-followed-by-newline will+% be ignored in the URL argument of \url and related+% macros.++\ifx\url\UnDeFiNeD+\def\url{\bgroup\urlsetup\let\dummy=}%+\fi++\def\urlsetup{\verbsetup\urlfont\verbavoidligs+  \catcode`\{1 \catcode`\}2+  \defcsactive\%{\urlpacifybibtex}%+  \defcsactive\ {\relax}%+  \defcsactive\^^M{\relax}%+  \defcsactive\.{\discretionary{}{\char`\.}{\char`\.}}%+  \defcsactive\/{\discretionary{\char`\/}{}{\char`\/}}%+  \defcsactive\`{\relax\lq}}++\let\urlfont\relax++\def\urlpacifybibtex{\futurelet\urlpacifybibtexnext\urlpacifybibtexI}++\def\urlpacifybibtexI{\ifx\urlpacifybibtexnext^^M%+  \else\%\fi}++% \mailto{ADDRESS} becomes+% <a href="mailto:ADDRESS">ADDRESS</a> in HTML, and+% ADDRESS in DVI.++\let\mailto\url++% \urlh{URL}{TEXT} becomes+% <a href="URL">TEXT</a> in HTML, and+% TEXT in DVI.++% If TEXT contains \\, the part after \\ appears in+% the DVI only.  If, further, this part contains \1,+% the latter is replaced by a fixed-width representation+% of URL.++\def\urlh{\bgroup\urlsetup+  \afterassignment\urlhI+  \gdef\urlhQurlarg}++\def\urlhI{\egroup+  \bgroup+    \let\\\relax+    \def\1{{\urlsetup\urlhQurlarg}}%+    \let\dummy=}++\def\urlp#1{{#1} \bgroup\urlsetup+  \afterassignment\urlpQwrapparens+  \gdef\urlpQurlarg}++\def\urlpQwrapparens{\egroup+  {\rm(}{\urlsetup\urlpQurlarg}{\rm)}}++% \urlhd{URL}{HTML-TEXT}{DVI-TEXT} becomes+% <a href="URL">HTML-TEXT</a> in HTML, and+% DVI-TEXT in DVI++\def\urlhd{\bgroup+  \def\do##1{\catcode`##1=12 }\dospecials+  \catcode`\{1 \catcode`\}2+  \urlhdQeaturlhtmlargs}++\def\urlhdQeaturlhtmlargs#1#2{\egroup}++\ifx\hyperref\UnDeFiNeD+\let\href\urlh+\let\hypertarget\gobblegroup+\let\hyperlink\gobblegroup+\def\hyperref#1#2#3#4{#2\ref{#4}#3}+\fi++%++\let\ignorenextinputtimestamp\relax++% don't let caps disable end-of-sentence spacing++\def\nocapdot{%+\count255=`\A+\loop+\sfcode\the\count255=1000+\ifnum\count255<`\Z+\advance\count255 by 1+\repeat+}++%++%\ifx\newenvironment\UnDeFiNeD+\let\htmlonly\iffalse+\let\endhtmlonly\fi+%\else+%\usepackage{comment}+%\excludecomment{htmlonly}+%\fi++\def\rawhtml{\errmessage{Can't occur outside+  \string\htmlonly}}+\def\endrawhtml{\errmessage{Can't occur outside+  \string\htmlonly}}++\let\htmlheadonly\iffalse+\let\endhtmlheadonly\fi++\let\cssblock\iffalse+\let\endcssblock\fi++\def\inputcss#1 {\relax}+\let\htmlstylesheet\inputcss+\let\htmladdimg\gobblegroup++\def\htmlref{\bgroup\aftergroup\gobblegroup\let\dummy=}++%++\let\htmlcolophon\gobblegroup+\let\htmlmathstyle\gobblegroup+\let\htmladvancedentities\relax++% Scheme++\let\scm\verb+\let\scminput\verbatiminput++\let\scmwritefile\verbwritefile+\let\scmwrite\verbwrite+\let\scmdribble\scm++\ifx\slatexversion\UNDEFINED+% SLaTeX compat+\let\scmkeyword\gobblegroup+\let\scmbuiltin\gobblegroup+\let\scmconstant\scmbuiltin+\let\scmvariable\scmbuiltin+\let\setbuiltin\scmbuiltin+\let\setconstant\scmbuiltin+\let\setkeyword\scmkeyword +\let\setvariable\scmvariable+\def\schemedisplay{\begingroup+  \verbsetup\verbavoidligs+  \verbinsertskip+  \schemedisplayI}%+\def\schemeresponse{\begingroup+  \verbsetup\verbavoidligs+  \verbinsertskip+  \schemeresponseI}%+{\catcode`\|0 |catcode`|\12+  |long|gdef|schemedisplayI#1\endschemedisplay{%+    #1|endgroup}%+  |long|gdef|schemeresponseI#1\endschemeresponse{%+    #1|endgroup}}%+\fi++\let\slatexlikecomments\relax+\let\noslatexlikecomments\relax++% definitions (useful in reference manuals)++\ifx\@@line\UnDeFiNeD+\let\@@line\line+\fi++\def\defun#1{\def\defuntype{#1}%+\medbreak+\@@line\bgroup+  \hbox\bgroup+    \aftergroup\enddefun+    \vrule width .5ex \thinspace+    \vrule \enspace+    \vbox\bgroup\setbox0=\hbox{\defuntype}%+      \advance\hsize-\wd0+      \advance\hsize-1em+      \obeylines+      \parindent=0pt+      \aftergroup\egroup+      \strut+      \let\dummy=}++\def\enddefun{\hfil\defuntype\egroup\smallskip}+++% Images++\let\imgdef\def++%\def\imgpreamble{\let\magnificationoutsideimgpreamble\magnification+%  \def\magnification{\count255=}}+%+%\def\endimgpreamble{\let\magnification\magnificationoutsideimgpreamble}+++\let\imgpreamble\iffalse+\let\endimgpreamble\fi++\let\makehtmlimage\relax+++% Tally control sequences are cheap count+% registers: they doesn't use up TeX's limited number of+% real count registers.++% A tally is a macro that expands to the+% number kept track of.  Thus \edef\kount{0} defines a+% tally \kount that currently contains 0.++% \advancetally\kount n increments \kount by n.+% \globaladvancetally increments the global \kount.+% If \kount is not defined, the \[global]advancetally+% macros define it to be 0 before proceeding with the+% incrementation.++\def\newtally#1{\edef#1{0}}++\def\advancetallyhelper#1#2#3{%+  \ifx#2\UNDEFINED+    #1\edef#2{0}\fi+  \edef\setcountCCLV{\count255=#2 }%+  \setcountCCLV+  \advance\count255 by #3+  #1\edef#2{\the\count255 }}++\def\advancetally{\advancetallyhelper\relax}+\def\globaladvancetally{\advancetallyhelper\global}++% plain's \beginsection splits pages too easily++%\def\beginsection#1\par{\sectionhelp{1}{}{#1}}++\def\beginsection{\vskip-\lastskip+  \bigbreak\noindent+  \bgroup\bf+    \let\par\sectionafterskip}++\def\beginsectionstar*{\beginsection}++% plain's \{left,center,right}line can't handle catcode change+% within their argument++\def\leftline{\@@line\bgroup\bgroup+  \aftergroup\leftlinefinish+  \let\dummy=}++\def\leftlinefinish{\hss\egroup}++\def\centerline{\@@line\bgroup\bgroup+  \aftergroup\leftlinefinish+  \hss\let\dummy=}++\def\rightline{\@@line\bgroup\hss\let\dummy=}++%++\let\strike\fiverm % can be much better!++%++\let\htmlpagebreak\relax++\let\htmlpagelabel\gobblegroup++\def\htmlpageref{\errmessage{Can't occur except inside+  \string\htmlonly}}++% Miscellaneous stuff++%\def\hr{$$\hbox{---}$$}+\def\hr{\medbreak\centerline{---}\medbreak}+%\def\hr{\par\centerline{$*$}\par}+%\def\hr{\smallskip\@@line{\leaders\hbox{~.~}\hfill}\smallskip}++%Commonplace math that doesn't require image files.  (Avoiding $+%here because $ triggers image-file generation.)++\let\nohtmlmathimg\relax+\let\nohtmlmathintextimg\relax+\let\nohtmlmathdisplayimg\relax++\let\htmlimageformat\gobblegroup+\let\htmlimgmagnification\gobblegroup++\let\externaltitle\gobblegroup++\def\mathg{$\bgroup\aftergroup\closemathg\let\dummy=}+\def\closemathg{$}++\let\mathp\mathg++\def\mathdg{$$\bgroup\aftergroup\closemathdg\let\dummy=}+\def\closemathdg{$$}++%+++\let\evalh\gobblegroup+\let\evalq\gobblegroup++% Backward compatible stuff++\let\endgifpreamble\endimgpreamble+\let\endhtmlgif\relax+\let\endhtmlimg\relax+\let\gifdef\imgdef+\let\gifpreamble\imgpreamble+%\let\href\urlh+\let\htmlgif\relax+\let\htmlimg\relax+\let\htmlimgformat\htmlimageformat+\let\n\noindent+\let\p\verb+\let\q\scm+\let\schemeeval\eval+\let\scmfile\scmdribble+\let\scmfileonly\scmwrite+\let\scmp\scm+%\let\scmverbatim\scm+\let\scmverbatimfile\scminput+\let\setverbatimescapechar\verbescapechar+%\let\verbatim\verb+\let\verbatimfile\verbatiminput+\let\verbinput\verbatiminput+\let\verbfilename\verbwritefile+\let\scmfilename\scmwritefile++% uppercase version of \romannumeral++\def\Romannumeral{\afterassignment\RomannumeralI\count255=}++\def\RomannumeralI{\uppercase\expandafter{\romannumeral\the\count255 }}++\def\f{\footnote}++\ifx\label\UnDeFiNeD+\else +\def\tag#1#2{\@bsphack+  \protected@write\@auxout{}%+    {\string\newlabel{#1}{{#2}{\thepage}}}%+\@esphack}%+\let\tagref\ref+\fi++\def\inputexternallabels#1 {\relax}+\def\includeexternallabels#1 {\relax}++% The rest of the file isn't needed for LaTeX++\ifx\section\UnDeFiNeD+\let\maybeloadfollowing\relax+\else +\catcode`\@\atcatcodebeforetiip+\let\maybeloadfollowing\endinput+\fi\maybeloadfollowing++% LaTeX stops loading here!++% Title++\newwrite\sectionscratchfileport++\def\subject{%+  \immediate\openout\sectionscratchfileport Z-sec-temp+  \begingroup+    \def\do##1{\catcode`##1=11 }\dospecials+    \catcode`\{=1 \catcode`\}=2+    \subjectI}++\def\subjectI#1{\endgroup+  \immediate\write\sectionscratchfileport {#1}%+  \immediate\closeout\sectionscratchfileport+  $$\vbox{\bf \def\\{\cr}%+      \halign{\hfil##\hfil\cr+        \input Z-sec-temp+        \cr}}$$%+  \medskip}++\let\title\subject++% Sections++\def\tracksectionchangeatlevel#1{%+  \expandafter\let\expandafter\thiscount\csname+    sectionnumber#1\endcsname+  \ifx\thiscount\relax+    \expandafter\edef\csname sectionnumber#1\endcsname{0}%+  \fi+  \expandafter\advancetally+    \csname sectionnumber#1\endcsname 1%+  \ifx\doingappendix0%+    \edef\recentlabel{\csname sectionnumber1\endcsname}%+  \else+    %\count255=\expandafter\csname sectionnumber1\endcsname+    \edef\recentlabel{\char\csname sectionnumber1\endcsname}%+  \fi+  \count255=0+  \loop+    \advance\count255 by 1+    \ifnum\count255=1+    \else\edef\recentlabel{\recentlabel.\csname+      sectionnumber\the\count255\endcsname}\fi+  \ifnum\count255<#1%+  \repeat+  \loop+    \advance\count255 by 1+    \expandafter\let\expandafter\nextcount\csname+      sectionnumber\the\count255\endcsname+    \ifx\nextcount\relax+      \let\continue0%+    \else+      \expandafter\edef\csname+        sectionnumber\the\count255\endcsname{0}%+      \let\continue1\fi+  \ifx\continue1%+  \repeat}++% Vanilla section-header look -- change this macro for new look++\newcount\secnumdepth++\secnumdepth=10++\def\sectiond#1{\count255=#1%+  \ifx\usingchapters1\advance\count255 by 1 \fi+  \edef\sectiondlvl{\the\count255 }%+  \futurelet\sectionnextchar\sectiondispatch}++\def\sectiondispatch{\ifx\sectionnextchar*%+  \def\sectioncontinue{\sectionstar{\sectiondlvl}}\else+  \ifnum\sectiondlvl>\secnumdepth+  \def\sectioncontinue{\sectionhelp{\sectiondlvl}{}}\else+  \tracksectionchangeatlevel{\sectiondlvl}+  \def\sectioncontinue{\sectionhelp{\sectiondlvl}%+    {\recentlabel\enspace}}\fi\fi+  \sectioncontinue}++\def\sectionstar#1*{\sectionhelp{#1}{}}+++\def\sectionhelp#1#2{%+  \edef\sectiondepth{#1}%+  \def\sectionnr{#2}%+  \immediate\openout\sectionscratchfileport Z-sec-temp+  \begingroup+  \def\do##1{\catcode`##1=11 }\dospecials+  \catcode`\{=1 \catcode`\}= 2+  \sectionheader}++\def\sectionheader#1{\endgroup+  \immediate\write\sectionscratchfileport {#1}%+  \immediate\closeout\sectionscratchfileport +  \vskip -\lastskip+  \ifnum\sectiondepth>\tocdepth\else+  \tocactivate+  {\let\folio0%+   \edef\temp{\write\tocout+     {\string\tocentry{\sectiondepth}{\sectionnr}{#1}{\folio}}}%+   \temp}\fi+  \vskip1.5\bigskipamount+\goodbreak %???+  \noindent+  \hbox{\vtop{\pretolerance 10000+    \raggedright+    \noindent\bf\sectionnr+    \input Z-sec-temp }}%+  \bgroup\let\par\sectionafterskip}++% \edef\temp{\write\tocout{\string\hskip#1\space em\string\relax\space #2%+%    \string\vtop{\string\hsize=.7\string\hsize+%    \string\noindent\string\raggedright\space #3}\string\par}}\temp++\def\sectionafterskip{\egroup\nobreak\par\noindent}++\def\section{\sectiond1}+\def\subsection{\sectiond2}+\def\subsubsection{\sectiond3}+\def\paragraph{\sectiond4}+\def\subparagraph{\sectiond5}++\let\usingchapters0++\def\chapter{\global\let\usingchapters1%+\futurelet\chapternextchar\chapterdispatch}++\def\chapterdispatch{\ifx\chapternextchar*%+  \let\chaptercontinue\chapterstar\else+  \tracksectionchangeatlevel{1}%+  \def\chaptercontinue{\chapterhelp{\recentlabel\enspace}}\fi+  \chaptercontinue}++\def\chapterstar*{\chapterhelp{}}++\def\chapterhelp#1{%+  % #1=number #2=heading-text+  \def\chapternr{#1}%+  \immediate\openout\sectionscratchfileport Z-sec-temp+  \begingroup+  \def\do##1{\catcode`##1=11 }\dospecials+  \catcode`\{=1 \catcode`\}=2+  \chapterheader}++\def\chapterheader#1{\endgroup+  \immediate\write\sectionscratchfileport {#1}%+  \immediate\closeout\sectionscratchfileport+  \tocactivate+  {\let\folio0%+   \edef\temp{\write\tocout{\string\tocentry{1}{\chapternr}{#1}{\folio}}}%+   \temp}%+  \vfill\eject+  \null\vskip3em+  \noindent+  \ifx\chapternr\empty\hbox{~}\else+  \ifx\doingappendix0%+    \hbox{\bf Chapter \chapternr}\else+  \hbox{\bf Appendix \chapternr}\fi\fi+  \vskip 1em+  \noindent+  \hbox{\bf\vtop{%\hsize=.7\hsize+    \pretolerance 10000+    \noindent\raggedright\input Z-sec-temp }}%+  \bgroup\let\par\chapterafterskip}++\def\chapterafterskip{\egroup\nobreak\vskip3em \noindent}++\let\doingappendix=0++\def\appendix{\let\doingappendix=1%+  \count255=`\A%+  \advance\count255 by -1+  \expandafter\edef\csname+    sectionnumber1\endcsname{\the\count255 }}+++% toc++\let\tocactive0++\newcount\tocdepth++\tocdepth=10++\def\tocoutensure{\ifx\tocout\UNDEFINED+  \csname newwrite\endcsname\tocout\fi}++\def\tocactivate{\ifx\tocactive0%+  \tocoutensure+  \tocsave+  \openout\tocout \jobname.toc+  \global\let\tocactive1\fi}++\def\tocspecials{\def\do##1{\catcode`##1=12 }\dospecials}++\def\tocsave{\openin0=\jobname.toc+  \ifeof0 \closein0 \else+    \openout\tocout Z-T-\jobname.tex+    \let\tocsaved 0%+    \loop+      \ifeof0 \closeout\tocout+        \let\tocsaved1%+      \else{\tocspecials+         \read0 to \tocsaveline+         \edef\temp{\write\tocout{\tocsaveline}}\temp}%+      \fi+    \ifx\tocsaved0%+    \repeat+  \fi+  \closein0 }++\def\tocentry#1#2{%+  %#1=depth #2=secnum+  \ifnum#1=1+    \ifnum\tocdepth>2+    \medbreak\begingroup\bf+    \else\begingroup\fi+  \else\begingroup\fi+  \vtop\bgroup\raggedright+  \noindent\hskip #1 em+  #2%+  \bgroup+  \aftergroup\tocentryI+  %read section title+  \let\dummy=}++\def\tocentryI#1{%+  %#1=page nr+  , #1\strut\egroup+  \endgroup\par+}++\def\tableofcontents{%+  \ifx\tocactive0%+    \openin0 \jobname.toc+    \ifeof0 \closein0 \else+      \closein0 \input \jobname.toc+    \fi+    \tocoutensure+    \openout\tocout \jobname.toc+    \global\let\tocactive1%+  \else+    \input Z-T-\jobname.tex+  \fi}++% allow {thebibliography} to be used directly+% in (plain-TeX) source document without +% generating it via BibTeX++\ifx\thebibliography\UnDeFiNeD+\def\thebibliography#1{\vskip-\lastskip+  \begingroup+  \def\endthebibliography{\endgroup\endgroup}%+  \def\input##1 ##2{\relax}%+  \setbox0=\hbox{\biblabelcontents{#1}}%+  \biblabelwidth=\wd0+  \@readbblfile}%+\fi++% Cross-references++% \openxrefout loads all the TAG-VALUE associations in+% \jobname.xrf and then opens \jobname.xrf as an+% output channel that \tag can use++\def\openxrefout{%+  \openin0=\jobname.xrf+  \ifeof0 \closein0 +  \else \closein0 {\catcode`\\0 \input \jobname.xrf }%+  \fi+  \expandafter\csname newwrite\endcsname\xrefout+  \openout\xrefout=\jobname.xrf+}++% I'd like to call \openxrefout lazily, but+% unfortunately it produces a bug in MiKTeX.+% So let's call it up front.++\openxrefout++% \tag{TAG}{VALUE} associates TAG with VALUE.+% Hereafter, \ref{TAG} will output VALUE.+% \tag stores its associations in \xrefout.+% \tag calls \openxrefout if \jobname.xrf hasn't+% already been opened++\def\tag#1#2{\ifx\xrefout\UNDEFINED\openxrefout\fi+  {\let\folio0%+    \edef\temp{%+     \write\xrefout{\string\expandafter\string\gdef+        \string\csname\space XREF#1\string\endcsname+        {#2}\string\relax}}%+    \temp}}++% \tagref{TAG} outputs VALUE, assuming \tag put such+% an association into \xrefout.  \tagref calls+% \openxrefout if \jobname.xrf hasn't already+% been opened++% Later, we will \let \ref = \tagref after making+% sure we aren't in eplain, which uses the ctlseq+% \ref differently++\def\tagref#1{\ifx\xrefout\UNDEFINED\openxrefout\fi+  \expandafter\ifx\csname XREF#1\endcsname\relax+  %\message or \write16 ?+  \message{\the\inputlineno: Unresolved label `#1'.}?\else+  \csname XREF#1\endcsname\fi}++% \label, as in LaTeX++\let\recentlabel\relax++% The sectioning commands+% define \recentlabel so a subsequent call to \label will pick up the+% right label.++\def\label#1{\tag{#1}{\recentlabel}%+  \tag{PAGE#1}{\folio}}++% \pageref, as in LaTeX++\def\pageref#1{\ref{PAGE#1}}++% eplain users see the \ref they are used to.  Others+% have \ref = \tagref++\ifx\eplain\UnDeFiNeD+\let\ref\tagref+\fi++%++\ifx\IfFileExists\UnDeFiNeD+\def\IfFileExists#1#2#3{%+  \openin0 #1 %+  \ifeof0 %+    #3%+  \else +    #2\fi+  \closein0 }%+\fi++\ifx\InputIfFileExists\UnDeFiNeD+\def\InputIfFileExists#1#2#3{%+  \IfFileExists{#1}{#2\input #1 }{#3}}%+\fi++\let\iffileexists\IfFileExists++%++% dummy def to let load dvipsnam.def ++\ifx\ProvidesFile\UnDeFiNeD+\def\ProvidesFile#1[#2]{}%+\fi++%++% Index generation+%+% Your TeX source contains \index{NAME} to+% signal that NAME should be included in the index.+% Check the makeindex documentation to see the various+% ways NAME can be specified, eg, for subitems, for+% explicitly specifying the alphabetization for a name+% involving TeX control sequences, etc.+%+% The first run of TeX will create \jobname.idx.+% makeindex on \jobname[.idx] will create the sorted+% index \jobname.ind.+%+% Use \inputindex (without arguments) to include this+% sorted index, typically somewhere to the end of your+% document.  This will produce the items and subitems.+% It won't produce a section heading however -- you+% will have to typeset one yourself.+%+% Use \printindex instead of \inputindex if you want+% the section heading ``Index'' automatically generated.++\def\sanitizeidxletters{\def\do##1{\catcode`##1=11 }%+  \do\\\do\$\do\&\do\#\do\^\do\_\do\%\do\~%+  \do\@\do\"\do\!\do\|\do\-\do\ \do\'}++\def\index{%\unskip+  \ifx\indexout\UNDEFINED+    \csname newwrite\endcsname\indexout+    \openout\indexout \jobname.idx\fi+  \begingroup+    \sanitizeidxletters+    \indexI}++\def\indexI#1{\endgroup+  \write\indexout{\string\indexentry{#1}{\folio}}%+  \ignorespaces}++% The following index style indents subitems on a+% separate lines++\def\theindex{\begingroup+  \parskip0pt \parindent0pt+  \def\indexitem##1{\par\hangindent30pt \hangafter1+    \hskip ##1 }%+  \def\item{\indexitem{0em}}%+  \def\subitem{\indexitem{2em}}%+  \def\subsubitem{\indexitem{4em}}%+  \def\see{{\it see} \bgroup\aftergroup\gobblegroup\let\dummy=}%+  \let\indexspace\medskip}++\def\endtheindex{\endgroup}++% \packindex declares that subitems be bundled into one+% semicolon-separated paragraph++\def\packindex{%+  \def\theindex{\begingroup+    \parskip0pt \parindent0pt+    \def\item{\par\hangindent20pt \hangafter1 }%+    \def\subitem{\unskip; }%+    \def\subsubitem{\unskip; }%+    \def\see{\bgroup\it see \aftergroup\gobblegroup\let\dummy=}%+    \let\indexspace\medskip}}++\def\inputindex{%+  \openin0 \jobname.ind+  \ifeof0 \closein0+    \message{\jobname.ind missing.}%+  \else\closein0+    \begingroup+      \def\begin##1{\csname##1\endcsname}%+      \def\end##1{\csname end##1\endcsname}%+      \input\jobname.ind+    \endgroup\fi}++\def\printindex{\csname beginsection\endcsname Index\par+  \inputindex}++%++\def\italiccorrection{\futurelet\italiccorrectionI+  \italiccorrectionII}++\def\italiccorrectionII{%+  \if\noexpand\italiccorrectionI,\else+  \if\noexpand\italiccorrectionI.\else+  \/\fi\fi}++\def\em{\it\ifmmode\else\aftergroup\italiccorrection\fi}++%\def\emph{\bgroup\it+%  \ifmmode\else\aftergroup\italiccorrection\fi+%  \let\dummy=}++\def\quote{\bgroup\narrower\smallbreak}+\def\endquote{\smallbreak\egroup}++\def\begin#1{\begingroup+  \def\end##1{\csname end#1\endcsname\endgroup}%+  \csname #1\endcsname}++\def\raggedleft{%+  \leftskip 0pt plus 1fil+  \parfillskip 0pt+}++\def\r#1{{\accent23 #1}}+++\ifx\strip@pt\UNDEFINED+\begingroup+  \catcode`P 12 \catcode`T 12+  \lowercase{\endgroup+    \gdef\strip@pt#1PT{#1}}%+\fi++% color++\ifx\color\UnDeFiNeD +%+\ifx\pdfoutput\UnDeFiNeD % PostScript+%+\def\colorCurrentColor{color cmyk 0 0 0 1}%+%+\def\colorRestoreCurrentColor{%+\special{\colorCurrentColor}\egroup\egroup}%+%+\def\colorWithModelrgb#1{\bgroup+\def\colorCurrentColor{color rgb #1}%+\special{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor}%+%+\def\colorWithModelRGBaux#1 #2 #3\end{\bgroup+\dimen0=#1pt \divide\dimen0 by 255+\edef\red{\expandafter\strip@pt\the\dimen0 }%+\dimen0=#2pt \divide\dimen0 by 255+\edef\green{\expandafter\strip@pt\the\dimen0 }%+\dimen0=#3pt \divide\dimen0 by 255+\edef\blue{\expandafter\strip@pt\the\dimen0 }%+\def\colorCurrentColor{color rgb \red\space \green\space \blue}%+\special{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor+\ignorespaces}+%+\def\colorWithModelcmyk#1{\bgroup+\def\colorCurrentColor{color cmyk #1}%+\special{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor}%+%+\def\colorWithModelgray#1{\bgroup+\def\colorCurrentColor{color gray #1}%+\special{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor}%+%+\def\colorWithModelnamed#1{\bgroup+\edef\colorCurrentColor{\csname+ColorNamed#1\endcsname}%+\special{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor}%+%+\def\definecolorWithModelrgb#1#2{\egroup+\expandafter\def\csname ColorNamed#1\endcsname+{color rgb #2}}%+%+\def\definecolorWithModelcmyk#1#2{\egroup+\expandafter\def\csname ColorNamed#1\endcsname+{color cmyk #2}}%+%+\def\definecolorWithModelgray#1#2{\egroup+\expandafter\def\csname ColorNamed#1\endcsname+{color gray #2}}%+%+\else % PDF+%+\def\colorCurrentColor{0 0 0 1 k}%+%+\def\colorRestoreCurrentColor{%+\pdfliteral{\colorCurrentColor}\egroup\egroup}%+%+\def\colorWithModelrgb#1{\bgroup+\def\colorCurrentColor{#1 rg}%+\pdfliteral{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor+\ignorespaces}%+%+\def\colorWithModelRGBaux#1 #2 #3\end{\bgroup+\dimen0=#1pt \divide\dimen0 by 255+\edef\red{\expandafter\strip@pt\the\dimen0 }%+\dimen0=#2pt \divide\dimen0 by 255+\edef\green{\expandafter\strip@pt\the\dimen0 }%+\dimen0=#3pt \divide\dimen0 by 255+\edef\blue{\expandafter\strip@pt\the\dimen0 }%+\def\colorCurrentColor{\red\space \green\space \blue\space rg}%+\pdfliteral{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor+\ignorespaces}+%+\def\colorWithModelcmyk#1{\bgroup+\def\colorCurrentColor{#1 k}%+\pdfliteral{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor+\ignorespaces}%+%+\def\colorWithModelgray#1{\bgroup+\def\colorCurrentColor{#1 g}%+\pdfliteral{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor+\ignorespaces}%+%+\def\colorWithModelnamed#1{\bgroup+\edef\colorCurrentColor{\csname+ColorNamed#1\endcsname}%+\pdfliteral{\colorCurrentColor}%+\aftergroup\colorRestoreCurrentColor+\ignorespaces}%+%+\def\definecolorWithModelrgb#1#2{\egroup+\expandafter\def\csname ColorNamed#1\endcsname+{#2 rg}}%+%+\def\definecolorWithModelcmyk#1#2{\egroup+\expandafter\def\csname ColorNamed#1\endcsname+{#2 k}}%+%+\def\definecolorWithModelgray#1#2{\egroup+\expandafter\def\csname ColorNamed#1\endcsname+{#2 g}}%+%+\fi+%+\def\color{\futurelet\colorQpeekchar\colorQpossiblynamed}%+%+\def\colorQpossiblynamed{\bgroup+\defcsactive\,{ }%+\if\colorQpeekchar[%+\let\colorQproceed\colorQexplicitmodel\else+\let\colorQproceed\colorWithModelnamed\fi+\colorQproceed}%+%+\def\colorQexplicitmodel[#1]{%+\csname colorWithModel#1\endcsname}%+%+\def\colorWithModelRGB#1{%+\colorWithModelRGBaux#1\end}%+%+\def\definecolor#1#2{\bgroup+\defcsactive\,{ }%+\csname definecolorWithModel#2\endcsname{#1}}%+%+% foll lets load texmf/tex/latex/graphics/dvipsnam.def+\def\DefineNamedColor#1{\definecolor}%+%+% these colors are standard in latex+\definecolor{red}{rgb}{1 0 0}%+\definecolor{green}{rgb}{0 1 0}%+\definecolor{blue}{rgb}{0 1 1}%+\definecolor{cyan}{cmyk}{1 0 0 0}%+\definecolor{magenta}{cmyk}{0 1 0 0}%+\definecolor{yellow}{cmyk}{0 0 1 0}%+\definecolor{black}{cmyk}{0 0 0 1}%+\definecolor{white}{rgb}{1 1 1}%+%+\fi++%the rest of the file isn't needed for eplain?++\def\itemize{\par\begingroup+  \advance\leftskip\parindent+  \smallbreak+  \def\item{\smallbreak\noindent+  \llap{$\bullet$\enspace}\ignorespaces}}++\def\enditemize{\smallbreak\smallbreak\endgroup\par}++\newtally\enumeratelevel++\def\enumerate{\par\begingroup+  \advancetally\enumeratelevel1%+  \newtally\enumeratenumber+  \advance\leftskip\parindent+  \smallbreak+  \def\item{\smallbreak\noindent+    \advancetally\enumeratenumber1%+    \ifnum\enumeratelevel=1 +      \edef\enumeratemark{\enumeratenumber}\else+    \ifnum\enumeratelevel=2 +      \count255=\enumeratenumber +      \advance\count255 by -1 \advance\count255 by `a+      \edef\enumeratemark{\noexpand\char\the\count255 }\else+    \ifnum\enumeratelevel=3 +      \edef\enumeratemark{\romannumeral\enumeratenumber}\else+    \ifnum\enumeratelevel=4+      \count255=\enumeratenumber +      \advance\count255 by -1 \advance\count255 by `A+      \edef\enumeratemark{\noexpand\char\the\count255 }\else+    \edef\enumeratemark{\enumeratenumber}\fi\fi\fi\fi+    \edef\recentlabel{\enumeratemark}% needed?+    \llap{\enumeratemark.\enspace}\ignorespaces}}++\def\endenumerate{\smallbreak\smallbreak\endgroup\par}++% Numbered footnotes++\ifx\plainfootnote\UNDEFINED+  \let\plainfootnote\footnote+\fi++\newtally\footnotenumber++\def\numfootnote{\globaladvancetally\footnotenumber 1%+  \bgroup\csname footnotehook\endcsname+    \plainfootnote{$^{\footnotenumber}$}\bgroup+      \edef\recentlabel{\footnotenumber}%+      \aftergroup\egroup+      \let\dummy=}++\let\f\numfootnote++\ifx\frac\UnDeFiNeD+\def\frac#1/#2{{#1\over#2}}%+\fi++% \path is like \verb except that its argument+% can break across lines at `.' and `/'.++\ifx\path\UnDeFiNeD+\def\path{\begingroup\verbsetup+  \pathfont+  \defcsactive\.{\discretionary{\char`\.}{}{\char`\.}}%+  \defcsactive\/{\discretionary{\char`\/}{}{\char`\/}}%+  \verbI}%+\fi++\let\pathfont\relax++\catcode`\@\atcatcodebeforetiip++\endtexonly++% end of file
+ install.sh view
+ plugins.cabal view
@@ -0,0 +1,38 @@+name:           plugins+version:        1.0+license:        LGPL+License-file:   LICENSE+author:         Don Stewart+maintainer:     dons@cse.unsw.edu.au+exposed-modules:+        AltData.Dynamic,+        AltData.Typeable,+        Language.Hi.Binary,+        Language.Hi.FastMutInt,+        Language.Hi.FastString,+        Language.Hi.Parser,+        Language.Hi.PrimPacked,+        Language.Hi.Syntax,+        System.Eval,+        System.Eval.Haskell,+        System.Eval.Utils,+        System.MkTemp,+        System.Plugins,+        System.Plugins.Consts,+        System.Plugins.Env,+        System.Plugins.Load,+        System.Plugins.LoadTypes,+        System.Plugins.Make,+        System.Plugins.Package,+        System.Plugins.PackageAPI,+        System.Plugins.ParsePkgConfCabal,+        System.Plugins.Parser,+        System.Plugins.Process,+        System.Plugins.Utils+c-sources:+        src/Language/Hi/hschooks.c+includes:             Linker.h+extensions:           CPP, ForeignFunctionInterface+Build-Depends:        base, Cabal, haskell-src+ghc-options:          -Wall -O -fasm -funbox-strict-fields -fno-warn-missing-signatures+hs-source-dir: src
+ plugins.cabal.hsx view
@@ -0,0 +1,38 @@+name:           plugins+version:        1.0+license:        LGPL+License-file:   LICENSE+author:         Don Stewart+maintainer:     dons@cse.unsw.edu.au+exposed-modules:+        AltData.Dynamic,+        AltData.Typeable,+        Language.Hi.Binary,+        Language.Hi.FastMutInt,+        Language.Hi.FastString,+        Language.Hi.Parser,+        Language.Hi.PrimPacked,+        Language.Hi.Syntax,+        System.Eval,+        System.Eval.Haskell,+        System.Eval.Utils,+        System.MkTemp,+        System.Plugins,+        System.Plugins.Consts,+        System.Plugins.Env,+        System.Plugins.Load,+        System.Plugins.LoadTypes,+        System.Plugins.Make,+        System.Plugins.Package,+        System.Plugins.PackageAPI,+        System.Plugins.ParsePkgConfCabal,+        System.Plugins.Parser,+        System.Plugins.Process,+        System.Plugins.Utils+c-sources:+        src/Language/Hi/hschooks.c+includes:             Linker.h+extensions:           CPP, ForeignFunctionInterface+Build-Depends:        base, Cabal, haskell-src-exts+ghc-options:          -Wall -O -fvia-C -funbox-strict-fields -fno-warn-missing-signatures+hs-source-dir: src
+ scripts/Setup-with-ghc.lhs view
@@ -0,0 +1,20 @@+#!/usr/bin/env runhaskell+> module Main where+> import Distribution.Simple+> import Distribution.Setup   ( ConfigFlags (..) )+> import System.Directory     ( findExecutable )+> +> main :: IO ()+> main = defaultMainWithHooks (defaultUserHooks { postConf = defaultPostConf })+>     where defaultPostConf args flags lbi {- xx -}+>               = do args' <- fmap (args++) (configToArgs flags)+>                    (postConf defaultUserHooks) args' flags lbi {- xx -}+> +> -- need to pass with-ghc arg onto ./configure for non-standard ghcs+> configToArgs :: ConfigFlags -> IO [String]+> configToArgs (ConfigFlags { configHcPath = Just hcPath })+>     = do exec <- findExecutable hcPath+>          case exec of+>            Just realPath -> return ["--with-ghc="++realPath]+>            Nothing -> return ["--with-ghc="++hcPath]+> configToArgs _ = return []
+ scripts/mkrelease.sh view
@@ -0,0 +1,11 @@+#!/bin/sh++cd /tmp+rm -rf hs-plugins-0.9.10*++darcs get --partial --set-scripts-executable /home/dons/hs-plugins+cd hs-plugins+rm -rf _darcs+cd ..+mv hs-plugins hs-plugins-0.9.10+tar czf hs-plugins-0.9.10.tar.gz hs-plugins-0.9.10
+ scripts/openbsd-port/Makefile view
@@ -0,0 +1,21 @@+# $OpenBSD$++COMMENT=		"dynamic link library for Haskell"++V=			0.9.10+DISTNAME=		hs-plugins-${V}+CATEGORIES=		devel+MAINTAINER=		Don Stewart <dons@openbsd.org>+HOMEPAGE= 		http://www.cse.unsw.edu.au/~dons/hs-plugins/+MASTER_SITES=		${HOMEPAGE}++MODULES=		ghc+CONFIGURE_STYLE=	gnu dest++# LGPL+PERMIT_PACKAGE_CDROM=	Yes+PERMIT_PACKAGE_FTP=	Yes+PERMIT_DISTFILES_CDROM=	Yes+PERMIT_DISTFILES_FTP=	Yes++.include <bsd.port.mk>
+ scripts/openbsd-port/distinfo view
@@ -0,0 +1,3 @@+MD5 (hs-plugins-0.9.4.tar.gz) = 120f38ca532b187ee52798f5c36cc920+RMD160 (hs-plugins-0.9.4.tar.gz) = 219eaf70e4bc0f1abc8a782d1bbd64ad2c5f8e86+SHA1 (hs-plugins-0.9.4.tar.gz) = ad38b9f4e5b90c1361c6c96bd94e2a9270ad3d78
+ scripts/openbsd-port/pkg/DESCR view
@@ -0,0 +1,6 @@+hs-plugins is a library for dynamic loading and compilation of Haskell+code. It provides typesafe "plugins" for Haskell.  The interface is+general enough that it can be used to create conventional plugins,+hmake-like Haskell interpreters embedded in applications, or to script+an application with Haskell (or a Haskell EDSL) as the extension+language.
+ scripts/openbsd-port/pkg/PLIST view
@@ -0,0 +1,28 @@+@comment $OpenBSD$+lib/hs-plugins/imports/Plugins.hi+lib/hs-plugins/imports/Plugins/BinIface.hi+lib/hs-plugins/imports/Plugins/Binary.hi+lib/hs-plugins/imports/Plugins/Consts.hi+lib/hs-plugins/imports/Plugins/Env.hi+lib/hs-plugins/imports/Plugins/FastMutInt.hi+lib/hs-plugins/imports/Plugins/FastString.hi+lib/hs-plugins/imports/Plugins/Iface.hi+lib/hs-plugins/imports/Plugins/Load.hi+lib/hs-plugins/imports/Plugins/Make.hi+lib/hs-plugins/imports/Plugins/Package.hi+lib/hs-plugins/imports/Plugins/ParsePkgConfLite.hi+lib/hs-plugins/imports/Plugins/Parser.hi+lib/hs-plugins/imports/Plugins/PrimPacked.hi+lib/hs-plugins/imports/Plugins/Utils.hi+lib/hs-plugins/include/hschooks.h+lib/hs-plugins/libHSplugins.a+lib/hs-plugins/libHSplugins_cbits.a+lib/hs-plugins/plugins.conf.in+@dirrm lib/hs-plugins/include+@dirrm lib/hs-plugins/imports/Plugins+@dirrm lib/hs-plugins/imports+@dirrm lib/hs-plugins+@exec /bin/cat %D/lib/hs-plugins/plugins.conf.in | /usr/bin/env PREFIX=%D %D/bin/ghc-pkg -u+@exec /bin/rm -f %D/lib/ghc-6.2.1/package.conf.old+@unexec %D/bin/ghc-pkg -r plugins+@unexec /bin/rm -f %D/lib/ghc-6.2.1/package.conf.old
+ src/AltData/Dynamic.hs view
@@ -0,0 +1,162 @@+{-# OPTIONS -fglasgow-exts #-}+--+-- |+-- Module      :  Data.Dynamic+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- The Dynamic interface provides basic support for dynamic types.+-- +-- Operations for injecting values of arbitrary type into+-- a dynamically typed value, Dynamic, are provided, together+-- with operations for converting dynamic values into a concrete+-- (monomorphic) type.+-- +-----------------------------------------------------------------------------++module AltData.Dynamic (++	-- Module Data.Typeable re-exported for convenience+	module AltData.Typeable,++	-- * The @Dynamic@ type+	Dynamic,	-- abstract, instance of: Show, Typeable++	-- * Converting to and from @Dynamic@+	toDyn,		-- :: Typeable a => a -> Dynamic+	fromDyn,	-- :: Typeable a => Dynamic -> a -> a+	fromDynamic,	-- :: Typeable a => Dynamic -> Maybe a+	+#if __GLASGOW_HASKELL__ >= 603+	-- * Applying functions of dynamic type+	dynApply,+	dynApp,+        dynTypeRep++#endif+  ) where++import AltData.Typeable+import Data.Maybe++import System.IO.Unsafe    (unsafePerformIO)++import GHC.Base+import GHC.Show+#if __GLASGOW_HASKELL__ >= 603+import GHC.Err+#endif++unsafeCoerce :: a -> b+unsafeCoerce = unsafeCoerce#++-------------------------------------------------------------+--+--		The type Dynamic+--+-------------------------------------------------------------++{-|+  A value of type 'Dynamic' is an object encapsulated together with its type.++  A 'Dynamic' may only represent a monomorphic value; an attempt to+  create a value of type 'Dynamic' from a polymorphically-typed+  expression will result in an ambiguity error (see 'toDyn').++  'Show'ing a value of type 'Dynamic' returns a pretty-printed representation+  of the object\'s type; useful for debugging.+-}+data Dynamic = Dynamic TypeRep Obj++instance Typeable Dynamic where+#if __GLASGOW_HASKELL__ >= 603+    typeOf _ = mkTyConApp (mkTyCon "AltData.Dynamic") []+#else+    typeOf _ = mkAppTy    (mkTyCon "AltData.Dynamic") []+#endif++instance Show Dynamic where+   -- the instance just prints the type representation.+   showsPrec _ (Dynamic t _) = +          showString "<<" . +	  showsPrec 0 t   . +	  showString ">>"++type Obj = forall a . a+ -- Dummy type to hold the dynamically typed value.+ --+ -- In GHC's new eval/apply execution model this type must+ -- be polymorphic.  It can't be a constructor, because then+ -- GHC will use the constructor convention when evaluating it,+ -- and this will go wrong if the object is really a function.  On+ -- the other hand, if we use a polymorphic type, GHC will use+ -- a fallback convention for evaluating it that works for all types.+ -- (using a function type here would also work).++-- | Converts an arbitrary value into an object of type 'Dynamic'.  +--+-- The type of the object must be an instance of 'Typeable', which+-- ensures that only monomorphically-typed objects may be converted to+-- 'Dynamic'.  To convert a polymorphic object into 'Dynamic', give it+-- a monomorphic type signature.  For example:+--+-- >    toDyn (id :: Int -> Int)+--+toDyn :: Typeable a => a -> Dynamic+toDyn v = Dynamic (typeOf v) (unsafeCoerce v)++-- | Converts a 'Dynamic' object back into an ordinary Haskell value of+-- the correct type.  See also 'fromDynamic'.+fromDyn :: Typeable a+ 	=> Dynamic 	-- ^ the dynamically-typed object+	-> a		-- ^ a default value +	-> a		-- ^ returns: the value of the first argument, if+			-- it has the correct type, otherwise the value of+			-- the second argument.+fromDyn (Dynamic t v) def+  | typeOf def == t = unsafeCoerce v+  | otherwise       = def++-- | Converts a 'Dynamic' object back into an ordinary Haskell value of+-- the correct type.  See also 'fromDyn'.+fromDynamic+	:: Typeable a+	=> Dynamic	-- ^ the dynamically-typed object+	-> Maybe a	-- ^ returns: @'Just' a@, if the dynamically-typed+			-- object has the correct type (and @a@ is its value), +			-- or 'Nothing' otherwise.+fromDynamic (Dynamic t v) =+  case unsafeCoerce v of +    r | t == typeOf r -> Just r+      | otherwise     -> unsafePerformIO (putStrLn $+                                "Couldn't match `"    ++show(typeOf r) +++                                        "' against `" ++show t         ++"'"+++                                "\n\tExpected type: " ++show(typeOf r) +++                                "\n\tInferred type: " ++show t+                        ) `seq` Nothing++#if __GLASGOW_HASKELL__ >= 603++-- (f::(a->b)) `dynApply` (x::a) = (f a)::b+dynApply :: Dynamic -> Dynamic -> Maybe Dynamic+dynApply (Dynamic t1 f) (Dynamic t2 x) =+  case funResultTy t1 t2 of+    Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))+    Nothing -> Nothing+++dynApp :: Dynamic -> Dynamic -> Dynamic+dynApp f x = case dynApply f x of +             Just r -> r+             Nothing -> error ("Type error in dynamic application.\n" +++                               "Can't apply function " ++ show f +++                               " to argument " ++ show x)++dynTypeRep :: Dynamic -> TypeRep+dynTypeRep (Dynamic tr _) = tr ++#endif
+ src/AltData/Typeable.hs view
@@ -0,0 +1,960 @@+{-# OPTIONS -fglasgow-exts #-}+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++-- Based on:+--+-- |+-- Module      :  Data.Typeable+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  portable+--+-- The Typeable class reifies types to some extent by associating type+-- representations to types. These type representations can be compared,+-- and one can in turn define a type-safe cast operation. To this end,+-- an unsafe cast is guarded by a test for type (representation)+-- equivalence. The module Data.Dynamic uses Typeable for an+-- implementation of dynamics. The module Data.Generics uses Typeable+-- and type-safe cast (but not dynamics) to support the \"Scrap your+-- boilerplate\" style of generic programming.+--++module AltData.Typeable++#if __GLASGOW_HASKELL__ >= 603+  (++	-- * The Typeable class+	Typeable( typeOf ),	-- :: a -> TypeRep++	-- * Type-safe cast+	cast,			-- :: (Typeable a, Typeable b) => a -> Maybe b+	gcast,			-- a generalisation of cast++	-- * Type representations+	TypeRep,	-- abstract, instance of: Eq, Show, Typeable+	TyCon,		-- abstract, instance of: Eq, Show, Typeable++	-- * Construction of type representations+	mkTyCon,	-- :: String  -> TyCon+	mkTyConApp,	-- :: TyCon   -> [TypeRep] -> TypeRep+	mkAppTy,	-- :: TypeRep -> TypeRep   -> TypeRep+	mkFunTy,	-- :: TypeRep -> TypeRep   -> TypeRep++	-- * Observation of type representations+	splitTyConApp,	-- :: TypeRep -> (TyCon, [TypeRep])+	funResultTy,	-- :: TypeRep -> TypeRep   -> Maybe TypeRep+	typeRepTyCon,	-- :: TypeRep -> TyCon+	typeRepArgs,	-- :: TypeRep -> [TypeRep]+	tyConString,	-- :: TyCon   -> String++	-- * The other Typeable classes+	-- | /Note:/ The general instances are provided for GHC only.+	Typeable1( typeOf1 ),	-- :: t a -> TypeRep+	Typeable2( typeOf2 ),	-- :: t a b -> TypeRep+	Typeable3( typeOf3 ),	-- :: t a b c -> TypeRep+	Typeable4( typeOf4 ),	-- :: t a b c d -> TypeRep+	Typeable5( typeOf5 ),	-- :: t a b c d e -> TypeRep+	Typeable6( typeOf6 ),	-- :: t a b c d e f -> TypeRep+	Typeable7( typeOf7 ),	-- :: t a b c d e f g -> TypeRep+	gcast1,			-- :: ... => c (t a) -> Maybe (c (t' a))+	gcast2,			-- :: ... => c (t a b) -> Maybe (c (t' a b))++	-- * Default instances+	-- | /Note:/ These are not needed by GHC, for which these instances+	-- are generated by general instance declarations.+	typeOfDefault,	-- :: (Typeable1 t, Typeable a) => t a -> TypeRep+	typeOf1Default,	-- :: (Typeable2 t, Typeable a) => t a b -> TypeRep+	typeOf2Default,	-- :: (Typeable3 t, Typeable a) => t a b c -> TypeRep+	typeOf3Default,	-- :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep+	typeOf4Default,	-- :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep+	typeOf5Default,	-- :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep+	typeOf6Default	-- :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep++  ) where++import qualified Data.HashTable as HT+import Data.Maybe+import Data.Either+import Data.Int+import Data.Word+import Data.List( foldl )++import GHC.Base+import GHC.Show+import GHC.Err+import GHC.Num+import GHC.Float+import GHC.Real( rem, Ratio )+import GHC.IOBase+import GHC.Ptr          -- So we can give Typeable instance for Ptr+import GHC.Stable       -- So we can give Typeable instance for StablePtr++unsafeCoerce :: a -> b+unsafeCoerce = unsafeCoerce#++#include "Typeable.h"++-------------------------------------------------------------+--+--		Type representations+--+-------------------------------------------------------------++-- | A concrete representation of a (monomorphic) type.  'TypeRep'+-- supports reasonably efficient equality.+--+-- equality of keys doesn't work for dynamically loaded code, so we+-- revert back to canonical type names.+-- +-- could use packed strings here.+--+data TypeRep = TypeRep !Key TyCon [TypeRep] ++-- Compare keys for equality+instance Eq TypeRep where+  (TypeRep _ t1 a1) == (TypeRep _ t2 a2) = t1 == t2 && a1 == a2++-- | An abstract representation of a type constructor.  'TyCon' objects can+-- be built using 'mkTyCon'.+data TyCon = TyCon !Key String++instance Eq TyCon where+  (TyCon _ s1) == (TyCon _ s2) = s1 == s2++	-- +	-- let fTy = mkTyCon "Foo" in show (mkTyConApp (mkTyCon ",,")+	--                                 [fTy,fTy,fTy])+	-- +	-- returns "(Foo,Foo,Foo)"+	--+	-- The TypeRep Show instance promises to print tuple types+	-- correctly. Tuple type constructors are specified by a +	-- sequence of commas, e.g., (mkTyCon ",,,,") returns+	-- the 5-tuple tycon.++----------------- Construction --------------------++-- | Applies a type constructor to a sequence of types+mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep+mkTyConApp tc@(TyCon tc_k _) args +  = TypeRep (appKeys tc_k arg_ks) tc args+  where+    arg_ks = [k | TypeRep k _ _ <- args]++-- | A special case of 'mkTyConApp', which applies the function +-- type constructor to a pair of types.+mkFunTy  :: TypeRep -> TypeRep -> TypeRep+mkFunTy f a = mkTyConApp funTc [f,a]++-- | Splits a type constructor application+splitTyConApp :: TypeRep -> (TyCon,[TypeRep])+splitTyConApp (TypeRep _ tc trs) = (tc,trs)++-- | Applies a type to a function type.  Returns: @'Just' u@ if the+-- first argument represents a function of type @t -> u@ and the+-- second argument represents a function of type @t@.  Otherwise,+-- returns 'Nothing'.+funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep+funResultTy trFun trArg+  = case splitTyConApp trFun of+      (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2+      _ -> Nothing++-- | Adds a TypeRep argument to a TypeRep.+mkAppTy :: TypeRep -> TypeRep -> TypeRep+mkAppTy (TypeRep tr_k tc trs) arg_tr+  = let (TypeRep arg_k _ _) = arg_tr+     in  TypeRep (appKey tr_k arg_k) tc (trs++[arg_tr])++-- If we enforce the restriction that there is only one+-- @TyCon@ for a type & it is shared among all its uses,+-- we can map them onto Ints very simply. The benefit is,+-- of course, that @TyCon@s can then be compared efficiently.++-- Provided the implementor of other @Typeable@ instances+-- takes care of making all the @TyCon@s CAFs (toplevel constants),+-- this will work. ++-- If this constraint does turn out to be a sore thumb, changing+-- the Eq instance for TyCons is trivial.++-- | Builds a 'TyCon' object representing a type constructor.  An+-- implementation of "Data.Typeable" should ensure that the following holds:+--+-- >  mkTyCon "a" == mkTyCon "a"+--++mkTyCon :: String	-- ^ the name of the type constructor (should be unique+			-- in the program, so it might be wise to use the+			-- fully qualified name).+	-> TyCon	-- ^ A unique 'TyCon' object+mkTyCon str = TyCon (mkTyConKey str) str++----------------- Observation ---------------------++-- | Observe the type constructor of a type representation+typeRepTyCon :: TypeRep -> TyCon+typeRepTyCon (TypeRep _ tc _) = tc++-- | Observe the argument types of a type representation+typeRepArgs :: TypeRep -> [TypeRep]+typeRepArgs (TypeRep _ _ args) = args++-- | Observe string encoding of a type representation+tyConString :: TyCon   -> String+tyConString  (TyCon _ str) = str++----------------- Showing TypeReps --------------------++instance Show TypeRep where+  showsPrec p (TypeRep _ tycon tys) =+    case tys of+      [] -> showsPrec p tycon+      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'+      [a,r] | tycon == funTc  -> showParen (p > 8) $+			         showsPrec 9 a .+                                 showString " -> " .+                                 showsPrec 8 r+      xs | isTupleTyCon tycon -> showTuple tycon xs+	 | otherwise	     ->+	    showParen (p > 9) $+   	    showsPrec p tycon . +	    showChar ' '      . +	    showArgs tys++instance Show TyCon where+  showsPrec _ (TyCon _ s) = showString s++isTupleTyCon :: TyCon -> Bool+isTupleTyCon (TyCon _ (',':_)) = True+isTupleTyCon _		       = False++-- Some (Show.TypeRep) helpers:++showArgs :: Show a => [a] -> ShowS+showArgs [] = id+showArgs [a] = showsPrec 10 a+showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as ++showTuple :: TyCon -> [TypeRep] -> ShowS+showTuple (TyCon _ str) args = showChar '(' . go str args+ where+  go [] [a] = showsPrec 10 a . showChar ')'+  go _  []  = showChar ')' -- a failure condition, really.+  go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as+  go _ _   = showChar ')'++-------------------------------------------------------------+--+--	The Typeable class and friends+--+-------------------------------------------------------------++-- | The class 'Typeable' allows a concrete representation of a type to+-- be calculated.+class Typeable a where+  typeOf :: a -> TypeRep+  -- ^ Takes a value of type @a@ and returns a concrete representation+  -- of that type.  The /value/ of the argument should be ignored by+  -- any instance of 'Typeable', so that it is safe to pass 'undefined' as+  -- the argument.++-- | Variant for unary type constructors+class Typeable1 t where+  typeOf1 :: t a -> TypeRep++-- | For defining a 'Typeable' instance from any 'Typeable1' instance.+typeOfDefault :: (Typeable1 t, Typeable a) => t a -> TypeRep+typeOfDefault x = typeOf1 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a -> a+   argType =  undefined++-- | Variant for binary type constructors+class Typeable2 t where+  typeOf2 :: t a b -> TypeRep++-- | For defining a 'Typeable1' instance from any 'Typeable2' instance.+typeOf1Default :: (Typeable2 t, Typeable a) => t a b -> TypeRep+typeOf1Default x = typeOf2 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b -> a+   argType =  undefined++-- | Variant for 3-ary type constructors+class Typeable3 t where+  typeOf3 :: t a b c -> TypeRep++-- | For defining a 'Typeable2' instance from any 'Typeable3' instance.+typeOf2Default :: (Typeable3 t, Typeable a) => t a b c -> TypeRep+typeOf2Default x = typeOf3 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c -> a+   argType =  undefined++-- | Variant for 4-ary type constructors+class Typeable4 t where+  typeOf4 :: t a b c d -> TypeRep++-- | For defining a 'Typeable3' instance from any 'Typeable4' instance.+typeOf3Default :: (Typeable4 t, Typeable a) => t a b c d -> TypeRep+typeOf3Default x = typeOf4 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d -> a+   argType =  undefined++-- | Variant for 5-ary type constructors+class Typeable5 t where+  typeOf5 :: t a b c d e -> TypeRep++-- | For defining a 'Typeable4' instance from any 'Typeable5' instance.+typeOf4Default :: (Typeable5 t, Typeable a) => t a b c d e -> TypeRep+typeOf4Default x = typeOf5 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d e -> a+   argType =  undefined++-- | Variant for 6-ary type constructors+class Typeable6 t where+  typeOf6 :: t a b c d e f -> TypeRep++-- | For defining a 'Typeable5' instance from any 'Typeable6' instance.+typeOf5Default :: (Typeable6 t, Typeable a) => t a b c d e f -> TypeRep+typeOf5Default x = typeOf6 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d e f -> a+   argType =  undefined++-- | Variant for 7-ary type constructors+class Typeable7 t where+  typeOf7 :: t a b c d e f g -> TypeRep++-- | For defining a 'Typeable6' instance from any 'Typeable7' instance.+typeOf6Default :: (Typeable7 t, Typeable a) => t a b c d e f g -> TypeRep+typeOf6Default x = typeOf7 x `mkAppTy` typeOf (argType x)+ where+   argType :: t a b c d e f g -> a+   argType =  undefined++-- Given a @Typeable@/n/ instance for an /n/-ary type constructor,+-- define the instances for partial applications.+-- Programmers using non-GHC implementations must do this manually+-- for each type constructor.+-- (The INSTANCE_TYPEABLE/n/ macros in Typeable.h include this.)++-- | One Typeable instance for all Typeable1 instances+instance (Typeable1 s, Typeable a)+       => Typeable (s a) where+  typeOf = typeOfDefault++-- | One Typeable1 instance for all Typeable2 instances+instance (Typeable2 s, Typeable a)+       => Typeable1 (s a) where+  typeOf1 = typeOf1Default++-- | One Typeable2 instance for all Typeable3 instances+instance (Typeable3 s, Typeable a)+       => Typeable2 (s a) where+  typeOf2 = typeOf2Default++-- | One Typeable3 instance for all Typeable4 instances+instance (Typeable4 s, Typeable a)+       => Typeable3 (s a) where+  typeOf3 = typeOf3Default++-- | One Typeable4 instance for all Typeable5 instances+instance (Typeable5 s, Typeable a)+       => Typeable4 (s a) where+  typeOf4 = typeOf4Default++-- | One Typeable5 instance for all Typeable6 instances+instance (Typeable6 s, Typeable a)+       => Typeable5 (s a) where+  typeOf5 = typeOf5Default++-- | One Typeable6 instance for all Typeable7 instances+instance (Typeable7 s, Typeable a)+       => Typeable6 (s a) where+  typeOf6 = typeOf6Default++-------------------------------------------------------------+--+--		Type-safe cast+--+-------------------------------------------------------------++-- | The type-safe cast operation+cast :: (Typeable a, Typeable b) => a -> Maybe b+cast x = r+       where+	 r = if typeOf x == typeOf (fromJust r)+               then Just $ unsafeCoerce x+	       else Nothing++-- | A flexible variation parameterised in a type constructor+gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)+gcast x = r+ where+  r = if typeOf (getArg x) == typeOf (getArg (fromJust r))+        then Just $ unsafeCoerce x+        else Nothing+  getArg :: c x -> x +  getArg = undefined++-- | Cast for * -> *+gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) +gcast1 x = r+ where+  r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))+       then Just $ unsafeCoerce x+       else Nothing+  getArg :: c x -> x +  getArg = undefined++-- | Cast for * -> * -> *+gcast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) +gcast2 x = r+ where+  r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))+       then Just $ unsafeCoerce x+       else Nothing+  getArg :: c x -> x +  getArg = undefined++-------------------------------------------------------------+--+--	Instances of the Typeable classes for Prelude types+--+-------------------------------------------------------------++INSTANCE_TYPEABLE1([],listTc,"[]")+INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")+INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")+INSTANCE_TYPEABLE2(Either,eitherTc,"Either")+INSTANCE_TYPEABLE2((->),funTc,"->")+INSTANCE_TYPEABLE1(IO,ioTc,"IO")+INSTANCE_TYPEABLE0((),unitTc,"()")++INSTANCE_TYPEABLE2((,),pairTc,",")+INSTANCE_TYPEABLE3((,,),tup3Tc,",,")++tup4Tc :: TyCon+tup4Tc = mkTyCon ",,,"++instance Typeable4 (,,,) where+  typeOf4 _ = mkTyConApp tup4Tc []++tup5Tc :: TyCon+tup5Tc = mkTyCon ",,,,"++instance Typeable5 (,,,,) where+  typeOf5 _ = mkTyConApp tup5Tc []++tup6Tc :: TyCon+tup6Tc = mkTyCon ",,,,,"++instance Typeable6 (,,,,,) where+  typeOf6 _ = mkTyConApp tup6Tc []++tup7Tc :: TyCon+tup7Tc = mkTyCon ",,,,,"++instance Typeable7 (,,,,,,) where+  typeOf7 _ = mkTyConApp tup7Tc []++INSTANCE_TYPEABLE1(Ptr,ptrTc,"Foreign.Ptr.Ptr")+INSTANCE_TYPEABLE1(StablePtr,stableptrTc,"Foreign.StablePtr.StablePtr")+INSTANCE_TYPEABLE1(IORef,iorefTc,"Data.IORef.IORef")++-------------------------------------------------------+--+-- Generate Typeable instances for standard datatypes+--+-------------------------------------------------------++INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")+INSTANCE_TYPEABLE0(Char,charTc,"Char")+INSTANCE_TYPEABLE0(Float,floatTc,"Float")+INSTANCE_TYPEABLE0(Double,doubleTc,"Double")+INSTANCE_TYPEABLE0(Int,intTc,"Int")+INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")+INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")+INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")++INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")+INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")+INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")+INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")++INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )+INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")+INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")+INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")++INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")+INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")++INSTANCE_TYPEABLE0(Word,wordTc,"Word" )++#else /* GHC < 6.3 */++  (+	-- * The Typeable class+	Typeable( typeOf ),	-- :: a -> TypeRep++	-- * Type-safe cast+	cast,			-- :: (Typeable a, Typeable b) => a -> Maybe b+	castss,			-- a cast for kind "* -> *"+	castarr,		-- another convenient variation++	-- * Type representations+	TypeRep,	-- abstract, instance of: Eq, Show, Typeable+	TyCon,		-- abstract, instance of: Eq, Show, Typeable++	-- * Construction of type representations+	mkTyCon,	-- :: String  -> TyCon+	mkAppTy,	-- :: TyCon   -> [TypeRep] -> TypeRep+	mkFunTy,	-- :: TypeRep -> TypeRep   -> TypeRep+	applyTy,	-- :: TypeRep -> TypeRep   -> Maybe TypeRep++	-- * Observation of type representations+	typerepTyCon,	-- :: TypeRep -> TyCon+	typerepArgs,	-- :: TypeRep -> [TypeRep]+	tyconString	-- :: TyCon   -> String+++  ) where++import qualified Data.HashTable as HT+import Data.Maybe+import Data.Either+import Data.Int+import Data.Word+import Data.List( foldl )++import GHC.Base+import GHC.Show+import GHC.Err+import GHC.Num+import GHC.Float+import GHC.Real( rem, Ratio )+import GHC.IOBase+import GHC.Ptr		-- So we can give Typeable instance for Ptr+import GHC.Stable	-- So we can give Typeable instance for StablePtr++unsafeCoerce :: a -> b+unsafeCoerce = unsafeCoerce#++#include "Typeable.h"+++-------------------------------------------------------------+--+--		Type representations+--+-------------------------------------------------------------+++-- | A concrete representation of a (monomorphic) type.  'TypeRep'+-- supports reasonably efficient equality.+data TypeRep = TypeRep !Key TyCon [TypeRep] ++-- Compare keys for equality+instance Eq TypeRep where+  (TypeRep _ t1 a1) == (TypeRep _ t2 a2) = t1 == t2 && a1 == a2++-- | An abstract representation of a type constructor.  'TyCon' objects can+-- be built using 'mkTyCon'.+data TyCon = TyCon !Key String++instance Eq TyCon where+  (TyCon _ s1) == (TyCon _ s2) = s1 == s2++	-- +	-- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")+	--                                 [fTy,fTy,fTy])+	-- +	-- returns "(Foo,Foo,Foo)"+	--+	-- The TypeRep Show instance promises to print tuple types+	-- correctly. Tuple type constructors are specified by a +	-- sequence of commas, e.g., (mkTyCon ",,,,") returns+	-- the 5-tuple tycon.++----------------- Construction --------------------++-- | Applies a type constructor to a sequence of types+mkAppTy  :: TyCon -> [TypeRep] -> TypeRep+mkAppTy tc@(TyCon tc_k _) args +  = TypeRep (appKeys tc_k arg_ks) tc args+  where+    arg_ks = [k | TypeRep k _ _ <- args]++funTc :: TyCon+funTc = mkTyCon "->"++-- | A special case of 'mkAppTy', which applies the function +-- type constructor to a pair of types.+mkFunTy  :: TypeRep -> TypeRep -> TypeRep+mkFunTy f a = mkAppTy funTc [f,a]++-- | Applies a type to a function type.  Returns: @'Just' u@ if the+-- first argument represents a function of type @t -> u@ and the+-- second argument represents a function of type @t@.  Otherwise,+-- returns 'Nothing'.+applyTy :: TypeRep -> TypeRep -> Maybe TypeRep+applyTy (TypeRep _ tc [t1,t2]) t3+  | tc == funTc && t1 == t3	= Just t2+applyTy _ _     		= Nothing++-- If we enforce the restriction that there is only one+-- @TyCon@ for a type & it is shared among all its uses,+-- we can map them onto Ints very simply. The benefit is,+-- of course, that @TyCon@s can then be compared efficiently.++-- Provided the implementor of other @Typeable@ instances+-- takes care of making all the @TyCon@s CAFs (toplevel constants),+-- this will work. ++-- If this constraint does turn out to be a sore thumb, changing+-- the Eq instance for TyCons is trivial.++-- | Builds a 'TyCon' object representing a type constructor.  An+-- implementation of "Data.Typeable" should ensure that the following holds:+--+-- >  mkTyCon "a" == mkTyCon "a"+--++mkTyCon :: String	-- ^ the name of the type constructor (should be unique+			-- in the program, so it might be wise to use the+			-- fully qualified name).+	-> TyCon	-- ^ A unique 'TyCon' object+mkTyCon str = TyCon (mkTyConKey str) str++++----------------- Observation ---------------------+++-- | Observe the type constructor of a type representation+typerepTyCon :: TypeRep -> TyCon+typerepTyCon (TypeRep _ tc _) = tc+++-- | Observe the argument types of a type representation+typerepArgs :: TypeRep -> [TypeRep]+typerepArgs (TypeRep _ _ args) = args+++-- | Observe string encoding of a type representation+tyconString :: TyCon   -> String+tyconString  (TyCon _ str) = str+++----------------- Showing TypeReps --------------------++instance Show TypeRep where+  showsPrec p (TypeRep _ tycon tys) =+    case tys of+      [] -> showsPrec p tycon+      [x]   | tycon == listTc -> showChar '[' . shows x . showChar ']'+      [a,r] | tycon == funTc  -> showParen (p > 8) $+			         showsPrec 9 a . showString " -> " . showsPrec 8 r+      xs | isTupleTyCon tycon -> showTuple tycon xs+	 | otherwise	     ->+	    showParen (p > 9) $+   	    showsPrec p tycon . +	    showChar ' '      . +	    showArgs tys++instance Show TyCon where+  showsPrec _ (TyCon _ s) = showString s++isTupleTyCon :: TyCon -> Bool+isTupleTyCon (TyCon _ (',':_)) = True+isTupleTyCon _		       = False++-- Some (Show.TypeRep) helpers:++showArgs :: Show a => [a] -> ShowS+showArgs [] = id+showArgs [a] = showsPrec 10 a+showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as ++showTuple :: TyCon -> [TypeRep] -> ShowS+showTuple (TyCon _ str) args = showChar '(' . go str args+ where+  go [] [a] = showsPrec 10 a . showChar ')'+  go _  []  = showChar ')' -- a failure condition, really.+  go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as+  go _ _   = showChar ')'+++-------------------------------------------------------------+--+--	The Typeable class+--+-------------------------------------------------------------++-- | The class 'Typeable' allows a concrete representation of a type to+-- be calculated.+class Typeable a where+  typeOf :: a -> TypeRep+  -- ^ Takes a value of type @a@ and returns a concrete representation+  -- of that type.  The /value/ of the argument should be ignored by+  -- any instance of 'Typeable', so that it is safe to pass 'undefined' as+  -- the argument.+++-------------------------------------------------------------+--+--		Type-safe cast+--+-------------------------------------------------------------++-- | The type-safe cast operation+cast :: (Typeable a, Typeable b) => a -> Maybe b+cast x = r+       where+	 r = if typeOf x == typeOf (fromJust r)+               then Just $ unsafeCoerce x+	       else Nothing+++-- | A convenient variation for kind "* -> *"+castss :: (Typeable a, Typeable b) => t a -> Maybe (t b)+castss x = r+       where+	 r = if typeOf (get x) == typeOf (get (fromJust r))+               then Just $ unsafeCoerce x+	       else Nothing+         get :: t c -> c+	 get = undefined+++-- | Another variation+castarr :: (Typeable a, Typeable b, Typeable c, Typeable d)+        => (a -> t b) -> Maybe (c -> t d)+castarr x = r+       where+	 r = if typeOf (get x) == typeOf (get (fromJust r))+               then Just $ unsafeCoerce x+	       else Nothing+         get :: (e -> t f) -> (e, f)+	 get = undefined++{-++The variations castss and castarr are arguably not really needed.+Let's discuss castss in some detail. To get rid of castss, we can+require "Typeable (t a)" and "Typeable (t b)" rather than just+"Typeable a" and "Typeable b". In that case, the ordinary cast would+work. Eventually, all kinds of library instances should become+Typeable. (There is another potential use of variations as those given+above. It allows quantification on type constructors.++-}+++-------------------------------------------------------------+--+--	Instances of the Typeable class for Prelude types+--+-------------------------------------------------------------++listTc :: TyCon+listTc = mkTyCon "[]"++instance Typeable a => Typeable [a] where+  typeOf ls = mkAppTy listTc [typeOf ((undefined :: [a] -> a) ls)]+	-- In GHC we can say+	--	typeOf (undefined :: a)+	-- using scoped type variables, but we use the +	-- more verbose form here, for compatibility with Hugs++unitTc :: TyCon+unitTc = mkTyCon "()"++instance Typeable () where+  typeOf _ = mkAppTy unitTc []++tup2Tc :: TyCon+tup2Tc = mkTyCon ","++instance (Typeable a, Typeable b) => Typeable (a,b) where+  typeOf tu = mkAppTy tup2Tc [typeOf ((undefined :: (a,b) -> a) tu),+			      typeOf ((undefined :: (a,b) -> b) tu)]++tup3Tc :: TyCon+tup3Tc = mkTyCon ",,"++instance ( Typeable a , Typeable b , Typeable c) => Typeable (a,b,c) where+  typeOf tu = mkAppTy tup3Tc [typeOf ((undefined :: (a,b,c) -> a) tu),+			      typeOf ((undefined :: (a,b,c) -> b) tu),+			      typeOf ((undefined :: (a,b,c) -> c) tu)]++tup4Tc :: TyCon+tup4Tc = mkTyCon ",,,"++instance ( Typeable a+	 , Typeable b+	 , Typeable c+	 , Typeable d) => Typeable (a,b,c,d) where+  typeOf tu = mkAppTy tup4Tc [typeOf ((undefined :: (a,b,c,d) -> a) tu),+			      typeOf ((undefined :: (a,b,c,d) -> b) tu),+			      typeOf ((undefined :: (a,b,c,d) -> c) tu),+			      typeOf ((undefined :: (a,b,c,d) -> d) tu)]+tup5Tc :: TyCon+tup5Tc = mkTyCon ",,,,"++instance ( Typeable a+	 , Typeable b+	 , Typeable c+	 , Typeable d+	 , Typeable e) => Typeable (a,b,c,d,e) where+  typeOf tu = mkAppTy tup5Tc [typeOf ((undefined :: (a,b,c,d,e) -> a) tu),+			      typeOf ((undefined :: (a,b,c,d,e) -> b) tu),+			      typeOf ((undefined :: (a,b,c,d,e) -> c) tu),+			      typeOf ((undefined :: (a,b,c,d,e) -> d) tu),+			      typeOf ((undefined :: (a,b,c,d,e) -> e) tu)]++instance (Typeable a, Typeable b) => Typeable (a -> b) where+  typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))+		     (typeOf ((undefined :: (a -> b) -> b) f))++++-------------------------------------------------------+--+-- Generate Typeable instances for standard datatypes+--+-------------------------------------------------------++INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")+INSTANCE_TYPEABLE0(Char,charTc,"Char")+INSTANCE_TYPEABLE0(Float,floatTc,"Float")+INSTANCE_TYPEABLE0(Double,doubleTc,"Double")+INSTANCE_TYPEABLE0(Int,intTc,"Int")+INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")+INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")+INSTANCE_TYPEABLE2(Either,eitherTc,"Either")+INSTANCE_TYPEABLE1(IO,ioTc,"IO")+INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")+INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")+INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")+INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")+INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")++INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")+INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")+INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")+INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")++INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )+INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")+INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")+INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")++INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")+INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")++INSTANCE_TYPEABLE1(IORef,ioRefTc,"IORef")++#endif /* GHC < 6.3 */+++---------------------------------------------+--+--		Internals +--+---------------------------------------------++newtype Key = Key Int deriving( Eq )++data KeyPr = KeyPr !Key !Key deriving( Eq )++hashKP :: KeyPr -> Int32+hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime++data Cache = Cache { next_key :: !(IORef Key),+		     tc_tbl   :: !(HT.HashTable String Key),+		     ap_tbl   :: !(HT.HashTable KeyPr Key) }++{-# NOINLINE cache #-}+cache :: Cache+cache = unsafePerformIO $ do+		empty_tc_tbl <- HT.new (==) HT.hashString+		empty_ap_tbl <- HT.new (==) hashKP+		key_loc      <- newIORef (Key 1) +		return (Cache { next_key = key_loc,+				tc_tbl = empty_tc_tbl, +				ap_tbl = empty_ap_tbl })++newKey :: IORef Key -> IO Key+newKey _ = do i <- genSym; return (Key i)+++-- In GHC we use the RTS's genSym function to get a new unique,+-- because in GHCi we might have two copies of the Data.Typeable+-- library running (one in the compiler and one in the running+-- program), and we need to make sure they don't share any keys.  +--+-- This is really a hack.  A better solution would be to centralise the+-- whole mutable state used by this module, i.e. both hashtables.  But+-- the current solution solves the immediate problem, which is that+-- dynamics generated in one world with one type were erroneously+-- being recognised by the other world as having a different type.+--+-- dons: SimonM says we need to unify the hashes by storing them in a+-- variable in the rts.+-- +foreign import ccall unsafe "genSymZh"+  genSym :: IO Int++mkTyConKey :: String -> Key+mkTyConKey str +  = unsafePerformIO $ do+	let Cache {next_key = kloc, tc_tbl = tbl} = cache+	mb_k <- HT.lookup tbl str+	case mb_k of+	  Just k  -> return k+	  Nothing -> do { k <- newKey kloc ;+			  HT.insert tbl str k ;+			  return k }++appKey :: Key -> Key -> Key+appKey k1 k2+  = unsafePerformIO $ do+	let Cache {next_key = kloc, ap_tbl = tbl} = cache+	mb_k <- HT.lookup tbl kpr+	case mb_k of+	  Just k  -> return k+	  Nothing -> do { k <- newKey kloc ;+			  HT.insert tbl kpr k ;+			  return k }+  where+    kpr = KeyPr k1 k2++appKeys :: Key -> [Key] -> Key+appKeys k ks = foldl appKey k ks
+ src/Language/Hi/Binary.hs view
@@ -0,0 +1,581 @@+{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -fno-warn-unused-imports -fno-warn-name-shadowing #-}+{-# OPTIONS -fno-warn-unused-matches -fno-warn-unused-binds   #-}+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA++-- Based on $fptools/ghc/compiler/utils/Binary.hs:+-- (c) The University of Glasgow 2002+--+-- Binary I/O library, with special tweaks for GHC+--+-- Based on the nhc98 Binary library, which is copyright+-- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.+-- Under the terms of the license for that software, we must tell you+-- where you can obtain the original version of the Binary library, namely+--     http://www.cs.york.ac.uk/fp/nhc98/+--+-- We never have to write stuff, so I've scrubbed all the put* code.+--++module Language.Hi.Binary ( +    {-type-}  Bin,+    {-class-} Binary(..),+    {-type-}  BinHandle,++   openBinIO, openBinIO_,+   openBinMem,+--   closeBin,++   seekBin,+   tellBin,+   castBin,++   readBinMem,++   isEOFBin,++   -- for writing instances:+   getByte,++   -- lazy Bin I/O+   lazyGet,++   -- GHC only:+   ByteArray(..),+   getByteArray,++   getBinFileWithDict,	-- :: Binary a => FilePath -> IO a++  ) where++-- The *host* architecture version:+#include "MachDeps.h"++-- import Hi.Utils -- ?++import Language.Hi.FastMutInt+import Language.Hi.FastString++#if __GLASGOW_HASKELL__ < 604+import Data.FiniteMap+#else+import qualified Data.Map as M+#endif ++import Data.Unique++import Data.Array.IO+import Data.Array+import Data.Bits+import Data.Int+import Data.Word+import Data.IORef+import Data.Char		( ord, chr )+import Data.Array.Base  	( unsafeRead, unsafeWrite )+import Control.Monad		( when )+import System.IO+import System.IO.Unsafe		( unsafeInterleaveIO )+import System.IO.Error		( mkIOError, eofErrorType )+import GHC.Real			( Ratio(..) )+import GHC.Exts+import GHC.IOBase	 	( IO(..) )+import GHC.Word			( Word8(..) )+#if __GLASGOW_HASKELL__ < 601+import GHC.Handle		( openFileEx, IOModeEx(..) )+#endif++#if __GLASGOW_HASKELL__ < 601+openBinaryFile f mode = openFileEx f (BinaryMode mode)+#endif++type BinArray = IOUArray Int Word8++---------------------------------------------------------------+--		BinHandle+---------------------------------------------------------------++data BinHandle+  = BinMem {		-- binary data stored in an unboxed array+     bh_usr :: UserData,	-- sigh, need parameterized modules :-)+     off_r :: !FastMutInt,		-- the current offset+     sz_r  :: !FastMutInt,		-- size of the array (cached)+     arr_r :: !(IORef BinArray) 	-- the array (bounds: (0,size-1))+    }+	-- XXX: should really store a "high water mark" for dumping out+	-- the binary data to a file.++  | BinIO {		-- binary data stored in a file+     bh_usr :: UserData,+     off_r :: !FastMutInt,		-- the current offset (cached)+     hdl   :: !Handle		-- the file handle (must be seekable)+   }+	-- cache the file ptr in BinIO; using hTell is too expensive+	-- to call repeatedly.  If anyone else is modifying this Handle+	-- at the same time, we'll be screwed.++getUserData :: BinHandle -> UserData+getUserData bh = bh_usr bh++setUserData :: BinHandle -> UserData -> BinHandle+setUserData bh us = bh { bh_usr = us }+++---------------------------------------------------------------+--		Bin+---------------------------------------------------------------++newtype Bin a = BinPtr Int +  deriving (Eq, Ord, Show, Bounded)++castBin :: Bin a -> Bin b+castBin (BinPtr i) = BinPtr i++---------------------------------------------------------------+--		class Binary+---------------------------------------------------------------++class Binary a where+    get    :: BinHandle -> IO a++getAt  :: Binary a => BinHandle -> Bin a -> IO a+getAt bh p = do seekBin bh p; get bh++openBinIO_ :: Handle -> IO BinHandle+openBinIO_ h = openBinIO h ++openBinIO :: Handle -> IO BinHandle+openBinIO h = do+  r <- newFastMutInt+  writeFastMutInt r 0+  return (BinIO noUserData r h)++openBinMem :: Int -> IO BinHandle+openBinMem size+ | size <= 0 = error "Hi.Binary.openBinMem: size must be >= 0"+ | otherwise = do+   arr <- newArray_ (0,size-1)+   arr_r <- newIORef arr+   ix_r <- newFastMutInt+   writeFastMutInt ix_r 0+   sz_r <- newFastMutInt+   writeFastMutInt sz_r size+   return (BinMem noUserData ix_r sz_r arr_r)++tellBin :: BinHandle -> IO (Bin a)+tellBin (BinIO  _ r _)   = do ix <- readFastMutInt r; return (BinPtr ix)+tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)++seekBin :: BinHandle -> Bin a -> IO ()+seekBin (BinIO _ ix_r h) (BinPtr p) = do +  writeFastMutInt ix_r p+  hSeek h AbsoluteSeek (fromIntegral p)+seekBin h@(BinMem _ ix_r sz_r a) (BinPtr p) = do+  sz <- readFastMutInt sz_r+  if (p >= sz)+	then do expandBin h p; writeFastMutInt ix_r p+	else writeFastMutInt ix_r p++isEOFBin :: BinHandle -> IO Bool+isEOFBin (BinMem _ ix_r sz_r a) = do+  ix <- readFastMutInt ix_r+  sz <- readFastMutInt sz_r+  return (ix >= sz)+isEOFBin (BinIO _ ix_r h) = hIsEOF h++readBinMem :: FilePath -> IO BinHandle+-- Return a BinHandle with a totally undefined State+readBinMem filename = do+  h <- openBinaryFile filename ReadMode+  filesize' <- hFileSize h+  let filesize = fromIntegral filesize'+  arr <- newArray_ (0,filesize-1)+  count <- hGetArray h arr filesize+  when (count /= filesize)+	(error ("Hi.Binary.readBinMem: only read " ++ show count ++ " bytes"))+  hClose h+  arr_r <- newIORef arr+  ix_r <- newFastMutInt+  writeFastMutInt ix_r 0+  sz_r <- newFastMutInt+  writeFastMutInt sz_r filesize+  return (BinMem noUserData ix_r sz_r arr_r)++-- expand the size of the array to include a specified offset+expandBin :: BinHandle -> Int -> IO ()+expandBin (BinMem _ ix_r sz_r arr_r) off = do+   sz <- readFastMutInt sz_r+   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))+   arr <- readIORef arr_r+   arr' <- newArray_ (0,sz'-1)+   sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i+ 	     | i <- [ 0 .. sz-1 ] ]+   writeFastMutInt sz_r sz'+   writeIORef arr_r arr'+#ifdef DEBUG+   hPutStrLn stderr ("Binary: expanding to size: " ++ show sz')+#endif+   return ()+expandBin (BinIO _ _ _) _ = return ()+	-- no need to expand a file, we'll assume they expand by themselves.++-- -----------------------------------------------------------------------------+-- Low-level reading/writing of bytes++getWord8 :: BinHandle -> IO Word8+getWord8 (BinMem _ ix_r sz_r arr_r) = do+    ix <- readFastMutInt ix_r+    sz <- readFastMutInt sz_r+    when (ix >= sz)  $+#if __GLASGOW_HASKELL__ <= 408+	throw (mkIOError eofErrorType "Hi.Binary.getWord8" Nothing Nothing)+#else+	ioError (mkIOError eofErrorType "Hi.Binary.getWord8" Nothing Nothing)+#endif+    arr <- readIORef arr_r+    w <- unsafeRead arr ix+    writeFastMutInt ix_r (ix+1)+    return w+getWord8 (BinIO _ ix_r h) = do+    ix <- readFastMutInt ix_r+    c <- hGetChar h+    writeFastMutInt ix_r (ix+1)+    return $! (fromIntegral (ord c))	-- XXX not really correct++getByte :: BinHandle -> IO Word8+getByte = getWord8++-- -----------------------------------------------------------------------------+-- Primitve Word writes++instance Binary Word8 where+  get  = getWord8++instance Binary Word16 where+  get h = do+    w1 <- getWord8 h+    w2 <- getWord8 h+    return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2)++instance Binary Word32 where+  get h = do+    w1 <- getWord8 h+    w2 <- getWord8 h+    w3 <- getWord8 h+    w4 <- getWord8 h+    return $! ((fromIntegral w1 `shiftL` 24) .|. +	       (fromIntegral w2 `shiftL` 16) .|. +	       (fromIntegral w3 `shiftL`  8) .|. +	       (fromIntegral w4))++instance Binary Word64 where+  get h = do+    w1 <- getWord8 h+    w2 <- getWord8 h+    w3 <- getWord8 h+    w4 <- getWord8 h+    w5 <- getWord8 h+    w6 <- getWord8 h+    w7 <- getWord8 h+    w8 <- getWord8 h+    return $! ((fromIntegral w1 `shiftL` 56) .|. +	       (fromIntegral w2 `shiftL` 48) .|. +	       (fromIntegral w3 `shiftL` 40) .|. +	       (fromIntegral w4 `shiftL` 32) .|. +	       (fromIntegral w5 `shiftL` 24) .|. +	       (fromIntegral w6 `shiftL` 16) .|. +	       (fromIntegral w7 `shiftL`  8) .|. +	       (fromIntegral w8))++-- -----------------------------------------------------------------------------+-- Primitve Int writes++instance Binary Int8 where+  get h    = do w <- get h; return $! (fromIntegral (w::Word8))++instance Binary Int16 where+  get h    = do w <- get h; return $! (fromIntegral (w::Word16))++instance Binary Int32 where+  get h    = do w <- get h; return $! (fromIntegral (w::Word32))++instance Binary Int64 where+  get h    = do w <- get h; return $! (fromIntegral (w::Word64))++-- -----------------------------------------------------------------------------+-- Instances for standard types++instance Binary () where+    get  _     = return ()++instance Binary Bool where+    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))++instance Binary Char where+    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))++instance Binary Int where+#if SIZEOF_HSINT == 4+    get  bh = do+	x <- get bh+	return $! (fromIntegral (x :: Int32))+#elif SIZEOF_HSINT == 8+    get  bh = do+	x <- get bh+	return $! (fromIntegral (x :: Int64))+#else+#error "unsupported sizeof(HsInt)"+#endif++instance Binary a => Binary [a] where+#if __GLASGOW_HASKELL__ < 605+    get bh         = do h <- getWord8 bh+                        case h of+                          0 -> return []+                          _ -> do x  <- get bh+                                  xs <- get bh+                                  return (x:xs)+#else+    get bh = do+       b <- getByte bh+       len <- if b == 0xff +                 then get bh+                 else return (fromIntegral b :: Word32)+       let loop 0 = return []+           loop n = do a <- get bh; as <- loop (n-1); return (a:as)+       loop len+#endif++instance (Binary a, Binary b) => Binary (a,b) where+    get bh        = do a <- get bh+                       b <- get bh+                       return (a,b)++instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where+    get bh          = do a <- get bh+                         b <- get bh+                         c <- get bh+                         return (a,b,c)++instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where+    get bh          = do a <- get bh+                         b <- get bh+                         c <- get bh+                         d <- get bh+                         return (a,b,c,d)++instance Binary a => Binary (Maybe a) where+    get bh           = do h <- getWord8 bh+                          case h of+                            0 -> return Nothing+                            _ -> do x <- get bh; return (Just x)++instance (Binary a, Binary b) => Binary (Either a b) where+    get bh            = do h <- getWord8 bh+                           case h of+                             0 -> do a <- get bh ; return (Left a)+                             _ -> do b <- get bh ; return (Right b)++#ifdef __GLASGOW_HASKELL__+instance Binary Integer where+    get bh = do +	b <- getByte bh+	case b of+	  0 -> do (I# i#) <- get bh+		  return (S# i#)+	  _ -> do (I# s#) <- get bh+		  sz <- get bh+		  (BA a#) <- getByteArray bh sz+		  return (J# s# a#)++getByteArray :: BinHandle -> Int -> IO ByteArray+getByteArray bh (I# sz) = do+  (MBA arr) <- newByteArray sz +  let loop n+	   | n ==# sz = return ()+	   | otherwise = do+		w <- getByte bh +		writeByteArray arr n w+		loop (n +# 1#)+  loop 0#+  freezeByteArray arr+++data ByteArray = BA ByteArray#+data MBA = MBA (MutableByteArray# RealWorld)++newByteArray :: Int# -> IO MBA+newByteArray sz = IO $ \s ->+  case newByteArray# sz s of { (# s, arr #) ->+  (# s, MBA arr #) }++freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray+freezeByteArray arr = IO $ \s ->+  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->+  (# s, BA arr #) }++#if __GLASGOW_HASKELL__ < 503+writeByteArray arr i w8 = IO $ \s ->+  case word8ToWord w8 of { W# w# -> +  case writeCharArray# arr i (chr# (word2Int# w#)) s  of { s ->+  (# s , () #) }}+#else+writeByteArray arr i (W8# w) = IO $ \s ->+  case writeWord8Array# arr i w s of { s ->+  (# s, () #) }+#endif++#if __GLASGOW_HASKELL__ < 503+indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#)))+#else+indexByteArray a# n# = W8# (indexWord8Array# a# n#)+#endif++instance (Integral a, Binary a) => Binary (Ratio a) where+    get bh = do a <- get bh; b <- get bh; return (a :% b)+#endif++instance Binary (Bin a) where+  get bh = do i <- get bh; return (BinPtr i)++-- -----------------------------------------------------------------------------+-- Lazy reading/writing++lazyGet :: Binary a => BinHandle -> IO a+lazyGet bh = do+    p <- get bh		-- a BinPtr+    p_a <- tellBin bh+    a <- unsafeInterleaveIO (getAt bh p_a)+    seekBin bh p -- skip over the object for now+    return a++-- --------------------------------------------------------------+-- 	Main wrappers: getBinFileWithDict, putBinFileWithDict+--+--	This layer is built on top of the stuff above, +--	and should not know anything about BinHandles+-- --------------------------------------------------------------++initBinMemSize       = (1024*1024) :: Int+#if   WORD_SIZE_IN_BITS == 32+binaryInterfaceMagic = 0x1face :: Word32+#elif WORD_SIZE_IN_BITS == 64+binaryInterfaceMagic = 0x1face64 :: Word32+#endif++getBinFileWithDict :: Binary a => FilePath -> IO a+getBinFileWithDict file_path = do+        bh <- Language.Hi.Binary.readBinMem file_path++	-- Read the magic number to check that this really is a GHC .hi file+	-- (This magic number does not change when we change +	--  GHC interface file format)+        magic <- get bh++        when (magic /= binaryInterfaceMagic) $+                error "magic number mismatch: old/corrupt interface file?"++	-- Read the dictionary+	-- The next word in the file is a pointer to where the dictionary is+	-- (probably at the end of the file)+        dict_p <- Language.Hi.Binary.get bh	-- Get the dictionary ptr+        data_p <- tellBin bh		-- Remember where we are now+        seekBin bh dict_p+        dict <- getDictionary bh++        seekBin bh data_p		-- Back to where we were before++	-- Initialise the user-data field of bh+        let bh' = setUserData bh (initReadState dict)++	-- At last, get the thing +        get bh'++-- -----------------------------------------------------------------------------+-- UserData+-- -----------------------------------------------------------------------------++data UserData = +   UserData { 	-- This field is used only when reading+	      ud_dict :: Dictionary,++		-- The next two fields are only used when writing+	      ud_next :: IORef Int,	-- The next index to use+#if __GLASGOW_HASKELL__ < 604+	      ud_map  :: IORef (FiniteMap Unique (Int,FastString))+#else+	      ud_map  :: IORef (M.Map Unique (Int,FastString))+#endif+	}++noUserData = error "Hi.Binary.UserData: no user data"++initReadState :: Dictionary -> UserData+initReadState dict = UserData{ ud_dict = dict,+			       ud_next = undef "next",+			       ud_map  = undef "map" }++newWriteState :: IO UserData+newWriteState = do+        j_r <- newIORef 0+#if __GLASGOW_HASKELL__ < 604+        out_r <- newIORef emptyFM+#else+        out_r <- newIORef M.empty+#endif+        return (UserData { ud_dict = error "dict",+                           ud_next = j_r,+                           ud_map  = out_r })+++undef s = error ("Hi.Binary.UserData: no " ++ s)++---------------------------------------------------------+--		The Dictionary +---------------------------------------------------------++type Dictionary = Array Int FastString	-- The dictionary+					-- Should be 0-indexed++getDictionary :: BinHandle -> IO Dictionary+getDictionary bh = do +  sz <- get bh+  elems <- sequence (take sz (repeat (getFS bh)))+  return (listArray (0,sz-1) elems)++#if __GLASGOW_HASKELL__ < 604+constructDictionary :: Int -> FiniteMap Unique (Int,FastString) -> Dictionary+constructDictionary j fm = array (0,j-1) (eltsFM fm)+#else+constructDictionary :: Int -> M.Map Unique (Int,FastString) -> Dictionary+constructDictionary j fm = array (0,j-1) (M.elems fm)+#endif++---------------------------------------------------------+--		Reading and writing FastStrings+---------------------------------------------------------+  +getFS bh = do+        (I# l)  <- get bh+        (BA ba) <- getByteArray bh (I# l)+        return $! (mkFastSubStringBA# ba 0# l)++instance Binary FastString where+        get bh = do j <- get bh -- Int+	            return $! (ud_dict (getUserData bh) ! j)+
+ src/Language/Hi/FastMutInt.hs view
@@ -0,0 +1,81 @@+{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -fno-warn-name-shadowing #-}+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+--+-- Based on code from $fptools/ghc/compiler/utils/FastMutInt.lhs+--+-- (c) Copyright 2002, The University Court of the University of Glasgow. ++--+-- Unboxed mutable Ints+--++module Language.Hi.FastMutInt (+        FastMutInt, +        newFastMutInt,+        readFastMutInt, +        writeFastMutInt,+        incFastMutInt, +        incFastMutIntBy+    ) where++#include "MachDeps.h"++#if __GLASGOW_HASKELL__ < 503+import GlaExts+import PrelIOBase+#else+import GHC.Base+import GHC.IOBase+#endif++#if __GLASGOW_HASKELL__ < 411+newByteArray# = newCharArray#+#endif++data FastMutInt = FastMutInt (MutableByteArray# RealWorld)++newFastMutInt :: IO FastMutInt+newFastMutInt = IO $ \s ->+  case newByteArray# size s of { (# s, arr #) ->+  (# s, FastMutInt arr #) }+  where I# size = SIZEOF_HSINT++readFastMutInt :: FastMutInt -> IO Int+readFastMutInt (FastMutInt arr) = IO $ \s ->+  case readIntArray# arr 0# s of { (# s, i #) ->+  (# s, I# i #) }++writeFastMutInt :: FastMutInt -> Int -> IO ()+writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->+  case writeIntArray# arr 0# i s of { s ->+  (# s, () #) }++incFastMutInt :: FastMutInt -> IO Int	-- Returns original value+incFastMutInt (FastMutInt arr) = IO $ \s ->+  case readIntArray# arr 0# s of { (# s, i #) ->+  case writeIntArray# arr 0# (i +# 1#) s of { s ->+  (# s, I# i #) } }++incFastMutIntBy :: FastMutInt -> Int -> IO Int	-- Returns original value+incFastMutIntBy (FastMutInt arr) (I# n) = IO $ \s ->+  case readIntArray# arr 0# s of { (# s, i #) ->+  case writeIntArray# arr 0# (i +# n) s of { s ->+  (# s, I# i #) } }+
+ src/Language/Hi/FastString.hs view
@@ -0,0 +1,508 @@+{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-matches #-}++{-# OPTIONS -#include "hschooks.h" #-}++-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- +-- Based on $fptools/ghc/compiler/utils/FastString.lhs+--+-- (c) The GRASP/AQUA Project, Glasgow University, 1997-1998+--+-- Fast strings+--+-- Compact representations of character strings with+-- unique identifiers (hash-cons'ish).+--++module Language.Hi.FastString+       (+	FastString(..),     -- not abstract, for now.++        mkFastString,       -- :: String -> FastString+        mkFastStringNarrow, -- :: String -> FastString+        mkFastSubString,    -- :: Addr -> Int -> Int -> FastString++	mkFastString#,      -- :: Addr# -> FastString+        mkFastSubStringBA#, -- :: ByteArray# -> Int# -> Int# -> FastString++        mkFastStringInt,    -- :: [Int] -> FastString++        uniqueOfFS,	    -- :: FastString -> Int#+	lengthFS,	    -- :: FastString -> Int+	nullFastString,     -- :: FastString -> Bool++	unpackFS,	    -- :: FastString -> String+	unpackIntFS,	    -- :: FastString -> [Int]+	appendFS,	    -- :: FastString -> FastString -> FastString+        headFS,		    -- :: FastString -> Char+        headIntFS,	    -- :: FastString -> Int+        tailFS,		    -- :: FastString -> FastString+	concatFS,	    -- :: [FastString] -> FastString+        consFS,             -- :: Char -> FastString -> FastString+	indexFS,	    -- :: FastString -> Int -> Char+	nilFS,		    -- :: FastString++        hPutFS,		    -- :: Handle -> FastString -> IO ()++	LitString, +	mkLitString#	    -- :: Addr# -> LitString+       ) where++import Language.Hi.PrimPacked++import System.IO+import Data.Char             ( chr, ord )++import GHC.Exts+import GHC.IOBase+import GHC.Arr		( STArray(..), newSTArray )+import GHC.Handle++import Foreign.C++-- import System.IO.Unsafe ( unsafePerformIO )+-- import Control.Monad.ST ( stToIO )+-- import Data.IORef	( IORef, newIORef, readIORef, writeIORef )+++#define hASH_TBL_SIZE 993++{-+@FastString@s are packed representations of strings+with a unique id for fast comparisons. The unique id+is assigned when creating the @FastString@, using+a hash table to map from the character string representation+to the unique ID.+-}++data FastString+  = FastString   -- packed repr. on the heap.+      Int#       -- unique id+		 --  0 => string literal, comparison+		 --  will+      Int#       -- length+      ByteArray# -- stuff++  | UnicodeStr   -- if contains characters outside '\1'..'\xFF'+      Int#       -- unique id+      [Int]      -- character numbers++instance Eq FastString where+	-- shortcut for real FastStrings+  (FastString u1 _ _) == (FastString u2 _ _) = u1 ==# u2+  a == b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> False }++  (FastString u1 _ _) /= (FastString u2 _ _) = u1 /=# u2+  a /= b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> True  }++instance Ord FastString where+	-- Compares lexicographically, not by unique+    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }+    a <	 b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }+    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }+    a >	 b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }+    max x y | x >= y	=  x+            | otherwise	=  y+    min x y | x <= y	=  x+            | otherwise	=  y+    compare a b = cmpFS a b++lengthFS :: FastString -> Int+lengthFS (FastString _ l# _) = I# l#+lengthFS (UnicodeStr _ s) = length s++nullFastString :: FastString -> Bool+nullFastString (FastString _ l# _) = l# ==# 0#+nullFastString (UnicodeStr _ []) = True+nullFastString (UnicodeStr _ (_:_)) = False++unpackFS :: FastString -> String+unpackFS (FastString _ l# ba#) = unpackNBytesBA (BA ba#) (I# l#)+unpackFS (UnicodeStr _ s) = map chr s++unpackIntFS :: FastString -> [Int]+unpackIntFS (UnicodeStr _ s) = s+unpackIntFS fs = map ord (unpackFS fs)++appendFS :: FastString -> FastString -> FastString+appendFS fs1 fs2 = mkFastStringInt (unpackIntFS fs1 ++ unpackIntFS fs2)++concatFS :: [FastString] -> FastString+concatFS ls = mkFastStringInt (concat (map unpackIntFS ls)) -- ToDo: do better++headFS :: FastString -> Char+headFS (FastString _ l# ba#) = + if l# ># 0# then C# (indexCharArray# ba# 0#) else error ("headFS: empty FS")+headFS (UnicodeStr _ (c:_)) = chr c+headFS (UnicodeStr _ []) = error ("headFS: empty FS")++headIntFS :: FastString -> Int+headIntFS (UnicodeStr _ (c:_)) = c+headIntFS fs = ord (headFS fs)++indexFS :: FastString -> Int -> Char+indexFS f i@(I# i#) =+ case f of+   FastString _ l# ba#+     | l# ># 0# && l# ># i#  -> C# (indexCharArray# ba# i#)+     | otherwise	     -> error (msg (I# l#))+   UnicodeStr _ s	     -> chr (s!!i)+ where+  msg l =  "indexFS: out of range: " ++ show (l,i)++tailFS :: FastString -> FastString+tailFS (FastString _ l# ba#) = mkFastSubStringBA# ba# 1# (l# -# 1#)+tailFS fs = mkFastStringInt (tail (unpackIntFS fs))++consFS :: Char -> FastString -> FastString+consFS c fs = mkFastStringInt (ord c : unpackIntFS fs)++uniqueOfFS :: FastString -> Int#+uniqueOfFS (FastString u# _ _) = u#+uniqueOfFS (UnicodeStr u# _) = u#++nilFS = mkFastString ""++{-+GHC-related stuff:++Internally, the compiler will maintain a fast string symbol+table, providing sharing and fast comparison. Creation of+new @FastString@s then covertly does a lookup, re-using the+@FastString@ if there was a hit.++Caution: mkFastStringUnicode assumes that if the string is in the+table, it sits under the UnicodeStr constructor. Other mkFastString+variants analogously assume the FastString constructor.+-}++data FastStringTable = + FastStringTable+    Int#+    (MutableArray# RealWorld [FastString])++type FastStringTableVar = IORef FastStringTable++string_table :: FastStringTableVar+string_table = + unsafePerformIO (+   stToIO (newSTArray (0::Int,hASH_TBL_SIZE) [])+	>>= \ (STArray _ _ arr#) ->+   newIORef (FastStringTable 0# arr#))++lookupTbl :: FastStringTable -> Int# -> IO [FastString]+lookupTbl (FastStringTable _ arr#) i# =+  IO ( \ s# ->+  readArray# arr# i# s#)++updTbl :: FastStringTableVar -> FastStringTable -> Int# -> [FastString] -> IO ()+updTbl fs_table_var (FastStringTable uid# arr#) i# ls =+ IO (\ s# -> case writeArray# arr# i# ls s# of { s2# -> +	(# s2#, () #) }) >>+ writeIORef fs_table_var (FastStringTable (uid# +# 1#) arr#)++mkFastString# :: Addr# -> FastString+mkFastString# a# =+ case strLength (Ptr a#) of { (I# len#) -> mkFastStringLen# a# len# }++mkFastStringLen# :: Addr# -> Int# -> FastString+mkFastStringLen# a# len# =+ unsafePerformIO  (+  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->+  let+   h = hashStr a# len#+  in+--  _trace ("hashed: "++show (I# h)) $+  lookupTbl ft h	>>= \ lookup_result ->+  case lookup_result of+    [] -> +       -- no match, add it to table by copying out the+       -- the string into a ByteArray+       -- _trace "empty bucket" $+       case copyPrefixStr a# (I# len#) of+	 BA barr# ->  +	   let f_str = FastString uid# len# barr# in+           updTbl string_table ft h [f_str] >>+           ({- _trace ("new: " ++ show f_str)   $ -} return f_str)+    ls -> +       -- non-empty `bucket', scan the list looking+       -- entry with same length and compare byte by byte.+       -- _trace ("non-empty bucket"++show ls) $+       case bucket_match ls len# a# of+	 Nothing -> +           case copyPrefixStr a# (I# len#) of+	     BA barr# ->  +              let f_str = FastString uid# len# barr# in+              updTbl string_table ft h (f_str:ls) >>+	      ( {- _trace ("new: " ++ show f_str)  $ -} return f_str)+	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v)+  where+   bucket_match [] _ _ = Nothing+   bucket_match (v@(FastString _ l# ba#):ls) len# a# =+      if len# ==# l# && eqStrPrefix a# ba# l# then+	 Just v+      else+	 bucket_match ls len# a#+   bucket_match (UnicodeStr _ _ : ls) len# a# =+      bucket_match ls len# a#++mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString+mkFastSubStringBA# barr# start# len# =+ unsafePerformIO  (+  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->+  let+   h = hashSubStrBA barr# start# len#+  in+--  _trace ("hashed(b): "++show (I# h)) $+  lookupTbl ft h		>>= \ lookup_result ->+  case lookup_result of+    [] -> +       -- no match, add it to table by copying out the+       -- the string into a ByteArray+       -- _trace "empty bucket(b)" $+       case copySubStrBA (BA barr#) (I# start#) (I# len#) of+         BA ba# ->  +          let f_str = FastString uid# len# ba# in+          updTbl string_table ft h [f_str]     >>+          -- _trace ("new(b): " ++ show f_str)   $+	  return f_str+    ls -> +       -- non-empty `bucket', scan the list looking+       -- entry with same length and compare byte by byte. +       -- _trace ("non-empty bucket(b)"++show ls) $+       case bucket_match ls start# len# barr# of+	 Nothing -> +          case copySubStrBA (BA barr#) (I# start#) (I# len#) of+            BA ba# ->  +              let f_str = FastString uid# len# ba# in+              updTbl string_table ft h (f_str:ls) >>+	      -- _trace ("new(b): " ++ show f_str)   $+	      return f_str+	 Just v  -> +              -- _trace ("re-use(b): "++show v) $+	      return v+  )+ where+   bucket_match [] _ _ _ = Nothing+   bucket_match (v:ls) start# len# ba# =+    case v of+     FastString _ l# barr# ->+      if len# ==# l# && eqStrPrefixBA barr# ba# start# len# then+	 Just v+      else+	 bucket_match ls start# len# ba#+     UnicodeStr _ _ -> bucket_match ls start# len# ba#++mkFastStringUnicode :: [Int] -> FastString+mkFastStringUnicode s =+ unsafePerformIO  (+  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->+  let+   h = hashUnicode s+  in+--  _trace ("hashed(b): "++show (I# h)) $+  lookupTbl ft h		>>= \ lookup_result ->+  case lookup_result of+    [] -> +       -- no match, add it to table by copying out the+       -- the string into a [Int]+          let f_str = UnicodeStr uid# s in+          updTbl string_table ft h [f_str]     >>+          -- _trace ("new(b): " ++ show f_str)   $+	  return f_str+    ls -> +       -- non-empty `bucket', scan the list looking+       -- entry with same length and compare byte by byte. +       -- _trace ("non-empty bucket(b)"++show ls) $+       case bucket_match ls of+	 Nothing -> +              let f_str = UnicodeStr uid# s in+              updTbl string_table ft h (f_str:ls) >>+	      -- _trace ("new(b): " ++ show f_str)   $+	      return f_str+	 Just v  -> +              -- _trace ("re-use(b): "++show v) $+	      return v+  )+ where+   bucket_match [] = Nothing+   bucket_match (v@(UnicodeStr _ s'):ls) =+       if s' == s then Just v else bucket_match ls+   bucket_match (FastString _ _ _ : ls) = bucket_match ls++mkFastStringNarrow :: String -> FastString+mkFastStringNarrow str =+ case packString str of { (I# len#, BA frozen#) -> +    mkFastSubStringBA# frozen# 0# len#+ }+ {- 0-indexed array, len# == index to one beyond end of string,+    i.e., (0,1) => empty string.    -}++mkFastString :: String -> FastString+mkFastString str = if all good str+    then mkFastStringNarrow str+    else mkFastStringUnicode (map ord str)+    where+    good c = c >= '\1' && c <= '\xFF'++mkFastStringInt :: [Int] -> FastString+mkFastStringInt str = if all good str+    then mkFastStringNarrow (map chr str)+    else mkFastStringUnicode str+    where+    good c = c >= 1 && c <= 0xFF++mkFastSubString :: Addr# -> Int -> Int -> FastString+mkFastSubString a# (I# start#) (I# len#) =+ mkFastStringLen# (a# `plusAddr#` start#) len#++hashStr  :: Addr# -> Int# -> Int#+ -- use the Addr to produce a hash value between 0 & m (inclusive)+hashStr a# len# =+  case len# of+   0# -> 0#+   1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#+   2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#+   _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#+  where+    c0 = indexCharOffAddr# a# 0#+    c1 = indexCharOffAddr# a# (len# `quotInt#` 2# -# 1#)+    c2 = indexCharOffAddr# a# (len# -# 1#)+{-+    c1 = indexCharOffAddr# a# 1#+    c2 = indexCharOffAddr# a# 2#+-}++hashSubStrBA  :: ByteArray# -> Int# -> Int# -> Int#+ -- use the byte array to produce a hash value between 0 & m (inclusive)+hashSubStrBA ba# start# len# =+  case len# of+   0# -> 0#+   1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#+   2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#+   _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#+  where+    c0 = indexCharArray# ba# (start# +# 0#)+    c1 = indexCharArray# ba# (start# +# (len# `quotInt#` 2# -# 1#))+    c2 = indexCharArray# ba# (start# +# (len# -# 1#))++--    c1 = indexCharArray# ba# 1#+--    c2 = indexCharArray# ba# 2#++hashUnicode :: [Int] -> Int#+ -- use the Addr to produce a hash value between 0 & m (inclusive)+hashUnicode [] = 0#+hashUnicode [I# c0] = ((c0 *# 631#) +# 1#) `remInt#` hASH_TBL_SIZE#+hashUnicode [I# c0, I# c1] = ((c0 *# 631#) +# (c1 *# 217#) +# 2#) `remInt#` hASH_TBL_SIZE#+hashUnicode s = ((c0 *# 631#) +# (c1 *# 217#) +# (c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#+  where+    I# len# = length s+    I# c0 = s !! 0+    I# c1 = s !! (I# (len# `quotInt#` 2# -# 1#))+    I# c2 = s !! (I# (len# -# 1#))++cmpFS :: FastString -> FastString -> Ordering+cmpFS (UnicodeStr u1# s1) (UnicodeStr u2# s2) = if u1# ==# u2# then EQ+    else compare s1 s2+cmpFS (UnicodeStr _ s1) s2 = compare s1 (unpackIntFS s2)+cmpFS s1 (UnicodeStr _ s2) = compare (unpackIntFS s1) s2+cmpFS (FastString u1# l1# b1#) (FastString u2# l2# b2#) =+  if u1# ==# u2# then EQ else+  let l# = if l1# <=# l2# then l1# else l2# in+  unsafePerformIO (+    memcmp b1# b2# l# >>= \ (I# res) ->+    return (+    if      res <#  0# then LT+    else if res ==# 0# then +	if l1# ==# l2# then EQ+	else if l1# <# l2# then LT else GT+    else		    GT+    ))++foreign import ccall unsafe "memcmp"+  memcmp :: ByteArray# -> ByteArray# -> Int# -> IO Int++-- -----------------------------------------------------------------------------+-- Outputting 'FastString's++#if __GLASGOW_HASKELL__ >= 504++-- this is our own version of hPutBuf for FastStrings, because in+-- 5.04+ we don't have mutable byte arrays and therefore hPutBufBA.+-- The closest is hPutArray in Data.Array.IO, but that does some extra+-- range checks that we want to avoid here.++foreign import ccall unsafe "__hscore_memcpy_dst_off"+   memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())++hPutFS handle (FastString _ l# ba#)+  | l# ==# 0#  = return ()+  | otherwise+   = do wantWritableHandle "hPutFS" handle $ +          \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do++          old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }+	    <- readIORef ref++	  let count = I# l#+	      raw = unsafeCoerce# ba# :: MutableByteArray# RealWorld++          -- enough room in handle buffer?+          if (size - w > count)+		-- There's enough room in the buffer:+		-- just copy the data in and update bufWPtr.+	    then do memcpy_baoff_ba old_raw w raw (fromIntegral count)+		    writeIORef ref old_buf{ bufWPtr = w + count }+		    return ()++		-- else, we have to flush+	    else do flushed_buf <- flushWriteBuffer fd stream old_buf+		    writeIORef ref flushed_buf+		    let this_buf = +			    Buffer{ bufBuf=raw, bufState=WriteBuffer, +				    bufRPtr=0, bufWPtr=count, bufSize=count }+		    flushWriteBuffer fd stream this_buf+		    return ()++#else++hPutFS :: Handle -> FastString -> IO ()+hPutFS handle (FastString _ l# ba#)+  | l# ==# 0#  = return ()+  | otherwise  = do mba <- stToIO $ unsafeThawByteArray (ByteArray (bot::Int) bot ba#)+                    hPutBufBAFull  handle mba (I# l#)+ where+  bot = error "hPutFS.ba"++#endif++-- ONLY here for debugging the NCG (so -ddump-stix works for string+-- literals); no idea if this is really necessary.  JRS, 010131+hPutFS handle (UnicodeStr _ is) +  = hPutStr handle ("(UnicodeStr " ++ show is ++ ")")++-- -----------------------------------------------------------------------------+-- LitStrings, here for convenience only.++type LitString = Ptr ()+-- ToDo: make it a Ptr when we don't have to support 4.08 any more++mkLitString# :: Addr# -> LitString+mkLitString# a# = Ptr a#
+ src/Language/Hi/Parser.hs view
@@ -0,0 +1,720 @@+{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-name-shadowing #-}+--+-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+--++--+-- Based on $fptools/ghc/compiler/iface/BinIface.hs+--+--  (c) The University of Glasgow 2002+-- +-- Binary interface file support.+--++--+-- This provides the "Binary" instances for the Iface type such that we+-- can parse binary representations of that type. i.e. from .hi files+--+-- The main problem we have is that all the stuff we don't care about,+-- we just want to read in to a string. So this has to be hand-hacked+-- somewhat.+--+-- The "Binary" class for hs-plugins only includes a get method. We+-- don't do any writing. Saves us having to properly reconstruct the+-- abstract syntax, which would pull in *way* too much of GHC.+--++++module Language.Hi.Parser ( readIface, module Language.Hi.Syntax ) where++import Language.Hi.Syntax+import Language.Hi.Binary+import Language.Hi.FastString++#include "../../../config.h"++-- ---------------------------------------------------------------------------+-- how to get there from here++readIface :: FilePath -> IO Iface+readIface hi_path = getBinFileWithDict hi_path++-- ---------------------------------------------------------------------+-- All the Binary instances+--+-- Reading a binary interface into ParsedIface+--+-- We pull the trick of only reading up to the point we need+--++instance Binary Iface where+    get bh = do+            version   <- get bh :: IO String+            build_tag <- get bh :: IO String     -- 'way' flag++#if __GLASGOW_HASKELL__ >= 604+            mod_name  <- get bh :: IO FastString+            _is_boot  <- get bh :: IO Bool+            let pkg_name = mkFastString "unknown"  -- >=604 has no package field+#elif CABAL == 1 && __GLASGOW_HASKELL__ == 603+            mod_name <- get bh :: IO FastString+            let pkg_name = mkFastString "unknown"+#else /* <= 622 */+            mod_name  <- get bh :: IO FastString+            pkg_name  <- get bh :: IO FastString+#endif+            mod_vers  <- get bh :: IO Version+            orphan    <- get bh :: IO Bool+            deps      <- get bh :: IO Dependencies++            get bh :: IO (Bin Int) -- fake a lazyGet for [Usage]+            usages    <- get bh :: IO [Usage]++            exports   <- get bh :: IO [IfaceExport]++--      (exp_vers  :: Version)              <- get bh+--      (fixities  :: [(OccName,Fixity)])   <- get bh+--      (deprecs   :: [IfaceDeprec])        <- get bh++--      (decls     :: [(Version,IfaceDecl)])<- get bh++--      (insts     :: [IfaceInst])          <- get bh+--      (rules     :: [IfaceRule])          <- get bh+--      (rule_vers :: Version)              <- get bh++            return $ Iface {+                 mi_package   = unpackFS pkg_name,+                 mi_module    = unpackFS mod_name,+                 mi_deps      = deps ,+                 mi_usages    = usages,+                 mi_exports   = exports {-,-} ++--              mi_mod_vers  = mod_vers,+--              mi_boot      = False,  -- .hi files are never .hi-boot files!+--              mi_orphan    = orphan,+--              mi_usages    = usages,+--              mi_exports   = exports,+--              mi_exp_vers  = exp_vers,+--              mi_fixities  = fixities,+--              mi_deprecs   = deprecs,+--              mi_decls     = decls,+--              mi_insts     = insts,+--              mi_rules     = rules,+--              mi_rule_vers = rule_vers +            }++------------------------------------------------------------------------+--+--        Types from: Iface.hs, HscTypes+--++-- fake a lazyGet+instance Binary Dependencies where+    get bh = do get bh :: IO (Bin Int)  -- really a BinPtr Int+                ms <- get bh :: IO [(FastString,Bool)]+                ps <- get bh :: IO [FastString]+                _  <- get bh :: IO [FastString]         -- !!orphans+                return Deps { dep_mods  = map unpackFS $! map fst ms, +                              dep_pkgs  = map unpackFS ps {-,-}+                       }++------------------------------------------------------------------------+-- Usages+------------------------------------------------------------------------++instance Binary OccName where+        get bh = do aa <- get bh :: IO NameSpace+                    ab <- get bh :: IO FastString+                    return $ OccName aa (unpackFS ab)++instance Binary NameSpace where+        get bh = do h <- getByte bh+                    case h of+                      0 -> return VarName+                      1 -> return DataName+                      2 -> return TvName+                      _ -> return TcClsName++instance Binary Usage where+    get bh = do (nm   :: FastString)                <- get bh+                (mod  :: Version)                   <- get bh+                (exps :: Maybe Version)             <- get bh+                (ents :: [(OccName,Version)])       <- get bh+                (rules :: Version)                  <- get bh+                return $ Usage {usg_name = (unpackFS nm), +                                usg_mod = mod,+                                usg_exports = exps, +                                usg_entities = ents,+                                usg_rules = rules }++------------------------------------------------------------------------+-- Exports++instance (Binary name) => Binary (GenAvailInfo name) where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: name) <- get bh+                  return $ Avail aa+          _ -> do (ab :: name)   <- get bh+                  (ac :: [name]) <- get bh+                  return $ AvailTC ab ac++{-+instance Binary a => Binary (Deprecs a) where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return Deprecs+          1 -> do (aa :: FastString) <- get bh+                  return Deprecs+          _ -> do (ab :: a) <- get bh+                  return Deprecs+-}++-------------------------------------------------------------------------+--        Types from: BasicTypes+-------------------------------------------------------------------------++{-+instance Binary Activation where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return Activation+          1 -> return Activation+          2 -> do (aa :: Int) <- get bh ; return Activation+          _ -> do (ab :: Int) <- get bh ; return Activation++instance Binary StrictnessMark where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return StrictnessMark+          1 -> return StrictnessMark+          _ -> return StrictnessMark++instance Binary Boxity where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return Boxity+          _ -> return Boxity++instance Binary TupCon where+    get bh = do+      (ab :: Boxity) <- get bh+      (ac :: Arity)  <- get bh+      return TupCon++instance Binary RecFlag where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return RecFlag+          _ -> return RecFlag++instance Binary DefMeth where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return DefMeth+          1 -> return DefMeth+          _ -> return DefMeth++instance Binary FixityDirection where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return FixityDirection+          1 -> return FixityDirection+          _ -> return FixityDirection++instance Binary Fixity where+    get bh = do+      (aa :: Int)             <- get bh+      (ab :: FixityDirection) <- get bh+      return Fixity++instance (Binary name) => Binary (IPName name) where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: name) <- get bh ; return IPName+          _ -> do (ab :: name) <- get bh ; return IPName++-------------------------------------------------------------------------+--        Types from: basicTypes/NewDemand+-------------------------------------------------------------------------++instance Binary DmdType where+    -- Ignore DmdEnv when spitting out the DmdType+    get bh = do (ds :: [Demand])  <- get bh+                (dr :: DmdResult) <- get bh+                return DmdType++instance Binary Demand where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return Demand+          1 -> return Demand+          2 -> do (aa :: Demand)  <- get bh ; return Demand+          3 -> do (ab :: Demands) <- get bh ; return Demand+          4 -> do (ac :: Demands) <- get bh ; return Demand+          5 -> do (ad :: Demand)  <- get bh ; return Demand+          _ -> return Demand++instance Binary Demands where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: Demand)   <- get bh+                  return Demands+          _ -> do (ab :: [Demand]) <- get bh+                  return Demands++instance Binary DmdResult where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return DmdResult+          1 -> return DmdResult+          _ -> return DmdResult++instance Binary StrictSig where+        get bh = do (aa :: DmdType) <- get bh ; return StrictSig+-}++-------------------------------------------------------------------------+--        Types from: CostCentre, from profiling/CostCentre.lhs+-------------------------------------------------------------------------++{-+instance Binary IsCafCC where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return IsCafCC+          _ -> return IsCafCC++instance Binary IsDupdCC where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return IsDupdCC+          _ -> return IsDupdCC++instance Binary CostCentre where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do return CostCentre+          1 -> do (aa :: CcName)        <- get bh+                  (ab :: ModuleName)    <- get bh+                  (ac :: IsDupdCC)      <- get bh+                  (ad :: IsCafCC)       <- get bh+                  return CostCentre+          _ -> do (ae :: ModuleName)    <- get bh+                  return CostCentre+-}++-------------------------------------------------------------------------+--        IfaceTypes and friends, from IfaceType.lhs+-------------------------------------------------------------------------++{-+instance Binary IfaceExtName where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (mod :: ModuleName) <- get bh+                  (occ :: OccName)    <- get bh+                  return IfaceExtName+          1 -> do (mod :: ModuleName) <- get bh+                  (occ :: OccName)    <- get bh+                  (vers :: Version)   <- get bh+                  return IfaceExtName+          _ -> do (occ :: OccName)    <- get bh+                  return IfaceExtName++instance Binary IfaceBndr where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: IfaceIdBndr) <- get bh ; return IfaceBndr+          _ -> do (ab :: IfaceTvBndr) <- get bh ; return IfaceBndr++instance Binary Kind where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return Kind+          1 -> return Kind+          2 -> return Kind+          3 -> return Kind+          4 -> return Kind+          _ -> do (k1 :: Kind) <- get bh+                  (k2 :: Kind) <- get bh+                  return Kind++instance Binary IfaceType where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: IfaceTvBndr)   <- get bh+                  (ab :: IfaceType)     <- get bh+                  return IfaceType+          1 -> do (ad :: OccName)       <- get bh+                  return IfaceType+          2 -> do (ae :: IfaceType)     <- get bh+                  (af :: IfaceType)     <- get bh+                  return IfaceType+          3 -> do (ag :: IfaceType)     <- get bh+                  (ah :: IfaceType)     <- get bh+                  return IfaceType+          5 -> do (ap :: IfacePredType) <- get bh+                  return IfaceType++        -- Now the special cases for TyConApp+          6 -> return IfaceType+          7 -> return IfaceType+          8 -> return IfaceType+          9 -> do (ty :: IfaceType)     <- get bh+                  return IfaceType+          10 -> return IfaceType+          11 -> do (t1 :: IfaceType)    <- get bh+                   (t2 :: IfaceType)    <- get bh+                   return IfaceType+          12 -> do (tc :: IfaceExtName) <- get bh+                   (tys :: [IfaceType]) <- get bh+                   return IfaceType+          _  -> do (tc :: IfaceTyCon)   <- get bh+                   (tys :: [IfaceType]) <- get bh+                   return IfaceType++instance Binary IfaceTyCon where+   get bh = do+    h <- getByte bh+    case h of+      1 -> return IfaceTyCon+      2 -> return IfaceTyCon+      _ -> do (bx :: Boxity) <- get bh+              (ar :: Arity)  <- get bh+              return IfaceTyCon++instance Binary IfacePredType where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: IfaceExtName) <- get bh+                  (ab :: [IfaceType])  <- get bh+                  return IfacePredType+          _ -> do (ac :: (IPName OccName))      <- get bh+                  (ad :: IfaceType)             <- get bh+                  return IfacePredType++instance Binary IfaceExpr where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: OccName)       <- get bh+                  return IfaceExpr+          1 -> do (ab :: IfaceType)     <- get bh+                  return IfaceExpr+          2 -> do (ac :: Boxity)        <- get bh+                  (ad :: [IfaceExpr])   <- get bh+                  return IfaceExpr+          3 -> do (ae :: IfaceBndr)     <- get bh+                  (af :: IfaceExpr)     <- get bh+                  return IfaceExpr+          4 -> do (ag :: IfaceExpr)     <- get bh+                  (ah :: IfaceExpr)     <- get bh+                  return IfaceExpr+          5 -> do (ai :: IfaceExpr)     <- get bh+                  (aj :: OccName)       <- get bh+                  (ak :: [IfaceAlt])    <- get bh+                  return IfaceExpr+          6 -> do (al :: IfaceBinding)  <- get bh+                  (am :: IfaceExpr)     <- get bh+                  return IfaceExpr+          7 -> do (an :: IfaceNote)     <- get bh+                  (ao :: IfaceExpr)     <- get bh+                  return IfaceExpr+          8 -> do (ap :: Literal)       <- get bh+                  return IfaceExpr+          9 -> do (as :: ForeignCall)   <- get bh+                  (at :: IfaceType)     <- get bh+                  return IfaceExpr+          _ -> do (aa :: IfaceExtName)  <- get bh+                  return IfaceExpr++instance Binary IfaceConAlt where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return IfaceConAlt+          1 -> do (aa :: OccName) <- get bh+                  return IfaceConAlt+          2 -> do (ab :: Boxity)  <- get bh+                  return IfaceConAlt+          _ -> do (ac :: Literal) <- get bh+                  return IfaceConAlt++instance Binary IfaceBinding where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: IfaceIdBndr) <- get bh+                  (ab :: IfaceExpr)   <- get bh+                  return IfaceBinding+          _ -> do (ac :: [(IfaceIdBndr,IfaceExpr)]) <- get bh+                  return IfaceBinding++instance Binary IfaceIdInfo where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return IfaceIdInfo+          _ -> do (info :: [IfaceInfoItem]) <- lazyGet bh+                  return IfaceIdInfo++instance Binary IfaceInfoItem where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: Arity)         <- get bh+                  return IfaceInfoItem+          1 -> do (ab :: StrictSig)     <- get bh+                  return IfaceInfoItem+          2 -> do (ac :: Activation)    <- get bh+                  (ad :: IfaceExpr)     <- get bh+                  return IfaceInfoItem+          3 -> return IfaceInfoItem+          _ -> do (ae :: IfaceExtName) <- get bh+                  (af :: Arity)        <- get bh+                  return IfaceInfoItem++instance Binary IfaceNote where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do (aa :: CostCentre) <- get bh+                  return IfaceNote+          1 -> do (ab :: IfaceType ) <- get bh+                  return IfaceNote+          2 -> return IfaceNote+          3 -> return IfaceNote+          _ -> do (ac :: String) <- get bh+                  return IfaceNote++instance Binary IfaceDecl where+    get bh = do+        h <- getByte bh+        case h of+          0 -> do +            (name :: OccName)           <- get bh+            (ty :: IfaceType)           <- get bh+            (idinfo :: IfaceIdInfo)     <- get bh+            return IfaceDecl+          1 -> error "Binary.get(TyClDecl): ForeignType"+          2 -> do+            (a1 :: IfaceContext)  <- get bh+            (a2 :: OccName)       <- get bh+            (a3 :: [IfaceTvBndr]) <- get bh+            (a4 :: IfaceConDecls) <- get bh+            (a5 :: RecFlag)       <- get bh+            (a6 :: ArgVrcs)       <- get bh+            (a7 :: Bool)          <- get bh+            return IfaceDecl+          3 -> do+            (aq :: OccName)       <- get bh+            (ar :: [IfaceTvBndr]) <- get bh+            (as :: ArgVrcs)       <- get bh+            (at :: IfaceType)     <- get bh+            return IfaceDecl+          _ -> do+            (a1 :: IfaceContext)    <- get bh+            (a2 :: OccName)         <- get bh+            (a3 :: [IfaceTvBndr])   <- get bh+            (a4 :: [FunDep OccName])<- get bh+            (a5 :: [IfaceClassOp])  <- get bh+            (a6 :: RecFlag)         <- get bh+            (a7 :: ArgVrcs)         <- get bh+            return IfaceDecl++instance Binary IfaceInst where+    get bh = do +        (ty :: IfaceType) <- get bh+        (dfun :: OccName) <- get bh+        return IfaceInst++instance Binary IfaceConDecls where+    get bh = do+        h <- getByte bh+        case h of+          0 -> return IfaceConDecls+          1 -> do (aa :: [IfaceConDecl]) <- get bh+                  return IfaceConDecls+          _ -> do (aa :: IfaceConDecl)   <- get bh+                  return IfaceConDecls++instance Binary IfaceConDecl where+    get bh = do+        (a1 :: OccName)         <- get bh+        (a2 :: [IfaceTvBndr])   <- get bh+        (a3 :: IfaceContext)    <- get bh+        (a4 :: [IfaceType])     <- get bh+        (a5 :: [StrictnessMark])<- get bh+        (a6 :: [OccName])       <- get bh+        return IfaceConDecl++instance Binary IfaceClassOp where+   get bh = do+        (n   :: OccName)   <- get bh+        (def :: DefMeth)   <- get bh+        (ty  :: IfaceType) <- get bh+        return IfaceClassOp++instance Binary IfaceRule where+    get bh = do+        (a1 :: RuleName)        <- get bh+        (a2 :: Activation)      <- get bh+        (a3 :: [IfaceBndr])     <- get bh+        (a4 :: IfaceExtName)    <- get bh+        (a5 :: [IfaceExpr])     <- get bh+        (a6 :: IfaceExpr)       <- get bh+        return IfaceRule++-}++------------------------------------------------------------------------+-- from Literal+------------------------------------------------------------------------++{-+instance Binary Literal where+    get bh = do+	    h <- getByte bh+	    case h of+	      0 -> do+		    (aa :: Char) <- get bh+		    return Literal+	      1 -> do+		    (ab :: FastString) <- get bh+		    return Literal+	      2 -> do return Literal+	      3 -> do+		    (ad :: Integer) <- get bh+		    return Literal+	      4 -> do+		    (ae :: Integer) <- get bh+		    return Literal+	      5 -> do+		    (af :: Integer) <- get bh+		    return Literal+	      6 -> do+		    (ag :: Integer) <- get bh+		    return Literal+	      7 -> do+		    (ah :: Rational) <- get bh+		    return Literal+	      8 -> do+		    (ai :: Rational) <- get bh+		    return Literal+	      9 -> do+		    (aj :: FastString) <- get bh+		    (mb :: Maybe Int)  <- get bh+		    return Literal+              _ -> return Literal -- ?++-}++------------------------------------------------------------------------+-- prelude/ForeignCall.lhs+------------------------------------------------------------------------++{-+instance Binary ForeignCall where+    get bh = do+	    h <- getByte bh+	    case h of+	      0 -> do (aa :: CCallSpec) <- get bh+		      return ForeignCall+	      _ -> do (ab :: DNCallSpec) <- get bh+		      return ForeignCall++instance Binary Safety where+    get bh = do+	    h <- getByte bh+	    case h of+	      0 -> do (aa :: Bool) <- get bh+		      return Safety+	      _ -> return Safety++instance Binary CExportSpec where+    get bh = do+	  (aa :: CLabelString) <- get bh+	  (ab :: CCallConv)    <- get bh+	  return CExportSpec++instance Binary CCallSpec where+    get bh = do+	  (aa :: CCallTarget) <- get bh+	  (ab :: CCallConv)   <- get bh+	  (ac :: Safety)      <- get bh+	  return CCallSpec++instance Binary CCallTarget where+    get bh = do+	    h <- getByte bh+	    case h of+	      0 -> do (aa :: CLabelString) <- get bh+		      return CCallTarget+	      _ -> return CCallTarget++instance Binary CCallConv where+    get bh = do+	    h <- getByte bh+	    case h of+	      0 -> return CCallConv+	      _ -> return CCallConv++instance Binary DNCallSpec where+    get bh = do+          (isStatic :: Bool)  <- get bh+	  (kind   :: DNKind)  <- get bh+	  (ass   :: String)   <- get bh+	  (nm    :: String)   <- get bh+	  return DNCallSpec++instance Binary DNKind where+    get bh = do+	    h <- getByte bh+	    case h of+	      _ -> return DNKind++instance Binary DNType where+    get bh = do+	    h <- getByte bh+	    case h of+	      _ -> return DNType++-}
+ src/Language/Hi/PrimPacked.hs view
@@ -0,0 +1,194 @@+{-# OPTIONS -cpp -fglasgow-exts #-}+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-matches #-}++{-# OPTIONS -#include "hschooks.h" #-}++-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- +-- Based on $fptools/ghc/compiler/utils/PrimPacked.lhs+--+-- (c) The GRASP/AQUA Project, Glasgow University, 1997-1998+--+--+-- Basic ops on packed representations+--+-- Some basic operations for working on packed representations of series+-- of bytes (character strings). Used by the interface lexer input+-- subsystem, mostly.++{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}++module Language.Hi.PrimPacked (+	Ptr(..), nullPtr, plusAddr#,+	BA(..),+	packString, 	   -- :: String -> (Int, BA)+	unpackNBytesBA,    -- :: BA -> Int -> [Char]+        strLength,	   -- :: Ptr CChar -> Int+        copyPrefixStr,	   -- :: Addr# -> Int -> BA+        copySubStrBA,	   -- :: BA -> Int -> Int -> BA+        eqStrPrefix,	   -- :: Addr# -> ByteArray# -> Int# -> Bool+        eqStrPrefixBA,	   -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool+ ) where++import Foreign+import GHC.Exts+import GHC.ST++-- Wrapper types for bytearrays++data BA    = BA  ByteArray#+data MBA s = MBA (MutableByteArray# s)++packString :: String -> (Int, BA)+packString str = (l, arr)+ where+  l@(I# length#) = length str++  arr = runST (do+    ch_array <- new_ps_array length#+      -- fill in packed string from "str"+    fill_in ch_array 0# str+      -- freeze the puppy:+    freeze_ps_array ch_array length#+   )++  fill_in :: MBA s -> Int# -> [Char] -> ST s ()+  fill_in arr_in# idx [] =+   return ()+  fill_in arr_in# idx (C# c : cs) =+   write_ps_array arr_in# idx c	 >>+   fill_in arr_in# (idx +# 1#) cs++-- Unpacking a string++unpackNBytesBA :: BA -> Int -> [Char]+unpackNBytesBA (BA bytes) (I# len)+ = unpack 0#+ where+    unpack nh+      | nh >=# len  = []+      | otherwise   = C# ch : unpack (nh +# 1#)+      where+	ch = indexCharArray# bytes nh++-- Copying a char string prefix into a byte array.++copyPrefixStr :: Addr# -> Int -> BA+copyPrefixStr a# len@(I# length#) = copy' length#+ where+   copy' length# = runST (do+     {- allocate an array that will hold the string+     -}+     ch_array <- new_ps_array length#+     {- Revert back to Haskell-only solution for the moment.+     	_ccall_ memcpy ch_array (A# a) len        >>=  \ () ->+     	write_ps_array ch_array length# (chr# 0#) >>+     -}+     -- fill in packed string from "addr"+     fill_in ch_array 0#+     -- freeze the puppy:+     freeze_ps_array ch_array length#+    )++   fill_in :: MBA s -> Int# -> ST s ()+   fill_in arr_in# idx+      | idx ==# length#+      = return ()+      | otherwise+      = case (indexCharOffAddr# a# idx) of { ch ->+	write_ps_array arr_in# idx ch >>+	fill_in arr_in# (idx +# 1#) }++-- Copying out a substring, assume a 0-indexed string:+-- (and positive lengths, thank you).++copySubStrBA :: BA -> Int -> Int -> BA+copySubStrBA (BA barr#) (I# start#) len@(I# length#) = ba+ where+  ba = runST (do+     -- allocate an array that will hold the string+    ch_array <- new_ps_array length#+     -- fill in packed string from "addr"+    fill_in ch_array 0#+     -- freeze the puppy:+    freeze_ps_array ch_array length#+   )++  fill_in :: MBA s -> Int# -> ST s ()+  fill_in arr_in# idx+      | idx ==# length#+      = return ()+      | otherwise+      = case (indexCharArray# barr# (start# +# idx)) of { ch ->+	write_ps_array arr_in# idx ch >>+	fill_in arr_in# (idx +# 1#) }++-- (Very :-) ``Specialised'' versions of some CharArray things...+-- [Copied from PackBase; no real reason -- UGH]++new_ps_array	:: Int# -> ST s (MBA s)+write_ps_array	:: MBA s -> Int# -> Char# -> ST s () +freeze_ps_array :: MBA s -> Int# -> ST s BA++#if __GLASGOW_HASKELL__ < 411+#define NEW_BYTE_ARRAY newCharArray#+#else +#define NEW_BYTE_ARRAY newByteArray#+#endif++new_ps_array size = ST $ \ s ->+    case (NEW_BYTE_ARRAY size s)  of { (# s2#, barr# #) ->+    (# s2#, MBA barr# #) }++write_ps_array (MBA barr#) n ch = ST $ \ s# ->+    case writeCharArray# barr# n ch s#	of { s2#   ->+    (# s2#, () #) }++-- same as unsafeFreezeByteArray+freeze_ps_array (MBA arr#) len# = ST $ \ s# ->+    case unsafeFreezeByteArray# arr# s# of { (# s2#, frozen# #) ->+    (# s2#, BA frozen# #) }++-- Compare two equal-length strings for equality:++eqStrPrefix :: Addr# -> ByteArray# -> Int# -> Bool+eqStrPrefix a# barr# len# = +  unsafePerformIO $ do+   x <- memcmp_ba a# barr# (I# len#)+   return (x == 0)++eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool+eqStrPrefixBA b1# b2# start# len# = +  unsafePerformIO $ do+    x <- memcmp_baoff_ba b2# (I# start#) b1# (I# len#)+    return (x == 0)++------------------------------------------------------------------------+-- in hschooks+--++foreign import ccall unsafe "plugin_strlen"+        strLength :: Ptr () -> Int++foreign import ccall unsafe "plugin_memcmp"+        memcmp_ba :: Addr# -> ByteArray# -> Int -> IO Int++foreign import ccall unsafe "plugin_memcmp_off"+        memcmp_baoff_ba :: ByteArray# -> Int -> ByteArray# -> Int -> IO Int+
+ src/Language/Hi/Syntax.hs view
@@ -0,0 +1,360 @@+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- +-- Based on code from $fptools/ghc/compiler/main/HscTypes.lhs+--  (c) The University of Glasgow 2002+--+ +module Language.Hi.Syntax where++import Language.Hi.FastString++import Data.List        ( intersperse )++-- ---------------------------------------------------------------------+-- An Iface, the representation of an .hi file.+--+-- The abstract syntax that we don't need is blanked with a default+-- type, however we must be careful in BinIface to still parse the+-- correct number of bytes for each data type. This involves leaving the+-- code alone, other than to add the types of the sub-constructors of+-- the types we have blanked out (because they can't be inferred+-- anymore).+--++data Iface = Iface {+        mi_package  :: String,          -- what package is this?+        mi_module   :: String,          -- what module is this?+        mi_deps     :: Dependencies,+        mi_usages   :: [Usage],+        mi_exports  :: [IfaceExport] {-,-}++--      mi_decls    :: [(Version,IfaceDecl)] {-,-}++--      mi_mod_vers :: !Version,+--      mi_orphan   :: !Bool,+--      mi_boot     :: !Bool,+--      mi_exp_vers :: !Version,+--      mi_fixities :: [(OccName,Fixity)],+--      mi_deprecs  :: [IfaceDeprec],+--      mi_insts     :: [IfaceInst],+--      mi_rules     :: [IfaceRule],+--      mi_rule_vers :: !Version,+     }++emptyIface = Iface {+        mi_package = undefined,+        mi_module  = undefined,+        mi_deps    = noDependencies,+        mi_usages  = undefined,+        mi_exports = undefined+   }++-- ---------------------------------------------------------------------+-- pretty-print an interface+--+showIface :: Iface -> String+showIface (Iface { mi_package = p, mi_module  = m, +                   mi_deps = deps, mi_usages = us }) = +        "interface \"" ++ p ++ "\" " ++ m ++ +        "\n" ++ pprDeps deps  +++        "\n" ++ (concat $ intersperse "\n" (map pprUsage us)) + --     "\n" ++ (concat $ intersperse "\n" (map pprExport es))++pprDeps :: Dependencies -> String+pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs }) +        = "module dependencies: "    ++ (concat $ intersperse ", " mods) +++          "\npackage dependencies: " ++ (concat $ intersperse ", " pkgs)++pprUsage :: Usage -> String+pprUsage usage = hsep ["import", usg_name usage]++pprExport :: IfaceExport -> String+pprExport (fsmod, items)+        = hsep [ "export", unpackFS fsmod, hsep (map pp_avail items) ]+  where+    pp_avail :: GenAvailInfo OccName -> String+    pp_avail (Avail nm)    = ppr_occ nm+    pp_avail (AvailTC _ []) = empty+    pp_avail (AvailTC n (n':ns))+        | n==n'     = (ppr_occ n) ++ pp_export ns+        | otherwise = (ppr_occ n) ++ "|" ++ pp_export (n':ns)++    pp_export []    = empty+    pp_export names = "{" ++ (hsep (map ppr_occ names)) ++ "}"++    ppr_occ (OccName _ s) = s++--+-- TODO bring in the Pretty library+--+hsep  = \ss -> concat (intersperse " " ss)+empty = ""++-- ---------------------------------------------------------------------+--+-- Dependency info about modules and packages below this one+-- in the import hierarchy.  See TcRnTypes.ImportAvails for details.+--+-- Invariant: the dependencies of a module M never includes M+-- Invariant: the lists are unordered, with no duplicates+--+-- The fields are:+--      Home-package module dependencies+--      External package dependencies+--      Orphan modules (whether home or external pkg)++data Dependencies = Deps { +        dep_mods  :: [ModuleName],+        dep_pkgs  :: [PackageName] {-,-} +     } deriving (Show)++noDependencies :: Dependencies+noDependencies = Deps [] []++--+-- Type aliases need to have a real type so the parser can work out how+-- to parse them. You have to find what these are by reading GHC.+--+type ModuleName   = String     {- was FastString -}      -- Module+type PackageName  = String     {- was FastString -}      -- Packages+type Version      = Int                                  -- BasicTypes+type EncodedFS    = FastString                           -- FastString+type IfaceExport  = (EncodedFS, [GenAvailInfo OccName])  -- HscTypes++data GenAvailInfo name  +        = Avail   name   -- An ordinary identifier+        | AvailTC name   -- The name of the type or class+                 [name]  -- The available pieces of type/class.+                         -- NB: If the type or class is itself+                         -- to be in scope, it must be in this list.+                         -- Thus, typically: AvailTC Eq [Eq, ==, /=]+        deriving Show++data OccName      = OccName NameSpace String {- was EncodedFS -}+        deriving Show++instance Eq OccName where+        (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2++data NameSpace    = VarName     -- variables, and "source" data constructors+                  | DataName    -- "real" data constructors+                  | TvName      -- tyvars+                  | TcClsName   -- type constructors and classes+        deriving (Eq, Show)++data Usage+  = Usage { usg_name     :: ModuleName,		-- Name of the module+	    usg_mod      :: Version,		-- Module version+	    usg_exports  :: Maybe Version,	-- Export-list version, if we depend on it+	    usg_entities :: [(OccName,Version)],-- Sorted by occurrence name+	    usg_rules    :: Version 		-- Orphan-rules version (for non-orphan+						-- modules this will always be initialVersion)+    } deriving Show++------------------------------------------------------------------------+-- TODO parsing type and decl information out of the .hi file+-- complex data structure...+--++{-+data IfaceExtName+  = ExtPkg ModuleName OccName		-- From an external package; no version #+					-- Also used for wired-in things regardless+					-- of whether they are home-pkg or not++  | HomePkg ModuleName OccName Version	-- From another module in home package;+					-- has version #++  | LocalTop OccName			-- Top-level from the same module as +					-- the enclosing IfaceDecl++  | LocalTopSub		-- Same as LocalTop, but for a class method or constr+	OccName		-- Class-meth/constr name+	OccName		-- Parent class/datatype name+	-- LocalTopSub is written into iface files as LocalTop; the parent +	-- info is only used when computing version information in MkIface++data IfaceTyCon 	-- Abbreviations for common tycons with known names+  = IfaceTc IfaceExtName	-- The common case+  | IfaceIntTc | IfaceBoolTc | IfaceCharTc+  | IfaceListTc | IfacePArrTc+  | IfaceTupTc Boxity Arity ++type Arity        = Int                                 -- BasicTypes++data Boxity+  = Boxed+  | Unboxed++type IfaceContext = [IfacePredType]++data IfacePredType 	-- NewTypes are handled as ordinary TyConApps+  = IfaceClassP IfaceExtName [IfaceType]+  | IfaceIParam (IPName OccName) IfaceType++data IPName name+  = Dupable   name	-- ?x: you can freely duplicate this implicit parameter+  | Linear name		-- %x: you must use the splitting function to duplicate it+  deriving( Eq, Ord )	-- Ord is used in the IP name cache finite map+			--	(used in HscTypes.OrigIParamCache)++data IfaceType+  = IfaceTyVar    OccName		-- Type variable only, not tycon+  | IfaceAppTy    IfaceType IfaceType+  | IfaceForAllTy IfaceTvBndr IfaceType+  | IfacePredTy IfacePredType+  | IfaceTyConApp IfaceTyCon [IfaceType]	-- Not necessarily saturated+						-- Includes newtypes, synonyms, tuples+  | IfaceFunTy  IfaceType IfaceType++data IfaceBndr 		-- Local (non-top-level) binders+  = IfaceIdBndr IfaceIdBndr+  | IfaceTvBndr IfaceTvBndr++type IfaceIdBndr  = (OccName, IfaceType)	-- OccName, because always local+type IfaceTvBndr  = (OccName, IfaceKind)+type IfaceKind    = Kind			-- Re-use the Kind type, but no KindVars in it++data IfaceIdInfo+  = NoInfo			-- When writing interface file without -O+  | HasInfo [IfaceInfoItem]	-- Has info, and here it is++data IfaceInfoItem+  = HsArity	 Arity+  | HsStrictness StrictSig+  | HsUnfold	 Activation IfaceExpr+  | HsNoCafRefs+  | HsWorker	 IfaceExtName Arity	-- Worker, if any see IdInfo.WorkerInfo+					-- for why we want arity here.+	-- NB: we need IfaceExtName (not just OccName) because the worker+	--     can simplify to a function in another module.+-- NB: Specialisations and rules come in separately and are+-- only later attached to the Id.  Partial reason: some are orphans.++newtype StrictSig = StrictSig DmdType++data IfaceDecl +  = IfaceId { ifName   :: OccName,+	      ifType   :: IfaceType, +	      ifIdInfo :: IfaceIdInfo }++  | IfaceData { ifCtxt     :: IfaceContext,	-- Context+		ifName     :: OccName,		-- Type constructor+		ifTyVars   :: [IfaceTvBndr],	-- Type variables+		ifCons	   :: IfaceConDecls,	-- Includes new/data info+	        ifRec	   :: RecFlag,		-- Recursive or not?+		ifVrcs     :: ArgVrcs,+		ifGeneric  :: Bool		-- True <=> generic converter functions available+    }						-- We need this for imported data decls, since the+						-- imported modules may have been compiled with+						-- different flags to the current compilation unit++  | IfaceSyn  {	ifName   :: OccName,		-- Type constructor+		ifTyVars :: [IfaceTvBndr],	-- Type variables+		ifVrcs   :: ArgVrcs,+		ifSynRhs :: IfaceType		-- synonym expansion+    }++  | IfaceClass { ifCtxt    :: IfaceContext, 	 	-- Context...+		 ifName    :: OccName,		    	-- Name of the class+		 ifTyVars  :: [IfaceTvBndr],		-- Type variables+		 ifFDs     :: [FunDep OccName],		-- Functional dependencies+		 ifSigs    :: [IfaceClassOp],		-- Method signatures+	         ifRec	   :: RecFlag,			-- Is newtype/datatype associated with the class recursive?+		 ifVrcs    :: ArgVrcs			-- ... and what are its argument variances ...+    }++  | IfaceForeign { ifName :: OccName,			-- Needs expanding when we move beyond .NET+		   ifExtName :: Maybe FastString }+-}++------------------------------------------------------------------------+--+-- all this stuff may be enabled if we ever want other information out+--++{-+type ArgVrcs      = [(Bool,Bool)]                       -- TyCon+type CLabelString = FastString                          -- CStrings+type CcName       = EncodedFS                           -- CostCentre+type DeprecTxt    = FastString                          -- BasicTypes+type FunDep a     = ([a],[a])                           -- Class+type IfaceAlt     = (IfaceConAlt,[OccName],IfaceExpr)   -- IfaceSyn+type IfaceContext = [IfacePredType]                     -- IfaceType+type IfaceDeprec  = Deprecs [(OccName,DeprecTxt)]       -- HscTypes+type IfaceIdBndr  = (OccName, IfaceType)                -- IfaceType+type IfaceKind    = Kind                                -- IfaceType+type IfaceTvBndr  = (OccName, IfaceKind)                -- IfaceType+type RuleName     = FastString                          -- CoreSyn++--+-- Empty definitions for the various types we need, but whose results we+-- don't care about.+--+-- 'data' types that have a parsing method associated with them+-- This list corresponds to each instance in BinIface+--+-- Try to keep this list ordered by the order they appear in BinIface+--+data Deprecs a          = Deprecs +data Activation         = Activation +data StrictnessMark     = StrictnessMark+data Boxity             = Boxity +data TupCon             = TupCon+data RecFlag            = RecFlag+data DefMeth            = DefMeth+data FixityDirection    = FixityDirection+data Fixity             = Fixity+data DmdType            = DmdType+data Demand             = Demand+data Demands            = Demands+data DmdResult          = DmdResult+data StrictSig          = StrictSig+data IsCafCC            = IsCafCC+data IsDupdCC           = IsDupdCC+data CostCentre         = CostCentre+data IfaceExtName       = IfaceExtName+data IfaceBndr          = IfaceBndr+data Kind               = Kind+data IfaceTyCon         = IfaceTyCon+data IfacePredType      = IfacePredType+data IfaceExpr          = IfaceExpr+data IfaceConAlt        = IfaceConAlt+data IfaceBinding       = IfaceBinding+data IfaceIdInfo        = IfaceIdInfo+data IfaceNoteItem      = IfaceNoteItem+data IfaceInfoItem      = IfaceInfoItem+data IfaceNote          = IfaceNote+data IfaceInst          = IfaceInst+data IfaceConDecls      = IfaceConDecls+data IfaceConDecl       = IfaceConDecl+data IfaceClassOp       = IfaceClassOp+data IfaceRule          = IfaceRule+data Literal            = Literal+data ForeignCall        = ForeignCall+data Safety             = Safety+data CExportSpec        = CExportSpec+data CCallSpec          = CCallSpec+data CCallTarget        = CCallTarget+data CCallConv          = CCallConv+data DNCallSpec         = DNCallSpec+data DNKind             = DNKind+data DNType             = DNType++-}
+ src/Language/Hi/hschooks.c view
@@ -0,0 +1,38 @@+/*+These routines customise the error messages+for various bits of the RTS.  They are linked+in instead of the defaults.+*/++#include <string.h>++/* For GHC 4.08, we are relying on the fact that RtsFlags has+ * compatibile layout with the current version, because we're+ * #including the current version of RtsFlags.h below.  4.08 didn't+ * ship with its own RtsFlags.h, unfortunately.   For later GHC+ * versions, we #include the correct RtsFlags.h.+ */++#include "Rts.h"+#include "RtsFlags.h"++#include "HsFFI.h"++HsInt+plugin_strlen( HsAddr a )+{+    return (strlen((char *)a));+}++HsInt+plugin_memcmp( HsAddr a1, HsAddr a2, HsInt len )+{+    return (memcmp((char *)a1, a2, len));+}++HsInt+plugin_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len )+{+    return (memcmp((char *)a1 + i, a2, len));+}+
+ src/Language/Hi/hschooks.h view
@@ -0,0 +1,13 @@+/* -----------------------------------------------------------------------------+ * $ Id: hschooks.h,v 1.1.1.1 2004/05/24 09:35:39 dons Exp $+ *+ * Hooks into the RTS from the compiler.+ *+ * -------------------------------------------------------------------------- */++#include "HsFFI.h"++// Out-of-line string functions, see PrimPacked.lhs+HsInt plugin_strlen( HsAddr a );+HsInt plugin_memcmp( HsAddr a1, HsAddr a2, HsInt len );+HsInt plugin_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len );
+ src/System/Eval.hs view
@@ -0,0 +1,25 @@+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++module System.Eval ( +        module System.Eval.Haskell,+   ) where++import System.Eval.Haskell  {-all-}+
+ src/System/Eval/Haskell.hs view
@@ -0,0 +1,302 @@+-- +-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++--+-- | Evaluate Haskell at runtime, using runtime compilation and dynamic+-- loading. Arguments are compiled to native code, and dynamically+-- loaded, returning a Haskell value representing the compiled argument.+-- The underlying implementation treats 'String' arguments as the source+-- for plugins to be compiled at runtime.+--++module System.Eval.Haskell ( +        eval,+        eval_,+        unsafeEval,+        unsafeEval_,+        typeOf,+        mkHsValues,++{-+        hs_eval_b,      -- return a Bool+        hs_eval_c,      -- return a CChar+        hs_eval_i,      -- return a CInt+        hs_eval_s,      -- return a CString+-}++        module System.Eval.Utils, ++    ) where++import System.Eval.Utils+import System.Plugins.Make+import System.Plugins.Load++import AltData.Dynamic             ( Dynamic )+import AltData.Typeable            ( Typeable )++import Data.Either+import Data.Map as Map++import System.IO+import System.Directory++-- import Foreign.C+-- import Foreign++-- | 'eval' provides a typesafe (to a limit) form of runtime evaluation+-- for Haskell -- a limited form of /runtime metaprogramming/. The+-- 'String' argument to 'eval' is a Haskell source fragment to evaluate+-- at rutime. @imps@ are a list of module names to use in the context of+-- the compiled value.+-- +-- The value returned by 'eval' is constrained to be 'Typeable' --+-- meaning we can perform a /limited/ runtime typecheck, using the+-- 'dynload' function. One consequence of this is that the code must+-- evaluate to a monomorphic value (which will be wrapped in a+-- 'Dynamic').+--+-- If the evaluated code typechecks under the 'Typeable' constraints,+-- 'Just v' is returned. 'Nothing' indicates typechecking failed.+-- Typechecking may fail at two places: when compiling the argument, or+-- when typechecking the splice point. 'eval' resembles a+-- metaprogramming 'run' operator for /closed/ source fragments.+--+-- To evaluate polymorphic values you need to wrap them in data+-- structures using rank-N types.+--+-- Examples:+--+-- > do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int)+-- >    when (isJust i) $ putStrLn (show (fromJust i))+--+eval :: Typeable a => String -> [Import] -> IO (Maybe a)+eval src imps = do+    pwd                <- getCurrentDirectory+    (cmdline,loadpath) <- getPaths+    tmpf               <- mkUniqueWith dynwrap src imps+    status             <- make tmpf cmdline+    m_rsrc <- case status of+        MakeSuccess _ obj -> do +           m_v <- dynload obj [pwd] loadpath symbol+           case m_v of LoadFailure _      -> return Nothing+                       LoadSuccess _ rsrc -> return $ Just rsrc+        MakeFailure err -> mapM_ putStrLn err >> return Nothing+    makeCleaner tmpf+    return m_rsrc++--+-- | 'eval_' is a variety of 'eval' with all the internal hooks+-- available. You are able to set any extra arguments to the compiler+-- (for example, optimisation flags) or dynamic loader, as well as+-- having any errors returned in an 'Either' type.+--+eval_ :: Typeable a =>+         String           -- ^ code to compile+      -> [Import]         -- ^ any imports+      -> [String]         -- ^ extra make flags+      -> [FilePath]       -- ^ (package.confs) for load+      -> [FilePath]       -- ^ include paths load is to search in+      -> IO (Either [String] (Maybe a)) -- ^ either errors, or maybe a well typed value++eval_ src mods args ldflags incs = do +    pwd                <- getCurrentDirectory+    (cmdline,loadpath) <- getPaths      -- find path to altdata+    tmpf               <- mkUniqueWith dynwrap src mods+    status             <- make tmpf $ ["-Onot"] ++ cmdline ++ args+    m_rsrc <- case status of+        MakeSuccess _ obj -> do +           m_v <- dynload obj (pwd:incs) (loadpath++ldflags) symbol+           return $ case m_v of LoadFailure e      -> Left e+                                LoadSuccess _ rsrc -> Right (Just rsrc)+        MakeFailure err -> return $ Left err+    makeCleaner tmpf+    return m_rsrc++-- | Sometimes when constructing string fragments to evaluate, the+-- programmer is able to provide some other constraint on the evaluated+-- string, such that the evaluated expression will be typesafe, without+-- requiring a 'Typeable' constraint. In such cases, the monomorphic+-- restriction is annoying. 'unsafeEval' removes any splice-point+-- typecheck, with an accompanying obligation on the programmer to+-- ensure that the fragment evaluated will be typesafe at the point it+-- is spliced.+--+-- An example of how to do this would be to wrap the fragment in a call+-- to 'show'. The augmented fragment would then be checked when compiled+-- to return a 'String', and the programmer can rely on this, without+-- requiring a splice-point typecheck, and thus no 'Typeable'+-- restriction.+--+-- Note that if you get the proof wrong, your program will likely+-- segfault.+-- +-- Example:+--+-- > do s <- unsafeEval "map toUpper \"haskell\"" ["Data.Char"]+-- >    when (isJust s) $ putStrLn (fromJust s)+--+unsafeEval :: String -> [Import] -> IO (Maybe a)+unsafeEval src mods = do+    pwd    <- getCurrentDirectory+    tmpf   <- mkUniqueWith wrap src mods+    status <- make tmpf []+    m_rsrc <- case status of+        MakeSuccess _ obj  -> do +           m_v <- load obj [pwd] [] symbol+           case m_v of LoadFailure _      -> return Nothing+                       LoadSuccess _ rsrc -> return $ Just rsrc+        MakeFailure err -> mapM_ putStrLn err >> return Nothing+    makeCleaner tmpf+    return m_rsrc++--+-- | 'unsafeEval_' is a form of 'unsafeEval' with all internal hooks+-- exposed. This is useful for application wishing to return error+-- messages to users, to specify particular libraries to link against+-- and so on.+--+unsafeEval_ :: String           -- ^ code to compile+            -> [Import]         -- ^ any imports+            -> [String]         -- ^ make flags+            -> [FilePath]       -- ^ (package.confs) for load+            -> [FilePath]       -- ^ include paths load is to search in+            -> IO (Either [String] a)++unsafeEval_ src mods args ldflags incs = do +    pwd  <- getCurrentDirectory+    tmpf <- mkUniqueWith wrap src mods+    status <- make tmpf args+    e_rsrc <- case status of+        MakeSuccess _ obj  -> do +           m_v <- load obj (pwd:incs) ldflags symbol+           case m_v of LoadFailure e      -> return $ Left e+                       LoadSuccess _ rsrc -> return $ Right rsrc+        MakeFailure err -> return $ Left err+    makeCleaner tmpf+    return e_rsrc+------------------------------------------------------------------------+--+-- | 'mkHsValues' is a helper function for converting 'Data.Map's+-- of names and values into Haskell code. It relies on the assumption of+-- names and values into Haskell code. It relies on the assumption that+-- the passed values' Show instances produce valid Haskell literals+-- (this is true for all Prelude types).+--+mkHsValues :: (Show a) => Map.Map String a -> String+mkHsValues values = concat $ elems $ Map.mapWithKey convertToHs values+	where convertToHs :: (Show a) => String -> a -> String+	      convertToHs name value = name ++ " = " ++ show value ++ "\n"+------------------------------------------------------------------------+--+-- | Return a compiled value's type, by using Dynamic to get a+-- representation of the inferred type.+--+typeOf :: String -> [Import] -> IO String+typeOf src mods = do+    pwd                <- getCurrentDirectory+    (cmdline,loadpath) <- getPaths+    tmpf               <- mkUniqueWith dynwrap src mods+    status             <- make tmpf cmdline+    ty <- case status of+        MakeSuccess _ obj -> do +            m_v <- load obj [pwd] loadpath symbol :: IO (LoadStatus Dynamic)+            case m_v of +                LoadFailure _   -> return "<failure>"+                LoadSuccess _ v -> return $ (init . tail) $ show v++        MakeFailure err -> mapM_ putStrLn err >> return []+    makeCleaner tmpf+    return ty++--+-- note that the wrapper uses our altdata library for dynamic typing.+-- hence it needs to see the path to the altdata package. grr. is it+-- installed or not? what path does it have?+--+dynwrap :: String -> String -> [Import] -> String+dynwrap expr nm mods =+        "module "++nm++ "( resource ) where\n" ++ +         concatMap (\m-> "import "++m++"\n") mods +++        "import AltData.Dynamic\n" +++        "resource = let { v = \n" +++        "{-# LINE 1 \"<eval>\" #-}\n" ++ expr ++ ";} in toDyn v"++-- ---------------------------------------------------------------------+-- unsafe wrapper+--+wrap :: String -> String -> [Import] -> String+wrap expr nm mods =+        "module "++nm++ "( resource ) where\n" ++ +        concatMap (\m-> "import "++m++"\n") mods +++        "resource = let { v = \n" +++        "{-# LINE 1 \"<Plugins.Eval>\" #-}\n" ++ expr ++ ";} in v"++{-+------------------------------------------------------------------------+--+-- And for our friends in foreign parts+--+-- TODO needs to accept char** to import list+--++--+-- return NULL pointer if an error occured.+--+  +foreign export ccall hs_eval_b  :: CString -> IO (Ptr CInt)+foreign export ccall hs_eval_c  :: CString -> IO (Ptr CChar)+foreign export ccall hs_eval_i  :: CString -> IO (Ptr CInt)+foreign export ccall hs_eval_s  :: CString -> IO CString++------------------------------------------------------------------------+--+-- TODO implement a marshalling for Dynamics, so that we can pass that+-- over to the C side for checking.+--++hs_eval_b :: CString -> IO (Ptr CInt)+hs_eval_b s = do m_v <- eval_cstring s+                 case m_v of Nothing -> return nullPtr +                             Just v  -> new (fromBool v)++hs_eval_c :: CString -> IO (Ptr CChar)+hs_eval_c s = do m_v <- eval_cstring s+                 case m_v of Nothing -> return nullPtr +                             Just v  -> new (castCharToCChar v)++-- should be Integral+hs_eval_i :: CString -> IO (Ptr CInt)+hs_eval_i s = do m_v <- eval_cstring s :: IO (Maybe Int)+                 case m_v of Nothing -> return nullPtr +                             Just v  -> new (fromIntegral v :: CInt)++hs_eval_s :: CString -> IO CString+hs_eval_s s = do m_v <- eval_cstring s+                 case m_v of Nothing -> return nullPtr +                             Just v  -> newCString v+ +--+-- convenience+--+eval_cstring :: Typeable a => CString -> IO (Maybe a)+eval_cstring cs = do s <- peekCString cs+                     eval s []            -- TODO use eval()++-}
+ src/System/Eval/Utils.hs view
@@ -0,0 +1,96 @@+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++--+-- compile and run haskell strings at runtime.+--++module System.Eval.Utils ( ++        Import,+        symbol,+        escape,+        getPaths,++        mkUniqueWith,+        cleanup,++        module Data.Maybe,+        module Control.Monad,++    ) where++import System.Plugins.Load                ( Symbol )+import System.Plugins.Utils++import System.IO+import System.Directory++import Data.Char++-- +-- we export these so that eval() users have a nice time+--+import Data.Maybe +import Control.Monad++--+-- imports Foo's+--+type Import = String++--+-- distinguished symbol name+--+symbol :: Symbol+symbol = "resource"++--+-- turn a Haskell string into a printable version of the same string+--+escape s = concatMap (\c -> showLitChar c $ "") s++--+-- For Dynamic eval's, work out the compile and load command lines+--+getPaths :: IO ([String],[String])+getPaths = do+        let make_line = ["-Onot","-fglasgow-exts","-package","plugins"]+        return (make_line,[])++-- ---------------------------------------------------------------------+-- create the tmp file, and write source into it, using wrapper to+-- create extra .hs src.+--+mkUniqueWith :: (String -> String -> [Import] -> String) +             -> String +             -> [Import] -> IO FilePath++mkUniqueWith wrapper src mods = do+        (tmpf,hdl) <- hMkUnique+        let nm   = mkModid (basename tmpf)       -- used as a module name+            src' = wrapper src nm mods+        hPutStr hdl src' >> hFlush hdl >> hClose hdl >> return tmpf++--+-- remove all the tmp files+--+cleanup :: String -> String -> IO ()+cleanup a b = mapM_ removeFile [a, b, replaceSuffix b ".hi"]+
+ src/System/MkTemp.hs view
@@ -0,0 +1,278 @@+{-# OPTIONS -fglasgow-exts #-}+--+-- glaexts for I# ops+-- +-- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++--+-- A Haskell reimplementation of the C mktemp/mkstemp/mkstemps library+-- based on the algorithms in:+-- >    $ OpenBSD: mktemp.c,v 1.17 2003/06/02 20:18:37 millert Exp $+-- which are available under the BSD license.+--++module System.MkTemp ( ++     mktemp,    -- :: FilePath -> IO Maybe FilePath+     mkstemp,   -- :: FilePath -> IO Maybe (FilePath, Handle)+     mkstemps,  -- :: FilePath -> Int -> IO Maybe (FilePath,Handle)+     mkdtemp,   -- :: FilePath -> IO Maybe FilePath++  ) where++import Data.List+import Data.Char                ( chr, ord, isDigit )+import Control.Monad            ( liftM )+import Control.Exception        ( handleJust )+import System.Directory         ( doesDirectoryExist, doesFileExist, createDirectory )+import System.IO+#ifndef __MINGW32__+import System.IO.Error          ( isAlreadyExistsError )+#else+import System.IO.Error          ( isAlreadyExistsError, isAlreadyInUseError, isPermissionError )+#endif++import GHC.IOBase               ( IOException(IOError), +                                  Exception(IOException), +                                  IOErrorType(AlreadyExists) )++#ifndef __MINGW32__+import qualified System.Posix.Internals ( c_getpid )+#endif++#ifdef HAVE_ARC4RANDOM+import GHC.Base hiding ( ord, chr )+import GHC.Int+#else+import System.Random            ( getStdRandom, Random(randomR) )+#endif++------------------------------------------------------------------------++mkstemps :: FilePath -> Int -> IO (Maybe (FilePath,Handle))+mkstemp  :: FilePath        -> IO (Maybe (FilePath,Handle))+mktemp   :: FilePath        -> IO (Maybe FilePath)+mkdtemp  :: FilePath        -> IO (Maybe FilePath)++mkstemps path slen = gettemp path True False slen++mkstemp  path      = gettemp path True False 0++mktemp  path = do v <- gettemp path False False 0+                  return $ case v of Just (path',_) -> Just path'; _ -> Nothing++mkdtemp path = do v <- gettemp path False True 0+                  return $ case v of Just (path',_) -> Just path'; _ -> Nothing++------------------------------------------------------------------------++gettemp :: FilePath -> Bool -> Bool -> Int -> IO (Maybe (FilePath, Handle))++gettemp [] _ _ _      = return Nothing+gettemp _ True True _ = return Nothing++gettemp path doopen domkdir slen = do+    --+    -- firstly, break up the path and extract the template+    --+    let (pref,tmpl,suff) = let (r,s) = splitAt (length path - slen) path+                               (p,t) = break (== 'X') r+                           in (p,t,s)+    --+    -- an error if there is only a suffix, it seems+    --+    if null pref && null tmpl then return Nothing else do {+    --+    -- replace end of template with process id, and rest with randomness+    --+    ;pid <- liftM show $ getProcessID+    ;let (rest, xs) = merge tmpl pid+    ;as <- randomise rest+    ;let tmpl' = as ++ xs+         path' = pref ++ tmpl' ++ suff+    --+    -- just check if we can get at the directory we might need+    --+    ;dir_ok <- if doopen || domkdir+               then let d = reverse $ dropWhile (/= '/') $ reverse path'+                    in doesDirectoryExist d+               else return True++    ;if not dir_ok then return Nothing else do {+    --+    -- We need a function for looking for appropriate temp files+    --+    ;let fn p+          | doopen    = handleJust isInUse (\_ -> return Nothing) $+                          do h <- open0600 p ; return $ Just h+          | domkdir   = handleJust alreadyExists (\_ -> return Nothing) $+                          do mkdir0700 p ; return $ Just undefined+          | otherwise = do b <- doesFileExist p+                           return $ if b then Nothing else Just undefined++    --+    -- now, try to create the tmp file, permute if we can't+    -- once we've tried all permutations, give up+    --+    ;let tryIt p t i =+            do v <- fn p+               case v of Just h  -> return $ Just (p,h)        -- it worked+                         Nothing -> let (i',t') = tweak i t+                                    in if null t' +                                       then return Nothing     -- no more+                                       else tryIt (pref++t'++suff) t' i'+    ;tryIt path' tmpl' 0++    }}++--+-- Replace X's with pid digits. Complete rewrite+--+merge :: String -> String -> (String,String)+merge t []          = (t  ,[])+merge [] _          = ([] ,[])+merge (_:ts) (p:ps) = (ts',p:ps')+        where (ts',ps') = merge ts ps++--+-- And replace remaining X's with random chars+-- randomR is pretty slow, oh well.+--+randomise :: String -> IO String+randomise []       = return []+randomise ('X':xs) = do p <- getRandom ()+                        let c = chr $! if p < 26 +                                       then p + (ord 'A') +                                       else (p - 26) + (ord 'a')+                        xs' <- randomise xs+                        return (c : xs')+randomise s = return s++--+-- "tricky little algorithm for backward compatibility"+-- could do with a Haskellish rewrite+--+tweak :: Int -> String -> (Int,String)+tweak i s +    | i > length s - 1 = (i,[])                 -- no more+    | s !! i == 'Z'    = if i == length s - 1 +                         then (i,[])            -- no more+                         else let s' = splice (i+1) 'a'+                              in tweak (i+1) s' -- loop+    | otherwise = let c = s !! i in case () of {_+        | isDigit c -> (i, splice i 'a' )+        | c == 'z'  -> (i, splice i 'A' )+        | otherwise -> let c' = chr $ (ord c) + 1 in (i,splice i c')+    }+    where+        splice j c = let (a,b) = splitAt j s in a ++ [c] ++ tail b++-- ---------------------------------------------------------------------++alreadyExists :: Exception -> Maybe Exception+alreadyExists e@(IOException ioe) +        | isAlreadyExistsError ioe = Just e+        | otherwise                = Nothing+alreadyExists _ = Nothing++isInUse :: Exception -> Maybe ()+#ifndef __MINGW32__+isInUse (IOException ioe) +        | isAlreadyExistsError ioe = Just ()+        | otherwise                = Nothing+isInUse _ = Nothing+#else+isInUse (IOException ioe) +        | isAlreadyInUseError  ioe = Just ()+        | isPermissionError    ioe = Just ()+        | isAlreadyExistsError ioe = Just ()    -- we throw this+        | otherwise               = Nothing+isInUse _ = Nothing+#endif++-- ---------------------------------------------------------------------+-- Create a file mode 0600 if possible+--+-- N.B. race condition between testing existence and opening+-- But we can live with that to avoid a posix dependency, right?+--+open0600 :: FilePath -> IO Handle+open0600 f = do+        b <- doesFileExist f+        if b then ioError err   -- race+             else openFile f ReadWriteMode+    where+        err = IOError Nothing AlreadyExists "open0600" "already exists" Nothing++{-+-- open(path, O_CREAT|O_EXCL|O_RDWR, 0600)+--+open0600 f = do+        openFd f ReadWrite (Just o600) excl >>= fdToHandle+   where +        o600 = ownerReadMode `unionFileModes` ownerWriteMode+        excl = defaultFileFlags { exclusive = True }+-}++--+-- create a directory mode 0700 if possible+--+mkdir0700 :: FilePath -> IO ()+mkdir0700 dir = createDirectory dir+{-+        System.Posix.Directory.createDirectory dir ownerModes+-}++-- | getProcessId, stolen from GHC /main\/SysTools.lhs/+--+#ifdef __MINGW32__+-- relies on Int == Int32 on Windows+foreign import ccall unsafe "_getpid" getProcessID' :: IO Int  +getProcessID :: IO Int+getProcessID = liftM abs getProcessID'+#else+getProcessID :: IO Int+#ifdef CYGWIN+getProcessID = System.Posix.Internals.c_getpid >>= return . abs . fromIntegral+#else+getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral+#endif+#endif++-- ---------------------------------------------------------------------+-- | Use a variety of random functions, if you like.+--+getRandom :: () -> IO Int++#ifndef HAVE_ARC4RANDOM+getRandom _ = getStdRandom (randomR (0,51))+#else+--+-- OpenBSD: "The arc4random() function provides a high quality 32-bit+-- pseudo-random number very quickly.  arc4random() seeds itself on a+-- regular basis from the kernel strong random number subsystem+-- described in random(4)." Also, it is a bit faster than getStdRandom+--+getRandom _ = do +    (I32# i) <- c_arc4random+    return (I# (word2Int# ((int2Word# i `and#` int2Word# 0xffff#) +                    `remWord#` int2Word# 52#)))++foreign import ccall unsafe "stdlib.h arc4random" c_arc4random :: IO Int32+#endif
+ src/System/Plugins.hs view
@@ -0,0 +1,37 @@+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++module System.Plugins (  ++        -- $Description++        module System.Plugins.Make,+        module System.Plugins.Load,++  ) where++import System.Plugins.Make     {-all-}+import System.Plugins.Load     {-all-}++--+-- $Description+--+-- [@NAME@] hs-plugins library : compile and load Haskell code at runtime+--+
+ src/System/Plugins/Consts.hs view
@@ -0,0 +1,78 @@+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++module System.Plugins.Consts where++#include "../../../config.h"+++#if __GLASGOW_HASKELL__ >= 604+import System.Directory          ( getTemporaryDirectory )+import System.IO.Unsafe          ( unsafePerformIO )+#endif+++-- | path to *build* dir, used by eval() for testing the examples+top             = TOP++-- | what is ghc called?+ghc             = WITH_GHC++-- | path to standard ghc libraries+ghcLibraryPath  = GHC_LIB_PATH++-- | name of the system package.conf file+sysPkgConf = "package.conf"++-- | This code is from runtime_loader:+--   The extension used by system modules.+sysPkgSuffix = ".o"+objSuf       = sysPkgSuffix+hiSuf        = ".hi"+hsSuf        = ".hs"+#if defined(CYGWIN) || defined(__MINGW32__)+dllSuf       = ".dll"+#else+dllSuf       = ".so"+#endif++-- | The prefix used by system modules.  This, in conjunction with+--  'systemModuleExtension', will result in a module filename that looks+-- like \"HSconcurrent.o\"+sysPkgPrefix      = "HS"++-- | '_' on a.out, and Darwin+#if LEADING_UNDERSCORE == 1+prefixUnderscore        = "_" +#else+prefixUnderscore        = ""+#endif++-- | Define tmpDir to where tmp files should be created on your platform++#if __GLASGOW_HASKELL__ >= 604+tmpDir = unsafePerformIO getTemporaryDirectory+{-# NOINLINE tmpDir #-}+#else+#if !defined(__MINGW32__)+tmpDir  = "/tmp"+#else+tmpDir  = error "tmpDir not defined for this platform. Try setting the TMPDIR env var"+#endif+#endif
+ src/System/Plugins/Env.hs view
@@ -0,0 +1,465 @@+--+-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++module System.Plugins.Env (+        env,+        withModEnv,+        withDepEnv,+        withPkgEnvs,+        withMerged,+        modifyModEnv,+        modifyDepEnv,+        modifyPkgEnv,+        modifyMerged,+        addModule,+        rmModule,+        addModules,+        isLoaded,+        loaded,+        addModuleDeps,+        getModuleDeps,+        rmModuleDeps,+        isMerged,+        lookupMerged,+        addMerge,+        addPkgConf,+        union,+        grabDefaultPkgConf,+        readPackageConf,+        lookupPkg++   ) where++#include "../../../config.h"++import System.Plugins.LoadTypes (Module)+import System.Plugins.PackageAPI  {- everything -}+#if CABAL == 1 || __GLASGOW_HASKELL__ >= 604+import System.Plugins.ParsePkgConfCabal( parsePkgConf )+#else+import System.Plugins.ParsePkgConfLite ( parsePkgConf )+#endif+import System.Plugins.Consts           ( ghcLibraryPath, sysPkgConf, sysPkgSuffix )++import Data.IORef               ( writeIORef, readIORef, newIORef, IORef() )+import Data.Maybe               ( isJust, isNothing, fromMaybe )+import Data.List                ( isPrefixOf, nub )++import System.IO.Unsafe         ( unsafePerformIO )+import System.Directory         ( doesFileExist )+#if defined(CYGWIN) || defined(__MINGW32__)+import Prelude hiding ( catch, ioError )+import System.Environment       ( getEnv )+import System.IO.Error          ( catch, ioError, isDoesNotExistError )+#endif++import Control.Concurrent.MVar  ( MVar(), newMVar, withMVar )++#if __GLASGOW_HASKELL__ < 604+import Data.FiniteMap++#else+import qualified Data.Map as M++--+-- and map Data.Map terms to FiniteMap terms+--+type FiniteMap k e = M.Map k e++emptyFM :: FiniteMap key elt+emptyFM   = M.empty++addToFM :: (Ord key) => FiniteMap key elt -> key -> elt -> FiniteMap key elt+addToFM   = \m k e -> M.insert k e m++delFromFM :: (Ord key) => FiniteMap key elt -> key -> FiniteMap key elt+delFromFM = flip M.delete++lookupFM :: (Ord key) => FiniteMap key elt -> key -> Maybe elt+lookupFM  = flip M.lookup++#endif++--+-- | We need to record what modules and packages we have loaded, so if+-- we read a .hi file that wants to load something already loaded, we+-- can safely ignore that request. We're in the IO monad anyway, so we+-- can add some extra state of our own.+--+-- The state is a FiniteMap String (Module,Int) (a hash of+-- package\/object names to Modules and how many times they've been+-- loaded).+--+-- It also contains the package.conf information, so that if there is a+-- package dependency we can find it correctly, even if it has a+-- non-standard path or name, and if it isn't an official package (but+-- rather one provided via -package-conf). This is stored as a FiniteMap+-- PackageName PackageConfig. The problem then is whether a user's+-- package.conf, that uses the same package name as an existing GHC+-- package, should be allowed, or should shadow a library package?  I+-- don't know, but I'm inclined to have the GHC package shadow the+-- user's package.+--+-- This idea is based on /Hampus Ram's dynamic loader/ dependency+-- tracking system. He uses state to record dependency trees to allow+-- clean unloading and other fun. This is quite cool. We're just using+-- state to make sure we don't load the same package twice. Implementing+-- the full dependency tree idea would be nice, though not fully+-- necessary as we have the dependency information store in .hi files,+-- unlike in hram's loader.+--++type ModEnv = FiniteMap String (Module,Int)++type DepEnv = FiniteMap Module [Module]++-- represents a package.conf file+type PkgEnv  = FiniteMap PackageName PackageConfig++-- record dependencies between (src,stub) -> merged modid+type MergeEnv = FiniteMap (FilePath,FilePath) FilePath++-- multiple package.conf's kept in separate namespaces+type PkgEnvs = [PkgEnv]++type Env = (MVar (), +            IORef ModEnv,+            IORef DepEnv,  +            IORef PkgEnvs,+            IORef MergeEnv)++--+-- our environment, contains a set of loaded objects, and a map of known+-- packages and their informations. Initially all we know is the default+-- package.conf information.+--+env = unsafePerformIO $ do +                mvar  <- newMVar ()+                ref1  <- newIORef emptyFM         -- loaded objects+                ref2  <- newIORef emptyFM+                p     <- grabDefaultPkgConf+                ref3  <- newIORef p               -- package.conf info+                ref4  <- newIORef emptyFM         -- merged files+                return (mvar, ref1, ref2, ref3, ref4)+{-# NOINLINE env #-}++-- -----------------------------------------------------------+--+-- | apply 'f' to the loaded objects Env, apply 'f' to the package.conf+-- FM /locks up the MVar/ so you can't recursively call a function+-- inside a with any -Env function. Nice and threadsafe+--+withModEnv  :: Env -> (ModEnv   -> IO a) -> IO a+withDepEnv  :: Env -> (DepEnv   -> IO a) -> IO a+withPkgEnvs :: Env -> (PkgEnvs  -> IO a) -> IO a+withMerged  :: Env -> (MergeEnv -> IO a) -> IO a++withModEnv  (mvar,ref,_,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)+withDepEnv  (mvar,_,ref,_,_) f = withMVar mvar (\_ -> readIORef ref >>= f)+withPkgEnvs (mvar,_,_,ref,_) f = withMVar mvar (\_ -> readIORef ref >>= f)+withMerged  (mvar,_,_,_,ref) f = withMVar mvar (\_ -> readIORef ref >>= f)++-- -----------------------------------------------------------+--+-- write an object name+-- write a new PackageConfig+--+modifyModEnv :: Env -> (ModEnv   -> IO ModEnv)  -> IO ()+modifyDepEnv :: Env -> (DepEnv   -> IO DepEnv)  -> IO ()+modifyPkgEnv :: Env -> (PkgEnvs  -> IO PkgEnvs) -> IO ()+modifyMerged :: Env -> (MergeEnv -> IO MergeEnv)-> IO ()++modifyModEnv (mvar,ref,_,_,_) f = lockAndWrite mvar ref f +modifyDepEnv (mvar,_,ref,_,_) f = lockAndWrite mvar ref f +modifyPkgEnv (mvar,_,_,ref,_) f = lockAndWrite mvar ref f +modifyMerged (mvar,_,_,_,ref) f = lockAndWrite mvar ref f++-- private+lockAndWrite mvar ref f = withMVar mvar (\_->readIORef ref>>=f>>=writeIORef ref)++-- -----------------------------------------------------------+--+-- | insert a loaded module name into the environment+--+addModule :: String -> Module -> IO ()+addModule s m = modifyModEnv env $ \fm -> let c = maybe 0 snd (lookupFM fm s)+                                          in return $ addToFM fm s (m,c+1)++--getModule :: String -> IO (Maybe Module)+--getModule s = withModEnv env $ \fm -> return (lookupFM fm s)++--+-- | remove a module name from the environment. Returns True if the+-- module was actually removed.+--+rmModule :: String -> IO Bool+rmModule s = do modifyModEnv env $ \fm -> let c = maybe 1 snd (lookupFM fm s)+                                              fm' = delFromFM fm s+                                          in if c-1 <= 0+                                                then return fm'+                                                else return fm+                withModEnv env $ \fm -> return (isNothing  (lookupFM fm s))++--+-- | insert a list of module names all in one go+--+addModules :: [(String,Module)] -> IO ()+addModules ns = mapM_ (uncurry addModule) ns++--+-- | is a module\/package already loaded?+--+isLoaded :: String -> IO Bool+isLoaded s = withModEnv env $ \fm -> return $ isJust (lookupFM fm s)++--+-- confusing! only for filter.+--+loaded :: String -> IO Bool+loaded m = do t <- isLoaded m ; return (not t)++-- -----------------------------------------------------------+--+-- module dependency stuff+--++--+-- | Set the dependencies of a Module.+--+addModuleDeps :: Module -> [Module] -> IO ()+addModuleDeps m deps = modifyDepEnv env $ \fm -> return $ addToFM fm m deps++--+-- | Get module dependencies. Nothing if none have been recored.+--+getModuleDeps :: Module -> IO [Module]+getModuleDeps m = withDepEnv env $ \fm -> return $ fromMaybe [] (lookupFM fm m)+++--+-- | Unrecord a module from the environment.+--+rmModuleDeps :: Module -> IO ()+rmModuleDeps m = modifyDepEnv env $ \fm -> return $ delFromFM fm m++-- -----------------------------------------------------------+-- Package management stuff++--+-- | Insert a single package.conf (containing multiple configs) means:+-- create a new FM. insert packages into FM. add FM to end of list of FM+-- stored in the environment.+--+addPkgConf :: FilePath -> IO ()+addPkgConf f = do +    ps <- readPackageConf f+    modifyPkgEnv env $ \ls -> return $ union ls ps++--+-- | add a new FM for the package.conf to the list of existing ones+--+union :: PkgEnvs -> [PackageConfig] -> PkgEnvs+union ls ps' = +        let fm = emptyFM -- new FM for this package.conf+        in foldr (\p fm' -> addToFM fm' (packageName p) p) fm ps' : ls++-- +-- | generate a PkgEnv from the system package.conf+-- The path to the default package.conf was determined by /configure/+-- This imposes a constraint that you must build your plugins with the+-- same ghc you use to build hs-plugins. This is reasonable, we feel.+--++grabDefaultPkgConf :: IO PkgEnvs+grabDefaultPkgConf = do+        pkgs <- readPackageConf $ ghcLibraryPath </> sysPkgConf+        return $ union [] pkgs++--+-- parse a source file, expanding any $libdir we see.+--+readPackageConf :: FilePath -> IO [PackageConfig]+readPackageConf f = do+        s <- readFile f+        let p = parsePkgConf s+        return $! map expand_libdir p++  where+      expand_libdir :: PackageConfig -> PackageConfig+      expand_libdir pk =+        let pk'   = updImportDirs  (\idirs -> map expand idirs) pk+            pk''  = updLibraryDirs (\ldirs -> map expand ldirs) pk'+        in  pk''++      expand :: FilePath -> FilePath+      expand s | "$libdir" `isPrefixOf` s = ghcLibraryPath ++ drop 7 s+      expand s = s+++--+-- Package path, given a package name, look it up in the environment and+-- return the path to all the libraries needed to load this package.+--+-- What do we need to load? With the library_dirs as prefix paths:+--      . anything in the hs_libraries fields, libdir expanded+--+--      . anything in the extra_libraries fields (i.e. cbits), expanded,+--+--      which includes system .so files.+--+--      . also load any dependencies now, because of that weird mtl+--      library that lang depends upon, but which doesn't show up in the+--      interfaces for some reason.+--+-- We return all the package paths that possibly exist, and the leave it+-- up to loadObject not to load the same ones twice...+--+lookupPkg :: PackageName -> IO ([FilePath],[FilePath])+lookupPkg p = do +        t <- lookupPkg' p+        case t of ([],(f,g)) -> return (f,g)+                  (ps,(f,g)) -> do gss <- mapM lookupPkg ps+				   let (f',g') = unzip gss+				   return $ (nub $ (concat f') ++ f,nub $ (concat g') ++ g)++data LibrarySpec+   = DLL String         -- -lLib+   | DLLPath FilePath   -- -Lpath++classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)+classifyLdInput ('-':'l':lib) = return (Just (DLL lib))+classifyLdInput ('-':'L':path) = return (Just (DLLPath path))+classifyLdInput _ = return Nothing++-- TODO need to define a MAC\/DARWIN symbol+#if defined(MACOSX)+mkSOName root = "lib" ++ root ++ ".dylib"+#elif defined(CYGWIN) || defined(__MINGW32__)+-- Win32 DLLs have no .dll extension here, because addDLL tries+-- both foo.dll and foo.drv+mkSOName root = root+#else+mkSOName root = "lib" ++ root ++ ".so"+#endif++--+-- return any stuff to load for this package, plus the list of packages+-- this package depends on. which includes stuff we have to then load+-- too.+--+lookupPkg' :: PackageName -> IO ([PackageName],([FilePath],[FilePath]))+lookupPkg' p = withPkgEnvs env $ \fms -> go fms p+    where+        go [] _       = return ([],([],[]))+        go (fm:fms) q = case lookupFM fm q of+            Nothing -> go fms q     -- look in other pkgs++            Just package -> do+                let    hslibs  = hsLibraries package+                       extras' = extraLibraries package+                       cbits   = filter (\e -> reverse (take (length "_cbits") (reverse e)) == "_cbits") extras'+                       extras  = filter (not . flip elem (cbits++["m","gmp"])) extras'+                       ldopts  = ldOptions package+                       deppkgs = packageDeps package+                ldInput <- mapM classifyLdInput ldopts+                let ldOptsLibs  = [ path | Just (DLL path) <- ldInput ]+                    ldOptsPaths = [ path | Just (DLLPath path) <- ldInput ]+                    dlls        = map mkSOName (extras ++ ldOptsLibs)+#if defined(CYGWIN) || defined(__MINGW32__)+                    libdirs = fix_topdir (libraryDirs package) ++ ldOptsPaths+#else+                    libdirs = libraryDirs package ++ ldOptsPaths+#endif+                libs <- mapM (findHSlib libdirs) (hslibs ++ cbits)+#if defined(CYGWIN) || defined(__MINGW32__)+                windowsos <- catch (getEnv "OS")+			   (\e -> if isDoesNotExistError e then return "Windows_98" else ioError e)+                windowsdir <-+                    if windowsos == "Windows_9X" -- I don't know Windows 9X has OS system variable+                      then return "C:/windows"+                      else return "C:/winnt"+                sysroot <- catch (getEnv "SYSTEMROOT")+			   (\e -> if isDoesNotExistError e then return windowsdir else ioError e) -- guess at a reasonable default+		let syslibdir = sysroot ++ (if windowsos == "Windows_9X" then "/SYSTEM" else "/SYSTEM32")+		libs' <- mapM (findDLL $ syslibdir : libdirs) dlls+#else+		libs' <- mapM (findDLL libdirs) dlls+#endif+                return (deppkgs, (filterRight libs,map (either id id) libs') )++#if defined(CYGWIN) || defined(__MINGW32__)+        -- replace $topdir+	fix_topdir []        = []+	fix_topdir (x:xs)    = replace_topdir x : fix_topdir xs++        replace_topdir []           = []+	replace_topdir ('$':xs) +	    | take 6 xs == "topdir" = ghcLibraryPath ++ (drop 6 xs)+	    | otherwise             = '$' : replace_topdir xs+	replace_topdir (x:xs)       = x : replace_topdir xs+#endif+        -- a list elimination form for the Maybe type+        filterRight :: [Either left right] -> [right]+        filterRight []           = []+        filterRight (Right x:xs) = x:filterRight xs+        filterRight (Left _:xs)  =   filterRight xs++        --+        -- Check that a path to a library actually reaches a library+        -- Problem: sysPkgSuffix  is ".o", but extra libraries could be+        -- ".so" -- what to do?+        --+        findHSlib :: [FilePath] -> String -> IO (Either String FilePath)+        findHSlib [] lib         = return (Left lib)+        findHSlib (dir:dirs) lib = do+                  let l = dir </> lib ++ sysPkgSuffix+                  b <- doesFileExist l+                  if b then return $ Right l     -- found it!+                       else findHSlib dirs lib++        findDLL :: [FilePath] -> String -> IO (Either String FilePath)+	findDLL [] lib         = return (Left lib)+	findDLL (dir:dirs) lib = do+		 let l = dir </> lib+		 b <- doesFileExist l+		 if b then return $ Right l+		      else findDLL dirs lib++------------------------------------------------------------------------+-- do we have a Module name for this merge?+--+isMerged :: FilePath -> FilePath -> IO Bool+isMerged a b = withMerged env $ \fm -> return $ isJust (lookupFM fm (a,b))++lookupMerged :: FilePath -> FilePath -> IO (Maybe FilePath)+lookupMerged a b = withMerged env $ \fm -> return $ lookupFM fm (a,b)++--+-- insert a new merge pair into env+--+addMerge :: FilePath -> FilePath -> FilePath -> IO ()+addMerge a b z = modifyMerged env $ \fm -> return $ addToFM fm (a,b) z++------------------------------------------------------------------------+-- break a module cycle+-- private:+--+(</>) :: FilePath -> FilePath -> FilePath+[] </> b = b+a  </> b = a ++ "/" ++ b
+ src/System/Plugins/Load.hs view
@@ -0,0 +1,694 @@+{-# OPTIONS -fglasgow-exts #-}+--+-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++-- | An interface to the GHC runtime's dynamic linker, providing runtime+-- loading and linking of Haskell object files, commonly known as+-- /plugins/.++module System.Plugins.Load (++      -- * The @LoadStatus@ type+      LoadStatus(..)++      -- * High-level interface+      , load+      , load_+      , dynload+      , pdynload +      , pdynload_+      , unload+      , unloadAll+      , reload+      , Module(..)++      -- * Low-level interface+      , initLinker      -- start it up+      , loadModule      -- load a vanilla .o+      , loadFunction    -- retrieve a function from an object+      , loadFunction_   -- retrieve a function from an object+      , loadPackage     -- load a ghc library and its cbits+      , unloadPackage   -- unload a ghc library and its cbits+      , loadPackageWith -- load a pkg using the package.conf provided+      , loadShared      -- load a .so object file+      , resolveObjs     -- and resolve symbols++      , loadRawObject   -- load a bare .o. no dep chasing, no .hi file reading++      , Symbol++      , getImports++  ) where++#include "../../../config.h"++import System.Plugins.Make             ( build )+import System.Plugins.Env+import System.Plugins.Utils+import System.Plugins.Consts           ( sysPkgSuffix, hiSuf, prefixUnderscore )+import System.Plugins.LoadTypes++import Language.Hi.Parser++import AltData.Dynamic          ( fromDynamic, Dynamic )+import AltData.Typeable         ( Typeable )++import Data.List                ( isSuffixOf, nub, nubBy )+import Control.Monad            ( when, filterM, liftM )+import System.Directory         ( doesFileExist, removeFile )+import Foreign.C.String         ( CString, withCString, peekCString )++import GHC.Ptr                  ( Ptr(..), nullPtr )+import GHC.Exts                 ( addrToHValue# )+import GHC.Prim                 ( unsafeCoerce# )++#if DEBUG+import System.IO                ( hFlush, stdout )+#endif+import System.IO                ( hClose )++-- TODO need a loadPackage p package.conf :: IO () primitive++--+-- | The @LoadStatus@ type encodes the return status of functions that+-- perform dynamic loading in a type isomorphic to 'Either'. Failure+-- returns a list of error strings, success returns a reference to a+-- loaded module, and the Haskell value corresponding to the symbol that+-- was indexed.+--+data LoadStatus a+        = LoadSuccess Module a+        | LoadFailure Errors++--+-- | 'load' is the basic interface to the dynamic loader. A call to+-- 'load' imports a single object file into the caller's address space,+-- returning the value associated with the symbol requested. Libraries+-- and modules that the requested module depends upon are loaded and+-- linked in turn.+--+-- The first argument is the path to the object file to load, the second+-- argument is a list of directories to search for dependent modules.+-- The third argument is a list of paths to user-defined, but+-- unregistered, /package.conf/ files. The 'Symbol' argument is the+-- symbol name of the value you with to retrieve.+--+-- The value returned must be given an explicit type signature, or+-- provided with appropriate type constraints such that Haskell compiler+-- can determine the expected type returned by 'load', as the return+-- type is notionally polymorphic.+-- +-- Example:+--+-- > do mv <- load "Plugin.o" ["api"] [] "resource"+-- >    case mv of+-- >        LoadFailure msg -> print msg+-- >        LoadSuccess _ v -> return v+--+load :: FilePath                -- ^ object file+     -> [FilePath]              -- ^ any include paths+     -> [PackageConf]           -- ^ list of package.conf paths+     -> Symbol                  -- ^ symbol to find+     -> IO (LoadStatus a)++load obj incpaths pkgconfs sym = do+    initLinker++    -- load extra package information+    mapM_ addPkgConf pkgconfs+    (hif,moduleDeps) <- loadDepends obj incpaths++    -- why is this the package name?+#if DEBUG+    putStr (' ':(decode $ mi_module hif)) >> hFlush stdout+#endif++    m' <- loadObject obj (Object (mi_module hif))+    let m = m' { iface = hif }+    resolveObjs (mapM_ unloadAll (m:moduleDeps))++#if DEBUG+    putStrLn " ... done" >> hFlush stdout+#endif+    addModuleDeps m' moduleDeps+    v <- loadFunction m sym+    return $ case v of +        Nothing -> LoadFailure ["load: couldn't find symbol <<"++sym++">>"]+        Just a  -> LoadSuccess m a++--+-- | Like load, but doesn't want a package.conf arg (they are rarely used)+--+load_ :: FilePath -> [FilePath] -> Symbol -> IO (LoadStatus a)+load_ o i s = load o i [] s++--+-- A work-around for Dynamics. The keys used to compare two TypeReps are+-- somehow not equal for the same type in hs-plugin's loaded objects.+-- Solution: implement our own dynamics...+--+-- The problem with dynload is that it requires the plugin to export+-- a value that is a Dynamic (in our case a (TypeRep,a) pair). If this+-- is not the case, we core dump. Use pdynload if you don't trust the+-- user to supply you with a Dynamic+--+dynload :: Typeable a    +        => FilePath  +        -> [FilePath]+        -> [PackageConf]+        -> Symbol+        -> IO (LoadStatus a)++dynload obj incpaths pkgconfs sym = do+    s <- load obj incpaths pkgconfs sym+    case s of e@(LoadFailure _)   -> return e+              LoadSuccess m dyn_v -> return $+                    case fromDynamic (unsafeCoerce# dyn_v :: Dynamic) of+                        Just v' -> LoadSuccess m v'+                        Nothing -> LoadFailure ["Mismatched types in interface"]++------------------------------------------------------------------------+--+-- The super-replacement for dynload+--+-- Use GHC at runtime so we get staged type inference, providing full+-- power dynamics, *on module interfaces only*. This is quite suitable+-- for plugins, of coures :)+--+-- TODO where does the .hc file go in the call to build() ?+--++pdynload :: FilePath                    -- ^ object to load+         -> [FilePath]                  -- ^ include paths+         -> [PackageConf]               -- ^ package confs+         -> Type                        -- ^ API type+         -> Symbol                      -- ^ symbol+         -> IO (LoadStatus a)++pdynload object incpaths pkgconfs ty sym = do +#if DEBUG+        putStr "Checking types ... " >> hFlush stdout+#endif+        errors <- unify object incpaths [] ty sym+#if DEBUG+        putStrLn "done"+#endif+        if null errors +                then load object incpaths pkgconfs sym+                else return $ LoadFailure errors++--+-- | Like pdynload, but you can specify extra arguments to the+-- typechecker.+--+pdynload_ :: FilePath       -- ^ object to load+          -> [FilePath]     -- ^ include paths for loading+          -> [PackageConf]  -- ^ any extra package.conf files+          -> [Arg]          -- ^ extra arguments to ghc, when typechecking+          -> Type           -- ^ expected type+          -> Symbol         -- ^ symbol to load+          -> IO (LoadStatus a)++pdynload_ object incpaths pkgconfs args ty sym = do+#if DEBUG+        putStr "Checking types ... " >> hFlush stdout+#endif+        errors <- unify object incpaths args ty sym+#if DEBUG+        putStrLn "done"+#endif+        if null errors +                then load object incpaths pkgconfs sym+                else return $ LoadFailure errors++------------------------------------------------------------------------+-- run the typechecker over the constraint file+--+-- Problem: if the user depends on a non-auto package to build the+-- module, then that package will not be in scope when we try to build+-- the module, when performing `unify'. Normally make() will handle this+-- (as it takes extra ghc args). pdynload ignores these, atm -- but it+-- shouldn't. Consider a pdynload() that accepts extra -package flags?+--+-- Also, pdynload() should accept extra in-scope modules.+-- Maybe other stuff we want to hack in here.+--+unify obj incs args ty sym = do+        (tmpf,hdl)   <- mkTemp+        (tmpf1,hdl1) <- mkTemp  -- and send .hi file here.+        hClose hdl1++        let nm  = mkModid (basename tmpf) +            src = mkTest nm (hierize' . mkModid . hierize $ obj)+                                (fst $ break (=='.') ty) ty sym+            is  = map ("-i"++) incs             -- api+            i   = "-i" ++ dirname obj           -- plugin++        hWrite hdl src++        e <- build tmpf tmpf1 (i:is++args++["-fno-code","-ohi "++tmpf1])+        mapM_ removeFile [tmpf,tmpf1]+        return e++        where+            -- fix up hierarchical names+            hierize []       = []+            hierize ('/':cs) = '\\' : hierize cs+            hierize (c:cs)   = c    : hierize cs++            hierize'[]        = []+            hierize' ('\\':cs) = '.' : hierize' cs+            hierize' (c:cs)   = c    : hierize' cs++mkTest modnm plugin api ty sym = +       "module "++ modnm ++" where" +++       "\nimport qualified " ++ plugin  +++       "\nimport qualified " ++ api     +++       "{-# LINE 1 \"<typecheck>\" #-}" +++       "\n_ = "++ plugin ++"."++ sym ++" :: "++ty++------------------------------------------------------------------------+{-+--+-- old version that tried to rip stuff from .hi files+--+pdynload obj incpaths pkgconfs sym ty = do+        (m, v) <- load obj incpaths pkgconfs sym+        ty'    <- mungeIface sym obj+        if ty == ty' +                then return $ Just (m, v)+                else return Nothing             -- mismatched types++   where +        -- grab the iface output from GHC. find the line relevant to our+        -- symbol. grab the string rep of the type.+        mungeIface sym o = do+                let hi = replaceSuffix o hiSuf+                (out,_) <- exec ghc ["--show-iface", hi]+                case find (\s -> (sym ++ " :: ") `isPrefixOf` s) out of+                        Nothing -> return undefined+                        Just v  -> do let v' = drop 3 $ dropWhile (/= ':') v+                                      return v'++-}++{-+--+-- a version of load the also unwraps and types a Dynamic object+--+dynload2 :: Typeable a => +           FilePath -> +           FilePath -> +           Maybe [PackageConf] ->+           Symbol ->  +           IO (Module, a)++dynload2 obj incpath pkgconfs sym = do+        (m, v) <- load obj incpath pkgconfs sym+        case fromDynamic v of+            Nothing -> panic $ "load: couldn't type "++(show v)+            Just a  -> return (m,a)+-}++------------------------------------------------------------------------+--+-- | unload a module (not its dependencies)+-- we have the dependencies, so cascaded unloading is possible+--+-- once you unload it, you can't 'load' it again, you have to 'reload'+-- it. Cause we don't unload all the dependencies+--+unload  :: Module -> IO ()+unload m = rmModuleDeps m >> unloadObj m++------------------------------------------------------------------------+--+-- | unload a module and its dependencies+-- we have the dependencies, so cascaded unloading is possible+--+unloadAll :: Module -> IO ()+unloadAll m = do moduleDeps <- getModuleDeps m+                 rmModuleDeps m+                 mapM_ unloadAll moduleDeps+                 unload m+++--+-- | this will be nice for panTHeon, needs thinking about the interface+-- reload a single object file. don't care about depends, assume they+-- are loaded. (should use state to store all this)+--+-- assumes you've already done a 'load'+--+-- should factor the code+--+reload :: Module -> Symbol -> IO (LoadStatus a)+reload m@(Module{path = p, iface = hi}) sym = do+        unloadObj m     -- unload module (and delete)+#if DEBUG+        putStr ("Reloading "++(mname m)++" ... ") >> hFlush stdout+#endif+        m_ <- loadObject p (Object $ mi_module hi)   -- load object at path p+        let m' = m_ { iface = hi }+    +        resolveObjs (unloadAll m)+#if DEBUG+        putStrLn "done" >> hFlush stdout+#endif+        v <- loadFunction m' sym+        return $ case v of +                Nothing -> LoadFailure ["load: couldn't find symbol <<"++sym++">>"]+                Just a  -> LoadSuccess m' a++-- ---------------------------------------------------------------------+-- This is a stripped-down version of André Pang's runtime_loader,+-- which in turn is based on GHC's ghci\/ObjLinker.lhs binding+--+--  Load and unload\/Haskell modules at runtime.  This is not really+--  \'dynamic loading\', as such -- that implies that you\'re working+--  with proper shared libraries, whereas this is far more simple and+--  only loads object files.  But it achieves the same goal: you can+--  load a Haskell module at runtime, load a function from it, and run+--  the function.  I have no idea if this works for types, but that+--  doesn\'t mean that you can\'t try it :).+--+-- read $fptools\/ghc\/compiler\/ghci\/ObjLinker.lhs for how to use this stuff+--+------------------------------------------------------------------------++-- | Call the initLinker function first, before calling any of the other+-- functions in this module - otherwise you\'ll get unresolved symbols.++-- initLinker :: IO ()+-- our initLinker transparently calls the one in GHC++--+-- | Load a function from a module (which must be loaded and resolved first).+--++loadFunction :: Module          -- ^ The module the value is in+             -> String          -- ^ Symbol name of value+             -> IO (Maybe a)    -- ^ The value you want+loadFunction (Module { iface = i }) valsym+    = loadFunction_ (mi_module i) valsym++loadFunction_ :: String+              -> String+              -> IO (Maybe a)+loadFunction_ m valsym+   = do let symbol = prefixUnderscore++m++"_"++(encode valsym)++"_closure"+#if DEBUG+        putStrLn $ "Looking for <<"++symbol++">>"+#endif+        ptr@(~(Ptr addr)) <- withCString symbol c_lookupSymbol+        if (ptr == nullPtr)+            then return Nothing+            else case addrToHValue# addr of+                (# hval #) -> return ( Just hval )++++--+-- | Load a GHC-compiled Haskell vanilla object file.+-- The first arg is the path to the object file+--+-- We make it idempotent to stop the nasty problem of loading the same+-- .o twice. Also the rts is a very special package that is already+-- loaded, even if we ask it to be loaded. N.B. we should insert it in+-- the list of known packages.+--+-- NB the environment stores the *full path* to an object. So if you+-- want to know if a module is already loaded, you need to supply the+-- *path* to that object, not the name.+-- +-- NB -- let's try just the module name.+--+-- loadObject loads normal .o objs, and packages too. .o objs come with+-- a nice canonical Z-encoded modid. packages just have a simple name.+-- Do we want to ensure they won't clash? Probably.+--++--+-- the second argument to loadObject is a string to use as the unique+-- identifier for this object. For normal .o objects, it should be the+-- Z-encoded modid from the .hi file. For archives\/packages, we can+-- probably get away with the package name+--+++loadObject :: FilePath -> Key -> IO Module+loadObject p ky@(Object k)  = loadObject' p ky k +loadObject p ky@(Package k) = loadObject' p ky k ++loadObject' :: FilePath -> Key -> String -> IO Module+loadObject' p ky k+    | ("HSrts"++sysPkgSuffix) `isSuffixOf` p = return (emptyMod p)++    | otherwise +    = do alreadyLoaded <- isLoaded k+         when (not alreadyLoaded) $ do+              r <- withCString p c_loadObj+              when (not r) (panic $ "Could not load module `"++p++"'")+         addModule k (emptyMod p)   -- needs to Z-encode module name+         return (emptyMod p)++    where emptyMod q = Module q (mkModid q) Vanilla emptyIface ky++--+-- load a single object. no dependencies. You should know what you're+-- doing.+--+loadModule :: FilePath -> IO Module+loadModule obj = do+    let hifile = replaceSuffix obj hiSuf+    exists <- doesFileExist hifile+    if (not exists)+        then error $ "No .hi file found for "++show obj+        else do hiface <- readIface hifile+                loadObject obj (Object (mi_module hiface))++--+-- | Load a generic .o file, good for loading C objects.+-- You should know what you're doing..+-- Returns a fairly meaningless iface value.+--+loadRawObject :: FilePath -> IO Module+loadRawObject obj = loadObject obj (Object k)+    where+        k = encode (mkModid obj)  -- Z-encoded module name++--+-- | Resolve (link) the modules loaded by the 'loadObject' function.+--+resolveObjs :: IO a -> IO ()+resolveObjs unloadLoaded+    = do r <- c_resolveObjs+         when (not r) $ unloadLoaded >> panic "resolvedObjs failed."+++-- | Unload a module+unloadObj :: Module -> IO () +unloadObj (Module { path = p, kind = k, key = ky }) = case k of+        Vanilla -> withCString p $ \c_p -> do+                removed <- rmModule name+                when (removed) $ do r <- c_unloadObj c_p +                                    when (not r) (panic "unloadObj: failed")+        Shared  -> return () -- can't unload .so?+    where name = case ky of Object s -> s ; Package pk -> pk+--+-- | from ghci\/ObjLinker.c+--+-- Load a .so type object file.+--+loadShared :: FilePath -> IO Module+loadShared str = do+#if DEBUG+    putStrLn $ " shared: " ++ str+#endif+    maybe_errmsg <- withCString str $ \dll -> c_addDLL dll+    if maybe_errmsg == nullPtr +        then return (Module str (mkModid str) Shared emptyIface (Package (mkModid str)))+        else do e <- peekCString maybe_errmsg+                panic $ "loadShared: couldn't load `"++str++"\' because "++e+++--+-- Load a -package that we might need, implicitly loading the cbits too+-- The argument is the name of package (e.g.  \"concurrent\")+--+-- How to find a package is determined by the package.conf info we store+-- in the environment. It is just a matter of looking it up.+--+-- Not printing names of dependent pkgs+--+loadPackage :: String -> IO ()+loadPackage p = do+#if DEBUG+        putStr (' ':p) >> hFlush stdout+#endif+        (libs,dlls) <- lookupPkg p+        mapM_ (\l -> loadObject l (Package (mkModid l))) libs+#if DEBUG+        putStr (' ':show libs) >> hFlush stdout+        putStr (' ':show dlls) >> hFlush stdout+#endif+	mapM_ loadShared dlls++++--+-- Unload a -package, that has already been loaded. Unload the cbits+-- too. The argument is the name of the package.+--+-- May need to check if it exists.+--+-- Note that we currently need to unload everything. grumble grumble.+--+-- We need to add the version number to the package name with 6.4 and+-- over. "yi-0.1" for example. This is a bug really.+--+unloadPackage :: String -> IO ()+unloadPackage pkg = do+    let pkg' = takeWhile (/= '-') pkg   -- in case of *-0.1+    libs <- liftM (\(a,_) -> (filter (isSublistOf pkg') ) a) (lookupPkg pkg)+    flip mapM_ libs $ \p -> withCString p $ \c_p -> do+                        r <- c_unloadObj c_p +                        when (not r) (panic "unloadObj: failed")+                        rmModule (mkModid p)      -- unrecord this module ++--+-- load a package using the given package.conf to help+-- TODO should report if it doesn't actually load the package, instead+-- of mapM_ doing nothing like above.+--+loadPackageWith :: String -> [PackageConf] -> IO ()+loadPackageWith p pkgconfs = do+#if DEBUG+        putStr "Loading package" >> hFlush stdout+#endif+        mapM_ addPkgConf pkgconfs+        loadPackage p+#if DEBUG+        putStrLn " done"+#endif+        ++-- ---------------------------------------------------------------------+-- module dependency loading+--+-- given an Foo.o vanilla object file, supposed to be a plugin compiled+-- by our library, find the associated .hi file. If this is found, load+-- the dependencies, packages first, then the modules. If it doesn't+-- exist, assume the user knows what they are doing and continue. The+-- linker will crash on them anyway. Second argument is any include+-- paths to search in+--+-- ToDo problem with absolute and relative paths, and different forms of+-- relative paths. A user may cause a dependency to be loaded, which+-- will search the incpaths, and perhaps find "./Foo.o". The user may+-- then explicitly load "Foo.o". These are the same, and the loader+-- should ignore the second load request. However, isLoaded will say+-- that "Foo.o" is not loaded, as the full string is used as a key to+-- the modenv fm. We need a canonical form for the keys -- is basename+-- good enough?+--+loadDepends :: FilePath -> [FilePath] -> IO (Iface,[Module])+loadDepends obj incpaths = do+    let hifile = replaceSuffix obj hiSuf+    exists <- doesFileExist hifile+    if (not exists)+        then do+#if DEBUG+                putStrLn "No .hi file found." >> hFlush stdout+#endif+                return (emptyIface,[])   -- could be considered fatal++        else do hiface <- readIface hifile+                let ds = mi_deps hiface++                -- remove ones that we've already loaded+                ds' <- filterM loaded (dep_mods ds)++                -- now, try to generate a path to the actual .o file+                -- fix up hierachical names+                let mods_ = map (\s -> (s, map (\c -> +                        if c == '.' then '/' else c) $ decode s)) ds'++                -- construct a list of possible dependent modules to load+                let mods = concatMap (\p -> +                            map (\(hi,m) -> (hi,p </> m++".o")) mods_) incpaths++                -- remove modules that don't exist+                mods' <- filterM (\(_,y) -> doesFileExist y) $+                                nubBy (\v u -> snd v == snd u)  mods++                -- now remove duplicate valid paths to the same object+                let mods'' = nubBy (\v u -> fst v == fst u)  mods'++                -- and find some packages to load, as well.+                let ps = dep_pkgs ds+                ps' <- filterM loaded (nub ps)++#if DEBUG+                when (not (null ps')) $+                        putStr "Loading package" >> hFlush stdout+#endif+                mapM_ loadPackage ps'+#if DEBUG+                when (not (null ps')) $+                        putStr " ... linking ... " >> hFlush stdout+#endif+                resolveObjs (mapM_ unloadPackage ps')+#if DEBUG+                when (not (null ps')) $ putStrLn "done" +                putStr "Loading object" +                mapM_ (\(m,_) -> putStr (" "++(decode m)) >> hFlush stdout) mods''+#endif+                moduleDeps <- mapM (\(hi,m) -> loadObject m (Object hi)) mods''+                return (hiface,moduleDeps)++-- ---------------------------------------------------------------------+-- Nice interface to .hi parser+--+getImports :: String -> IO [String]+getImports m = do+        hi <- readIface (m ++ hiSuf)+        return $ dep_mods (mi_deps hi)++-- ---------------------------------------------------------------------+-- C interface+--+foreign import ccall unsafe "lookupSymbol"+   c_lookupSymbol :: CString -> IO (Ptr a)++foreign import ccall unsafe "loadObj"+   c_loadObj :: CString -> IO Bool++foreign import ccall unsafe "unloadObj"+   c_unloadObj :: CString -> IO Bool++foreign import ccall unsafe "resolveObjs"+   c_resolveObjs :: IO Bool++foreign import ccall unsafe "addDLL"+   c_addDLL :: CString -> IO CString++foreign import ccall unsafe "initLinker"+   initLinker :: IO ()
+ src/System/Plugins/LoadTypes.hs view
@@ -0,0 +1,52 @@+-- +-- Copyright (c) 2005 Lemmih <lemmih@gmail.com>+-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- This program 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.+-- +-- This program 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 program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA+-- 02111-1307, USA.+-- ++module System.Plugins.LoadTypes+    ( Key (..)+    , Symbol+    , Type+    , Errors+    , PackageConf+    , Module (..)+    , ObjType (..)+    ) where++import Language.Hi.Parser++data Key = Object String | Package String++type Symbol      = String+type Type        = String+type Errors      = [String]+type PackageConf = FilePath++data Module = Module { path  :: !FilePath +                     , mname :: !String +                     , kind  :: !ObjType +                     , iface :: Iface    -- cache the iface+                     , key   :: Key+                     }+instance Ord Module where+    compare m1 m2 = mname m1 `compare` mname m2++instance Eq Module where+    m1 == m2 = mname m1 == mname m2++data ObjType = Vanilla | Shared deriving Eq
+ src/System/Plugins/Make.hs view
@@ -0,0 +1,443 @@+-- +-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++-- | An interface to a Haskell compiler, providing the facilities of a+-- compilation manager.++module System.Plugins.Make ( ++        -- * The @MakeStatus@ type+        MakeStatus(..),++        -- * The @MakeCode@ type+        MakeCode(..),++        -- * Compiling Haskell modules+        make, +        makeAll,+        makeWith, ++        -- * Handling reecompilation+        hasChanged,+        hasChanged',+        recompileAll,+        recompileAll',++        -- * Merging together Haskell source files +        MergeStatus(..),+        MergeCode,+        Args,+        Errors,+        merge, +        mergeTo,+        mergeToDir,++        -- * Cleaning up temporary files+        makeClean,+        makeCleaner,++        -- * Low-level compilation primitives+        build, {- internal -}++  ) where++import System.Plugins.Utils+import System.Plugins.Parser+import System.Plugins.LoadTypes        ( Module (Module, path) )+import System.Plugins.Consts           ( ghc, hiSuf, objSuf, hsSuf )+import System.Plugins.Process          ( exec )+import System.Plugins.Env              ( lookupMerged, addMerge+                                       , getModuleDeps)++#if DEBUG+import System.IO (hFlush, stdout, openFile, IOMode(..),hClose, hPutStr)+#else+import System.IO (openFile, IOMode(..),hClose,hPutStr)+#endif++import System.Directory         ( doesFileExist, removeFile+                                , getModificationTime )++import Control.Exception        ( handleJust )+import GHC.IOBase               ( Exception(IOException) )++#if __GLASGOW_HASKELL__ >= 604+import System.IO.Error          ( isDoesNotExistError )+#endif++--+-- | The @MakeStatus@ type represents success or failure of compilation.+-- Compilation can fail for the usual reasons: syntax errors, type+-- errors and the like. The @MakeFailure@ constructor returns any error+-- messages produced by the compiler. @MakeSuccess@ returns a @MakeCode@+-- value, and the path to the object file produced.+--+data MakeStatus +        = MakeSuccess MakeCode FilePath     -- ^ compilation was successful+        | MakeFailure Errors                -- ^ compilation failed+        deriving (Eq,Show)++-- | The @MakeCode@ type is used when compilation is successful, to+-- distinguish two cases: +--  * The source file needed recompiling, and this was done+--  * The source file was already up to date, recompilation was skipped+data MakeCode   +    = ReComp    -- ^ recompilation was performed+    | NotReq    -- ^ recompilation was not required+        deriving (Eq,Show)++--+-- | An equivalent status for the preprocessor phase+--+data MergeStatus +        = MergeSuccess MergeCode Args FilePath  -- ^ the merge was successful+        | MergeFailure Errors                   -- ^ failure, and any errors returned+        deriving (Eq,Show)++-- +-- | Merging may be avoided if the source files are older than an+-- existing merged result. The @MergeCode@ type indicates whether+-- merging was performed, or whether it was unneccessary.+--+type MergeCode = MakeCode++-- | A list of @String@ arguments+type Args   = [Arg]++-- | Convience synonym+type Errors = [String]++-- touch.++-- ---------------------------------------------------------------------+-- | One-shot unconditional compilation of a single Haskell module.+-- @make@ behaves like 'ghc -c'. Extra arguments to 'ghc' may be passed+-- in the 'args' parameter, they will be appended to the argument list.+-- @make@ always recompiles its target, whether or not it is out of+-- date.+-- +-- A side-effect of calling 'make' is to have GHC produce a @.hi@ file+-- containing a list of package and objects that the source depends on.+-- Subsequent calls to 'load' will use this interface file to load+-- module and library dependencies prior to loading the object itself.+--+make :: FilePath -> [Arg] -> IO MakeStatus+make src args = rawMake src ("-c":args)  True++-- | 'makeAll' recursively compiles any dependencies it can find using+-- GHC's @--make@ flag. Dependencies will be recompiled only if they are+-- visible to 'ghc' -- this may require passing appropriate include path+-- flags in the 'args' parameter. 'makeAll' takes the top-level file as+-- the first argument.+--+makeAll :: FilePath -> [Arg] -> IO MakeStatus+makeAll src args = +    rawMake src ( "--make":"-no-hs-main":"-no-link":"-v0":args ) False++-- | This is a variety of 'make' that first calls 'merge' to+-- combine the plugin source with a syntax stub. The result is then+-- compiled. This is provided for EDSL authors who wish to add extra+-- syntax to a user\'s source. It is important to note that the+-- module and types from the second file argument are used to override+-- any of those that appear in the first argument. For example, consider+-- the following source files:+--+-- > module A where+-- > a :: Integer+-- > a = 1+--+-- and+-- +-- > module B where+-- > a :: Int+--+-- Calling @makeWith "A" "B" []@ will merge the module name and types+-- from module B into module A, generating a third file:+--+-- > {-# LINE 1 "A.hs" #-}+-- > module MxYz123 where+-- > {-# LINE 3 "B.hs" #-}+-- > a :: Int+-- > {-# LINE 4 "A.hs" #-}+-- > a = 1+--      +makeWith :: FilePath                           -- ^ a src file+         -> FilePath                           -- ^ a syntax stub file+         -> [Arg]                              -- ^ any required args+         -> IO MakeStatus                      -- ^ path to an object file++makeWith src stub args = do+    status <- merge src stub+    case status of+        MergeFailure errs -> return $ MakeFailure ("merge failed:\n":errs)+        MergeSuccess _ args' tmpf -> do+                 status' <- rawMake tmpf ("-c": args' ++ args) True+                 return status'++------------------------------------------------------------------------+--+-- | @hasChanged@ returns @True@ if the module or any of its+-- dependencies have older object files than source files.  Defaults to+-- @True@ if some files couldn't be located.+--+hasChanged :: Module -> IO Bool+hasChanged = hasChanged' ["hs","lhs"]++hasChanged' :: [String] -> Module -> IO Bool+hasChanged' suffices m@(Module {path = p})+    = do modFile <- doesFileExist p+         mbFile <- findFile suffices p+         case mbFile of+           Just f | modFile+             -> do srcT <- getModificationTime f+                   objT <- getModificationTime p+                   if srcT > objT+                      then return True+                      else do deps <- getModuleDeps m+                              depsStatus <- mapM (hasChanged' suffices) deps+                              return (or depsStatus)+           _ -> return True++--+-- | 'recompileAll' is like 'makeAll', but rather than relying on +-- @ghc --make@, we explicitly check a module\'s dependencies using our+-- internal map of module dependencies. Performance is thus better, and+-- the result is more accurate.+--+recompileAll :: Module -> [Arg] -> IO MakeStatus+recompileAll = recompileAll' ["hs","lhs"]++recompileAll' :: [String] -> Module -> [Arg] -> IO MakeStatus+recompileAll' suffices m args+    = do changed <- hasChanged m+         if changed+            then do mbSource <- findFile suffices (path m)+                    case mbSource of+                      Nothing+                          -> error $ "Couldn't find source for object file: " ++ path m+                      Just source+                          -> makeAll source args+            else return (MakeSuccess NotReq (path m))++-- ---------------------------------------------------------------------+-- rawMake : really do the compilation+-- Conditional on file modification times, compile a .hs file+-- When using 'make', the name of the src file must be the name of the+-- .o file you are expecting back+--+-- Problem: we use GHC producing stdout to indicate compilation failure.+-- We should instead check the error conditions. I.e. --make will+-- produce output, but of course compiles correctly. TODO+-- So, e.g. --make requires -v0 to stop spurious output confusing+-- rawMake+--+-- Problem :: makeAll incorrectly refuses to recompile if the top level+-- src isn't new.+--++rawMake :: FilePath        -- ^ src+        -> [Arg]           -- ^ any compiler args+        -> Bool            -- ^ do our own recompilation checking+        -> IO MakeStatus++rawMake src args docheck = do+        src_exists <- doesFileExist src+        if not src_exists+                then return $ MakeFailure ["Source file does not exist: "++src]+                else do {+        ; let (obj,_) = outFilePath src args+        ; src_changed <- if docheck then src `newer` obj else return True+        ; if not src_changed+          then return $ MakeSuccess NotReq obj+          else do +#if DEBUG    +                putStr "Compiling object ... " >> hFlush stdout+#endif+                err <- build src obj args+#if DEBUG    +                putStrLn "done"+#endif+                return $ if null err +                         then MakeSuccess ReComp obj +                         else MakeFailure err+        }++--+-- | Lower-level than 'make'. Compile a .hs file to a .o file+-- If the plugin needs to import an api (which should be almost+-- everyone) then the ghc flags to find the api need to be provided as+-- arguments+--+build :: FilePath          -- ^ path to .hs source+      -> FilePath          -- ^ path to object file+      -> [String]          -- ^ any extra cmd line flags+      -> IO [String]++build src obj extra_opts = do++    let odir = dirname obj -- always put the .hi file next to the .o file+                           -- does this work in the presence of hier plugins?+                           -- won't handle hier names properly.++    let ghc_opts = [ "-Onot" ]+        output   = [ "-o", obj, "-odir", odir, +                     "-hidir", odir, "-i" ++ odir ]++    let flags = ghc_opts ++ output ++ extra_opts ++ [src]++#if DEBUG+    -- env.+    putStr $ show $ ghc : flags+#endif++    (_out,err) <- exec ghc flags       -- this is a fork()++    obj_exists <- doesFileExist obj -- sanity+    return $ if not obj_exists && null err -- no errors, but no object?+             then ["Compiled, but didn't create object file `"++obj++"'!"]+             else err++-- ---------------------------------------------------------------------+-- | Merge to source files into a temporary file. If we've tried to+-- merge these two stub files before, then reuse the module name (helps+-- recompilation checking)+--+-- The merging operation is extremely useful for providing extra default+-- syntax. An EDSL user then need not worry about declaring module+-- names, or having required imports.  In this way, the stub file can+-- also be used to provide syntax declarations that would be+-- inconvenient to require of the plugin author. +--+-- 'merge' will include any import and export declarations written in+-- the stub, as well as any module name, so that plugin author\'s need+-- not worry about this compulsory syntax. Additionally, if a plugin+-- requires some non-standard library, which must be provided as a+-- @-package@ flag to GHC, they may specify this using the non-standard+-- @GLOBALOPTIONS@ pragma.  Options specified in the source this way+-- will be added to the command line. This is useful for users who wish+-- to use GHC flags that cannot be specified using the conventional+-- @OPTIONS@ pragma. The merging operation uses the parser hs-plugins+-- was configured with, either 'Language.Haskell' or the HSX parser, to+-- parse Haskell source files.+--+merge :: FilePath -> FilePath -> IO MergeStatus+merge src stb = do +    m_mod <- lookupMerged src stb+    (out,domerge) <- case m_mod of+                Nothing -> do out <- mkUnique+                              addMerge src stb (dropSuffix out)+                              return (out, True) -- definitely out of date+                Just nm -> return $ (nm <> hsSuf, False)+    rawMerge src stb out domerge++-- | 'mergeTo' behaves like 'merge', but we can specify the file in+-- which to place output. +mergeTo :: FilePath -> FilePath -> FilePath -> IO MergeStatus+mergeTo src stb out = rawMerge src stb out False++-- | 'mergeToDir' behaves like 'merge', but lets you specify a target+-- directory.+mergeToDir :: FilePath -> FilePath -> FilePath -> IO MergeStatus+mergeToDir src stb dir = do+    out <- mkUniqueIn dir+    rawMerge src stb out True++-- ---------------------------------------------------------------------+-- Conditional on file modification times, merge a src file with a+-- syntax stub file into a result file.+--+-- Merge should only occur if the srcs has changed since last time.+-- Parser errors result in MergeFailure, and are reported to the client+--+-- Also returns a list of cmdline flags found in pragmas in the src of+-- the files. This last feature exists as OPTION pragmas aren't handled+-- (for obvious reasons, relating to the implementation of OPTIONS+-- parsing in GHC) by the library parser, and, also, we want a way for+-- the user to introduce *dynamic* cmd line flags in the .conf file.+-- This is achieved via the GLOBALOPTIONS pragma : an extension to ghc+-- pragma syntax+--+rawMerge :: FilePath -> FilePath -> FilePath -> Bool -> IO MergeStatus+rawMerge src stb out always_merge = do+    src_exists <- doesFileExist src+    stb_exists <- doesFileExist stb+    case () of {_+        | not src_exists  -> return $ +                MergeFailure ["Source file does not exist : "++src]+        | not stb_exists -> return $ +                MergeFailure ["Source file does not exist : "++stb]+        | otherwise -> do {+    +    ;do_merge <- do src_changed <- src `newer` out+                    stb_changed <- stb `newer` out+                    return $ src_changed || stb_changed++    ;if not do_merge && not always_merge+     then return $ MergeSuccess NotReq [] out+     else do+        src_str <- readFile src+        stb_str <- readFile stb++        let (a,a') = parsePragmas src_str+            (b,b') = parsePragmas stb_str+            opts = a ++ a' ++ b ++ b'++        let e_src_syn = parse src src_str+            e_stb_syn = parse stb stb_str+    +        -- check if there were parser errors+        case (e_src_syn,e_stb_syn) of+                (Left e,  _)       -> return $ MergeFailure [e]+                (_ , Left e)       -> return $ MergeFailure [e]+                (Right src_syn, Right stb_syn) -> do {++        ;let mrg_syn = mergeModules src_syn stb_syn+             mrg_syn'= replaceModName mrg_syn (mkModid $ basename out)+             mrg_str = pretty mrg_syn'++        ;hdl <- openFile out WriteMode  -- overwrite!+        ;hPutStr hdl mrg_str ; hClose hdl+        ;return $ MergeSuccess ReComp opts out -- must have recreated file+    }}}++-- ---------------------------------------------------------------------+-- | makeClean : assuming we some element of [f.hs,f.hi,f.o], remove the+-- .hi and .o components. Silently ignore any missing components. /Does+-- not remove .hs files/. To do that use 'makeCleaner'. This would be+-- useful for merged files, for example.+--+makeClean :: FilePath -> IO ()+makeClean f = let f_hi = dropSuffix  f <> hiSuf+                  f_o  = dropSuffix  f <> objSuf+              in mapM_ rm_f [f_hi, f_o]++makeCleaner :: FilePath -> IO ()+makeCleaner f = makeClean f >> rm_f (dropSuffix f <> hsSuf)+           +-- internal:+--      try to remove a file, ignoring if it didn't exist in the first place+-- Doesn't seem to be able to remove all files in all circumstances, why?+--+rm_f f = handleJust doesntExist (\_->return ()) (removeFile f)+    where+        doesntExist (IOException ioe)+                | isDoesNotExistError ioe = Just ()+                | otherwise               = Nothing+        doesntExist _ = Nothing+
+ src/System/Plugins/Package.hs view
@@ -0,0 +1,67 @@+--+-- Copyright (C) 2004 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA++--+-- Read information from a package.conf+--++module System.Plugins.Package {-everything-} where++type PackageName = String++--+-- Take directly from ghc/utils/ghc-pkg/Package.hs+--++data PackageConfig = Package {+	name            :: PackageName,+	auto		:: Bool,+	import_dirs     :: [FilePath],+	source_dirs     :: [FilePath],+	library_dirs    :: [FilePath],+	hs_libraries    :: [String],+	extra_libraries :: [String],+	include_dirs    :: [FilePath],+	c_includes      :: [String],+	package_deps    :: [String],+	extra_ghc_opts  :: [String],+	extra_cc_opts   :: [String],+	extra_ld_opts   :: [String],+	framework_dirs  :: [FilePath], -- ignored everywhere but on Darwin/MacOS X+	extra_frameworks:: [String]  -- ignored everywhere but on Darwin/MacOS X+     } deriving Show+++defaultPackageConfig = Package {+	name = error "defaultPackage",+	auto = False,+	import_dirs     = [],+	source_dirs     = [],+	library_dirs    = [],+	hs_libraries    = [],+	extra_libraries = [],+	include_dirs    = [],+	c_includes      = [],+	package_deps    = [],+	extra_ghc_opts  = [],+	extra_cc_opts   = [],+	extra_ld_opts   = [],+	framework_dirs  = [],+	extra_frameworks= []+    }+
+ src/System/Plugins/PackageAPI.hs view
@@ -0,0 +1,95 @@+--+-- Copyright (C) 2005 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA++--+-- We export an abstract interface to package conf`s because we have+-- to handle either traditional or Cabal style package conf`s.+--++module System.Plugins.PackageAPI (+         PackageName+       , PackageConfig+       , packageName+       , packageName_+       , importDirs+       , hsLibraries+       , libraryDirs+       , extraLibraries+       , ldOptions+       , packageDeps+       , updImportDirs+       , updLibraryDirs +   ) where++#include "../../../config.h"++#if CABAL == 1 || __GLASGOW_HASKELL__ >= 604+import Distribution.InstalledPackageInfo+import Distribution.Package+#else+import System.Plugins.Package+#endif++packageName    :: PackageConfig -> PackageName +packageDeps    :: PackageConfig -> [PackageName]+updImportDirs  :: ([FilePath] -> [FilePath]) -> PackageConfig -> PackageConfig+updLibraryDirs :: ([FilePath] -> [FilePath]) -> PackageConfig -> PackageConfig++-- We use different package.conf parsers when running on 6.2.x or 6.4+#if CABAL == 1 || __GLASGOW_HASKELL__ >= 604++type PackageName = String++type PackageConfig = InstalledPackageInfo++packageName = showPackageId . package+packageName_ = pkgName . package+packageDeps = (map showPackageId) . depends++updImportDirs f pk@(InstalledPackageInfo { importDirs = idirs }) =+        pk { importDirs = f idirs }+updLibraryDirs f pk@(InstalledPackageInfo { libraryDirs = ldirs }) =+        pk { libraryDirs = f ldirs }+#else++packageName    = name+packageName_   = name+packageDeps    = package_deps++updImportDirs f pk@(Package {import_dirs = idirs}) +        = pk {import_dirs = f idirs}++updLibraryDirs f pk@(Package {library_dirs = ldirs}) +        = pk {library_dirs = f ldirs}++importDirs     :: PackageConfig -> [FilePath]+importDirs     = import_dirs++hsLibraries    :: PackageConfig -> [String]+hsLibraries    = hs_libraries++libraryDirs    :: PackageConfig -> [FilePath]+libraryDirs    = library_dirs++extraLibraries :: PackageConfig -> [String]+extraLibraries = extra_libraries++ldOptions :: PackageConfig -> [String]+ldOptions = extra_ld_opts++#endif
+ src/System/Plugins/ParsePkgConfCabal.hs view
@@ -0,0 +1,796 @@+{-# OPTIONS -fglasgow-exts #-}+{-# OPTIONS -w #-}++module System.Plugins.ParsePkgConfCabal ( +        parsePkgConf, parseOnePkgConf+  ) where++import Distribution.InstalledPackageInfo+import Distribution.Package+import Distribution.Version++import Data.Char             ( isSpace, isAlpha, isAlphaNum, isUpper, isDigit )+import Data.List             ( break )+import Data.Array+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif++-- parser produced by Happy Version 1.15++newtype HappyAbsSyn  = HappyAbsSyn (() -> ())+happyIn5 :: ([ PackageConfig ]) -> (HappyAbsSyn )+happyIn5 x = unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> ([ PackageConfig ])+happyOut5 x = unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: ([ PackageConfig ]) -> (HappyAbsSyn )+happyIn6 x = unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> ([ PackageConfig ])+happyOut6 x = unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (PackageConfig) -> (HappyAbsSyn )+happyIn7 x = unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (PackageConfig)+happyOut7 x = unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (PackageConfig -> PackageConfig) -> (HappyAbsSyn )+happyIn8 x = unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (PackageConfig -> PackageConfig)+happyOut8 x = unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (PackageConfig -> PackageConfig) -> (HappyAbsSyn )+happyIn9 x = unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (PackageConfig -> PackageConfig)+happyOut9 x = unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: (PackageIdentifier) -> (HappyAbsSyn )+happyIn10 x = unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> (PackageIdentifier)+happyOut10 x = unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: (Version) -> (HappyAbsSyn )+happyIn11 x = unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> (Version)+happyOut11 x = unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: ([PackageIdentifier]) -> (HappyAbsSyn )+happyIn12 x = unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> ([PackageIdentifier])+happyOut12 x = unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyIn13 :: ([PackageIdentifier]) -> (HappyAbsSyn )+happyIn13 x = unsafeCoerce# x+{-# INLINE happyIn13 #-}+happyOut13 :: (HappyAbsSyn ) -> ([PackageIdentifier])+happyOut13 x = unsafeCoerce# x+{-# INLINE happyOut13 #-}+happyIn14 :: ([Int]) -> (HappyAbsSyn )+happyIn14 x = unsafeCoerce# x+{-# INLINE happyIn14 #-}+happyOut14 :: (HappyAbsSyn ) -> ([Int])+happyOut14 x = unsafeCoerce# x+{-# INLINE happyOut14 #-}+happyIn15 :: ([Int]) -> (HappyAbsSyn )+happyIn15 x = unsafeCoerce# x+{-# INLINE happyIn15 #-}+happyOut15 :: (HappyAbsSyn ) -> ([Int])+happyOut15 x = unsafeCoerce# x+{-# INLINE happyOut15 #-}+happyIn16 :: ([String]) -> (HappyAbsSyn )+happyIn16 x = unsafeCoerce# x+{-# INLINE happyIn16 #-}+happyOut16 :: (HappyAbsSyn ) -> ([String])+happyOut16 x = unsafeCoerce# x+{-# INLINE happyOut16 #-}+happyIn17 :: ([String]) -> (HappyAbsSyn )+happyIn17 x = unsafeCoerce# x+{-# INLINE happyIn17 #-}+happyOut17 :: (HappyAbsSyn ) -> ([String])+happyOut17 x = unsafeCoerce# x+{-# INLINE happyOut17 #-}+happyInTok :: Token -> (HappyAbsSyn )+happyInTok x = unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> Token+happyOutTok x = unsafeCoerce# x+{-# INLINE happyOutTok #-}++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x50\x00\x4a\x00\x4c\x00\x49\x00\x46\x00\x4b\x00\x45\x00\x0a\x00\x1e\x00\x00\x00\x00\x00\x44\x00\x16\x00\x00\x00\x43\x00\x00\x00\x42\x00\x00\x00\x03\x00\x00\x00\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x01\x00\x00\x00\x40\x00\x00\x00\x3e\x00\x3d\x00\x1c\x00\x00\x00\x3f\x00\x00\x00\x00\x00\x3b\x00\x00\x00\x3a\x00\x39\x00\x35\x00\x00\x00\x00\x00\x38\x00\x31\x00\x34\x00\x33\x00\x37\x00\x36\x00\x28\x00\x00\x00\x30\x00\x32\x00\x2f\x00\x09\x00\x2d\x00\x00\x00\x2e\x00\x26\x00\x2c\x00\x22\x00\x00\x00\x00\x00\x2b\x00\x29\x00\x0d\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x2a\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1d\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\xfe\xff\x00\x00\x21\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfc\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1f\x00\x00\x00\x1a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x04\x00\x00\x00\xfb\xff\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xfd\xff\x00\x00\x00\x00\xf8\xff\x00\x00\xfc\xff\x00\x00\xfa\xff\x00\x00\xf9\xff\x00\x00\xf7\xff\xf6\xff\xf1\xff\xf2\xff\x00\x00\xf4\xff\xf5\xff\x00\x00\xf3\xff\xed\xff\x00\x00\x00\x00\xe7\xff\x00\x00\xe5\xff\xe6\xff\x00\x00\xee\xff\x00\x00\x00\x00\x00\x00\xec\xff\xe4\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf0\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xeb\xff\xe9\xff\x00\x00\x00\x00\x00\x00\xea\xff\xe8\xff\x00\x00\x00\x00\x00\x00\xef\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x05\x00\x01\x00\x05\x00\x08\x00\x07\x00\x03\x00\x0c\x00\x0c\x00\x0b\x00\x09\x00\x08\x00\x09\x00\x04\x00\x04\x00\x0b\x00\x04\x00\x04\x00\x08\x00\x0a\x00\x08\x00\x09\x00\x09\x00\x05\x00\x02\x00\x0a\x00\x08\x00\x05\x00\x03\x00\x04\x00\x01\x00\x02\x00\x04\x00\x05\x00\x04\x00\x05\x00\x0a\x00\x04\x00\x06\x00\x02\x00\x09\x00\x02\x00\x00\x00\x02\x00\x0a\x00\x07\x00\x03\x00\x07\x00\xff\xff\x04\x00\x06\x00\x05\x00\x05\x00\x03\x00\x06\x00\x01\x00\x07\x00\x02\x00\x06\x00\x08\x00\xff\xff\x05\x00\x09\x00\x06\x00\x01\x00\x04\x00\x08\x00\x05\x00\x09\x00\xff\xff\xff\xff\x07\x00\x07\x00\x06\x00\x08\x00\x07\x00\x01\x00\x04\x00\xff\xff\x03\x00\x0b\x00\x0b\x00\x08\x00\x03\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x1e\x00\x1d\x00\x16\x00\x1f\x00\x17\x00\x1a\x00\x20\x00\x20\x00\x18\x00\x1e\x00\x1b\x00\x1c\x00\x3a\x00\x0b\x00\x41\x00\x22\x00\x22\x00\x06\x00\x3b\x00\x23\x00\x24\x00\x24\x00\x1e\x00\x14\x00\x3f\x00\x2a\x00\x15\x00\x0c\x00\x0d\x00\x08\x00\x09\x00\x25\x00\x26\x00\x10\x00\x11\x00\x38\x00\x15\x00\x30\x00\x11\x00\x36\x00\x04\x00\x06\x00\x44\x00\x3b\x00\x3d\x00\x43\x00\x35\x00\x00\x00\x3f\x00\x41\x00\x3e\x00\x3c\x00\x38\x00\x36\x00\x33\x00\x2f\x00\x34\x00\x30\x00\x32\x00\x00\x00\x2e\x00\x2d\x00\x2a\x00\x1d\x00\x27\x00\x23\x00\x28\x00\x2c\x00\x00\x00\x00\x00\x29\x00\x0f\x00\x13\x00\x06\x00\x0f\x00\x0c\x00\x0b\x00\x00\x00\x04\x00\xff\xff\xff\xff\x06\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = array (2, 27) [+	(2 , happyReduce_2),+	(3 , happyReduce_3),+	(4 , happyReduce_4),+	(5 , happyReduce_5),+	(6 , happyReduce_6),+	(7 , happyReduce_7),+	(8 , happyReduce_8),+	(9 , happyReduce_9),+	(10 , happyReduce_10),+	(11 , happyReduce_11),+	(12 , happyReduce_12),+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16),+	(17 , happyReduce_17),+	(18 , happyReduce_18),+	(19 , happyReduce_19),+	(20 , happyReduce_20),+	(21 , happyReduce_21),+	(22 , happyReduce_22),+	(23 , happyReduce_23),+	(24 , happyReduce_24),+	(25 , happyReduce_25),+	(26 , happyReduce_26),+	(27 , happyReduce_27)+	]++happy_n_terms = 12 :: Int+happy_n_nonterms = 13 :: Int++happyReduce_2 = happySpecReduce_2 0# happyReduction_2+happyReduction_2 happy_x_2+	happy_x_1+	 =  happyIn5+		 ([]+	)++happyReduce_3 = happySpecReduce_3 0# happyReduction_3+happyReduction_3 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn5+		 (reverse happy_var_2+	)}++happyReduce_4 = happySpecReduce_1 1# happyReduction_4+happyReduction_4 happy_x_1+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> +	happyIn6+		 ([ happy_var_1 ]+	)}++happyReduce_5 = happySpecReduce_3 1# happyReduction_5+happyReduction_5 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> +	case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (happy_var_3 : happy_var_1+	)}}++happyReduce_6 = happyReduce 4# 2# happyReduction_6+happyReduction_6 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut8 happy_x_3 of { happy_var_3 -> +	happyIn7+		 (happy_var_3 defaultPackageConfig+	) `HappyStk` happyRest}++happyReduce_7 = happySpecReduce_1 3# happyReduction_7+happyReduction_7 happy_x_1+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> +	happyIn8+		 (\p -> happy_var_1 p+	)}++happyReduce_8 = happySpecReduce_3 3# happyReduction_8+happyReduction_8 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> +	case happyOut9 happy_x_3 of { happy_var_3 -> +	happyIn8+		 (\p -> happy_var_1 (happy_var_3 p)+	)}}++happyReduce_9 = happySpecReduce_3 4# happyReduction_9+happyReduction_9 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOut10 happy_x_3 of { happy_var_3 -> +	happyIn9+		 (\p -> case happy_var_1 of+		   "package" -> p {package = happy_var_3}+		   _      -> error "unknown key in config file"+	)}}++happyReduce_10 = happySpecReduce_3 4# happyReduction_10+happyReduction_10 happy_x_3+	happy_x_2+	happy_x_1+	 =  happyIn9+		 (id+	)++happyReduce_11 = happySpecReduce_3 4# happyReduction_11+happyReduction_11 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOutTok happy_x_3 of { (ITconid    happy_var_3) -> +	happyIn9+		 (case happy_var_1 of {+		   	"exposed" -> +			   case happy_var_3 of {+				"True"  -> (\p -> p {exposed=True});+				"False" -> (\p -> p {exposed=False});+				_       -> error "exposed must be either True or False" };+		   	"license" -> id; -- not interested+		   	_         -> error "unknown constructor" }+	)}}++happyReduce_12 = happyReduce 4# 4# happyReduction_12+happyReduction_12 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = happyIn9+		 (id+	) `HappyStk` happyRest++happyReduce_13 = happySpecReduce_3 4# happyReduction_13+happyReduction_13 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOut16 happy_x_3 of { happy_var_3 -> +	happyIn9+		 (\p -> case happy_var_1 of+		        "exposedModules"    -> p{exposedModules    = happy_var_3}+		        "hiddenModules"     -> p{hiddenModules     = happy_var_3}+		        "importDirs"        -> p{importDirs        = happy_var_3}+		        "libraryDirs"       -> p{libraryDirs       = happy_var_3}+		        "hsLibraries"       -> p{hsLibraries       = happy_var_3}+		        "extraLibraries"    -> p{extraLibraries    = happy_var_3}+		        "includeDirs"       -> p{includeDirs       = happy_var_3}+		        "includes"          -> p{includes          = happy_var_3}+		        "hugsOptions"       -> p{hugsOptions       = happy_var_3}+		        "ccOptions"         -> p{ccOptions         = happy_var_3}+		        "ldOptions"         -> p{ldOptions         = happy_var_3}+		        "frameworkDirs"     -> p{frameworkDirs     = happy_var_3}+		        "frameworks"        -> p{frameworks        = happy_var_3}+		        "haddockInterfaces" -> p{haddockInterfaces = happy_var_3}+		        "haddockHTMLs"      -> p{haddockHTMLs      = happy_var_3}+		        "depends"     	    -> p{depends = []}+				-- empty list only, non-empty handled below+			other -> p+	)}}++happyReduce_14 = happySpecReduce_3 4# happyReduction_14+happyReduction_14 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOut12 happy_x_3 of { happy_var_3 -> +	happyIn9+		 (case happy_var_1 of+		        "depends"     -> (\p -> p{depends = happy_var_3})+			_other        -> error "unknown key in config file"+	)}}++happyReduce_15 = happyReduce 10# 5# happyReduction_15+happyReduction_15 (happy_x_10 `HappyStk`+	happy_x_9 `HappyStk`+	happy_x_8 `HappyStk`+	happy_x_7 `HappyStk`+	happy_x_6 `HappyStk`+	happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOutTok happy_x_5 of { (ITstring   happy_var_5) -> +	case happyOut11 happy_x_9 of { happy_var_9 -> +	happyIn10+		 (PackageIdentifier{ pkgName = happy_var_5, +					     pkgVersion = happy_var_9 }+	) `HappyStk` happyRest}}++happyReduce_16 = happyReduce 10# 6# happyReduction_16+happyReduction_16 (happy_x_10 `HappyStk`+	happy_x_9 `HappyStk`+	happy_x_8 `HappyStk`+	happy_x_7 `HappyStk`+	happy_x_6 `HappyStk`+	happy_x_5 `HappyStk`+	happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut14 happy_x_5 of { happy_var_5 -> +	case happyOut16 happy_x_9 of { happy_var_9 -> +	happyIn11+		 (Version{ versionBranch=happy_var_5, versionTags=happy_var_9 }+	) `HappyStk` happyRest}}++happyReduce_17 = happySpecReduce_3 7# happyReduction_17+happyReduction_17 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut13 happy_x_2 of { happy_var_2 -> +	happyIn12+		 (happy_var_2+	)}++happyReduce_18 = happySpecReduce_1 8# happyReduction_18+happyReduction_18 happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	happyIn13+		 ([ happy_var_1 ]+	)}++happyReduce_19 = happySpecReduce_3 8# happyReduction_19+happyReduction_19 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut10 happy_x_1 of { happy_var_1 -> +	case happyOut13 happy_x_3 of { happy_var_3 -> +	happyIn13+		 (happy_var_1 : happy_var_3+	)}}++happyReduce_20 = happySpecReduce_2 9# happyReduction_20+happyReduction_20 happy_x_2+	happy_x_1+	 =  happyIn14+		 ([]+	)++happyReduce_21 = happySpecReduce_3 9# happyReduction_21+happyReduction_21 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut15 happy_x_2 of { happy_var_2 -> +	happyIn14+		 (happy_var_2+	)}++happyReduce_22 = happySpecReduce_1 10# happyReduction_22+happyReduction_22 happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITinteger  happy_var_1) -> +	happyIn15+		 ([ fromIntegral happy_var_1 ]+	)}++happyReduce_23 = happySpecReduce_3 10# happyReduction_23+happyReduction_23 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITinteger  happy_var_1) -> +	case happyOut15 happy_x_3 of { happy_var_3 -> +	happyIn15+		 (fromIntegral happy_var_1 : happy_var_3+	)}}++happyReduce_24 = happySpecReduce_2 11# happyReduction_24+happyReduction_24 happy_x_2+	happy_x_1+	 =  happyIn16+		 ([]+	)++happyReduce_25 = happySpecReduce_3 11# happyReduction_25+happyReduction_25 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut17 happy_x_2 of { happy_var_2 -> +	happyIn16+		 (reverse happy_var_2+	)}++happyReduce_26 = happySpecReduce_1 12# happyReduction_26+happyReduction_26 happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITstring   happy_var_1) -> +	happyIn17+		 ([ happy_var_1 ]+	)}++happyReduce_27 = happySpecReduce_3 12# happyReduction_27+happyReduction_27 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut17 happy_x_1 of { happy_var_1 -> +	case happyOutTok happy_x_3 of { (ITstring   happy_var_3) -> +	happyIn17+		 (happy_var_3 : happy_var_1+	)}}++happyNewToken action sts stk [] =+	happyDoAction 11# (error "reading EOF!") action sts stk []++happyNewToken action sts stk (tk:tks) =+	let cont i = happyDoAction i tk action sts stk tks in+	case tk of {+	ITocurly -> cont 1#;+	ITccurly -> cont 2#;+	ITobrack -> cont 3#;+	ITcbrack -> cont 4#;+	ITcomma -> cont 5#;+	ITequal -> cont 6#;+	ITvarid    happy_dollar_dollar -> cont 7#;+	ITconid    happy_dollar_dollar -> cont 8#;+	ITstring   happy_dollar_dollar -> cont 9#;+	ITinteger  happy_dollar_dollar -> cont 10#;+	_ -> happyError' (tk:tks)+	}++happyError_ tk tks = happyError' (tk:tks)++newtype HappyIdentity a = HappyIdentity a+happyIdentity = HappyIdentity+happyRunIdentity (HappyIdentity a) = a++instance Monad HappyIdentity where+    return = HappyIdentity+    (HappyIdentity p) >>= q = q p++happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b+happyThen = (>>=)+happyReturn :: () => a -> HappyIdentity a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> HappyIdentity a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [Token] -> HappyIdentity a+happyError' = HappyIdentity . happyError++parse tks = happyRunIdentity happySomeParser where+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut5 x))++parseOne tks = happyRunIdentity happySomeParser where+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut7 x))++happySeq = happyDoSeq++type PackageConfig = InstalledPackageInfo++defaultPackageConfig = emptyInstalledPackageInfo++data Token +        = ITocurly+        | ITccurly+        | ITobrack+        | ITcbrack+        | ITcomma+        | ITequal+        | ITvarid String+        | ITconid String+        | ITstring String+        | ITinteger Int++lexer :: String -> [Token]++lexer [] = []+lexer ('{':cs) = ITocurly : lexer cs+lexer ('}':cs) = ITccurly : lexer cs+lexer ('[':cs) = ITobrack : lexer cs+lexer (']':cs) = ITcbrack : lexer cs+lexer (',':cs) = ITcomma : lexer cs+lexer ('=':cs) = ITequal : lexer cs+lexer ('"':cs) = lexString cs ""+lexer (c:cs)+    | isSpace c = lexer cs+    | isAlpha c = lexID (c:cs) +    | isDigit c = lexInt (c:cs)+lexer _ = error ( "Unexpected token")++lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest+    where+	(id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs++lexInt cs = let (intStr, rest) = span isDigit cs+            in  ITinteger (read intStr) : lexer rest+++lexString ('"':cs) s = ITstring (reverse s) : lexer cs+lexString ('\\':c:cs) s = lexString cs (c:s)+lexString (c:cs) s = lexString cs (c:s)++happyError _ = error "Couldn't parse package configuration."++parsePkgConf :: String -> [PackageConfig]+parsePkgConf = parse . lexer++parseOnePkgConf :: String -> PackageConfig+parseOnePkgConf = parseOne . lexer+{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "GenericTemplate.hs" #-}+-- $Id$+++{-# LINE 28 "GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList+++++++{-# LINE 49 "GenericTemplate.hs" #-}+++{-# LINE 59 "GenericTemplate.hs" #-}+++++++++++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+	happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+	= {- nothing -}+++	  case action of+		0#		  -> {- nothing -}+				     happyFail i tk st+		-1# 	  -> {- nothing -}+				     happyAccept i tk st+		n | (n <# (0# :: Int#)) -> {- nothing -}++				     (happyReduceArr ! rule) i tk st+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))+		n		  -> {- nothing -}+++				     happyShift new_state i tk st+				     where new_state = (n -# (1# :: Int#))+   where off    = indexShortOffAddr happyActOffsets st+	 off_i  = (off +# i)+	 check  = if (off_i >=# (0# :: Int#))+			then (indexShortOffAddr happyCheck off_i ==#  i)+			else False+ 	 action | check     = indexShortOffAddr happyTable off_i+		| otherwise = indexShortOffAddr happyDefActions st++++++++++++indexShortOffAddr (HappyA# arr) off =+#if __GLASGOW_HASKELL__ > 500+	narrow16Int# i+#elif __GLASGOW_HASKELL__ == 500+	intToInt16# i+#else+	(i `iShiftL#` 16#) `iShiftRA#` 16#+#endif+  where+#if __GLASGOW_HASKELL__ >= 503+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+#else+	i = word2Int# ((high `shiftL#` 8#) `or#` low)+#endif+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))+	off' = off *# 2#++++++data HappyAddr = HappyA# Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 170 "GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in+--     trace "shifting the error token" $+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k -# (1# :: Int#)) sts of+	 sts1@((HappyCons (st1@(action)) (_))) ->+        	let r = fn stk in  -- it doesn't hurt to always seq here...+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+        happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+             drop_stk = happyDropStk k stk++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = +   {- nothing -}+   happyDoAction j tk new_state+   where off    = indexShortOffAddr happyGotoOffsets st+	 off_i  = (off +# nt)+ 	 new_state = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail  0# tk old_st _ stk =+--	trace "failing" $ +    	happyError_ tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  0# tk old_st (HappyCons ((action)) (sts)) +						(saved_tok `HappyStk` _ `HappyStk` stk) =+--	trace ("discarding state, depth " ++ show (length stk))  $+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail  i tk (action) sts stk =+--      trace "entering error recovery" $+	happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--	happySeq = happyDoSeq+-- otherwise it emits+-- 	happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ src/System/Plugins/ParsePkgConfCabal.y_in view
@@ -0,0 +1,218 @@+-- +-- Copyright (C) 2005 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++-- +-- Taken (apart from the most minor of alterations) from+-- ghc/utils/ghc-pkg/ParsePkgConfLite.hs from GHC 6.2.2 source tree+-- and then modified to mimic the behaviour of the parser within+-- ghc/compiler/main/ParsePkgConf.y in GHC 6.4, without importing+-- heavy-weight infrastructure from the GHC source tree such as module+-- FastString, Lexer, etc.+--+-- (c) Copyright 2002, The University Court of the University of Glasgow. +--++{+{-# OPTIONS -w #-}++module System.Plugins.ParsePkgConfCabal ( +        parsePkgConf, parseOnePkgConf+  ) where++import Distribution.InstalledPackageInfo+import Distribution.Package+import Distribution.Version++import Data.Char             ( isSpace, isAlpha, isAlphaNum, isUpper, isDigit )+import Data.List             ( break )++}++%token+ '{'		{ ITocurly }+ '}'		{ ITccurly }+ '['		{ ITobrack }+ ']'		{ ITcbrack }+ ','		{ ITcomma }+ '='		{ ITequal }+ VARID   	{ ITvarid    $$ }+ CONID   	{ ITconid    $$ }+ STRING		{ ITstring   $$ }+ INT            { ITinteger  $$ }++%name parse pkgconf+%name parseOne pkg+%tokentype { Token }+%%++pkgconf :: { [ PackageConfig ] }+	: '[' ']'			{ [] }+	| '[' pkgs ']'			{ reverse $2 }++pkgs 	:: { [ PackageConfig ] }+	: pkg 				{ [ $1 ] }+	| pkgs ',' pkg			{ $3 : $1 }++pkg 	:: { PackageConfig }+	: CONID '{' fields '}'		{ $3 defaultPackageConfig }++fields  :: { PackageConfig -> PackageConfig }+	: field				{ \p -> $1 p }+	| fields ',' field		{ \p -> $1 ($3 p) }++field	:: { PackageConfig -> PackageConfig }+	: VARID '=' pkgid+                 {\p -> case $1 of+		   "package" -> p {package = $3}+		   _      -> error "unknown key in config file" }+			+        | VARID '=' STRING              { id }+		-- we aren't interested in the string fields, they're all+		-- boring (copyright, maintainer etc.)++        | VARID '=' CONID+		{ case $1 of {+		   	"exposed" -> +			   case $3 of {+				"True"  -> (\p -> p {exposed=True});+				"False" -> (\p -> p {exposed=False});+				_       -> error "exposed must be either True or False" };+		   	"license" -> id; -- not interested+		   	_         -> error "unknown constructor" }+		}++	| VARID '=' CONID STRING	{ id }+		-- another case of license++	| VARID '=' strlist+		{\p -> case $1 of+		        "exposedModules"    -> p{exposedModules    = $3}+		        "hiddenModules"     -> p{hiddenModules     = $3}+		        "importDirs"        -> p{importDirs        = $3}+		        "libraryDirs"       -> p{libraryDirs       = $3}+		        "hsLibraries"       -> p{hsLibraries       = $3}+		        "extraLibraries"    -> p{extraLibraries    = $3}+		        "includeDirs"       -> p{includeDirs       = $3}+		        "includes"          -> p{includes          = $3}+		        "hugsOptions"       -> p{hugsOptions       = $3}+		        "ccOptions"         -> p{ccOptions         = $3}+		        "ldOptions"         -> p{ldOptions         = $3}+		        "frameworkDirs"     -> p{frameworkDirs     = $3}+		        "frameworks"        -> p{frameworks        = $3}+		        "haddockInterfaces" -> p{haddockInterfaces = $3}+		        "haddockHTMLs"      -> p{haddockHTMLs      = $3}+		        "depends"     	    -> p{depends = []}+				-- empty list only, non-empty handled below+			other -> p+		}+	| VARID '=' pkgidlist+		{ case $1 of+		        "depends"     -> (\p -> p{depends = $3})+			_other        -> error "unknown key in config file"+		}+++pkgid	:: { PackageIdentifier }+	: CONID '{' VARID '=' STRING ',' VARID '=' version '}'+			{ PackageIdentifier{ pkgName = $5, +					     pkgVersion = $9 } }++version :: { Version }+	: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'+			{ Version{ versionBranch=$5, versionTags=$9 } }++pkgidlist :: { [PackageIdentifier] }+	: '[' pkgids ']'		{ $2 }+	-- empty list case is covered by strlist, to avoid conflicts++pkgids	:: { [PackageIdentifier] }+	: pkgid				{ [ $1 ] }+	| pkgid ',' pkgids		{ $1 : $3 }++intlist :: { [Int] }+        : '[' ']'			{ [] }+	| '[' ints ']'			{ $2 }++ints	:: { [Int] }+	: INT				{ [ fromIntegral $1 ] }+	| INT ',' ints			{ fromIntegral $1 : $3 }++strlist :: { [String] }+        : '[' ']'			{ [] }+	| '[' strs ']'			{ reverse $2 }++strs	:: { [String] }+	: STRING			{ [ $1 ] }+	| strs ',' STRING		{ $3 : $1 }++{++type PackageConfig = InstalledPackageInfo++defaultPackageConfig = emptyInstalledPackageInfo++data Token +        = ITocurly+        | ITccurly+        | ITobrack+        | ITcbrack+        | ITcomma+        | ITequal+        | ITvarid String+        | ITconid String+        | ITstring String+        | ITinteger Int++lexer :: String -> [Token]++lexer [] = []+lexer ('{':cs) = ITocurly : lexer cs+lexer ('}':cs) = ITccurly : lexer cs+lexer ('[':cs) = ITobrack : lexer cs+lexer (']':cs) = ITcbrack : lexer cs+lexer (',':cs) = ITcomma : lexer cs+lexer ('=':cs) = ITequal : lexer cs+lexer ('"':cs) = lexString cs ""+lexer (c:cs)+    | isSpace c = lexer cs+    | isAlpha c = lexID (c:cs) +    | isDigit c = lexInt (c:cs)+lexer _ = error ( "Unexpected token")++lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest+    where+	(id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs++lexInt cs = let (intStr, rest) = span isDigit cs+            in  ITinteger (read intStr) : lexer rest+++lexString ('"':cs) s = ITstring (reverse s) : lexer cs+lexString ('\\':c:cs) s = lexString cs (c:s)+lexString (c:cs) s = lexString cs (c:s)++happyError _ = error "Couldn't parse package configuration."++parsePkgConf :: String -> [PackageConfig]+parsePkgConf = parse . lexer++parseOnePkgConf :: String -> PackageConfig+parseOnePkgConf = parseOne . lexer++}
+ src/System/Plugins/ParsePkgConfLite.hs view
@@ -0,0 +1,616 @@+{-# OPTIONS -fglasgow-exts #-}+{-# OPTIONS -w #-}++module System.Plugins.ParsePkgConfLite ( +        parsePkgConf, parseOnePkgConf+  ) where++import System.Plugins.Package  ( PackageConfig(..), defaultPackageConfig )++import Char             ( isSpace, isAlpha, isAlphaNum, isUpper )+import List             ( break )+import Array+#if __GLASGOW_HASKELL__ >= 503+import GHC.Exts+#else+import GlaExts+#endif++-- parser produced by Happy Version 1.15++newtype HappyAbsSyn  = HappyAbsSyn (() -> ())+happyIn5 :: ([ PackageConfig ]) -> (HappyAbsSyn )+happyIn5 x = unsafeCoerce# x+{-# INLINE happyIn5 #-}+happyOut5 :: (HappyAbsSyn ) -> ([ PackageConfig ])+happyOut5 x = unsafeCoerce# x+{-# INLINE happyOut5 #-}+happyIn6 :: ([ PackageConfig ]) -> (HappyAbsSyn )+happyIn6 x = unsafeCoerce# x+{-# INLINE happyIn6 #-}+happyOut6 :: (HappyAbsSyn ) -> ([ PackageConfig ])+happyOut6 x = unsafeCoerce# x+{-# INLINE happyOut6 #-}+happyIn7 :: (PackageConfig) -> (HappyAbsSyn )+happyIn7 x = unsafeCoerce# x+{-# INLINE happyIn7 #-}+happyOut7 :: (HappyAbsSyn ) -> (PackageConfig)+happyOut7 x = unsafeCoerce# x+{-# INLINE happyOut7 #-}+happyIn8 :: (PackageConfig -> PackageConfig) -> (HappyAbsSyn )+happyIn8 x = unsafeCoerce# x+{-# INLINE happyIn8 #-}+happyOut8 :: (HappyAbsSyn ) -> (PackageConfig -> PackageConfig)+happyOut8 x = unsafeCoerce# x+{-# INLINE happyOut8 #-}+happyIn9 :: (PackageConfig -> PackageConfig) -> (HappyAbsSyn )+happyIn9 x = unsafeCoerce# x+{-# INLINE happyIn9 #-}+happyOut9 :: (HappyAbsSyn ) -> (PackageConfig -> PackageConfig)+happyOut9 x = unsafeCoerce# x+{-# INLINE happyOut9 #-}+happyIn10 :: ([String]) -> (HappyAbsSyn )+happyIn10 x = unsafeCoerce# x+{-# INLINE happyIn10 #-}+happyOut10 :: (HappyAbsSyn ) -> ([String])+happyOut10 x = unsafeCoerce# x+{-# INLINE happyOut10 #-}+happyIn11 :: ([String]) -> (HappyAbsSyn )+happyIn11 x = unsafeCoerce# x+{-# INLINE happyIn11 #-}+happyOut11 :: (HappyAbsSyn ) -> ([String])+happyOut11 x = unsafeCoerce# x+{-# INLINE happyOut11 #-}+happyIn12 :: (Bool) -> (HappyAbsSyn )+happyIn12 x = unsafeCoerce# x+{-# INLINE happyIn12 #-}+happyOut12 :: (HappyAbsSyn ) -> (Bool)+happyOut12 x = unsafeCoerce# x+{-# INLINE happyOut12 #-}+happyInTok :: Token -> (HappyAbsSyn )+happyInTok x = unsafeCoerce# x+{-# INLINE happyInTok #-}+happyOutTok :: (HappyAbsSyn ) -> Token+happyOutTok x = unsafeCoerce# x+{-# INLINE happyOutTok #-}++happyActOffsets :: HappyAddr+happyActOffsets = HappyA# "\x1f\x00\x1e\x00\x1d\x00\x1b\x00\x1a\x00\x1c\x00\x19\x00\x01\x00\x0e\x00\x00\x00\x00\x00\x17\x00\x08\x00\x00\x00\x16\x00\x00\x00\x13\x00\x00\x00\xfe\xff\x00\x00\x12\x00\x00\x00\x00\x00\x00\x00\xff\xff\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x11\x00\x00\x00\x00\x00"#++happyGotoOffsets :: HappyAddr+happyGotoOffsets = HappyA# "\x18\x00\x15\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x00\x00\x00\xfd\xff\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x0f\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#++happyDefActions :: HappyAddr+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xfd\xff\x00\x00\x00\x00\xf8\xff\x00\x00\xfc\xff\x00\x00\xfa\xff\x00\x00\xf9\xff\x00\x00\xf7\xff\xf4\xff\xf5\xff\x00\x00\xef\xff\xf6\xff\x00\x00\xf3\xff\xf1\xff\xf2\xff\x00\x00\xf0\xff"#++happyCheck :: HappyAddr+happyCheck = HappyA# "\xff\xff\x03\x00\x05\x00\x04\x00\x07\x00\x04\x00\x08\x00\x09\x00\x09\x00\x08\x00\x02\x00\x01\x00\x02\x00\x05\x00\x03\x00\x04\x00\x04\x00\x05\x00\x04\x00\x05\x00\x04\x00\x06\x00\x02\x00\x02\x00\x00\x00\x07\x00\x09\x00\x08\x00\x06\x00\x01\x00\x07\x00\x04\x00\x03\x00\xff\xff\x03\x00\x0a\x00\x0a\x00\xff\xff\x08\x00\xff\xff\xff\xff\xff\xff"#++happyTable :: HappyAddr+happyTable = HappyA# "\x00\x00\x19\x00\x16\x00\x1d\x00\x17\x00\x0b\x00\x1a\x00\x1b\x00\x1e\x00\x06\x00\x14\x00\x08\x00\x09\x00\x15\x00\x0c\x00\x0d\x00\x1f\x00\x20\x00\x10\x00\x11\x00\x15\x00\x1b\x00\x11\x00\x04\x00\x06\x00\x0f\x00\x21\x00\x06\x00\x13\x00\x0c\x00\x0f\x00\x0b\x00\x04\x00\x00\x00\x08\x00\xff\xff\xff\xff\x00\x00\x06\x00\x00\x00\x00\x00\x00\x00"#++happyReduceArr = array (2, 16) [+	(2 , happyReduce_2),+	(3 , happyReduce_3),+	(4 , happyReduce_4),+	(5 , happyReduce_5),+	(6 , happyReduce_6),+	(7 , happyReduce_7),+	(8 , happyReduce_8),+	(9 , happyReduce_9),+	(10 , happyReduce_10),+	(11 , happyReduce_11),+	(12 , happyReduce_12),+	(13 , happyReduce_13),+	(14 , happyReduce_14),+	(15 , happyReduce_15),+	(16 , happyReduce_16)+	]++happy_n_terms = 11 :: Int+happy_n_nonterms = 8 :: Int++happyReduce_2 = happySpecReduce_2 0# happyReduction_2+happyReduction_2 happy_x_2+	happy_x_1+	 =  happyIn5+		 ([]+	)++happyReduce_3 = happySpecReduce_3 0# happyReduction_3+happyReduction_3 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_2 of { happy_var_2 -> +	happyIn5+		 (reverse happy_var_2+	)}++happyReduce_4 = happySpecReduce_1 1# happyReduction_4+happyReduction_4 happy_x_1+	 =  case happyOut7 happy_x_1 of { happy_var_1 -> +	happyIn6+		 ([ happy_var_1 ]+	)}++happyReduce_5 = happySpecReduce_3 1# happyReduction_5+happyReduction_5 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut6 happy_x_1 of { happy_var_1 -> +	case happyOut7 happy_x_3 of { happy_var_3 -> +	happyIn6+		 (happy_var_3 : happy_var_1+	)}}++happyReduce_6 = happyReduce 4# 2# happyReduction_6+happyReduction_6 (happy_x_4 `HappyStk`+	happy_x_3 `HappyStk`+	happy_x_2 `HappyStk`+	happy_x_1 `HappyStk`+	happyRest)+	 = case happyOut8 happy_x_3 of { happy_var_3 -> +	happyIn7+		 (happy_var_3 defaultPackageConfig+	) `HappyStk` happyRest}++happyReduce_7 = happySpecReduce_1 3# happyReduction_7+happyReduction_7 happy_x_1+	 =  case happyOut9 happy_x_1 of { happy_var_1 -> +	happyIn8+		 (\p -> happy_var_1 p+	)}++happyReduce_8 = happySpecReduce_3 3# happyReduction_8+happyReduction_8 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut8 happy_x_1 of { happy_var_1 -> +	case happyOut9 happy_x_3 of { happy_var_3 -> +	happyIn8+		 (\p -> happy_var_1 (happy_var_3 p)+	)}}++happyReduce_9 = happySpecReduce_3 4# happyReduction_9+happyReduction_9 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOutTok happy_x_3 of { (ITstring   happy_var_3) -> +	happyIn9+		 (\p -> case happy_var_1 of+		   "name" -> p{name = happy_var_3}+		   _      -> error "unknown key in config file"+	)}}++happyReduce_10 = happySpecReduce_3 4# happyReduction_10+happyReduction_10 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOut12 happy_x_3 of { happy_var_3 -> +	happyIn9+		 (\p -> case happy_var_1 of {+		   	"auto" -> p{auto = happy_var_3};+		   	_      -> p }+	)}}++happyReduce_11 = happySpecReduce_3 4# happyReduction_11+happyReduction_11 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITvarid    happy_var_1) -> +	case happyOut10 happy_x_3 of { happy_var_3 -> +	happyIn9+		 (\p -> case happy_var_1 of+		        "import_dirs"     -> p{import_dirs     = happy_var_3}+		        "library_dirs"    -> p{library_dirs    = happy_var_3}+		        "hs_libraries"    -> p{hs_libraries    = happy_var_3}+		        "extra_libraries" -> p{extra_libraries = happy_var_3}+		        "include_dirs"    -> p{include_dirs    = happy_var_3}+		        "c_includes"      -> p{c_includes      = happy_var_3}+		        "package_deps"    -> p{package_deps    = happy_var_3}+		        "extra_ghc_opts"  -> p{extra_ghc_opts  = happy_var_3}+		        "extra_cc_opts"   -> p{extra_cc_opts   = happy_var_3}+		        "extra_ld_opts"   -> p{extra_ld_opts   = happy_var_3}+		        "framework_dirs"  -> p{framework_dirs  = happy_var_3}+		        "extra_frameworks"-> p{extra_frameworks= happy_var_3}+			_other            -> p+	)}}++happyReduce_12 = happySpecReduce_2 5# happyReduction_12+happyReduction_12 happy_x_2+	happy_x_1+	 =  happyIn10+		 ([]+	)++happyReduce_13 = happySpecReduce_3 5# happyReduction_13+happyReduction_13 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_2 of { happy_var_2 -> +	happyIn10+		 (reverse happy_var_2+	)}++happyReduce_14 = happySpecReduce_1 6# happyReduction_14+happyReduction_14 happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITstring   happy_var_1) -> +	happyIn11+		 ([ happy_var_1 ]+	)}++happyReduce_15 = happySpecReduce_3 6# happyReduction_15+happyReduction_15 happy_x_3+	happy_x_2+	happy_x_1+	 =  case happyOut11 happy_x_1 of { happy_var_1 -> +	case happyOutTok happy_x_3 of { (ITstring   happy_var_3) -> +	happyIn11+		 (happy_var_3 : happy_var_1+	)}}++happyReduce_16 = happySpecReduce_1 7# happyReduction_16+happyReduction_16 happy_x_1+	 =  case happyOutTok happy_x_1 of { (ITconid    happy_var_1) -> +	happyIn12+		 ( case happy_var_1 of {+					    "True"  -> True;+					    "False" -> False;+					    _       -> error ("unknown constructor in config file: " ++ happy_var_1) }+	)}++happyNewToken action sts stk [] =+	happyDoAction 10# (error "reading EOF!") action sts stk []++happyNewToken action sts stk (tk:tks) =+	let cont i = happyDoAction i tk action sts stk tks in+	case tk of {+	ITocurly -> cont 1#;+	ITccurly -> cont 2#;+	ITobrack -> cont 3#;+	ITcbrack -> cont 4#;+	ITcomma -> cont 5#;+	ITequal -> cont 6#;+	ITvarid    happy_dollar_dollar -> cont 7#;+	ITconid    happy_dollar_dollar -> cont 8#;+	ITstring   happy_dollar_dollar -> cont 9#;+	_ -> happyError' (tk:tks)+	}++happyError_ tk tks = happyError' (tk:tks)++newtype HappyIdentity a = HappyIdentity a+happyIdentity = HappyIdentity+happyRunIdentity (HappyIdentity a) = a++instance Monad HappyIdentity where+    return = HappyIdentity+    (HappyIdentity p) >>= q = q p++happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b+happyThen = (>>=)+happyReturn :: () => a -> HappyIdentity a+happyReturn = (return)+happyThen1 m k tks = (>>=) m (\a -> k a tks)+happyReturn1 :: () => a -> b -> HappyIdentity a+happyReturn1 = \a tks -> (return) a+happyError' :: () => [Token] -> HappyIdentity a+happyError' = HappyIdentity . happyError++parse tks = happyRunIdentity happySomeParser where+  happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut5 x))++parseOne tks = happyRunIdentity happySomeParser where+  happySomeParser = happyThen (happyParse 1# tks) (\x -> happyReturn (happyOut7 x))++happySeq = happyDontSeq++data Token +        = ITocurly+        | ITccurly+        | ITobrack+        | ITcbrack+        | ITcomma+        | ITequal+        | ITvarid String+        | ITconid String+        | ITstring String++lexer :: String -> [Token]++lexer [] = []+lexer ('{':cs) = ITocurly : lexer cs+lexer ('}':cs) = ITccurly : lexer cs+lexer ('[':cs) = ITobrack : lexer cs+lexer (']':cs) = ITcbrack : lexer cs+lexer (',':cs) = ITcomma : lexer cs+lexer ('=':cs) = ITequal : lexer cs+lexer ('"':cs) = lexString cs ""+lexer (c:cs)+    | isSpace c = lexer cs+    | isAlpha c = lexID (c:cs) where+lexer _ = error "Unexpected token"++lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest+    where+	(id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs++lexString ('"':cs) s = ITstring (reverse s) : lexer cs+lexString ('\\':c:cs) s = lexString cs (c:s)+lexString (c:cs) s = lexString cs (c:s)++happyError _ = error "Couldn't parse package configuration."++parsePkgConf :: String -> [PackageConfig]+parsePkgConf = parse . lexer++parseOnePkgConf :: String -> PackageConfig+parseOnePkgConf = parseOne . lexer+{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-}+{-# LINE 1 "<command line>" #-}+{-# LINE 1 "GenericTemplate.hs" #-}+-- $Id$+++{-# LINE 28 "GenericTemplate.hs" #-}+++data Happy_IntList = HappyCons Int# Happy_IntList+++++++{-# LINE 49 "GenericTemplate.hs" #-}+++{-# LINE 59 "GenericTemplate.hs" #-}+++++++++++infixr 9 `HappyStk`+data HappyStk a = HappyStk a (HappyStk a)++-----------------------------------------------------------------------------+-- starting the parse++happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll++-----------------------------------------------------------------------------+-- Accepting the parse++-- If the current token is 0#, it means we've just accepted a partial+-- parse (a %partial parser).  We must ignore the saved token on the top of+-- the stack in this case.+happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) =+	happyReturn1 ans+happyAccept j tk st sts (HappyStk ans _) = +	(happyTcHack j (happyTcHack st)) (happyReturn1 ans)++-----------------------------------------------------------------------------+-- Arrays only: do the next action++++happyDoAction i tk st+	= {- nothing -}+++	  case action of+		0#		  -> {- nothing -}+				     happyFail i tk st+		-1# 	  -> {- nothing -}+				     happyAccept i tk st+		n | (n <# (0# :: Int#)) -> {- nothing -}++				     (happyReduceArr ! rule) i tk st+				     where rule = (I# ((negateInt# ((n +# (1# :: Int#))))))+		n		  -> {- nothing -}+++				     happyShift new_state i tk st+				     where new_state = (n -# (1# :: Int#))+   where off    = indexShortOffAddr happyActOffsets st+	 off_i  = (off +# i)+	 check  = if (off_i >=# (0# :: Int#))+			then (indexShortOffAddr happyCheck off_i ==#  i)+			else False+ 	 action | check     = indexShortOffAddr happyTable off_i+		| otherwise = indexShortOffAddr happyDefActions st++++++++++++indexShortOffAddr (HappyA# arr) off =+#if __GLASGOW_HASKELL__ > 500+	narrow16Int# i+#elif __GLASGOW_HASKELL__ == 500+	intToInt16# i+#else+	(i `iShiftL#` 16#) `iShiftRA#` 16#+#endif+  where+#if __GLASGOW_HASKELL__ >= 503+	i = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+#else+	i = word2Int# ((high `shiftL#` 8#) `or#` low)+#endif+	high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+	low  = int2Word# (ord# (indexCharOffAddr# arr off'))+	off' = off *# 2#++++++data HappyAddr = HappyA# Addr#+++++-----------------------------------------------------------------------------+-- HappyState data type (not arrays)++{-# LINE 170 "GenericTemplate.hs" #-}++-----------------------------------------------------------------------------+-- Shifting a token++happyShift new_state 0# tk st sts stk@(x `HappyStk` _) =+     let i = (case unsafeCoerce# x of { (I# (i)) -> i }) in+--     trace "shifting the error token" $+     happyDoAction i tk new_state (HappyCons (st) (sts)) (stk)++happyShift new_state i tk st sts stk =+     happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk)++-- happyReduce is specialised for the common cases.++happySpecReduce_0 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_0 nt fn j tk st@((action)) sts stk+     = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk)++happySpecReduce_1 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk')+     = let r = fn v1 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_2 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk')+     = let r = fn v1 v2 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happySpecReduce_3 i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk')+     = let r = fn v1 v2 v3 in+       happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk'))++happyReduce k i fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyReduce k nt fn j tk st sts stk+     = case happyDrop (k -# (1# :: Int#)) sts of+	 sts1@((HappyCons (st1@(action)) (_))) ->+        	let r = fn stk in  -- it doesn't hurt to always seq here...+       		happyDoSeq r (happyGoto nt j tk st1 sts1 r)++happyMonadReduce k nt fn 0# tk st sts stk+     = happyFail 0# tk st sts stk+happyMonadReduce k nt fn j tk st sts stk =+        happyThen1 (fn stk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))+       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))+             drop_stk = happyDropStk k stk++happyDrop 0# l = l+happyDrop n (HappyCons (_) (t)) = happyDrop (n -# (1# :: Int#)) t++happyDropStk 0# l = l+happyDropStk n (x `HappyStk` xs) = happyDropStk (n -# (1#::Int#)) xs++-----------------------------------------------------------------------------+-- Moving to a new state after a reduction+++happyGoto nt j tk st = +   {- nothing -}+   happyDoAction j tk new_state+   where off    = indexShortOffAddr happyGotoOffsets st+	 off_i  = (off +# nt)+ 	 new_state = indexShortOffAddr happyTable off_i+++++-----------------------------------------------------------------------------+-- Error recovery (0# is the error token)++-- parse error if we are in recovery and we fail again+happyFail  0# tk old_st _ stk =+--	trace "failing" $ +    	happyError_ tk++{-  We don't need state discarding for our restricted implementation of+    "error".  In fact, it can cause some bogus parses, so I've disabled it+    for now --SDM++-- discard a state+happyFail  0# tk old_st (HappyCons ((action)) (sts)) +						(saved_tok `HappyStk` _ `HappyStk` stk) =+--	trace ("discarding state, depth " ++ show (length stk))  $+	happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk))+-}++-- Enter error recovery: generate an error token,+--                       save the old token and carry on.+happyFail  i tk (action) sts stk =+--      trace "entering error recovery" $+	happyDoAction 0# tk action sts ( (unsafeCoerce# (I# (i))) `HappyStk` stk)++-- Internal happy errors:++notHappyAtAll = error "Internal Happy error\n"++-----------------------------------------------------------------------------+-- Hack to get the typechecker to accept our action functions+++happyTcHack :: Int# -> a -> a+happyTcHack x y = y+{-# INLINE happyTcHack #-}+++-----------------------------------------------------------------------------+-- Seq-ing.  If the --strict flag is given, then Happy emits +--	happySeq = happyDoSeq+-- otherwise it emits+-- 	happySeq = happyDontSeq++happyDoSeq, happyDontSeq :: a -> b -> b+happyDoSeq   a b = a `seq` b+happyDontSeq a b = b++-----------------------------------------------------------------------------+-- Don't inline any functions from the template.  GHC has a nasty habit+-- of deciding to inline happyGoto everywhere, which increases the size of+-- the generated parser quite a bit.+++{-# NOINLINE happyDoAction #-}+{-# NOINLINE happyTable #-}+{-# NOINLINE happyCheck #-}+{-# NOINLINE happyActOffsets #-}+{-# NOINLINE happyGotoOffsets #-}+{-# NOINLINE happyDefActions #-}++{-# NOINLINE happyShift #-}+{-# NOINLINE happySpecReduce_0 #-}+{-# NOINLINE happySpecReduce_1 #-}+{-# NOINLINE happySpecReduce_2 #-}+{-# NOINLINE happySpecReduce_3 #-}+{-# NOINLINE happyReduce #-}+{-# NOINLINE happyMonadReduce #-}+{-# NOINLINE happyGoto #-}+{-# NOINLINE happyFail #-}++-- end of Happy Template.
+ src/System/Plugins/ParsePkgConfLite.y view
@@ -0,0 +1,159 @@+-- +-- Copyright (C) 2004 Sean Seefried - http://www.cse.unsw.edu.au/~sseefried+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++-- +-- Taken (apart from the most minor of alterations) from +-- ghc/utils/ghc-pkg/ParsePkgConfLite.hs:+--+-- (c) Copyright 2002, The University Court of the University of Glasgow. +--++{++{-# OPTIONS -w #-}++module System.Plugins.ParsePkgConfLite ( +        parsePkgConf, parseOnePkgConf+  ) where++import System.Plugins.Package  ( PackageConfig(..), defaultPackageConfig )++import Char             ( isSpace, isAlpha, isAlphaNum, isUpper )+import List             ( break )++}++%token+ '{'		{ ITocurly }+ '}'		{ ITccurly }+ '['		{ ITobrack }+ ']'		{ ITcbrack }+ ','		{ ITcomma }+ '='		{ ITequal }+ VARID   	{ ITvarid    $$ }+ CONID   	{ ITconid    $$ }+ STRING		{ ITstring   $$ }++%name parse pkgconf+%name parseOne pkg+%tokentype { Token }+%%++pkgconf :: { [ PackageConfig ] }+	: '[' ']'			{ [] }+	| '[' pkgs ']'			{ reverse $2 }++pkgs 	:: { [ PackageConfig ] }+	: pkg 				{ [ $1 ] }+	| pkgs ',' pkg			{ $3 : $1 }++pkg 	:: { PackageConfig }+	: CONID '{' fields '}'		{ $3 defaultPackageConfig }++fields  :: { PackageConfig -> PackageConfig }+	: field				{ \p -> $1 p }+	| fields ',' field		{ \p -> $1 ($3 p) }++field	:: { PackageConfig -> PackageConfig }+	: VARID '=' STRING		+                 {\p -> case $1 of+		   "name" -> p{name = $3}+		   _      -> error "unknown key in config file" }+			+        | VARID '=' bool+		{\p -> case $1 of {+		   	"auto" -> p{auto = $3};+		   	_      -> p } }++	| VARID '=' strlist		+		{\p -> case $1 of+		        "import_dirs"     -> p{import_dirs     = $3}+		        "library_dirs"    -> p{library_dirs    = $3}+		        "hs_libraries"    -> p{hs_libraries    = $3}+		        "extra_libraries" -> p{extra_libraries = $3}+		        "include_dirs"    -> p{include_dirs    = $3}+		        "c_includes"      -> p{c_includes      = $3}+		        "package_deps"    -> p{package_deps    = $3}+		        "extra_ghc_opts"  -> p{extra_ghc_opts  = $3}+		        "extra_cc_opts"   -> p{extra_cc_opts   = $3}+		        "extra_ld_opts"   -> p{extra_ld_opts   = $3}+		        "framework_dirs"  -> p{framework_dirs  = $3}+		        "extra_frameworks"-> p{extra_frameworks= $3}+			_other            -> p+		}++strlist :: { [String] }+        : '[' ']'			{ [] }+	| '[' strs ']'			{ reverse $2 }++strs	:: { [String] }+	: STRING			{ [ $1 ] }+	| strs ',' STRING		{ $3 : $1 }++bool    :: { Bool }+	: CONID				{% case $1 of {+					    "True"  -> True;+					    "False" -> False;+					    _       -> error ("unknown constructor in config file: " ++ $1) } }++{++data Token +        = ITocurly+        | ITccurly+        | ITobrack+        | ITcbrack+        | ITcomma+        | ITequal+        | ITvarid String+        | ITconid String+        | ITstring String++lexer :: String -> [Token]++lexer [] = []+lexer ('{':cs) = ITocurly : lexer cs+lexer ('}':cs) = ITccurly : lexer cs+lexer ('[':cs) = ITobrack : lexer cs+lexer (']':cs) = ITcbrack : lexer cs+lexer (',':cs) = ITcomma : lexer cs+lexer ('=':cs) = ITequal : lexer cs+lexer ('"':cs) = lexString cs ""+lexer (c:cs)+    | isSpace c = lexer cs+    | isAlpha c = lexID (c:cs) where+lexer _ = error "Unexpected token"++lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest+    where+	(id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs++lexString ('"':cs) s = ITstring (reverse s) : lexer cs+lexString ('\\':c:cs) s = lexString cs (c:s)+lexString (c:cs) s = lexString cs (c:s)++happyError _ = error "Couldn't parse package configuration."++parsePkgConf :: String -> [PackageConfig]+parsePkgConf = parse . lexer++parseOnePkgConf :: String -> PackageConfig+parseOnePkgConf = parseOne . lexer++}
+ src/System/Plugins/Parser.hs view
@@ -0,0 +1,238 @@+{-# OPTIONS -fglasgow-exts #-}+-- +-- Copyright (C) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- This program 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.+-- +-- This program 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 program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA+-- 02111-1307, USA.+-- ++module System.Plugins.Parser ( +        parse, mergeModules, pretty, parsePragmas,+        HsModule(..) ,+        replaceModName+  ) where++#include "../../../config.h"++import Data.List +import Data.Char+import Data.Either++#if defined(WITH_HSX)+import Language.Haskell.Hsx+#else+import Language.Haskell.Parser+import Language.Haskell.Syntax+import Language.Haskell.Pretty+#endif++--+-- | parse a file (as a string) as Haskell src+-- +parse :: FilePath                -- ^ module name+      -> String                  -- ^ haskell src+      -> Either String HsModule  -- ^ abstract syntax++parse f fsrc = +#if defined(WITH_HSX)+    case parseFileContentsWithMode (ParseMode f) fsrc of+#else+    case parseModuleWithMode (ParseMode f) fsrc of+#endif+        ParseOk src       -> Right src+        ParseFailed loc _ -> Left $ srcmsg loc+  where+    srcmsg loc = "parse error in " ++ f ++ "\n" ++ +                  "line: "  ++ (show $ srcLine loc) ++ +                  ", col: " ++ (show $ srcColumn loc)++ "\n"++--+-- | pretty print haskell src+--+-- doesn't handle operators with '#' at the end. i.e. unsafeCoerce#+--+pretty :: HsModule -> String+pretty code = prettyPrintWithMode (defaultMode { linePragmas = True }) code+++-- | mergeModules : generate a full Haskell src file, give a .hs config+-- file, and a stub to take default syntax and decls from. Mostly we+-- just ensure they don't do anything bad, and that the names are+-- correct for the module.+--+-- Transformations:+--+--      . Take src location pragmas from the conf file (1st file)+--      . Use the template's (2nd argument) module name+--      . Only use export list from template (2nd arg)+--      . Merge top-level decls+--      . need to force the type of the plugin to match the stub,+--      overwriting any type they supply.+--+mergeModules :: HsModule ->    -- Configure module+                HsModule ->    -- Template module+                HsModule       -- A merge of the two++mergeModules (HsModule l  _   _  is  ds )+             (HsModule _  m' es' is' ds')+         = (HsModule l  m' es' +                        (mImps m' is is') +                        (mDecl ds ds') )++-- +-- | replace Module name with String.+--+replaceModName :: HsModule -> String -> HsModule+replaceModName (HsModule l _ es is ds) nm = (HsModule l (Module nm) es is ds)++--  +-- | merge import declarations:+--+--  *   ensure that the config file doesn't import the stub name+--  *   merge import lists uniquely, and when they match, merge their decls+--+-- TODO * we don't merge imports of the same module from both files. +--      We should, and then merge the decls in their import list+--      * rename args, too confusing.+--+-- quick fix: strip all type signatures from the source.+--+mImps :: Module ->              -- plugin module name+        [HsImportDecl] ->       -- conf file imports+        [HsImportDecl] ->       -- stub file imports+        [HsImportDecl]++mImps plug_mod cimps timps = +    case filter (!~ self) cimps of cimps' -> unionBy (=~) cimps' timps+  where +    self = ( HsImportDecl undefined plug_mod undefined undefined undefined )++--+-- | merge top-level declarations+--+-- Remove decls found in template, using those from the config file.+-- Need to sort decls by types, then decls first, in both.+--+-- Could we write a pass to handle editor, foo :: String ?+-- We must keep the type from the template.+--+mDecl ds es = let ds' = filter (not.typeDecl) ds+              in sortBy decls $! unionBy (=~) ds' es+  where+    decls a b = compare (encoding a) (encoding b)++    typeDecl :: HsDecl -> Bool+    typeDecl (HsTypeSig _ _ _) = True+    typeDecl _ = False++    encoding :: HsDecl -> Int+    encoding d = case d of+           HsFunBind _        -> 1+           HsPatBind _ _ _ _  -> 1+           _                  -> 0++--+-- syntactic equality over the useful Haskell abstract syntax+-- this may be extended if we try to merge the files more thoroughly+--+class SynEq a where+    (=~) :: a -> a -> Bool+    (!~) :: a -> a -> Bool+    n !~ m = not (n =~ m)+        +instance SynEq HsDecl where+    (HsPatBind _ (HsPVar n) _ _) =~ (HsPatBind _ (HsPVar m) _ _) = n == m+    (HsTypeSig _ (n:_) _)        =~ (HsTypeSig _ (m:_) _)        = n == m+    _ =~ _ = False++instance SynEq HsImportDecl where+    (HsImportDecl _ m _ _ _) =~ (HsImportDecl _ n _ _ _)    = n == m+++--+-- | Parsing option pragmas.+--+-- This is not a type checker. If the user supplies bogus options,+-- they'll get slightly mystical error messages. Also, we /want/ to+-- handle -package options, and other /static/ flags. This is more than+-- GHC.+--+-- GHC user's guide : +--+-- >    OPTIONS pragmas are only looked for at the top of your source+-- >    files, up to the first (non-literate,non-empty) line not+-- >    containing OPTIONS. Multiple OPTIONS pragmas are recognised.+--+-- based on getOptionsFromSource(), in main\/DriverUtil.hs+--+parsePragmas :: String              -- ^ input src+            -> ([String],[String])  -- ^ normal options, global options++parsePragmas s = look $ lines s+    where+        look [] = ([],[])+        look (l':ls) =+            let l = remove_spaces l'+            in case () of+                () | null l                      -> look ls+                   | prefixMatch "#" l           -> look ls+                   | prefixMatch "{-# LINE" l    -> look ls+                   | Just (Option o) <- matchPragma l+                        -> let (as,bs) = look ls in (words o ++ as,bs)+                   | Just (Global g) <- matchPragma l+                        -> let (as,bs) = look ls in (as,words g ++ bs)+                   | otherwise -> ([],[])++--+-- based on main\/DriverUtil.hs+--+-- extended to handle dynamic options too+--++data Pragma = Option !String | Global !String++matchPragma :: String -> Maybe Pragma+matchPragma s+        | Just s1 <- maybePrefixMatch "{-#" s, -- -}+          Just s2 <- maybePrefixMatch "OPTIONS" (remove_spaces s1),+          Just s3 <- maybePrefixMatch "}-#" (reverse s2)+        = Just (Option (reverse s3))++        | Just s1 <- maybePrefixMatch "{-#" s, -- -}+          Just s2 <- maybePrefixMatch "GLOBALOPTIONS" (remove_spaces s1),+          Just s3 <- maybePrefixMatch "}-#" (reverse s2)+        = Just (Global (reverse s3))++        | otherwise+        = Nothing++remove_spaces :: String -> String+remove_spaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace++--+-- verbatim from utils\/Utils.lhs+--+prefixMatch :: Eq a => [a] -> [a] -> Bool+prefixMatch [] _str = True+prefixMatch _pat [] = False+prefixMatch (p:ps) (s:ss) | p == s    = prefixMatch ps ss+                          | otherwise = False++maybePrefixMatch :: String -> String -> Maybe String+maybePrefixMatch []    rest = Just rest+maybePrefixMatch (_:_) []   = Nothing+maybePrefixMatch (p:pat) (r:rest)+        | p == r    = maybePrefixMatch pat rest+        | otherwise = Nothing
+ src/System/Plugins/Process.hs view
@@ -0,0 +1,89 @@+--+-- | A Posix.popen compatibility mapping.+--+-- If we use this, we should build -threaded+--+module System.Plugins.Process (exec, popen) where++import System.Exit+#if __GLASGOW_HASKELL__ >= 604+import System.IO+import System.Process+import Control.Concurrent       (forkIO)+#else+import qualified Posix as P+#endif++import qualified Control.Exception++--+-- slight wrapper over popen for calls that don't care about stdin to the program+--+exec :: String -> [String] -> IO ([String],[String])+exec f as = do+        (a,b,_) <- popen f as (Just [])+        return (lines a, lines b)++#if __GLASGOW_HASKELL__ >= 604++type ProcessID = ProcessHandle++--+-- Ignoring exit status for now.+--+-- XXX there are still issues. Large amounts of output can cause what+-- seems to be a dead lock on the pipe write from runplugs, for example.+-- Posix.popen doesn't have this problem, so maybe we can reproduce its+-- pipe handling somehow.+--+popen :: FilePath -> [String] -> Maybe String -> IO (String,String,ProcessID)+popen file args minput =+    Control.Exception.handle (\e -> return ([],show e,error (show e))) $ do++    (inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing++    case minput of+        Just input -> hPutStr inp input >> hClose inp -- importante!+        Nothing    -> return ()++    -- Now, grab the input+    output <- hGetContents out+    errput <- hGetContents err++    -- SimonM sez:+    -- ... avoids blocking the main thread, but ensures that all the+    -- data gets pulled as it becomes available. you have to force the+    -- output strings before waiting for the process to terminate.+    --+    forkIO (Control.Exception.evaluate (length output) >> return ())+    forkIO (Control.Exception.evaluate (length errput) >> return ())++    -- And now we wait. We must wait after we read, unsurprisingly.+    exitCode <- waitForProcess pid -- blocks without -threaded, you're warned.+    case exitCode of+      ExitFailure code+          | null errput -> let errMsg = file ++ ": failed with error code " ++ show code+                           in return ([],errMsg,error errMsg)+      _ -> return (output,errput,pid)++#else++--+-- catch so that we can deal with forkProcess failing gracefully.  and+-- getProcessStatus is needed so as not to get a bunch of zombies,+-- leading to forkProcess failing.+--+-- Large amounts of input will cause problems with blocking as we wait+-- on the process to finish. Make sure no lambdabot processes will+-- generate 1000s of lines of output.+--+popen :: FilePath -> [String] -> Maybe String -> IO (String,String,P.ProcessID)+popen f s m = +        Control.Exception.handle (\e -> return ([], show e, error $ show e )) $ do+            x@(_,_,pid) <- P.popen f s m +            b <- P.getProcessStatus True False pid  -- wait+            return $ case b of    +                Nothing -> ([], "process has disappeared", pid)+                _       -> x++#endif
+ src/System/Plugins/Utils.hs view
@@ -0,0 +1,503 @@+-- +-- Copyright (C) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- +-- 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307+-- USA+-- ++module System.Plugins.Utils ( +    Arg,++    hWrite,++    mkUnique,+    hMkUnique,+    mkUniqueIn,+    hMkUniqueIn,++    findFile,++    mkTemp, mkTempIn, {- internal -}++    replaceSuffix,+    outFilePath,+    dropSuffix,+    mkModid,+    changeFileExt,+    joinFileExt,+    splitFileExt,++    isSublistOf,                -- :: Eq a => [a] -> [a] -> Bool++    dirname,+    basename,++    (</>), (<.>), (<+>), (<>),++    newer,++    encode,+    decode,+    EncodedString,++    panic++  ) where++#include "../../../config.h"++import System.Plugins.Env              ( isLoaded )+import System.Plugins.Consts           ( objSuf, hiSuf, tmpDir )+import qualified System.MkTemp ( mkstemps )++import Data.Char+import Data.List++import System.IO+import System.Environment           ( getEnv )+import System.Directory++-- ---------------------------------------------------------------------+-- some misc types we use++type Arg = String++-- ---------------------------------------------------------------------+-- | useful+--+panic s = ioError ( userError s )++-- ---------------------------------------------------------------------+-- | writeFile for Handles+--+hWrite :: Handle -> String -> IO ()+hWrite hdl src = hPutStr hdl src >> hClose hdl >> return ()+++-- ---------------------------------------------------------------------+-- | mkstemps.+--+-- We use the Haskell version now... it is faster than calling into+-- mkstemps(3).+--++mkstemps :: String -> Int -> IO (String,Handle)+mkstemps path slen = do+        m_v <- System.MkTemp.mkstemps path slen+        case m_v of Nothing -> error "mkstemps : couldn't create temp file"+                    Just v' -> return v'++{-++mkstemps path slen = do +    withCString path $ \ ptr -> do+        let c_slen = fromIntegral $ slen+1+        fd   <- throwErrnoIfMinus1 "mkstemps" $ c_mkstemps ptr c_slen+        name <- peekCString ptr+        hdl  <- fdToHandle fd+        return (name, hdl)++foreign import ccall unsafe "mkstemps" c_mkstemps :: CString -> CInt -> IO Fd++-}++-- ---------------------------------------------------------------------+-- | create a new temp file, returning name and handle.+-- bit like the mktemp shell utility+--+mkTemp :: IO (String,Handle)+mkTemp = do tmpd  <- catch (getEnv "TMPDIR") (\_ -> return tmpDir)+            mkTempIn tmpd++mkTempIn :: String -> IO (String, Handle)+mkTempIn tmpd = do+        (tmpf,hdl)  <- mkstemps (tmpd++"/MXXXXXXXXX.hs") 3+        let modname = mkModid $ dropSuffix tmpf+        if and $ map (\c -> isAlphaNum c && c /= '_') modname+                then return (tmpf,hdl)+                else panic $ "Illegal characters in temp file: `"++tmpf++"'"++-- ---------------------------------------------------------------------+-- | Get a new temp file, unique from those in /tmp, and from those+-- modules already loaded. Very nice for merge/eval uses.+--+-- Will run for a long time if we can't create a temp file, luckily+-- mkstemps gives us a pretty big search space+--+mkUnique :: IO FilePath+mkUnique = do (t,h) <- hMkUnique+              hClose h >> return t++hMkUnique :: IO (FilePath,Handle)+hMkUnique = do (t,h) <- mkTemp+               alreadyLoaded <- isLoaded t -- not unique!+               if alreadyLoaded +                        then hClose h >> removeFile t >> hMkUnique+                        else return (t,h)++mkUniqueIn :: FilePath -> IO FilePath+mkUniqueIn dir = do (t,h) <- hMkUniqueIn dir+		    hClose h >> return t++hMkUniqueIn :: FilePath -> IO (FilePath,Handle)+hMkUniqueIn dir = do (t,h) <- mkTempIn dir+                     alreadyLoaded <- isLoaded t -- not unique!+                     if alreadyLoaded +                        then hClose h >> removeFile t >> hMkUniqueIn dir+                        else return (t,h)++findFile :: [String] -> FilePath -> IO (Maybe FilePath)+findFile [] _  = return Nothing+findFile (ext:exts) file+    = do let l = changeFileExt file ext+         b <- doesFileExist l+         if b then return $ Just l+              else findFile exts file++-- ---------------------------------------------------------------------+-- some filename manipulation stuff++--+-- | </>, <.> : join two path components+--+infixr 6 </>+infixr 6 <.>++(</>), (<.>), (<+>), (<>) :: FilePath -> FilePath -> FilePath+[] </> b = b+a  </> b = a ++ "/" ++ b++[] <.> b = b+a  <.> b = a ++ "." ++ b++[] <+> b = b+a  <+> b = a ++ " " ++ b++[] <> b = b+a  <> b = a ++ b++--+-- | dirname : return the directory portion of a file path+-- if null, return "."+--+dirname :: FilePath -> FilePath+dirname p  =+    let x = findIndices (== '\\') p+        y = findIndices (== '/') p+    in+    if not $ null x+      then if not $ null y+          then if (maximum x) > (maximum y) then dirname' '\\' p else dirname' '/' p+          else dirname' '\\' p+      else dirname' '/' p+    where+        dirname' chara pa =+            case reverse $ dropWhile (/= chara) $ reverse pa of+                [] -> "."+                pa' -> pa'++--+-- | basename : return the filename portion of a path+--+basename :: FilePath -> FilePath+basename p =+    let x = findIndices (== '\\') p+        y = findIndices (== '/') p+    in+    if not $ null x+      then if not $ null y+          then if (maximum x) > (maximum y) then basename' '\\' p else basename' '/' p+          else basename' '\\' p+      else basename' '/' p+    where+        basename' chara pa = reverse $ takeWhile (/= chara) $ reverse pa++--+-- drop suffix+--+dropSuffix :: FilePath -> FilePath+dropSuffix f = reverse . tail . dropWhile (/= '.') $ reverse f++--+-- | work out the mod name from a filepath+mkModid :: String -> String+mkModid = (takeWhile (/= '.')) . reverse . (takeWhile (\x -> ('/'/= x) && ('\\' /= x))) . reverse+++-----------------------------------------------------------+-- Code from Cabal ----------------------------------------++-- | Changes the extension of a file path.+changeFileExt :: FilePath           -- ^ The path information to modify.+              -> String             -- ^ The new extension (without a leading period).+                                    -- Specify an empty string to remove an existing+                                    -- extension from path.+              -> FilePath           -- ^ A string containing the modified path information.+changeFileExt fpath ext = joinFileExt name ext+  where+    (name,_) = splitFileExt fpath++-- | The 'joinFileExt' function is the opposite of 'splitFileExt'.+-- It joins a file name and an extension to form a complete file path.+--+-- The general rule is:+--+-- > filename `joinFileExt` ext == path+-- >   where+-- >     (filename,ext) = splitFileExt path+joinFileExt :: String -> String -> FilePath+joinFileExt fpath ""  = fpath+joinFileExt fpath ext = fpath ++ '.':ext++-- | Split the path into file name and extension. If the file doesn\'t have extension,+-- the function will return empty string. The extension doesn\'t include a leading period.+--+-- Examples:+--+-- > splitFileExt "foo.ext" == ("foo", "ext")+-- > splitFileExt "foo"     == ("foo", "")+-- > splitFileExt "."       == (".",   "")+-- > splitFileExt ".."      == ("..",  "")+-- > splitFileExt "foo.bar."== ("foo.bar.", "")+splitFileExt :: FilePath -> (String, String)+splitFileExt p =+  case break (== '.') fname of+        (suf@(_:_),_:pre) -> (reverse (pre++fpath), reverse suf)+        _                 -> (p, [])+  where+    (fname,fpath) = break isPathSeparator (reverse p)++-- | Checks whether the character is a valid path separator for the host+-- platform. The valid character is a 'pathSeparator' but since the Windows+-- operating system also accepts a slash (\"\/\") since DOS 2, the function+-- checks for it on this platform, too.+isPathSeparator :: Char -> Bool+isPathSeparator ch =+#if defined(CYGWIN) || defined(__MINGW32__)+  ch == '/' || ch == '\\'+#else+  ch == '/'+#endif++-- Code from Cabal end ------------------------------------+-----------------------------------------------------------+++-- | return the object file, given the .conf file+-- i.e. /home/dons/foo.rc -> /home/dons/foo.o+--+-- we depend on the suffix we are given having a lead '.'+--+replaceSuffix :: FilePath -> String -> FilePath+replaceSuffix [] _ = [] -- ?+replaceSuffix f suf = +    case reverse $ dropWhile (/= '.') $ reverse f of+        [] -> f  ++ suf                 -- no '.' in file name+        f' -> f' ++ tail suf++--+-- Normally we create the .hi and .o files next to the .hs files.+-- For some uses this is annoying (i.e. true EDSL users don't actually+-- want to know that their code is compiled at all), and for hmake-like+-- applications. +--+-- This code checks if "-o foo" or "-odir foodir" are supplied as args+-- to make(), and if so returns a modified file path, otherwise it+-- uses the source file to determing the path to where the object and+-- .hi file will be put.+--+outFilePath :: FilePath -> [Arg] -> (FilePath,FilePath)+outFilePath src args =+    let objs  = find_o args -- user sets explicit object path+        paths = find_p args -- user sets a directory to put stuff in+    in case () of { _+        | not (null objs)+        -> let obj = last objs in (obj, mk_hi obj)++        | not (null paths)+        -> let obj = last paths </> mk_o (basename src) in (obj, mk_hi obj)++        | otherwise+        -> (mk_o src, mk_hi src)+    }+    where +          outpath = "-o"+          outdir  = "-odir"++          mk_hi s = replaceSuffix s hiSuf+          mk_o  s = replaceSuffix s objSuf++          find_o [] = []+          find_o (f:f':fs) | f == outpath = [f']+                           | otherwise    = find_o $! f':fs+          find_o _ = []++          find_p [] = []+          find_p (f:f':fs) | f == outdir  = [f']+                           | otherwise    = find_p $! f':fs+          find_p _ = []++------------------------------------------------------------------------++--+-- | is file1 newer than file2?+--+-- needs some fixing to work with 6.0.x series. (is this true?)+--+-- fileExist still seems to throw exceptions on some platforms: ia64 in+-- particular.+--+-- invarient : we already assume the first file, 'a', exists+--+newer :: FilePath -> FilePath -> IO Bool+newer a b = do+    a_t      <- getModificationTime a+    b_exists <- doesFileExist b+    if not b_exists+        then return True                -- needs compiling+        else do b_t <- getModificationTime b+                return ( a_t > b_t )    -- maybe need recompiling++------------------------------------------------------------------------+--+-- | return the Z-Encoding of the string.+--+-- Stolen from GHC. Use -package ghc as soon as possible+--+type EncodedString = String++encode :: String -> EncodedString+encode []     = []+encode (c:cs) = encode_ch c ++ encode cs++unencodedChar :: Char -> Bool   -- True for chars that don't need encoding+unencodedChar 'Z' = False+unencodedChar 'z' = False+unencodedChar c   =  c >= 'a' && c <= 'z'+                  || c >= 'A' && c <= 'Z'+                  || c >= '0' && c <= '9'++--+-- Decode is used for user printing.+--+decode :: EncodedString -> String+decode [] = []+decode ('Z' : d : rest) | isDigit d = decode_tuple   d rest+                        | otherwise = decode_upper   d : decode rest+decode ('z' : d : rest) | isDigit d = decode_num_esc d rest+                        | otherwise = decode_lower   d : decode rest+decode (c  : rest) = c : decode rest++decode_upper, decode_lower :: Char -> Char++decode_upper 'L' = '('+decode_upper 'R' = ')'+decode_upper 'M' = '['+decode_upper 'N' = ']'+decode_upper 'C' = ':'+decode_upper 'Z' = 'Z'+decode_upper ch  = error $ "decode_upper can't handle this char `"++[ch]++"'"+            +decode_lower 'z' = 'z'+decode_lower 'a' = '&'+decode_lower 'b' = '|'+decode_lower 'c' = '^'+decode_lower 'd' = '$'+decode_lower 'e' = '='+decode_lower 'g' = '>'+decode_lower 'h' = '#'+decode_lower 'i' = '.'+decode_lower 'l' = '<'+decode_lower 'm' = '-'+decode_lower 'n' = '!'+decode_lower 'p' = '+'+decode_lower 'q' = '\''+decode_lower 'r' = '\\'+decode_lower 's' = '/'+decode_lower 't' = '*'+decode_lower 'u' = '_'+decode_lower 'v' = '%'+decode_lower ch  = error $ "decode_lower can't handle this char `"++[ch]++"'"++-- Characters not having a specific code are coded as z224U+decode_num_esc :: Char -> [Char] -> String+decode_num_esc d cs+  = go (digitToInt d) cs+  where+    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest+    go n ('U' : rest)           = chr n : decode rest+    go _ other = error $+        "decode_num_esc can't handle this: \""++other++"\""+++encode_ch :: Char -> EncodedString+encode_ch c | unencodedChar c = [c]     -- Common case first++-- Constructors+encode_ch '('  = "ZL"   -- Needed for things like (,), and (->)+encode_ch ')'  = "ZR"   -- For symmetry with (+encode_ch '['  = "ZM"+encode_ch ']'  = "ZN"+encode_ch ':'  = "ZC"+encode_ch 'Z'  = "ZZ"++-- Variables+encode_ch 'z'  = "zz"+encode_ch '&'  = "za"+encode_ch '|'  = "zb"+encode_ch '^'  = "zc"+encode_ch '$'  = "zd"+encode_ch '='  = "ze"+encode_ch '>'  = "zg"+encode_ch '#'  = "zh"+encode_ch '.'  = "zi"+encode_ch '<'  = "zl"+encode_ch '-'  = "zm"+encode_ch '!'  = "zn"+encode_ch '+'  = "zp"+encode_ch '\'' = "zq"+encode_ch '\\' = "zr"+encode_ch '/'  = "zs"+encode_ch '*'  = "zt"+encode_ch '_'  = "zu"+encode_ch '%'  = "zv"+encode_ch c    = 'z' : shows (ord c) "U"++decode_tuple :: Char -> EncodedString -> String+decode_tuple d cs+  = go (digitToInt d) cs+  where+    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest+    go 0 ['T']          = "()"+    go n ['T']          = '(' : replicate (n-1) ',' ++ ")"+    go 1 ['H']          = "(# #)"+    go n ['H']          = '(' : '#' : replicate (n-1) ',' ++ "#)"+    go _ other = error $ "decode_tuple \'"++other++"'"++-- ---------------------------------------------------------------------++--+-- 'isSublistOf' takes two arguments and returns 'True' iff the first+-- list is a sublist of the second list. This means that the first list+-- is wholly contained within the second list. Both lists must be+-- finite.++isSublistOf :: Eq a => [a] -> [a] -> Bool+isSublistOf [] _ = True+isSublistOf _ [] = False+isSublistOf x y@(_:ys)+    | isPrefixOf x y = True+    | otherwise      = isSublistOf x ys+
+ testsuite/README view
@@ -0,0 +1,17 @@+These examples illustrate the various uses of hs-plugins.++conf		a configuration file edsl using plugins+dynload		dynamically typed load+eval		runtime evaluation of haskell strings, from Haskell and C+hmake		the 'plugs' haskell interpreter+iface		test the interface file parser+load		load a plugin+make		build a Haskell file+makewith	merge and build a Haskell file+multi		load multiple plugins at once+objc		load Haskell plugins into object C programs+pkgconf		test package.conf parsing+popen		test popen+reload		reload a plugin when it changes+shell		a simple string filter+unload		test unloading of plugins
+ testsuite/TIMINGS view
@@ -0,0 +1,45 @@+Method:+	* "pdynload" +		comes from pdynload/small+	* "load + ghc" +		comes from pdynload/null, with lines 13-14+		uncommented from prog/Main.hs+	* "dynload" +		from dynload/simple+	* "load, no check"+		from pdynload/null, with lines 13-14 of prog/Main.hs+		commented out++For example, to run the "pdynload" test:+	$ cd pdynload/small+	$ make+	$ make check	  # to prime caches, etc.+	$ time make check+	$ time make check+	$ time make check # run 'time make check' until value converges++The converged value is entered into the "Raw" timings, and then the+scaled timing is calculated for each machine. These scaled values were+then averaged over the number of machines, yielding the final+"Average" scores -- the average over a number of machines and os.++Raw timing:+pdynload 	load+ghc	dynload		load, no check++0.33		0.25		0.22		0.21	-- P4 2.6 ,  OpenBSD+0.38		0.31		0.29		0.27	-- P4 2.66,  Linux+0.84		0.77		0.64		0.55	-- Quad P4 2.4, Linux+0.76		0.60		0.52		0.50	-- AMD 1.1G, Linux+0.95            0.83            0.75            0.72    -- G5 2.0G,  Mac OS X+							-- Quad Itanium 1,Linux++Scaled:+1.57		1.19		1.05		1+1.40		1.15		1.07+1.52		1.4		1.16+1.52		1.2		1.04+1.32            1.15            1.04++Average:+=1.46         =	1.218	      = 1.07+					
+ testsuite/build.mk view
@@ -0,0 +1,40 @@+# how to build the default projects++include $(TOP)/config.mk+include $(TOP)/testsuite/check.mk++BIN= 		prog/a.out+OBJ=		prog/Main.o+SRC=		prog/Main.hs++BINDIR=		prog+REALBIN=	./a.out++API_OBJ=	api/API.o++INCLUDES=   	-i$(TOP)/testsuite/$(TEST)/api+GHCFLAGS=   	-Onot -cpp -fglasgow-exts++.SUFFIXES : .o .hs .hi .lhs .hc .s++all: $(BIN)++$(BIN) : $(PRIOR_OBJS) $(API_OBJ) $(SRC) $(EXTRA_OBJS)+	@rm -f $@+	@$(GHC) --make -o $@ $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) $(API) $(SRC)++# Standard suffix rules+.o.hi:+	@:+.hs.o:+	@$(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $<++clean:+	find . -name '*~' -exec rm {} \;+	rm -rf *.{o,hi,dep}+	rm -rf */*.{hi,o,old} */a.out+	rm -rf */*core+	rm -rf */*.a+	rm -rf */package.conf+	rm -rf *.a+
+ testsuite/check.mk view
@@ -0,0 +1,24 @@+include $(TOP)/config.mk++check: $(BIN)+	@(cd $(BINDIR) ;\+	  expected="expected" ;\+          if [ -f "expected" -o -f "expected.$(GLASGOW_HASKELL)" ] ;\+	  then \+		actual_out="/tmp/hs-plugins-actual.out.$$$$"	   ;\+		diff_out="/tmp/hs-plugins.diff.$$$$"		   ;\+		$(REALBIN) > $$actual_out  2>&1         || true ;\+		if [ -f "expected.$(GLASGOW_HASKELL)" ] ; then \+			expected="expected.$(GLASGOW_HASKELL)" ;\+		fi ;\+		diff -u $$expected $$actual_out > $$diff_out || true ;\+		if [ -s "$$diff_out" ] ; then \+			echo "failed with:"	;\+			cat "$$diff_out" | sed '1,3d' ;\+		else \+			echo "ok." 	;\+		fi ;\+		rm $$actual_out $$diff_out	;\+	 else \+		$(REALBIN) 2>&1 || true ;\+	 fi)
+ testsuite/conf/simple/Mailrc.conf view
@@ -0,0 +1,11 @@+import System.Directory++resource = mail { +--	editor = do b <- doesFileExist "/usr/bin/emacs"+--		    return $ if b then "emacs" else "vi" ,+	editor = do b <- doesFileExist "/bin/sh"+  		    return "sh",++	attribution = \name -> "Today, "++name++" wrote :"+}+
+ testsuite/conf/simple/Mailrc.stub view
@@ -0,0 +1,28 @@+module Mailrc ( resource )  where++import API++resource :: Interface+resource = mail++++++++++++++++++++++
+ testsuite/conf/simple/Makefile view
@@ -0,0 +1,4 @@+TEST=	conf/simple++TOP=../../..+include ../../build.mk
+ testsuite/conf/simple/api/API.hs view
@@ -0,0 +1,27 @@+--+-- the configuration file interface.+--++module API where++data Color = Black | Grey | Green | Cyan | Yellow | Magenta | Red++data Interface = Interface {+        editor          :: IO String,+        attribution     :: String -> String,+        header_color    :: Color,+        colorize        :: [String],+        include         :: Bool+     }++-- Default settings+mail :: Interface+mail = Interface { +        editor = return "vi",++        attribution = (\user -> user ++ " wrote:"),+        header_color = Grey,+        colorize = [],+        include = True+     }+
+ testsuite/conf/simple/prog/Main.hs view
@@ -0,0 +1,22 @@++import System.Plugins+import API++conf    = "../Mailrc.conf"+stub    = "../Mailrc.stub"+apipath = "../api"++main = do+        status <- makeWith conf stub ["-i"++apipath]+        o <- case status of+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"+                MakeSuccess _ o -> return o+        status <- load o [apipath] [] "resource"+        v <- case status of+                LoadFailure err   -> mapM_ putStrLn err >> error "no"+                LoadSuccess _ v -> return v+        +        user_editor <- editor v+        putStrLn user_editor+        makeCleaner o+
+ testsuite/conf/simple/prog/expected view
@@ -0,0 +1,1 @@+sh
+ testsuite/dynload/io/Makefile view
@@ -0,0 +1,6 @@+TEST=dynload/io++EXTRA_OBJS=TestIO.o++TOP=../../..+include ../../build.mk
+ testsuite/dynload/io/TestIO.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS -fglasgow-exts -cpp #-}+--+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)+--++module TestIO ( resource_dyn )  where++import API+import AltData.Dynamic++import System.IO+import System.Posix.Types   ( ProcessID, Fd )+import System.Posix.Process ( forkProcess, executeFile, getProcessID )+import System.Posix.IO      ( createPipe, stdInput, +                              stdOutput, fdToHandle, closeFd, dupTo )++resource_dyn :: Dynamic+resource_dyn = toDyn resource++resource :: TestIO+resource = testio { field = date }+++--+-- call a shell command , returning it's output+--+date :: IO String+date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed")+          hGetLine hdl ++------------------------------------------------------------------------+--+-- my implementation of $val = `cmd`; (if this was perl)+--+-- provide similar functionality to popen(3), +-- along with bidirectional ipc via pipes+-- return's the pid of the child process+--+-- there are two different forkProcess functions. the pre-620 was a+-- unix-fork style function, and the modern function has semantics more+-- like the Awkward-Squad paper. We provide implementations of popen+-- using both versions, depending on which GHC the user wants to try.+-- ++popen :: FilePath -> IO (Handle, Handle, ProcessID)+popen cmd = do+        (pr, pw) <- createPipe+        (cr, cw) <- createPipe    ++        -- parent --+        let parent = do closeFd cw+                        closeFd pr+        -- child --+        let child  = do closeFd pw+                        closeFd cr +                        exec cmd (pr,cw)+                        error "exec cmd failed!" -- typing only++-- if the parser front end understood cpp, this would work+-- #if __GLASGOW_HASKELL__ >= 601+        pid <- forkProcess child -- fork child+        parent                   -- and run parent code+-- #else+--          p   <- forkProcess+--          pid <- case p of+--                  Just pid -> parent >> return pid+--                  Nothing  -> child+-- #endif++        hcr <- fdToHandle cr+        hpw <- fdToHandle pw++        return (hcr,hpw,pid)++--+-- execve cmd in the child process, dup'ing the file descriptors passed+-- as arguments to become the child's stdin and stdout.+--+exec :: FilePath -> (Fd,Fd) -> IO ()+exec cmd (pr,cw) = do+        dupTo pr stdInput+        dupTo cw stdOutput+        executeFile cmd False [] Nothing++------------------------------------------------------------------------
+ testsuite/dynload/io/api/API.hs view
@@ -0,0 +1,19 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import AltData.Typeable++data TestIO = TestIO { +                field :: IO String +        }++instance Typeable TestIO where+#if __GLASGOW_HASKELL__ >= 603+    typeOf i = mkTyConApp (mkTyCon "API.TestIO") []+#else+    typeOf i = mkAppTy (mkTyCon "API.TestIO") []+#endif++testio :: TestIO+testio = TestIO { field = return "default value" }
+ testsuite/dynload/io/prog/Main.hs view
@@ -0,0 +1,12 @@++import System.Plugins+import API++main = do+        m_v   <- dynload "../TestIO.o" ["../api"] +                                       [] "resource_dyn"+        case m_v of+                LoadFailure _   -> error "couldn't compile"+                LoadSuccess _ v -> do +                        s <- field v+                        if s /= [] then print True else print False
+ testsuite/dynload/io/prog/expected view
@@ -0,0 +1,1 @@+True
+ testsuite/dynload/poly/Makefile view
@@ -0,0 +1,4 @@+TEST=dynload/poly+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/dynload/poly/Plugin.hs view
@@ -0,0 +1,12 @@+module Plugin where++import API+import AltData.Dynamic++my_fun = plugin { +                equals = \x y -> (x /= y)  -- a strange equals function :)+         }++resource_dyn :: Dynamic+resource_dyn = toDyn my_fun+
+ testsuite/dynload/poly/api/API.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS -cpp #-}++module API where++import AltData.Typeable++data Interface = Interface { +        equals :: forall t. Eq t => t -> t -> Bool+     }++--+-- see how it hides the internal type.. but to compile GHC still checks+-- the type.+--+instance Typeable Interface where+#if __GLASGOW_HASKELL__ >= 603+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []+#else+    typeOf i = mkAppTy (mkTyCon "API.Interface") []+#endif++plugin :: Interface+plugin = Interface  { equals = (==) }+
+ testsuite/dynload/poly/prog/Main.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS -cpp #-}++#include "../../../../config.h"++import System.Plugins+import API++main = do +        m_v <- dynload "../Plugin.o" ["../api"]+                                     [] +                                     "resource_dyn"+        case m_v of+                LoadFailure _ -> error "didn't compile"+                LoadSuccess _ (Interface eq) -> do+                                 putStrLn $ show $   1 `eq` 2+                                 putStrLn $ show $ 'a' `eq` 'b'+
+ testsuite/dynload/poly/prog/expected view
@@ -0,0 +1,2 @@+True+True
+ testsuite/dynload/should_fail/Makefile view
@@ -0,0 +1,4 @@+TEST=   dynload/should_fail+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/dynload/should_fail/Plugin.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}+module Plugin where++import API+import AltData.Dynamic++v :: Int+v = 0xdeadbeef++resource_dyn :: Dynamic+resource_dyn = toDyn v+
+ testsuite/dynload/should_fail/api/API.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import AltData.Typeable++data Interface = Interface { +        function :: String+   }++instance Typeable Interface where+#if __GLASGOW_HASKELL__ >= 603+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []+#else+    typeOf i = mkAppTy (mkTyCon "API.Interface") []+#endif++plugin :: Interface+plugin = Interface  { function = "goodbye" }+
+ testsuite/dynload/should_fail/prog/Main.hs view
@@ -0,0 +1,14 @@++import System.Plugins+import API++main = do +    m_v   <- dynload "../Plugin.o" +                     ["../api"] +                     [] +                     "resource_dyn"++    case m_v of+        LoadFailure _    -> putStrLn "didn't compile"+        LoadSuccess _ v  -> putStrLn $ function v+
+ testsuite/dynload/should_fail/prog/expected view
@@ -0,0 +1,4 @@+Couldn't match `API.Interface' against `Int'+	Expected type: API.Interface+	Inferred type: Int+didn't compile
+ testsuite/dynload/should_fail_1/Makefile view
@@ -0,0 +1,4 @@+TEST=   dynload/should_fail_1+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/dynload/should_fail_1/Plugin.hs view
@@ -0,0 +1,15 @@+--+-- trying to be really mean.+--++module Plugin where++import API+import AltData.Dynamic++v :: Int -> Int+v = \x -> 0xdeadbeef++resource_dyn :: Dynamic+resource_dyn = toDyn v+
+ testsuite/dynload/should_fail_1/api/API.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import AltData.Typeable++data Interface = Interface { +        function :: String+   }++instance Typeable Interface where+#if __GLASGOW_HASKELL__ >= 603+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []+#else+    typeOf i = mkAppTy (mkTyCon "API.Interface") []+#endif++plugin :: Interface+plugin = Interface  { function = "goodbye" }+
+ testsuite/dynload/should_fail_1/prog/Main.hs view
@@ -0,0 +1,11 @@++import System.Plugins+import API++main = do +    m_v   <- dynload "../Plugin.o" ["../api"] +                                   [] "resource_dyn"+    case m_v of+        LoadFailure _   -> putStrLn "didn't compile"+        LoadSuccess _ v -> putStrLn $ (function v)+
+ testsuite/dynload/should_fail_1/prog/expected view
@@ -0,0 +1,4 @@+Couldn't match `API.Interface' against `Int -> Int'+	Expected type: API.Interface+	Inferred type: Int -> Int+didn't compile
+ testsuite/dynload/should_fail_2/Makefile view
@@ -0,0 +1,4 @@+TEST=		dynload/should_fail_2++TOP=../../..+include ../../build.mk
+ testsuite/dynload/should_fail_2/Plugin.in view
@@ -0,0 +1,19 @@+--+-- the plugin doesn't even make the resource_dyn a Dynamic.+--+-- let's hope that makeWith strips out the invalid declarations+--++{-# OPTIONS -fglasgow-exts #-}++module Plugin where++import API+import AltData.Typeable+import GHC.Base++v :: Int+v = 0xdeadbeef++resource_dyn = (typeOf v, unsafeCoerce v)+
+ testsuite/dynload/should_fail_2/Plugin.stub view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module Plugin ( resource_dyn )  where++import API+import AltData.Dynamic++resource = plugin++resource_dyn :: Dynamic+resource_dyn = toDyn resource+
+ testsuite/dynload/should_fail_2/api/API.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import AltData.Typeable+import GHC.Base++data Interface = Interface { +        function :: String+   }+        +instance Typeable Interface where+#if __GLASGOW_HASKELL__ >= 603+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []+#else+    typeOf i = mkAppTy (mkTyCon "API.Interface") []+#endif++plugin :: Interface+plugin = Interface  { function = "goodbye" }++unsafeCoerce = unsafeCoerce#
+ testsuite/dynload/should_fail_2/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+import API++conf    = "../Plugin.in"+stub    = "../Plugin.stub"++main = do +        status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata/"]+        case status of+         MakeFailure e   -> mapM_ putStrLn e >> putStrLn "failed"+         MakeSuccess _ o -> do {+              ; m_v <- dynload o ["../api"] [] "resource_dyn"+              ; makeCleaner o+              ; case m_v of+                        LoadFailure _   -> putStrLn "didn't load"+                        LoadSuccess _ v -> putStrLn $ (function v)+         }+
+ testsuite/dynload/should_fail_2/prog/expected view
@@ -0,0 +1,8 @@++../Plugin.in:18:+    Couldn't match `Dynamic' against `(t, t1)'+	Expected type: Dynamic+	Inferred type: (t, t1)+    In the definition of `resource_dyn':+	resource_dyn = (typeOf v, unsafeCoerce v)+failed
+ testsuite/dynload/should_fail_2/prog/expected.604 view
@@ -0,0 +1,7 @@++../Plugin.in:18:15:+    Couldn't match `Dynamic' against `(a, b)'+      Expected type: Dynamic+      Inferred type: (a, b)+    In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v)+failed
+ testsuite/dynload/should_fail_2/prog/expected.605 view
@@ -0,0 +1,7 @@++../Plugin.in:18:15:+    Couldn't match `Dynamic' against `(a, b)'+      Expected type: Dynamic+      Inferred type: (a, b)+    In the definition of `resource_dyn': resource_dyn = (typeOf v, unsafeCoerce v)+failed
+ testsuite/dynload/should_fail_3/Makefile view
@@ -0,0 +1,4 @@+TEST=		dynload/should_fail_3++TOP=../../..+include ../../build.mk
+ testsuite/dynload/should_fail_3/Plugin.in view
@@ -0,0 +1,19 @@+--+-- the plugin doesn't even make the resource_dyn a Dynamic.+-- let's hope that makeWith strips out the invalid declarations+--++{-# OPTIONS -fglasgow-exts #-}++module Plugin where++import API++import AltData.Typeable+import GHC.Base++v :: Int+v = 0xdeadbeef++resource_dyn = (typeOf plugin, unsafeCoerce v)+
+ testsuite/dynload/should_fail_3/Plugin.stub view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module Plugin ( resource_dyn )  where++import API+import AltData.Dynamic++resource = plugin++resource_dyn :: Dynamic+resource_dyn = toDyn resource+
+ testsuite/dynload/should_fail_3/api/API.hs view
@@ -0,0 +1,22 @@+{-# OPTIONS -cpp -fglasgow-exts #-}++module API where++import AltData.Typeable+import GHC.Base++data Interface = Interface { +        function :: String+   }++instance Typeable Interface where+#if __GLASGOW_HASKELL__ >= 603+    typeOf _ = mkTyConApp (mkTyCon "API.Interface") []+#else+    typeOf _ = mkAppTy (mkTyCon "API.Interface") []+#endif++plugin :: Interface+plugin = Interface  { function = "goodbye" }++unsafeCoerce = unsafeCoerce#
+ testsuite/dynload/should_fail_3/prog/Main.hs view
@@ -0,0 +1,18 @@++import System.Plugins+import API++conf    = "../Plugin.in"+stub    = "../Plugin.stub"++main = do +        status <- makeWith conf stub ["-i../api", "-i../../../../src/altdata"]+        o <- case status of+                MakeFailure e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess _ o -> return o+        m_v <- dynload o ["../api"] [] "resource_dyn"+        case m_v of+                LoadFailure _   -> error "didn't compile"+                LoadSuccess _ v -> do putStrLn $ (function v)+                                      makeCleaner o+
+ testsuite/dynload/should_fail_3/prog/expected view
@@ -0,0 +1,9 @@++../Plugin.in:18:+    Couldn't match `Dynamic' against `(t, t1)'+	Expected type: Dynamic+	Inferred type: (t, t1)+    In the definition of `resource_dyn':+	resource_dyn = (typeOf plugin, unsafeCoerce v)++Fail: failed
+ testsuite/dynload/should_fail_3/prog/expected.604 view
@@ -0,0 +1,8 @@++../Plugin.in:18:15:+    Couldn't match `Dynamic' against `(a, b)'+      Expected type: Dynamic+      Inferred type: (a, b)+    In the definition of `resource_dyn':+	resource_dyn = (typeOf plugin, unsafeCoerce v)+a.out: failed
+ testsuite/dynload/should_fail_3/prog/expected.605 view
@@ -0,0 +1,8 @@++../Plugin.in:18:15:+    Couldn't match `Dynamic' against `(a, b)'+      Expected type: Dynamic+      Inferred type: (a, b)+    In the definition of `resource_dyn':+	resource_dyn = (typeOf plugin, unsafeCoerce v)+a.out: failed
+ testsuite/dynload/simple/Makefile view
@@ -0,0 +1,4 @@+TEST=dynload/simple+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/dynload/simple/Plugin.hs view
@@ -0,0 +1,11 @@+{-# OPTIONS -fglasgow-exts #-}+module Plugin where++import API+import AltData.Dynamic++my_fun = plugin { function = "plugin says \"hello\"" }++resource_dyn :: Dynamic+resource_dyn = toDyn my_fun+
+ testsuite/dynload/simple/api/API.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS -cpp #-}++module API where++import AltData.Typeable++data Interface = Interface { +        function :: String+   }++instance Typeable Interface where+#if __GLASGOW_HASKELL__ >= 603+    typeOf i = mkTyConApp (mkTyCon "API.Interface") []+#else+    typeOf i = mkAppTy (mkTyCon "API.Interface") []+#endif++plugin :: Interface+plugin = Interface  { function = "goodbye" }+
+ testsuite/dynload/simple/prog/Main.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS -cpp #-}++#include "../../../../config.h"++import System.Plugins+import API++main = do +        m_v <- dynload "../Plugin.o" ["../api"]+                                     []+                                     "resource_dyn"+        case m_v of+                LoadFailure _   -> error "didn't compile"+                LoadSuccess _ v -> putStrLn $ (function v)+
+ testsuite/dynload/simple/prog/expected view
@@ -0,0 +1,1 @@+plugin says "hello"
+ testsuite/eval.mk view
@@ -0,0 +1,25 @@+include $(TOP)/config.mk+include $(TOP)/testsuite/check.mk++BIN=a.out+SRC=Main.hs++BINDIR=		"."+REALBIN=	./$(BIN)++.SUFFIXES : .o .hs .hi .lhs .hc .s++all: $(BIN)++$(BIN): $(SRC) $(OBJS)+	@rm -f $@+	@$(GHC) --make -fglasgow-exts $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) $(SRC)++# Standard suffix rules+.o.hi:+	@:+.hs.o:+	@$(GHC) $(INCLUDES) $(PKGFLAGS) $(GHCFLAGS) $(EXTRAFLAGS) -c $<++clean: +	@rm -rf *.hi *.o *~ $(BIN)
+ testsuite/eval/eval1/Main.hs view
@@ -0,0 +1,5 @@++import System.Eval.Haskell++main = do i <- eval "1 + 6 :: Int" [] :: IO (Maybe Int)+          if isJust i then putStrLn $ show (fromJust i) else return ()
+ testsuite/eval/eval1/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/eval1/expected view
@@ -0,0 +1,1 @@+7
+ testsuite/eval/eval2/Main.hs view
@@ -0,0 +1,6 @@+import System.Eval.Haskell++main = do m_s <- eval "map toUpper \"haskell\"" ["Data.Char"]+          case m_s of+                Nothing -> putStrLn "typechecking failed"+                Just s  -> putStrLn s
+ testsuite/eval/eval2/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/eval2/expected view
@@ -0,0 +1,1 @@+HASKELL
+ testsuite/eval/eval3/Main.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS -cpp #-}+--+-- Should evaluate to '3', unless something goes wrong.+--+-- Not so bad to use AltData, as it is already derived for all the basic+-- types. Then, just replace deriving Typeable, with hand-derived+-- instance of Typeable (see hs-plugins/testsuite/eval/eval_fn1/Poly.hs+--+--++#include "../../../config.h"++import System.Eval+import AltData.Dynamic++main = do+    a <- return $ toDyn (3::Integer)++    -- so, we try to compile a function that takes a dyn.+    -- looks like with GHC 6.4, we need to make sure the package.confs work:+    m_b <- unsafeEval_ "\\dyn -> fromDyn dyn (7 :: Integer)"+                ["AltData.Dynamic"]+                [ ]+                [ ]+                []++    case m_b of +        Left s   -> mapM_ putStrLn s+        Right b  -> putStrLn $ show (b a :: Integer) -- now apply it+                +{-+-- should work, but doesn't. type check fails +-- (due to static vs dynamic typing issue)++     m_b <- unsafeEval_ "\\dyn -> fromMaybe (7 :: Int) (fromDynamic dyn)"+                                ["Data.Dynamic","Data.Maybe"] [] []+-}+
+ testsuite/eval/eval3/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/eval3/expected view
@@ -0,0 +1,1 @@+3
+ testsuite/eval/eval_/Main.hs view
@@ -0,0 +1,9 @@++import System.Eval.Haskell++main = do i <- eval_ "Just (7 :: Int)" +                     ["Maybe"] +                     ["-fglasgow-exts"] +                     []+                     [] :: IO (Either [String] (Maybe (Maybe Int)))+          print i
+ testsuite/eval/eval_/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/eval_/expected view
@@ -0,0 +1,1 @@+Right (Just (Just 7))
+ testsuite/eval/eval_fn/Main.hs view
@@ -0,0 +1,10 @@+--+-- lambda abstraction!+--+--+-- needs unsafeEval because eval has a broken Dynamic check+--+import System.Eval.Haskell++main = do fn <- unsafeEval "(\\x -> (x,x::Int))" [] :: IO (Maybe (Int -> (Int,Int)))+          when (isJust fn) $ putStrLn $ show $ (fromJust fn) 7
+ testsuite/eval/eval_fn/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/eval_fn/expected view
@@ -0,0 +1,1 @@+(7,7)
+ testsuite/eval/eval_fn1/Main.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS -fglasgow-exts #-}+--+-- polymorphic eval!+--++module Main where++import Poly+import System.Eval.Haskell++main = do m_f <- eval "Fn (\\x y -> x == y)" ["Poly"]+          when (isJust m_f) $ do+                let (Fn f) = fromJust m_f+                putStrLn $ show (f True True)+                putStrLn $ show (f 1 2)
+ testsuite/eval/eval_fn1/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/eval_fn1/Poly.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS -cpp -fglasgow-exts #-} +module Poly where++import AltData.Typeable++data Fn = Fn {fn :: forall t. Eq t => t -> t -> Bool}++--+-- ignore type inside the Fn... is this correct?+--+instance Typeable Fn where+#if __GLASGOW_HASKELL__ >= 603+    typeOf _ = mkTyConApp (mkTyCon "Poly.Fn") []+#else+    typeOf _ = mkAppTy (mkTyCon "Poly.Fn") []+#endif
+ testsuite/eval/eval_fn1/expected view
@@ -0,0 +1,2 @@+True+False
+ testsuite/eval/foreign_eval/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../foreign.mk
+ testsuite/eval/foreign_eval/README view
@@ -0,0 +1,1 @@+run a string of Haskell code from a C program.
+ testsuite/eval/foreign_eval/dont_test view
+ testsuite/eval/foreign_eval/expected view
@@ -0,0 +1,1 @@+10946
+ testsuite/eval/foreign_eval/main.c view
@@ -0,0 +1,16 @@+#include <stdio.h>++#include "EvalHaskell.h"++int main(int argc, char *argv[])+{+  int *p;+  hs_init(&argc, &argv);+  p = hs_eval_i("let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20 :: Int");+  if (p == NULL)+	  printf("failed!\n");+  else+	  printf("%d\n",*p);+  hs_exit();+  return 0;+}
+ testsuite/eval/foreign_eval1/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../foreign.mk
+ testsuite/eval/foreign_eval1/dont_test view
+ testsuite/eval/foreign_eval1/expected view
@@ -0,0 +1,1 @@+10946
+ testsuite/eval/foreign_eval1/main.c view
@@ -0,0 +1,16 @@+#include <stdio.h>++#include "EvalHaskell.h"++int main(int argc, char *argv[])+{+  char *p;+  hs_init(&argc, &argv);+  p = hs_eval_s("show $ let fibs = 1:1:zipWith (+) fibs (tail fibs) in fibs !! 20");+  if (p == NULL)+  	  printf("failed!\n");+  else+	  printf("%s\n",p);+  hs_exit();+  return 0;+}
+ testsuite/eval/foreign_should_fail/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../foreign.mk
+ testsuite/eval/foreign_should_fail/dont_test view
+ testsuite/eval/foreign_should_fail/expected view
@@ -0,0 +1,2 @@+<eval>:1: parse error on input `in'+failed!
+ testsuite/eval/foreign_should_fail/expected.604 view
@@ -0,0 +1,1 @@+failed!
+ testsuite/eval/foreign_should_fail/expected.605 view
@@ -0,0 +1,1 @@+failed!
+ testsuite/eval/foreign_should_fail/main.c view
@@ -0,0 +1,16 @@+#include <stdio.h>++#include "EvalHaskell.h"++int main(int argc, char *argv[])+{+  int *p;+  hs_init(&argc, &argv);+  p = hs_eval_i("show $ case 1 + 2 in{-wrong-} x -> x");+  if (p == NULL)+	  printf("failed!\n");+  else+	  printf("%d\n",*p);+  hs_exit();+  return 0;+}
+ testsuite/eval/foreign_should_fail_illtyped/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../foreign.mk
+ testsuite/eval/foreign_should_fail_illtyped/dont_test view
+ testsuite/eval/foreign_should_fail_illtyped/expected view
@@ -0,0 +1,4 @@+Couldn't match `Int' against `[Char]'+	Expected type: Int+	Inferred type: [Char]+failed!
+ testsuite/eval/foreign_should_fail_illtyped/expected.604 view
@@ -0,0 +1,1 @@+failed!
+ testsuite/eval/foreign_should_fail_illtyped/expected.605 view
@@ -0,0 +1,1 @@+failed!
+ testsuite/eval/foreign_should_fail_illtyped/main.c view
@@ -0,0 +1,16 @@+#include <stdio.h>++#include "EvalHaskell.h"++int main(int argc, char *argv[])+{+  int *p;+  hs_init(&argc, &argv);+  p = hs_eval_i("\"an ill-typed string\"");+  if (p == NULL)+	  printf("failed!\n");+  else+	  printf("%d\n",*p);+  hs_exit();+  return 0;+}
+ testsuite/eval/unsafeidir/Main.hs view
@@ -0,0 +1,16 @@++import System.Plugins.Make+import System.Eval.Haskell++main = do make "a/Extra.hs" []+        +          i <- unsafeEval_ "show (Just (1 + 6 :: Int)) ++ extra" +                        ["Data.Maybe", "Extra"] +                        ["-ia"]      -- no make flags+                        []           -- no package.confs+                        ["a"]        -- include paths to load from+                        :: IO (Either [String] String)+               +          case i of+                Right i -> putStrLn $ show i+                Left es -> mapM_ putStrLn es
+ testsuite/eval/unsafeidir/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/eval/unsafeidir/a/Extra.hs view
@@ -0,0 +1,3 @@+module Extra where++extra = "an extra value"
+ testsuite/eval/unsafeidir/expected view
@@ -0,0 +1,1 @@+"Just 7an extra value"
+ testsuite/foreign.mk view
@@ -0,0 +1,22 @@+include $(TOP)/config.mk+include $(TOP)/testsuite/check.mk+++INCLUDES=   -I$(TOP)++# compile with GHC to save us setting all the necessary include and+# lib flags. use ghc -v to find out what these are if you wish to go+# via gcc.+BIN=./a.out+SRC=main.c++BINDIR=		"."+REALBIN=	$(BIN)++all:  $(BIN)++$(BIN): $(SRC)+	$(GHC) -package plugins $(INCLUDES) $(PKGFLAGS) $(SRC)++clean: +	rm -rf *.hi *.o *~ $(BIN)
+ testsuite/hier/hier1/Makefile view
@@ -0,0 +1,8 @@+TEST=   hier/hier1++EXTRA_OBJS=Plugin.o+PRIOR_OBJS=Modules/Flags.o+EXTRAFLAGS=++TOP=../../..+include ../../build.mk
+ testsuite/hier/hier1/Modules/Flags.hs view
@@ -0,0 +1,15 @@+--+-- A simple module+--++module Modules.Flags where+++data FlagRec = FlagRec {+        f1 :: Int,+        f2 :: Int+}+++foo :: FlagRec -> Int+foo x = f1 x
+ testsuite/hier/hier1/Modules/Makefile view
@@ -0,0 +1,6 @@++all:+	ghc -O -c Flags.hs++clean:+	rm -f *.hi *.o
+ testsuite/hier/hier1/Plugin.hs view
@@ -0,0 +1,14 @@+--+-- Plugin+--++module Plugin where++import API+import Modules.Flags as Flags+++resource = plugin {+        dbFunc = (\x -> Flags.f1 x)+}+
+ testsuite/hier/hier1/api/API.hs view
@@ -0,0 +1,16 @@+--+-- API for plugin test+--++module API where++import Modules.Flags as Flags++data Interface = Interface {+        dbFunc :: Flags.FlagRec -> Int+}+++plugin :: Interface+plugin = Interface { dbFunc = (\x -> 1) }+
+ testsuite/hier/hier1/prog/Main.hs view
@@ -0,0 +1,21 @@+--+-- Test multiple plugins+--+++module Main where++import System.Plugins+import API+import Modules.Flags as Flags+++rec = Flags.FlagRec { Flags.f1 = 4, Flags.f2 = 10 }+++main = do+        status <- load "../Plugin.o" ["../api",".."] [] "resource"+        case status of+                LoadFailure _ -> error "load failed"+                LoadSuccess _ v -> do let func = dbFunc v+                                      print (func rec)
+ testsuite/hier/hier1/prog/expected view
@@ -0,0 +1,1 @@+4
+ testsuite/hier/hier2/A/B/C/Module.hs view
@@ -0,0 +1,8 @@+--+-- A simple module+--++module A.B.C.Module where++symbol = "You found me"+
+ testsuite/hier/hier2/A/Makefile view
@@ -0,0 +1,7 @@++all:+	ghc -c B/C/Module.hs+++clean:+	rm -f B/C/*.hi B/C/*.o
+ testsuite/hier/hier2/Makefile view
@@ -0,0 +1,7 @@+TEST=   hier/hier2++PRIOR_OBJS=A/B/C/Module.o+EXTRAFLAGS=++TOP=../../..+include ../../build.mk
+ testsuite/hier/hier2/api/API.hs view
@@ -0,0 +1,4 @@+module API where++-- just a dummy for the build system+
+ testsuite/hier/hier2/prog/Main.hs view
@@ -0,0 +1,15 @@+--+-- Test if we can load a module with a hierarchical name from some weird+-- path. Tests our the module name handling in the .hi file parser.+--+++module Main where++import System.Plugins++main = do+        status <- load "../A/B/C/Module.o" [".."] [] "symbol"+        case status of+                LoadFailure ers -> mapM_ putStrLn ers+                LoadSuccess _ v -> print (v :: String)
+ testsuite/hier/hier2/prog/expected view
@@ -0,0 +1,1 @@+"You found me"
+ testsuite/hier/hier3/Main.hs view
@@ -0,0 +1,25 @@+module Main where++import System.Plugins++main = do++    makeAll "One.hs" []++    load2 "Two.o"++    load2 "./Two.o"         -- shouldn't load+    load2 "../hier3/Two.o"  -- shouldn't load+    load2 "././././Two.o"   -- shouldn't load++    -- and this one pulls in "../hier3/Two.o" as a dep+    y <- load "One.o" ["../hier3"] [] "resource"+    case y of+        LoadSuccess _ s -> putStrLn $ "One plugin: " ++ s+        LoadFailure _   -> putStrLn "Failure: y"++load2 f = do+    x <- load f [".", "../hier3", ""] [] "resource"   -- depend on One.o+    case x of+        LoadSuccess _ s -> putStrLn $ "Two plugin: " ++ s+        LoadFailure _   -> putStrLn "Failure: x"
+ testsuite/hier/hier3/Makefile view
@@ -0,0 +1,7 @@+TEST=   hier/hier3++EXTRA_OBJS=One.o Two.o+EXTRAFLAGS=++TOP=../../..+include ../../eval.mk
+ testsuite/hier/hier3/One.hs view
@@ -0,0 +1,7 @@++module One where++import qualified Two++resource = "This is the sub-plugin of (" ++ Two.resource ++ ")"+
+ testsuite/hier/hier3/Two.hs view
@@ -0,0 +1,4 @@+module Two where++resource = "This is the top plugin"+
+ testsuite/hier/hier3/expected view
@@ -0,0 +1,5 @@+Two plugin: This is the top plugin+Two plugin: This is the top plugin+Two plugin: This is the top plugin+Two plugin: This is the top plugin+One plugin: This is the sub-plugin of (This is the top plugin)
+ testsuite/hier/hier4/A.hs view
@@ -0,0 +1,11 @@++-- now, the question is: is it possible to not depend on a module or+-- package, but nonetheless have an orphan to it? this could cause+-- problems....++module A where++import B++u :: Int+u = undefined
+ testsuite/hier/hier4/B.hs view
@@ -0,0 +1,4 @@+module B where++import C () -- instances, to make available to those who use B+
+ testsuite/hier/hier4/C.hs view
@@ -0,0 +1,12 @@++-- try to construct an orphan module == an instance decl-only module,+-- that uses classes and types not defined in this module++module C (C) where++import D++instance C a => D (T a) where++class C a where+
+ testsuite/hier/hier4/D.hs view
@@ -0,0 +1,6 @@++module D where++class D a where++data T a = T
+ testsuite/hier/hier4/Main.hs view
@@ -0,0 +1,12 @@+module Main where++import System.Plugins++main = do++    makeAll "A.hs" []++    y <- load "A.o" ["."] [] "u"+    case y of+        LoadSuccess _ _ -> putStrLn $ "YES"+        LoadFailure e   -> mapM_ putStrLn e
+ testsuite/hier/hier4/Makefile view
@@ -0,0 +1,4 @@+TEST=   hier/hier4++TOP=../../..+include ../../eval.mk
+ testsuite/hier/hier4/expected view
@@ -0,0 +1,1 @@+YES
+ testsuite/iface/null/A.hs view
@@ -0,0 +1,1 @@+module A where
+ testsuite/iface/null/B.hs view
@@ -0,0 +1,1 @@+module B where
+ testsuite/iface/null/Main.hs view
@@ -0,0 +1,9 @@+module Main ( main ) where++import Language.Hi.Parser++import A+import B++main = do iface <- readIface "Main.hi"+          putStrLn (showIface iface)
+ testsuite/iface/null/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/iface/null/expected view
@@ -0,0 +1,5 @@+interface "Main" Main+module dependencies: A, B+package dependencies: base, haskell98, hi+import A+import B
+ testsuite/iface/null/expected.604 view
@@ -0,0 +1,5 @@+interface "unknown" Main+module dependencies: A, B+package dependencies: base-1.0, plugins-1.0+import B+import A
+ testsuite/iface/null/expected.605 view
@@ -0,0 +1,5 @@+interface "unknown" Main+module dependencies: A, B+package dependencies: base-1.0, plugins-1.0+import B+import A
+ testsuite/load/io/Makefile view
@@ -0,0 +1,6 @@+TEST= load/io++EXTRA_OBJS=TestIO.o++TOP=../../..+include ../../build.mk
+ testsuite/load/io/TestIO.hs view
@@ -0,0 +1,84 @@+{-# OPTIONS -cpp #-}+--+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)+--++module TestIO ( resource, resource_dyn )  where++import API+import Data.Dynamic++import System.IO+import System.Posix.Types   ( ProcessID, Fd )+import System.Posix.Process ( forkProcess, executeFile, getProcessID )+import System.Posix.IO      ( createPipe, stdInput, +                              stdOutput, fdToHandle, closeFd, dupTo )++resource = testio { field = date }++resource_dyn :: Dynamic+resource_dyn = toDyn resource++--+-- call a shell command , returning it's output+--+date :: IO String+date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed")+          hGetLine hdl ++------------------------------------------------------------------------+--+-- my implementation of $val = `cmd`; (if this was perl)+--+-- provide similar functionality to popen(3), +-- along with bidirectional ipc via pipes+-- return's the pid of the child process+--+-- there are two different forkProcess functions. the pre-620 was a+-- unix-fork style function, and the modern function has semantics more+-- like the Awkward-Squad paper. We provide implementations of popen+-- using both versions, depending on which GHC the user wants to try.+-- ++popen :: FilePath -> IO (Handle, Handle, ProcessID)+popen cmd = do+        (pr, pw) <- createPipe+        (cr, cw) <- createPipe    ++        -- parent --+        let parent = do closeFd cw+                        closeFd pr+        -- child --+        let child  = do closeFd pw+                        closeFd cr +                        exec cmd (pr,cw)+                        error "exec cmd failed!" -- typing only++-- if the parser front end understood cpp, this would work+-- #if __GLASGOW_HASKELL__ >= 601+        pid <- forkProcess child -- fork child+        parent                   -- and run parent code+-- #else+--          p   <- forkProcess+--          pid <- case p of+--                  Just pid -> parent >> return pid+--                  Nothing  -> child+-- #endif++        hcr <- fdToHandle cr+        hpw <- fdToHandle pw++        return (hcr,hpw,pid)++--+-- execve cmd in the child process, dup'ing the file descriptors passed+-- as arguments to become the child's stdin and stdout.+--+exec :: FilePath -> (Fd,Fd) -> IO ()+exec cmd (pr,cw) = do+        dupTo pr stdInput+        dupTo cw stdOutput+        executeFile cmd False [] Nothing++------------------------------------------------------------------------
+ testsuite/load/io/api/API.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data TestIO = TestIO { +                field :: IO String +        }+   deriving (Typeable, Show)++instance Show (IO String) where+    show _ = "<<io action>>"++testio :: TestIO+testio = TestIO { field = return "default value" }
+ testsuite/load/io/prog/Main.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS -cpp #-}++#include "../../../../config.h"++import System.Plugins+import API++main :: IO ()+main = do+        m_v <- load "../TestIO.o" ["../api"] [] "resource"+        v <- case m_v of+                LoadFailure _   -> error "load failed"+                LoadSuccess _ v -> return v+        s <- field v+        if null s then print False else print True
+ testsuite/load/io/prog/expected view
@@ -0,0 +1,1 @@+True
+ testsuite/load/load_0/Makefile view
@@ -0,0 +1,6 @@+TEST= load/load_0++EXTRA_OBJS=Test.o++TOP=../../..+include ../../build.mk
+ testsuite/load/load_0/Test.hs view
@@ -0,0 +1,6 @@++module Test where++import API++resource = test { field = "success" }
+ testsuite/load/load_0/api/API.hs view
@@ -0,0 +1,8 @@+module API where++data Test = Test { +                field :: String +        }++test :: Test+test = Test { field = "default value" }
+ testsuite/load/load_0/prog/Main.hs view
@@ -0,0 +1,11 @@++import System.Plugins+import API++main = do+        m_v <- load_ "../Test.o" ["../api"] "resource"+        v <- case m_v of+                LoadFailure _   -> error "load failed"+                LoadSuccess _ v -> return v+        let s = field v+        print s
+ testsuite/load/load_0/prog/expected view
@@ -0,0 +1,1 @@+"success"
+ testsuite/load/loadpkg/Main.hs view
@@ -0,0 +1,4 @@++import System.Plugins++main = loadPackageWith "posix" []
+ testsuite/load/loadpkg/Makefile view
@@ -0,0 +1,4 @@+TEST= load/loadpkg++TOP=../../..+include ../../eval.mk
+ testsuite/load/loadpkg/expected view
+ testsuite/load/null/Makefile view
@@ -0,0 +1,4 @@+TEST= load/null+EXTRA_OBJS=Null.o+TOP=../../..+include ../../build.mk
+ testsuite/load/null/Null.hs view
@@ -0,0 +1,11 @@+module Null ( resource, resource_dyn )  where++import API+import Data.Dynamic+import Prelude hiding (null)++resource = null++-- ! this has to be special: it can't be overridden by the user.+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/load/null/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Null = Null { a, b :: Int }+   deriving (Typeable, Show)++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/load/null/prog/Main.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS -cpp #-}++#include "../../../../config.h"++import System.Plugins+import API++-- an example where we just want to load an object and run it++main = do +    let includes = [TOP ++ "/testsuite/load/null/api"]+    m_v <- load "../Null.o" includes [] "resource"+    v <- case m_v of+        LoadSuccess _ v -> return v+        _               -> error "load failed"+                +    putStrLn ( show (a v) )
+ testsuite/load/null/prog/expected view
@@ -0,0 +1,1 @@+42
+ testsuite/load/thiemann0/Makefile view
@@ -0,0 +1,6 @@+TEST= load/thiemann0++#EXTRA_OBJS=Test.o++TOP=../../..+include ../../build.mk
+ testsuite/load/thiemann0/Test.hs view
@@ -0,0 +1,11 @@++-- P.Thiemann reports that 'import Char' leads to undefined symbol for+-- __stginit_Char_.++module Test where++import API+import Char++resource = test { field = map toUpper "success" }+
+ testsuite/load/thiemann0/api/API.hs view
@@ -0,0 +1,8 @@+module API where++data Test = Test { +                field :: String +        }++test :: Test+test = Test { field = "default value" }
+ testsuite/load/thiemann0/prog/Main.hs view
@@ -0,0 +1,16 @@++import System.Plugins+import API++main = do+        status <- make "../Test.hs" ["-i../api"]+        obj    <- case status of+                    MakeSuccess _ o -> return o+                    MakeFailure e   -> mapM_ putStrLn e >> error "failed"++        m_v <- load_ obj ["../api"] "resource"+        v <- case m_v of+                LoadFailure _   -> error "load failed"+                LoadSuccess _ v -> return v+        let s = field v+        print s
+ testsuite/load/thiemann0/prog/expected view
@@ -0,0 +1,1 @@+"SUCCESS"
+ testsuite/load/thiemann2/C.hs view
@@ -0,0 +1,6 @@+module C where++import API+import qualified A++resource = let Test s = A.resource in Test { field = s }
+ testsuite/load/thiemann2/Makefile view
@@ -0,0 +1,6 @@+TEST= load/thiemann2+EXTRAFLAGS+=-iprog++TOP=../../..+include ../../build.mk+
+ testsuite/load/thiemann2/api/API.hs view
@@ -0,0 +1,8 @@+module API where++data Test = Test { +                field :: String +        }++test :: Test+test = Test { field = "default value" }
+ testsuite/load/thiemann2/prog/A.hs view
@@ -0,0 +1,8 @@+module A where++import API++import qualified B++resource = Test { field = B.resource }+
+ testsuite/load/thiemann2/prog/B.hs view
@@ -0,0 +1,3 @@+module B where++resource = "i'm in b"
+ testsuite/load/thiemann2/prog/Main.hs view
@@ -0,0 +1,20 @@++import System.Plugins+import API++import A++main = do+        -- compile C (A and B are already compiled)+        status <- makeAll "../C.hs" ["-i../api"]+        obj    <- case status of+                    MakeSuccess _ o -> return o+                    MakeFailure e   -> mapM_ putStrLn e >> error "failed"++        -- should load C+        m_v <- load_ obj ["../api","."] "resource"+        v <- case m_v of+                LoadFailure _   -> error "load failed"+                LoadSuccess _ v -> return v+        let s = field v+        print s
+ testsuite/load/thiemann2/prog/expected view
@@ -0,0 +1,1 @@+"i'm in b"
+ testsuite/load/unloadpkg/Main.hs view
@@ -0,0 +1,6 @@++import System.Plugins++main = do loadPackage "posix"+          unloadPackage  "posix"+          loadPackage "posix"
+ testsuite/load/unloadpkg/Makefile view
@@ -0,0 +1,4 @@+TEST= load/unloadpkg++TOP=../../..+include ../../eval.mk
+ testsuite/load/unloadpkg/expected view
+ testsuite/loadCLib/null/Makefile view
@@ -0,0 +1,4 @@+TEST=   loadCLib/null+EXTRA_OBJS=Null.o+TOP=../../..+include ../../build.mk
+ testsuite/loadCLib/null/Null.hs view
@@ -0,0 +1,12 @@+module Null ( resource )  where++import API+import Data.Dynamic+import Prelude hiding (null)+import Graphics.Rendering.OpenGL++resource = null++-- ! this has to be special: it can't be overridden by the user.+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/loadCLib/null/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Null = Null { a, b :: Int }+   deriving (Typeable, Show)++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/loadCLib/null/prog/Main.hs view
@@ -0,0 +1,11 @@++import System.Plugins+import API++-- an example where we just want to load an object and run it++main = do +    m_v   <- load_ "../Null.o" ["../api",".."] "resource"+    case m_v of+        LoadFailure err -> error (unlines err)+        LoadSuccess m v -> do putStrLn ( show (a v) ) ; unload m
+ testsuite/loadCLib/null/prog/expected view
@@ -0,0 +1,1 @@+42
+ testsuite/make/makeall001/A.hs view
@@ -0,0 +1,3 @@+module A where++a = "a"
+ testsuite/make/makeall001/B.hs view
@@ -0,0 +1,3 @@+module B where++b = "b"
+ testsuite/make/makeall001/C.hs view
@@ -0,0 +1,3 @@+module C where++c = "c"
+ testsuite/make/makeall001/Makefile view
@@ -0,0 +1,3 @@+TEST=   make/makeall001+TOP=../../..+include ../../build.mk
+ testsuite/make/makeall001/Tiny.hs view
@@ -0,0 +1,13 @@+module Tiny ( resource )  where++import API++import A+import B+import C++resource = tiny { ++    field = a ++ b ++ c+    +}
+ testsuite/make/makeall001/api/API.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS -fglasgow-exts #-}+-- ^ needed to derive Typeable++module API where++import Data.Dynamic++data Tiny = Tiny { field :: String }+   deriving (Typeable, Show)++tiny :: Tiny+tiny = Tiny { field = "default value" }+
+ testsuite/make/makeall001/prog/Main.hs view
@@ -0,0 +1,18 @@++-- little more complex. use the path to the obj file we get back from+-- 'make'. load() uses this to find the .hi file++import System.Plugins+import API++main = do+        status  <- makeAll "../Tiny.hs" ["-i../api"]+        o <- case status of+                MakeSuccess _ o -> return o+                MakeFailure e -> mapM_ putStrLn e >> error "failed"+        m_v   <- load o [".."] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ field v +
+ testsuite/make/makeall001/prog/expected view
@@ -0,0 +1,1 @@+abc
+ testsuite/make/null/Makefile view
@@ -0,0 +1,4 @@+TEST=   make/null++TOP=../../..+include ../../build.mk
+ testsuite/make/null/Null.hs view
@@ -0,0 +1,11 @@+module Null ( resource, resource_dyn )  where++import API+import Data.Dynamic+import Prelude hiding (null)++resource = null++-- ! this has to be special: it can't be overridden by the user.+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/make/null/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Null = Null { a, b :: Int }+   deriving (Typeable, Show)++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/make/null/prog/Main.hs view
@@ -0,0 +1,13 @@++-- an example where we want to compile and load a file++import System.Plugins+import API++main = do +    make "../Null.hs" ["-i../api"]+    m_v  <- load "../Null.o" ["../api"] [] "resource"+    v <- case m_v of+        LoadSuccess _ v -> return v+        _               -> error "load failed"+    putStrLn ( show (a v) )
+ testsuite/make/null/prog/expected view
@@ -0,0 +1,1 @@+42
+ testsuite/make/o/Makefile view
@@ -0,0 +1,3 @@+TEST=make/o+TOP =../../..+include ../../build.mk
+ testsuite/make/o/Plugin.hs view
@@ -0,0 +1,7 @@+module Plugin ( resource )  where++import API++resource = plugin { +    field = "hello out there"+}
+ testsuite/make/o/api/API.hs view
@@ -0,0 +1,8 @@+module API where++data Interface = Interface {+       field :: String +}++plugin :: Interface+plugin = Interface { field = undefined }
+ testsuite/make/o/prog/Main.hs view
@@ -0,0 +1,28 @@+import System.Plugins+import API++import System.Directory++-- note: the name of the original *source* module is used to find+-- symbols in the *object* file. load works out what the source file+-- name was by looking at the object file name, i.e. it assumes they+-- have the same name. so, if you are going to store objects in a+-- tmpdir, you should make a tmp directory, and store them inside that,+-- rather than mkstemp'ing the name of the object file yourself.+--+-- this should go away once we can read .hi files.++main = do+#if __GLASGOW_HASKELL__ >= 604+        tmpDir <- getTemporaryDirectory+#else+        let tmpDir = "/tmp"+#endif+        make "../Plugin.hs" [ "-i../api", "-o", (tmpDir ++ "/Plugin.o") ]+        m_v   <- load (tmpDir ++ "/Plugin.o") ["../api"] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ field v ++        mapM_ removeFile [ (tmpDir ++ "/Plugin.hi"), (tmpDir ++ "/Plugin.o") ]
+ testsuite/make/o/prog/expected view
@@ -0,0 +1,1 @@+hello out there
+ testsuite/make/odir/Makefile view
@@ -0,0 +1,3 @@+TEST=   make/odir+TOP=../../..+include ../../build.mk
+ testsuite/make/odir/Plugin.hs view
@@ -0,0 +1,7 @@+module Plugin ( resource )  where++import API++resource = plugin { +    field = "hello out there"+}
+ testsuite/make/odir/api/API.hs view
@@ -0,0 +1,8 @@+module API where++data Interface = Interface {+       field :: String +}++plugin :: Interface+plugin = Interface { field = undefined }
+ testsuite/make/odir/prog/Main.hs view
@@ -0,0 +1,21 @@+import System.Plugins+import API+import System.Directory++main = do+#if __GLASGOW_HASKELL__ >= 604+        tmpDir <- getTemporaryDirectory+#else+        let tmpDir = "/tmp"+#endif+        status <- make "../Plugin.hs" [ "-i../api", "-odir", tmpDir ]+        o <- case status of+                MakeSuccess _ o -> return o+                MakeFailure e -> mapM_ putStrLn e >> error "didn't compile"+        m_v     <- load o ["../api"] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ field v +        mapM_ removeFile [(tmpDir ++ "/Plugin.hi"), (tmpDir ++ "/Plugin.o") ]+
+ testsuite/make/odir/prog/expected view
@@ -0,0 +1,1 @@+hello out there
+ testsuite/make/remake001/Bar.hs view
@@ -0,0 +1,3 @@+module Bar where++bar = undefined
+ testsuite/make/remake001/Foo.hs view
@@ -0,0 +1,3 @@+module Foo where++foo = undefined
+ testsuite/make/remake001/Main.hs view
@@ -0,0 +1,36 @@+--+-- expected output:+-- $ ./a.out +-- True+-- False+-- True+-- False+--++import System.Plugins+import System.Directory+   +main = do+        status <- make "Foo.hs" [] -- should make+        print status++        status <- make "Foo.hs" [] -- shouldn't make+        print status+   +        status <- merge "Foo.hs" "Bar.hs"+        case status of+                MergeFailure e    -> error $ show e+                MergeSuccess _ _ fp -> do {++        ;status <- make fp []       -- should make+        ;() <- case status of +                MakeSuccess c _ -> print c+                MakeFailure e   -> error $ show e++        ;status <- make fp []       -- shouldn't make+        ;case status of +                MakeSuccess c _ -> print c+                MakeFailure e   -> error $ show e+        ;removeFile "Foo.o"+        }+
+ testsuite/make/remake001/Makefile view
@@ -0,0 +1,4 @@+TEST=   merge/remake001++TOP=../../..+include ../../eval.mk
+ testsuite/make/remake001/expected view
@@ -0,0 +1,4 @@+MakeSuccess ReComp "Foo.o"+MakeSuccess NotReq "Foo.o"+ReComp+NotReq
+ testsuite/make/remake001_should_fail/Bar.hs view
@@ -0,0 +1,3 @@+module Bar where++bar = undef {- error -}
+ testsuite/make/remake001_should_fail/Foo.hs view
@@ -0,0 +1,3 @@+module Foo where++foo = undefined
+ testsuite/make/remake001_should_fail/Main.hs view
@@ -0,0 +1,31 @@++import System.Plugins++import System.Directory+   +main = do+        status <- make "Foo.hs" [] -- should make+        print status++        status <- make "Foo.hs" [] -- shouldn't make+        print status+   +        status  <- merge "Foo.hs" "Bar.hs"+        case status of+                MergeFailure e    -> error $ show e+                MergeSuccess _ _ fp -> do {++        ;status <- make fp []       -- should make+        ;() <- case status of +                MakeSuccess c _ -> print c+                MakeFailure _   -> print "make failure"++        ;status <- make fp []       -- shouldn't make+        ;case status of +                MakeSuccess c _ -> print c+                MakeFailure _   -> print "make failure"++        ;removeFile "Foo.o" -- make test deterministic+        }++
+ testsuite/make/remake001_should_fail/Makefile view
@@ -0,0 +1,4 @@+TEST=   make/remake001_should_fail++TOP=../../..+include ../../eval.mk
+ testsuite/make/remake001_should_fail/expected view
@@ -0,0 +1,4 @@+MakeSuccess ReComp "Foo.o"+MakeSuccess NotReq "Foo.o"+"make failure"+"make failure"
+ testsuite/make/simple/Makefile view
@@ -0,0 +1,3 @@+TEST=   make/simple+TOP=../../..+include ../../build.mk
+ testsuite/make/simple/Tiny.hs view
@@ -0,0 +1,14 @@+module Tiny ( resource, resource_dyn )  where++import API+import Data.Dynamic++resource = tiny { ++    field = "hello strange world"+    +}++resource_dyn :: Dynamic+resource_dyn = toDyn resource+
+ testsuite/make/simple/api/API.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS -fglasgow-exts #-}+-- ^ needed to derive Typeable++module API where++import Data.Dynamic++data Tiny = Tiny { field :: String }+   deriving (Typeable, Show)++tiny :: Tiny+tiny = Tiny { field = "default value" }+
+ testsuite/make/simple/prog/Main.hs view
@@ -0,0 +1,19 @@++-- little more complex. use the path to the obj file we get back from+-- 'make'. load() uses this to find the .hi file++import System.Plugins+import API++main = do+        status  <- make "../Tiny.hs" ["-i../api"]+        o <- case status of+                MakeSuccess _ o -> return o+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"++        m_v   <- load o ["../api"] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ field v +
+ testsuite/make/simple/prog/expected view
@@ -0,0 +1,1 @@+hello strange world
+ testsuite/makewith/global_pragma/Makefile view
@@ -0,0 +1,5 @@++TEST=makewith/global_pragma++TOP=../../..+include ../../build.mk
+ testsuite/makewith/global_pragma/Plugin.hs view
@@ -0,0 +1,17 @@+{-# GLOBALOPTIONS -package mtl #-}++module M ( resource ) where++import API+import System.IO.Unsafe+import System.Process+import System.IO++resource = tiny { field = date }++date :: String+date = unsafePerformIO $ do+            (_,outh,_,proc) <- runInteractiveProcess "echo" ["hello"] Nothing Nothing		+    	    waitForProcess proc+            s <- hGetContents outh+            return s
+ testsuite/makewith/global_pragma/api/API.hs view
@@ -0,0 +1,8 @@++module API where++data Tiny = Tiny { field :: String }++tiny :: Tiny+tiny = Tiny { field = "default value" }+
+ testsuite/makewith/global_pragma/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+import API++conf    = "../Plugin.hs"+apipath = "../api"++main = do+        status <- makeWith conf conf ["-i"++apipath]+        o <- case status of+                MakeFailure e   -> mapM_ putStrLn e >> error "compile failed"+                MakeSuccess _ o -> return o+        m_v   <- load o [apipath] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            LoadFailure ers -> mapM_ putStrLn ers >> error "load failed"+        putStr $ field v +        makeCleaner o+
+ testsuite/makewith/global_pragma/prog/expected view
@@ -0,0 +1,1 @@+hello
+ testsuite/makewith/io/Makefile view
@@ -0,0 +1,4 @@+TEST=makewith/io++TOP=../../..+include ../../build.mk
+ testsuite/makewith/io/README view
@@ -0,0 +1,2 @@+An example using IO monad fields in the .conf file.+
+ testsuite/makewith/io/TestIO.conf.in view
@@ -0,0 +1,22 @@+{-# OPTIONS -cpp #-}+--+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- LGPL version 2.1 or later (see http://www.gnu.org/copyleft/lesser.html)+--++import System.IO+import System.Process++resource = testio { field = date }++--+-- call a shell command , returning it's output+--+date :: IO String+date = do+#if !defined(CYGWIN) || !defined(__MINGW32__)+          (_,out,_,_) <- catch (runInteractiveCommand "/bin/date") (\_->error "popen failed")+#else+          (_,out,_,_) <- catch (runInteractiveCommand "@PREFIX@/../../bin/date") (\_->error "popen failed")+#endif+          hGetLine out
+ testsuite/makewith/io/TestIO.stub view
@@ -0,0 +1,10 @@++module TestIO ( resource, resource_dyn )  where++import API+import Data.Dynamic++resource = testio++resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/makewith/io/api/API.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data TestIO = TestIO { +                field :: IO String +        }+   deriving (Typeable, Show)++instance Show (IO String) where+    show _ = "<<io action>>"++testio :: TestIO+testio = TestIO { field = return "default value" }
+ testsuite/makewith/io/prog/Main.hs view
@@ -0,0 +1,21 @@++import System.Plugins+import API++conf    = "../TestIO.conf"+stub    = "../TestIO.stub"+apipath = "../api"++main = do+        status <- makeWith conf stub ["-i"++apipath]+        o <- case status of+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"+                MakeSuccess _ o -> return o+        m_v   <- load o [apipath] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        s <- field v++        makeCleaner o+        if null s then print False else print True
+ testsuite/makewith/io/prog/expected view
@@ -0,0 +1,6 @@+merge failed:++parse error in ../TestIO.conf+line: 17, col: 1++a.out: failed
+ testsuite/makewith/merge00/Bar.hs view
@@ -0,0 +1,3 @@+module Bar where++resource :: Int
+ testsuite/makewith/merge00/Foo.hs view
@@ -0,0 +1,4 @@+module Foo where++resource :: Integer+resource = 0xBAD
+ testsuite/makewith/merge00/Main.hs view
@@ -0,0 +1,38 @@++import System.Plugins++import System.Directory++a    = "Foo.hs" -- uesr code+b    = "Bar.hs" -- trusted code. Result is "Bar.o"++main = do+        status <- merge a b +        f <- case status of+                MergeFailure e     -> error "merge failure"+                MergeSuccess _ _ f -> return f++        status <- merge a b +        f' <- case status of+                MergeFailure e          -> error "merge failure"+                MergeSuccess ReComp _ f -> error "unnec. merge"+                MergeSuccess NotReq _ f -> return f++        print ( f == f' )++        status <- make f' []+        o <- case status of+                  MakeFailure   e -> error "make failed"+                  MakeSuccess _ o -> return o++        m_v   <- load o [] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ show $ (v :: Int)++        removeFile o+        return ()++        makeCleaner f+
+ testsuite/makewith/merge00/Makefile view
@@ -0,0 +1,4 @@+TEST=makewith/merge00++TOP=../../..+include ../../eval.mk
+ testsuite/makewith/merge00/expected view
@@ -0,0 +1,2 @@+True+2989
+ testsuite/makewith/mergeto0/Bar.hs view
@@ -0,0 +1,3 @@+module Bar where++resource :: Int
+ testsuite/makewith/mergeto0/Foo.hs view
@@ -0,0 +1,4 @@+module Foo where++resource :: Integer+resource = 0xBAD
+ testsuite/makewith/mergeto0/Main.hs view
@@ -0,0 +1,37 @@++import System.Plugins++import System.Directory++a    = "Foo.hs" -- uesr code+b    = "Bar.hs" -- trusted code. Result is "Bar.o"+c    = "Out.hs"++main = do+        status <- mergeTo a b c+        f <- case status of+                MergeFailure e     -> error "mergeto failure"+                MergeSuccess _ _ f -> return f+        print $ f == c++        status <- mergeTo a b c+        f' <- case status of+                MergeFailure e          -> error "mergeto failure"+                MergeSuccess ReComp _ f -> error "unnec. mergeto"+                MergeSuccess NotReq _ f -> return f -- good, not req++        print $ f == f' && f == c++        status <- make f' []+        o <- case status of+                  MakeFailure   e -> error "make failed"+                  MakeSuccess _ o -> return o++        m_v   <- load o [] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ show $ (v :: Int)++        makeCleaner c+
+ testsuite/makewith/mergeto0/Makefile view
@@ -0,0 +1,4 @@+TEST=makewith/mergeto0++TOP=../../..+include ../../eval.mk
+ testsuite/makewith/mergeto0/expected view
@@ -0,0 +1,3 @@+True+True+2989
+ testsuite/makewith/module_name/Bar.hs view
@@ -0,0 +1,3 @@+module Bar where++resource :: Int
+ testsuite/makewith/module_name/Foo.hs view
@@ -0,0 +1,4 @@+module Foo where++resource :: Integer+resource = 1
+ testsuite/makewith/module_name/Main.hs view
@@ -0,0 +1,33 @@++import System.Plugins++import System.Directory++a    = "Foo.hs" -- uesr code+b    = "Bar.hs" -- trusted code. Result is "Bar.o"++main = do+        status <- makeWith a b []+        s <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        status <- makeWith a b []+        s' <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        status <- makeWith a b []+        s'' <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        print $ (s == s') && (s' == s'')++        m_v   <- load s [] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ show $ (v :: Int)++        makeCleaner s''
+ testsuite/makewith/module_name/Makefile view
@@ -0,0 +1,4 @@+TEST=makewith/module_name++TOP=../../..+include ../../eval.mk
+ testsuite/makewith/module_name/expected view
@@ -0,0 +1,5 @@+ReComp+NotReq+NotReq+True+1
+ testsuite/makewith/multi_make/Bar.hs view
@@ -0,0 +1,4 @@+module Bar where++resource :: Int+resource = 2
+ testsuite/makewith/multi_make/Foo.hs view
@@ -0,0 +1,4 @@+module Foo where++resource :: Integer+resource = 1
+ testsuite/makewith/multi_make/Main.hs view
@@ -0,0 +1,37 @@++import System.Plugins++import System.Directory++a    = "Foo.hs" -- user code+b    = "Bar.hs" -- more user code+z    = "Stub.hs" -- and a stub++main = do+        status <- makeWith a z []+        s <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        status <- makeWith b z []+        s' <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        -- shouldn't need to remerge (a,z)+        status <- makeWith a z []+        t <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        -- shouldn't need to remerge (b,z)+        status <- makeWith b z []+        t' <- case status of+                MakeFailure   e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess n s -> print n >> return s++        print $ s /= s' -- test we got unique modules+        print $ t /= t' -- test we got unique modules++        mapM_ makeCleaner [s,s']+
+ testsuite/makewith/multi_make/Makefile view
@@ -0,0 +1,4 @@+TEST=makewith/multi_make++TOP=../../..+include ../../eval.mk
+ testsuite/makewith/multi_make/Stub.hs view
@@ -0,0 +1,4 @@+module Stub where++resource :: Int+
+ testsuite/makewith/multi_make/expected view
@@ -0,0 +1,6 @@+ReComp+ReComp+NotReq+NotReq+True+True
+ testsuite/makewith/should_fail_0/Makefile view
@@ -0,0 +1,4 @@+TEST=makewith/should_fail_0++TOP=../../..+include ../../build.mk
+ testsuite/makewith/should_fail_0/Plugin.in view
@@ -0,0 +1,3 @@+module Plugin where++resource = 0xBAD :: Int
+ testsuite/makewith/should_fail_0/Plugin.stub view
@@ -0,0 +1,6 @@+module Plugin ( resource ) where++import API++resource :: Interface+resource = plugin
+ testsuite/makewith/should_fail_0/api/API.hs view
@@ -0,0 +1,10 @@++module API where++data Interface = Interface { +        function :: String+   }++plugin :: Interface+plugin = Interface  { function = "goodbye" }+
+ testsuite/makewith/should_fail_0/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+import API++conf    = "../Plugin.in"+stub    = "../Plugin.stub"++main = do +        status <- makeWith conf stub ["-i../api"]+        case status of+                MakeFailure e    -> putStrLn "make failed"+                MakeSuccess _  o ->  do+                        m_v   <- load o ["../api"] [] "resource"+                        v     <- case m_v of+                                    LoadSuccess _ v -> return v+                                    _               -> error "load failed"+                        putStrLn $ (function v)+                        makeCleaner o+
+ testsuite/makewith/should_fail_0/prog/expected view
@@ -0,0 +1,1 @@+make failed
+ testsuite/makewith/tiny/Makefile view
@@ -0,0 +1,5 @@++TEST=makewith/tiny++TOP=../../..+include ../../build.mk
+ testsuite/makewith/tiny/Tiny.conf view
@@ -0,0 +1,8 @@+resource = tiny { ++    field = "hello strange world"+    +}+++
+ testsuite/makewith/tiny/Tiny.stub view
@@ -0,0 +1,31 @@+module Tiny ( resource, resource_dyn )  where++import API+import Data.Dynamic++resource = tiny++resource_dyn :: Dynamic+resource_dyn = toDyn resource++++++++++++++++++++++
+ testsuite/makewith/tiny/api/API.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS -fglasgow-exts #-}+-- ^ needed to derive Typeable++module API where++import Data.Dynamic++data Tiny = Tiny { field :: String }+   deriving (Typeable, Show)++tiny :: Tiny+tiny = Tiny { field = "default value" }+
+ testsuite/makewith/tiny/prog/Main.hs view
@@ -0,0 +1,21 @@++import System.Plugins+import API+import Data.Either++conf    = "../Tiny.conf"+stub    = "../Tiny.stub"+apipath = "../api"++main = do+        status <- makeWith conf stub ["-i"++apipath]+        o <- case status of+                MakeFailure e   -> mapM_ putStrLn e >> error "failed"+                MakeSuccess _ o -> return o+        m_v   <- load o [apipath] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        putStrLn $ field v +        makeCleaner o+
+ testsuite/makewith/tiny/prog/expected view
@@ -0,0 +1,1 @@+hello strange world
+ testsuite/makewith/unsafeio/Makefile view
@@ -0,0 +1,5 @@++TEST=makewith/unsafeio++TOP=../../..+include ../../build.mk
+ testsuite/makewith/unsafeio/README view
@@ -0,0 +1,3 @@+hmm. on 6.3  we need to add 'mtl' to a package dependency, other+HSlang complains of a missing symbol. Is this a bug in the+package.conf for HSlang?
+ testsuite/makewith/unsafeio/Unsafe.conf.in view
@@ -0,0 +1,21 @@+{-# GLOBALOPTIONS -package mtl #-}+-- illustrates the use of static options in pragmas++import System.IO.Unsafe+import System.IO+import System.Process++resource = unsafe { field = date }++-- illustrates the use of the devil's work+date :: String+date = unsafePerformIO $ do+#if !defined(CYGWIN) || !defined(__MINGW32__)+            (_,outh,_,proc) <- runInteractiveProcess "date" [] Nothing Nothing		+#else+            (_,outh,_,proc) <- runInteractiveProcess "@PREFIX@/../../bin/date" [] Nothing Nothing		+#endif+    	    waitForProcess proc+            s <- hGetContents outh+            return s+
+ testsuite/makewith/unsafeio/Unsafe.stub view
@@ -0,0 +1,13 @@++module Unsafe ( resource, resource_dyn )  where++import API+import Data.Dynamic++resource = unsafe++--+-- special+--+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/makewith/unsafeio/api/API.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Unsafe = Unsafe { +                field :: String +        }+   deriving (Typeable, Show)++unsafe :: Unsafe+unsafe = Unsafe { field = "default value" }
+ testsuite/makewith/unsafeio/prog/Main.hs view
@@ -0,0 +1,20 @@+import System.Plugins+import API+import Data.Either++conf    = "../Unsafe.conf"+stub    = "../Unsafe.stub"+apipath = "../api"++main = do+        status <- makeWith conf stub ["-i"++apipath]+        o <- case status of+                MakeFailure e -> mapM_ putStrLn e >> error "failed"+                MakeSuccess _ o -> return o+        m_v   <- load o [apipath] [] "resource"+        v <- case m_v of+            LoadSuccess _ v -> return v+            _               -> error "load failed"+        let s = field v+        makeCleaner o+        if null s then print False else print True
+ testsuite/makewith/unsafeio/prog/README view
@@ -0,0 +1,8 @@+this is an example of an application that uses the HSConf library to+dynamically load compiled conf files.++We use the .conf file in the parent directory, and communicate with+the plugin via the API in the api_package/ directory.++The plugin is a .o file+The api is a GHC package archive
+ testsuite/makewith/unsafeio/prog/expected view
@@ -0,0 +1,6 @@+merge failed:++parse error in ../Unsafe.conf+line: 13, col: 1++a.out: failed
+ testsuite/misc/mkstemps/Main.hs view
@@ -0,0 +1,69 @@+ +import System.MkTemp++import Data.Maybe++import System.IO+import System.Directory++main = do+        createDirectory "t"++        ------------------------------------------------------------------------+        -- Try mkstemp with simple template+        --+        ts <- mapM (\_ -> mkstemp "t/t.X" ) [0..(26+26)] -- 1+26+26 files+        () <- if (not $ all isJust ts)+              then putStrLn $ "mkstemp couldn't create all expected files"+              else putStrLn $ "created "++(show $ length $ catMaybes ts)++" files"+        closeAll ts++        -- next one shouldn't be possible+        t <- mkstemp "t/t.X"+        () <- if (not $ isNothing t)+              then putStrLn $ "shouldn't have been able to create this file"+              else putStrLn $ "correctly ran out of permutations"+        closeAll [t]++        rmAll (t:ts)++        ------------------------------------------------------------------------+        -- Try again with large tmp+        --+        ts <- mapM (\_->do v <- mkstemp "t/t.XXXXXXXXXX" +                           case v of Just (t,h) -> hClose h >> return v+                                     _ -> return v ) [1..10000]++        () <- if (not $ all isJust ts)+              then putStrLn $ "mkstemp couldn't create all expected files"+              else putStrLn $ "mkstemp:	created "++(show $ length $ catMaybes ts)++" files"+        rmAll ts++        ------------------------------------------------------------------------+        -- test mkstemps+        --+        ts <- mapM (\_->do v <- mkstemps "t/t.XXXXXXXXXX.hs" 3+                           case v of Just (t,h) -> hClose h >> return v+                                     _ -> return v ) [1..2000]+        () <- if (not $ all isJust ts)+              then putStrLn $ "mkstemps couldn't create all expected files"+              else putStrLn $ "mkstemps:	created "++(show $ length $ catMaybes ts)++" files"+        rmAll ts++        ------------------------------------------------------------------------+        -- mkdtemp+        --+        ts <- mapM (\_ -> mkdtemp "t/XXXXXXXXXX") [1..2000]+        () <- if (not $ all isJust ts)+              then putStrLn $ "mkdtemp:	couldn't create all expected directories"+              else putStrLn $ "mkdtemp:	created "++(show $ length $ catMaybes ts)++" directories"+        rmAllDirs ts+    +        ------------------------------------------------------------------------++        removeDirectory "t"++    where+        closeAll  ts = mapM_ hClose $ map snd $ catMaybes ts+        rmAll     ts = mapM_ removeFile $ map fst $ catMaybes ts+        rmAllDirs ts = mapM_ removeDirectory $ catMaybes ts
+ testsuite/misc/mkstemps/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/misc/mkstemps/expected view
@@ -0,0 +1,5 @@+created 53 files+correctly ran out of permutations+mkstemp:	created 10000 files+mkstemps:	created 2000 files+mkdtemp:	created 2000 directories
+ testsuite/multi/3plugins/Makefile view
@@ -0,0 +1,6 @@+TEST=   multi/3plugins++EXTRA_OBJS=Plugin1.o  Plugin2.o  Plugin3.o++TOP=../../..+include ../../build.mk
+ testsuite/multi/3plugins/Plugin1.hs view
@@ -0,0 +1,8 @@+module Plugin1 where++import API+import Data.Char++resource = plugin {+        valueOf = map toUpper+}
+ testsuite/multi/3plugins/Plugin2.hs view
@@ -0,0 +1,9 @@+module Plugin2 where++import API+import Data.Char++resource = plugin {+        valueOf = \s -> show $ map ord s+}+
+ testsuite/multi/3plugins/Plugin3.hs view
@@ -0,0 +1,7 @@+module Plugin3 where++import API++resource = plugin {+        valueOf = reverse+}
+ testsuite/multi/3plugins/api/API.hs view
@@ -0,0 +1,9 @@+module API where++data Interface = Interface { +        valueOf :: String -> String +}++plugin :: Interface +plugin = Interface { valueOf = id }+
+ testsuite/multi/3plugins/prog/Main.hs view
@@ -0,0 +1,13 @@+import System.Plugins+import API++main = do+        let plist = ["../Plugin1.o", "../Plugin2.o", "../Plugin3.o"]+        plugins <- mapM (\p -> load p ["../api"] [] "resource") plist+        let functions = map (valueOf . fromLoadSuc) plugins++        -- apply the function from each plugin in turn+        mapM_ (\f -> putStrLn $ f "haskell is for hackers") functions++fromLoadSuc (LoadFailure _)   = error "load failed"+fromLoadSuc (LoadSuccess _ v) = v
+ testsuite/multi/3plugins/prog/expected view
@@ -0,0 +1,3 @@+HASKELL IS FOR HACKERS+[104,97,115,107,101,108,108,32,105,115,32,102,111,114,32,104,97,99,107,101,114,115]+srekcah rof si lleksah
+ testsuite/objc/expression_parser/ArithmeticExpressionParser.hs view
@@ -0,0 +1,30 @@+module ArithmeticExpressionParser where++import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr++resource :: String -> IO String+resource text = do+  parsedText <- mapM parseString (lines text)+  return (unlines parsedText)++parseString s = do+  case (parse expr "" s) of+    Left err -> return ("Error " ++ show err)+    Right num -> return (show num)++expr :: Parser Integer+expr = buildExpressionParser table factor <?> "expression"++table = [ [op "*" (*) AssocLeft, op "/" div AssocLeft]+        , [op "+" (+) AssocLeft, op "-" (-) AssocLeft] ]+  where+    op s f assoc = Infix (do { string s; return f }) assoc++factor = do { char '('; x <- expr; char ')'; return x }+         <|> number+         <?> "simple expression"++number :: Parser Integer+number = do { ds <- many1 digit; return (read ds) } <?> "number"+
+ testsuite/objc/expression_parser/English.lproj/Credits.rtf view
@@ -0,0 +1,29 @@+{\rtf0\ansi{\fonttbl\f0\fswiss Helvetica;}+{\colortbl;\red255\green255\blue255;}+\paperw9840\paperh8400+\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\ql\qnatural++\f0\b\fs24 \cf0 Engineering:+\b0 \+	Some people\+\++\b Human Interface Design:+\b0 \+	Some other people\+\++\b Testing:+\b0 \+	Hopefully not nobody\+\++\b Documentation:+\b0 \+	Whoever\+\++\b With special thanks to:+\b0 \+	Mom\+}
+ testsuite/objc/expression_parser/English.lproj/InfoPlist.strings view
binary file changed (absent → 568 bytes)
+ testsuite/objc/expression_parser/English.lproj/MainMenu.nib/classes.nib view
@@ -0,0 +1,4 @@+{+    IBClasses = ({CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }); +    IBVersion = 1; +}
+ testsuite/objc/expression_parser/English.lproj/MainMenu.nib/info.nib view
@@ -0,0 +1,21 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">+<plist version="1.0">+<dict>+	<key>IBDocumentLocation</key>+	<string>116 123 356 240 0 0 1600 1178 </string>+	<key>IBEditorPositions</key>+	<dict>+		<key>29</key>+		<string>117 405 318 44 0 0 1600 1178 </string>+	</dict>+	<key>IBFramework Version</key>+	<string>328.0</string>+	<key>IBOpenObjects</key>+	<array>+		<integer>29</integer>+	</array>+	<key>IBSystem Version</key>+	<string>7B8</string>+</dict>+</plist>
+ testsuite/objc/expression_parser/English.lproj/MainMenu.nib/objects.nib view
binary file changed (absent → 5248 bytes)
+ testsuite/objc/expression_parser/English.lproj/MyDocument.nib/classes.nib view
@@ -0,0 +1,13 @@+{+    IBClasses = (+        {CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }, +        {+            ACTIONS = {chooseParser = id; evaluateExpression = id; }; +            CLASS = MyDocument; +            LANGUAGE = ObjC; +            OUTLETS = {evaluation = id; expressionEntry = id; parser = id; }; +            SUPERCLASS = NSDocument; +        }+    ); +    IBVersion = 1; +}
+ testsuite/objc/expression_parser/English.lproj/MyDocument.nib/info.nib view
@@ -0,0 +1,16 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">+<plist version="1.0">+<dict>+	<key>IBDocumentLocation</key>+	<string>79 43 356 240 0 0 1280 832 </string>+	<key>IBFramework Version</key>+	<string>349.0</string>+	<key>IBOpenObjects</key>+	<array>+		<integer>21</integer>+	</array>+	<key>IBSystem Version</key>+	<string>7F44</string>+</dict>+</plist>
+ testsuite/objc/expression_parser/English.lproj/MyDocument.nib/keyedobjects.nib view
binary file changed (absent → 7470 bytes)
+ testsuite/objc/expression_parser/English.lproj/MyDocument.nib/objects.nib view
binary file changed (absent → 2952 bytes)
+ testsuite/objc/expression_parser/Info.plist view
@@ -0,0 +1,47 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">+<plist version="1.0">+<dict>+	<key>CFBundleDevelopmentRegion</key>+	<string>English</string>+	<key>CFBundleDocumentTypes</key>+	<array>+		<dict>+			<key>CFBundleTypeExtensions</key>+			<array>+				<string>????</string>+			</array>+			<key>CFBundleTypeIconFile</key>+			<string></string>+			<key>CFBundleTypeName</key>+			<string>DocumentType</string>+			<key>CFBundleTypeOSTypes</key>+			<array>+				<string>????</string>+			</array>+			<key>CFBundleTypeRole</key>+			<string>Editor</string>+			<key>NSDocumentClass</key>+			<string>MyDocument</string>+		</dict>+	</array>+	<key>CFBundleExecutable</key>+	<string>PluginExpressionParser</string>+	<key>CFBundleIconFile</key>+	<string></string>+	<key>CFBundleIdentifier</key>+	<string>com.apple.yourCocoaDocApp</string>+	<key>CFBundleInfoDictionaryVersion</key>+	<string>6.0</string>+	<key>CFBundlePackageType</key>+	<string>APPL</string>+	<key>CFBundleSignature</key>+	<string>????</string>+	<key>CFBundleVersion</key>+	<string>0.1</string>+	<key>NSMainNibFile</key>+	<string>MainMenu</string>+	<key>NSPrincipalClass</key>+	<string>NSApplication</string>+</dict>+</plist>
+ testsuite/objc/expression_parser/KeyValueParser.hs view
@@ -0,0 +1,33 @@+module KeyValueParser where++import Text.ParserCombinators.Parsec++parseKeyValue = do+  key <- parseKey+  char '='+  value <- parseValue+  return (key, value)++parseKey = many1 letter++parseValue =+  do+    openQuote <- char '"' <|> char '\''+    value <- many1 letter+    char openQuote+    return value+  <|>+  do+    value <- many1 letter+    return value++parseString s = do+  case (parse parseKeyValue "" s) of+    Left err -> return ("Error " ++ show err)+    Right (key, value) -> return ("Key: " ++ key ++ ", Value: " ++ value)++resource :: String -> IO String+resource text = do+  parsedText <- mapM parseString (lines text)+  return (unlines parsedText)+
+ testsuite/objc/expression_parser/Makefile view
@@ -0,0 +1,67 @@+APP_DIR = build/PluginExpressionParser.app+APP_CONTENTS_DIR = $(APP_DIR)/Contents+APP_ARCH_EXEC_DIR = $(APP_CONTENTS_DIR)/MacOS+APP_RESOURCES_DIR = $(APP_CONTENTS_DIR)/Resources+EXECUTABLE = $(APP_ARCH_EXEC_DIR)/PluginExpressionParser++OBJECT_FILES = main.o MyDocument.o PluginEvalAux.o+BUILD_OBJECT_FILES = $(addprefix build/,$(OBJECT_FILES)) \+		     build/PluginEvalAux_stub.o++HOST = $(shell uname)++ifeq ($(HOST),Darwin)+default: app+else+default: no_app+endif++app: $(APP_CONTENTS_DIR) $(APP_RESOURCES_DIR) $(EXECUTABLE)++#++$(EXECUTABLE): $(APP_ARCH_EXEC_DIR) $(BUILD_OBJECT_FILES)+	ghc \+	  -o "$(EXECUTABLE)" \+	  -framework Cocoa \+	  -package-conf ../../../plugins.conf.inplace \+	  -package plugins \+	  -no-hs-main \+	  $(BUILD_OBJECT_FILES)++build/MyDocument.o: MyDocument.m MyDocument.h+	gcc -c -o "$@" -Wall -I`ghc --print-libdir`/include "$<"++build/main.o: main.m+	gcc -c -o "$@" -Wall -I`ghc --print-libdir`/include "$<"++build/PluginEvalAux.o: PluginEvalAux.hs+	ghc --make \+	  -package-conf ../../../plugins.conf.inplace \+	  -package plugins \+	  -odir build/ \+	  -hidir build/ \+	  "$<"++#++$(APP_DIR):+	mkdir -p "$@"++$(APP_ARCH_EXEC_DIR): $(APP_DIR)+	mkdir -p "$@"++$(APP_CONTENTS_DIR): $(APP_DIR) Info.plist+	mkdir -p "$(APP_CONTENTS_DIR)"+	cp Info.plist "$@"+	echo -n 'APPL????' > "$@"/PkgInfo++$(APP_RESOURCES_DIR): $(APP_DIR) English.lproj+	mkdir -p "$(APP_RESOURCES_DIR)"+	cp -R English.lproj "$@"++#++clean:+	-rm -rf build *_stub.?+
+ testsuite/objc/expression_parser/MyDocument.h view
@@ -0,0 +1,16 @@+/* MyDocument */++#import <Cocoa/Cocoa.h>++#include "RunHaskell.h"++@interface MyDocument : NSDocument+{+    IBOutlet id evaluation;+    IBOutlet id expressionEntry;+    IBOutlet id parser;+}+- (IBAction)chooseParser:(id)sender;+- (IBAction)evaluateExpression:(id)sender;++@end
+ testsuite/objc/expression_parser/MyDocument.m view
@@ -0,0 +1,52 @@+#import "MyDocument.h"++@implementation MyDocument++- (NSString *)windowNibName {+    return @"MyDocument";+}++- (NSData *)dataRepresentationOfType:(NSString *)type {+    return nil;+}++- (BOOL)loadDataRepresentation:(NSData *)data ofType:(NSString *)type {+    return NO;+}+++- (IBAction)chooseParser:(id)sender+{+    int result;+    NSArray *fileTypes = [NSArray arrayWithObject:@"hs"];+    NSOpenPanel *oPanel = [NSOpenPanel openPanel];+    +    result = [oPanel runModalForDirectory:nil file:nil types:fileTypes];+    if (result == NSOKButton)+    {+        NSArray *filesToOpen = [oPanel filenames];+        [parser setStringValue:[filesToOpen objectAtIndex:0]];+    }+}++- (IBAction)evaluateExpression:(id)sender+{+    NSLog(@"evaluateExpression");+    NSString *filePathNSS = [parser stringValue];+    char *filePath = [filePathNSS cString];+    +    NSString *expressionNSS = [[expressionEntry textStorage] string];+    char *expression = [expressionNSS cString];+    +    NSLog (@"filePath:%s expression:%s", filePath, expression);+    +    char *result = evalhaskell_CString(filePath, expression);+    NSString *resultNSS = [NSString stringWithCString:result];+    NSAttributedString *resultNSAS = [[NSAttributedString alloc]+	                              initWithString:resultNSS+				          attributes:nil];+    [[evaluation textStorage] setAttributedString:resultNSAS];++}++@end
+ testsuite/objc/expression_parser/PluginEvalAux.hs view
@@ -0,0 +1,43 @@+{-# OPTIONS -fglasgow-exts -fffi #-}++module PluginEvalAux where++import System.Plugins.Make+import System.Plugins.Load+import System.Plugins.Utils++import Foreign.C+import Control.Exception        ( evaluate )+import System.IO+import System.Directory         ( renameFile, removeFile )++symbol = "resource"++evalWithStringResult :: FilePath -> String -> IO String+evalWithStringResult srcFile s = do+  status <- make srcFile ["-Onot"]+  case status of+      MakeFailure err   -> putStrLn "error occured" >> return (show err)+      MakeSuccess _ obj -> load' obj+  where+    load' obj = do+      loadResult <- load obj [] [] symbol+      case loadResult of+        LoadFailure errs -> putStrLn "load error" >> return (show errs)+	LoadSuccess m (rsrc :: String -> IO String) -> do+	  v' <- rsrc s+	  unload m+	  mapM_ removeFile [ obj, replaceSuffix obj ".hi" ]+	  return v'++foreign export ccall evalhaskell_CString :: CString -> CString -> IO CString++evalhaskell_CString :: CString -> CString -> IO CString+evalhaskell_CString filePathCS sCS = do+  s <- peekCString sCS+  filePath <- peekCString filePathCS+  retval <- evalWithStringResult filePath s+  newCString retval++-- vi:sw=2 sts=2+
+ testsuite/objc/expression_parser/PluginExpressionParser.xcode/project.pbxproj view
@@ -0,0 +1,602 @@+// !$*UTF8*$!+{+	archiveVersion = 1;+	classes = {+	};+	objectVersion = 39;+	objects = {+		089C165FFE840EACC02AAC07 = {+			children = (+				089C1660FE840EACC02AAC07,+			);+			isa = PBXVariantGroup;+			name = InfoPlist.strings;+			refType = 4;+			sourceTree = "<group>";+		};+		089C1660FE840EACC02AAC07 = {+			fileEncoding = 10;+			isa = PBXFileReference;+			lastKnownFileType = text.plist.strings;+			name = English;+			path = English.lproj/InfoPlist.strings;+			refType = 4;+			sourceTree = "<group>";+		};+//080+//081+//082+//083+//084+//100+//101+//102+//103+//104+		1058C7A6FEA54F5311CA2CBB = {+			children = (+				1058C7A7FEA54F5311CA2CBB,+			);+			isa = PBXGroup;+			name = "Linked Frameworks";+			refType = 4;+			sourceTree = "<group>";+		};+		1058C7A7FEA54F5311CA2CBB = {+			fallbackIsa = PBXFileReference;+			isa = PBXFrameworkReference;+			lastKnownFileType = wrapper.framework;+			name = Cocoa.framework;+			path = /System/Library/Frameworks/Cocoa.framework;+			refType = 0;+			sourceTree = "<absolute>";+		};+		1058C7A8FEA54F5311CA2CBB = {+			children = (+				2A37F4C5FDCFA73011CA2CEA,+				2A37F4C4FDCFA73011CA2CEA,+			);+			isa = PBXGroup;+			name = "Other Frameworks";+			refType = 4;+			sourceTree = "<group>";+		};+//100+//101+//102+//103+//104+//190+//191+//192+//193+//194+		19C28FB0FE9D524F11CA2CBB = {+			children = (+				8D15AC370486D014006FF6A4,+			);+			isa = PBXGroup;+			name = Products;+			refType = 4;+			sourceTree = "<group>";+		};+//190+//191+//192+//193+//194+//2A0+//2A1+//2A2+//2A3+//2A4+		2A37F4A9FDCFA73011CA2CEA = {+			buildSettings = {+			};+			buildStyles = (+				4A9504D0FFE6A4CB11CA0CBA,+				4A9504D1FFE6A4CB11CA0CBA,+			);+			hasScannedForEncodings = 1;+			isa = PBXProject;+			mainGroup = 2A37F4AAFDCFA73011CA2CEA;+			projectDirPath = "";+			targets = (+				8D15AC270486D014006FF6A4,+				7B5F81A4067389B000AC9FA4,+			);+		};+		2A37F4AAFDCFA73011CA2CEA = {+			children = (+				7B5F81A1067383A700AC9FA4,+				7B5F81980673839D00AC9FA4,+				2A37F4ABFDCFA73011CA2CEA,+				2A37F4AFFDCFA73011CA2CEA,+				2A37F4B8FDCFA73011CA2CEA,+				2A37F4C3FDCFA73011CA2CEA,+				19C28FB0FE9D524F11CA2CBB,+			);+			isa = PBXGroup;+			name = PluginExpressionParser;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4ABFDCFA73011CA2CEA = {+			children = (+				2A37F4AEFDCFA73011CA2CEA,+				2A37F4ACFDCFA73011CA2CEA,+			);+			isa = PBXGroup;+			name = Classes;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4ACFDCFA73011CA2CEA = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.c.objc;+			path = MyDocument.m;+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4AEFDCFA73011CA2CEA = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.c.h;+			path = MyDocument.h;+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4AFFDCFA73011CA2CEA = {+			children = (+				7B5F81990673839D00AC9FA4,+				32DBCF750370BD2300C91783,+				7B5F819506737AAC00AC9FA4,+				2A37F4B0FDCFA73011CA2CEA,+			);+			isa = PBXGroup;+			name = "Other Sources";+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B0FDCFA73011CA2CEA = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.c.objc;+			path = main.m;+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B4FDCFA73011CA2CEA = {+			children = (+				2A37F4B5FDCFA73011CA2CEA,+			);+			isa = PBXVariantGroup;+			name = MyDocument.nib;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B5FDCFA73011CA2CEA = {+			isa = PBXFileReference;+			lastKnownFileType = wrapper.nib;+			name = English;+			path = English.lproj/MyDocument.nib;+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B6FDCFA73011CA2CEA = {+			children = (+				2A37F4B7FDCFA73011CA2CEA,+			);+			isa = PBXVariantGroup;+			name = MainMenu.nib;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B7FDCFA73011CA2CEA = {+			isa = PBXFileReference;+			lastKnownFileType = wrapper.nib;+			name = English;+			path = English.lproj/MainMenu.nib;+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B8FDCFA73011CA2CEA = {+			children = (+				2A37F4B9FDCFA73011CA2CEA,+				2A37F4B6FDCFA73011CA2CEA,+				2A37F4B4FDCFA73011CA2CEA,+				8D15AC360486D014006FF6A4,+				089C165FFE840EACC02AAC07,+			);+			isa = PBXGroup;+			name = Resources;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4B9FDCFA73011CA2CEA = {+			children = (+				2A37F4BAFDCFA73011CA2CEA,+			);+			isa = PBXVariantGroup;+			name = Credits.rtf;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4BAFDCFA73011CA2CEA = {+			isa = PBXFileReference;+			lastKnownFileType = text.rtf;+			name = English;+			path = English.lproj/Credits.rtf;+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4C3FDCFA73011CA2CEA = {+			children = (+				1058C7A6FEA54F5311CA2CBB,+				1058C7A8FEA54F5311CA2CBB,+			);+			isa = PBXGroup;+			name = Frameworks;+			path = "";+			refType = 4;+			sourceTree = "<group>";+		};+		2A37F4C4FDCFA73011CA2CEA = {+			fallbackIsa = PBXFileReference;+			isa = PBXFrameworkReference;+			lastKnownFileType = wrapper.framework;+			name = AppKit.framework;+			path = /System/Library/Frameworks/AppKit.framework;+			refType = 0;+			sourceTree = "<absolute>";+		};+		2A37F4C5FDCFA73011CA2CEA = {+			fallbackIsa = PBXFileReference;+			isa = PBXFrameworkReference;+			lastKnownFileType = wrapper.framework;+			name = Foundation.framework;+			path = /System/Library/Frameworks/Foundation.framework;+			refType = 0;+			sourceTree = "<absolute>";+		};+//2A0+//2A1+//2A2+//2A3+//2A4+//320+//321+//322+//323+//324+		32DBCF750370BD2300C91783 = {+			fileEncoding = 4;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.c.h;+			path = PluginExpressionParser_Prefix.pch;+			refType = 4;+			sourceTree = "<group>";+		};+//320+//321+//322+//323+//324+//4A0+//4A1+//4A2+//4A3+//4A4+		4A9504D0FFE6A4CB11CA0CBA = {+			buildRules = (+			);+			buildSettings = {+				COPY_PHASE_STRIP = NO;+				DEBUGGING_SYMBOLS = YES;+				GCC_DYNAMIC_NO_PIC = NO;+				GCC_ENABLE_FIX_AND_CONTINUE = YES;+				GCC_GENERATE_DEBUGGING_SYMBOLS = YES;+				GCC_OPTIMIZATION_LEVEL = 0;+				OPTIMIZATION_CFLAGS = "-O0";+				ZERO_LINK = YES;+			};+			isa = PBXBuildStyle;+			name = Development;+		};+		4A9504D1FFE6A4CB11CA0CBA = {+			buildRules = (+			);+			buildSettings = {+				COPY_PHASE_STRIP = YES;+				GCC_ENABLE_FIX_AND_CONTINUE = NO;+				ZERO_LINK = NO;+			};+			isa = PBXBuildStyle;+			name = Deployment;+		};+//4A0+//4A1+//4A2+//4A3+//4A4+//7B0+//7B1+//7B2+//7B3+//7B4+		7B5F819506737AAC00AC9FA4 = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.c.h;+			path = RunHaskell.h;+			refType = 4;+			sourceTree = "<group>";+		};+		7B5F819606737AAC00AC9FA4 = {+			fileRef = 7B5F819506737AAC00AC9FA4;+			isa = PBXBuildFile;+			settings = {+			};+		};+		7B5F81970673839D00AC9FA4 = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.haskell;+			path = KeyValueParser.hs;+			refType = 4;+			sourceTree = "<group>";+		};+		7B5F81980673839D00AC9FA4 = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.make;+			path = Makefile;+			refType = 4;+			sourceTree = "<group>";+		};+		7B5F81990673839D00AC9FA4 = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.haskell;+			path = PluginEvalAux.hs;+			refType = 4;+			sourceTree = "<group>";+		};+		7B5F819A0673839D00AC9FA4 = {+			fileRef = 7B5F81970673839D00AC9FA4;+			isa = PBXBuildFile;+			settings = {+			};+		};+		7B5F819B0673839D00AC9FA4 = {+			fileRef = 7B5F81980673839D00AC9FA4;+			isa = PBXBuildFile;+			settings = {+			};+		};+		7B5F819C0673839D00AC9FA4 = {+			fileRef = 7B5F81990673839D00AC9FA4;+			isa = PBXBuildFile;+			settings = {+			};+		};+		7B5F819D067383A400AC9FA4 = {+			fileEncoding = 30;+			isa = PBXFileReference;+			lastKnownFileType = sourcecode.haskell;+			path = ArithmeticExpressionParser.hs;+			refType = 4;+			sourceTree = "<group>";+		};+		7B5F819E067383A400AC9FA4 = {+			fileRef = 7B5F819D067383A400AC9FA4;+			isa = PBXBuildFile;+			settings = {+			};+		};+		7B5F81A1067383A700AC9FA4 = {+			children = (+				7B5F819D067383A400AC9FA4,+				7B5F81970673839D00AC9FA4,+			);+			isa = PBXGroup;+			name = Parsers;+			refType = 4;+			sourceTree = "<group>";+		};+		7B5F81A4067389B000AC9FA4 = {+			buildArgumentsString = "$(ACTION)";+			buildPhases = (+			);+			buildSettings = {+				OPTIMIZATION_CFLAGS = "";+				OTHER_CFLAGS = "";+				OTHER_LDFLAGS = "";+				OTHER_REZFLAGS = "";+				PRODUCT_NAME = "PluginExpressionParser (GNU make)";+				SECTORDER_FLAGS = "";+				WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas";+			};+			buildToolPath = /usr/bin/make;+			dependencies = (+			);+			isa = PBXLegacyTarget;+			name = "PluginExpressionParser (GNU make)";+			passBuildSettingsInEnvironment = 1;+			productName = "PluginExpressionParser (GNU make)";+		};+//7B0+//7B1+//7B2+//7B3+//7B4+//8D0+//8D1+//8D2+//8D3+//8D4+		8D15AC270486D014006FF6A4 = {+			buildPhases = (+				8D15AC280486D014006FF6A4,+				8D15AC2B0486D014006FF6A4,+				8D15AC300486D014006FF6A4,+				8D15AC330486D014006FF6A4,+			);+			buildRules = (+			);+			buildSettings = {+				FRAMEWORK_SEARCH_PATHS = "";+				GCC_ENABLE_TRIGRAPHS = NO;+				GCC_GENERATE_DEBUGGING_SYMBOLS = NO;+				GCC_PRECOMPILE_PREFIX_HEADER = YES;+				GCC_PREFIX_HEADER = PluginExpressionParser_Prefix.pch;+				GCC_WARN_ABOUT_MISSING_PROTOTYPES = NO;+				GCC_WARN_FOUR_CHARACTER_CONSTANTS = NO;+				GCC_WARN_UNKNOWN_PRAGMAS = NO;+				HEADER_SEARCH_PATHS = "";+				INFOPLIST_FILE = Info.plist;+				INSTALL_PATH = "$(HOME)/Applications";+				LIBRARY_SEARCH_PATHS = "";+				OTHER_CFLAGS = "";+				OTHER_LDFLAGS = "";+				PRODUCT_NAME = PluginExpressionParser;+				SECTORDER_FLAGS = "";+				WARNING_CFLAGS = "-Wmost -Wno-four-char-constants -Wno-unknown-pragmas";+				WRAPPER_EXTENSION = app;+			};+			dependencies = (+			);+			isa = PBXNativeTarget;+			name = PluginExpressionParser;+			productInstallPath = "$(HOME)/Applications";+			productName = PluginExpressionParser;+			productReference = 8D15AC370486D014006FF6A4;+			productType = "com.apple.product-type.application";+		};+		8D15AC280486D014006FF6A4 = {+			buildActionMask = 2147483647;+			files = (+				8D15AC290486D014006FF6A4,+				8D15AC2A0486D014006FF6A4,+				7B5F819606737AAC00AC9FA4,+			);+			isa = PBXHeadersBuildPhase;+			runOnlyForDeploymentPostprocessing = 0;+		};+		8D15AC290486D014006FF6A4 = {+			fileRef = 32DBCF750370BD2300C91783;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC2A0486D014006FF6A4 = {+			fileRef = 2A37F4AEFDCFA73011CA2CEA;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC2B0486D014006FF6A4 = {+			buildActionMask = 2147483647;+			files = (+				8D15AC2C0486D014006FF6A4,+				8D15AC2D0486D014006FF6A4,+				8D15AC2E0486D014006FF6A4,+				8D15AC2F0486D014006FF6A4,+				7B5F819A0673839D00AC9FA4,+				7B5F819B0673839D00AC9FA4,+				7B5F819C0673839D00AC9FA4,+				7B5F819E067383A400AC9FA4,+			);+			isa = PBXResourcesBuildPhase;+			runOnlyForDeploymentPostprocessing = 0;+		};+		8D15AC2C0486D014006FF6A4 = {+			fileRef = 2A37F4B9FDCFA73011CA2CEA;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC2D0486D014006FF6A4 = {+			fileRef = 2A37F4B6FDCFA73011CA2CEA;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC2E0486D014006FF6A4 = {+			fileRef = 2A37F4B4FDCFA73011CA2CEA;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC2F0486D014006FF6A4 = {+			fileRef = 089C165FFE840EACC02AAC07;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC300486D014006FF6A4 = {+			buildActionMask = 2147483647;+			files = (+				8D15AC310486D014006FF6A4,+				8D15AC320486D014006FF6A4,+			);+			isa = PBXSourcesBuildPhase;+			runOnlyForDeploymentPostprocessing = 0;+		};+		8D15AC310486D014006FF6A4 = {+			fileRef = 2A37F4ACFDCFA73011CA2CEA;+			isa = PBXBuildFile;+			settings = {+				ATTRIBUTES = (+				);+			};+		};+		8D15AC320486D014006FF6A4 = {+			fileRef = 2A37F4B0FDCFA73011CA2CEA;+			isa = PBXBuildFile;+			settings = {+				ATTRIBUTES = (+				);+			};+		};+		8D15AC330486D014006FF6A4 = {+			buildActionMask = 2147483647;+			files = (+				8D15AC340486D014006FF6A4,+			);+			isa = PBXFrameworksBuildPhase;+			runOnlyForDeploymentPostprocessing = 0;+		};+		8D15AC340486D014006FF6A4 = {+			fileRef = 1058C7A7FEA54F5311CA2CBB;+			isa = PBXBuildFile;+			settings = {+			};+		};+		8D15AC360486D014006FF6A4 = {+			fileEncoding = 4;+			isa = PBXFileReference;+			lastKnownFileType = text.plist;+			path = Info.plist;+			refType = 4;+			sourceTree = "<group>";+		};+		8D15AC370486D014006FF6A4 = {+			explicitFileType = wrapper.application;+			includeInIndex = 0;+			isa = PBXFileReference;+			path = PluginExpressionParser.app;+			refType = 3;+			sourceTree = BUILT_PRODUCTS_DIR;+		};+	};+	rootObject = 2A37F4A9FDCFA73011CA2CEA;+}
+ testsuite/objc/expression_parser/PluginExpressionParser_Prefix.pch view
@@ -0,0 +1,7 @@+//+// Prefix header for all source files of the 'PluginExpressionParser' target in the 'PluginExpressionParser' project+//++#ifdef __OBJC__+    #import <Cocoa/Cocoa.h>+#endif
+ testsuite/objc/expression_parser/README view
@@ -0,0 +1,6 @@+This little application is an example of using hs-plugins to embed a Haskell+'interpreter' inside an Objective-C, Cocoa-based program.  You will need Mac OS+X for this to be of any use!++To build it, type 'make', which will build a .app bundle in the build/ directory.  Or, 'open *.xcode', and hit the build button in there.+
+ testsuite/objc/expression_parser/RunHaskell.h view
@@ -0,0 +1,4 @@+#include "HsFFI.h"++extern HsPtr evalhaskell_CString(HsPtr a1, HsPtr a2);+
+ testsuite/objc/expression_parser/dont_test view
+ testsuite/objc/expression_parser/main.m view
@@ -0,0 +1,26 @@+//+//  main.m+//  PluginExpressionParser+//+//  Created by AndrŽ Pang on Mon Jun 07 2004.+//  Copyright (c) 2004 __MyCompanyName__. All rights reserved.+//++#import <Cocoa/Cocoa.h>++#include "HsFFI.h"++extern void __stginit_PluginEvalAux (void);++int main(int argc, char *argv[])+{+    hs_init(&argc, &argv);+    hs_add_root(__stginit_PluginEvalAux);+    const char *c_argv = (const char *) argv;+    int retval = NSApplicationMain(argc, &c_argv);+    hs_exit();+    return retval;+}++/* vi:sw=4 */+
+ testsuite/objc/expression_parser/version.plist view
@@ -0,0 +1,16 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">+<plist version="1.0">+<dict>+	<key>BuildVersion</key>+	<string>17</string>+	<key>CFBundleShortVersionString</key>+	<string>0.1</string>+	<key>CFBundleVersion</key>+	<string>0.1</string>+	<key>ProjectName</key>+	<string>NibPBTemplates</string>+	<key>SourceVersion</key>+	<string>1150000</string>+</dict>+</plist>
+ testsuite/pdynload/badint/Makefile view
@@ -0,0 +1,5 @@++TEST=pdynload/badint++TOP=../../..+include ../../build.mk
+ testsuite/pdynload/badint/Plugin.hs view
@@ -0,0 +1,4 @@+module Plugin where++resource :: Num t => t+resource = 0xBAD
+ testsuite/pdynload/badint/api/API.hs view
@@ -0,0 +1,9 @@+module API where++data Interface = Interface { +                transform :: String -> String+     }++rsrc :: Interface+rsrc = Interface { transform = id }+
+ testsuite/pdynload/badint/prog/Main.hs view
@@ -0,0 +1,18 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e-> mapM_ putStrLn e+                +   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+                case v of+                  LoadSuccess _ a -> putStrLn $ (transform a) "foo"+                  _               -> putStrLn "wrong types"+
+ testsuite/pdynload/badint/prog/expected view
@@ -0,0 +1,1 @@+wrong types
+ testsuite/pdynload/bayley1/Load.hs view
@@ -0,0 +1,42 @@+module Load where++import API+import System.Plugins++--+-- load doesn't seem to behave nicely when using dirname on hier names+--+-- make, and maybe other places, use dirname to work out various names+-- from paths, which is invalid when hier names are used..+--++testload = do++  s  <- make "../Plugin1.hs"     ["-i../api"]+  o1 <- case s of+    MakeSuccess _ o -> return o+    MakeFailure e   -> mapM_ putStrLn e >> fail "o1"+    +  s  <- make "../Sub/Plugin2.hs" ["-i../api","-hidir.."] -- !+  o2 <- case s of+    MakeSuccess _ o -> return o+    MakeFailure e   -> mapM_ putStrLn e >> fail "o2"++  fc <- pdynload o1 ["..","../api"] [] "API.PluginAPI" "action"++  case fc of+    LoadFailure msg -> mapM_ putStrLn msg +    LoadSuccess modul proc -> do+      let ac :: API.PluginAPI; ac = proc+      let s = proc 42+      print s++  -- will reqeust  'Plugin2', but module is actually 'Sub.Plugin2'+  print o2+  fc <- pdynload (o2) ["..","../api"] [] "API.PluginAPI" "action"+  case fc of+    LoadFailure msg -> mapM_ putStrLn msg +    LoadSuccess modul proc -> do+      let ac :: API.PluginAPI; ac = proc+      let s = proc 42+      print s
+ testsuite/pdynload/bayley1/Makefile view
@@ -0,0 +1,5 @@++TEST=pdynload/bayley1++TOP=../../..+include ../../build.mk
+ testsuite/pdynload/bayley1/Plugin1.hs view
@@ -0,0 +1,6 @@+module Plugin1 where++import qualified API+action :: API.PluginAPI+action i = show i+
+ testsuite/pdynload/bayley1/Sub/Plugin2.hs view
@@ -0,0 +1,6 @@+module Sub.Plugin2 where++import qualified API+action :: API.PluginAPI+action i = show i+
+ testsuite/pdynload/bayley1/api/API.hs view
@@ -0,0 +1,6 @@+module API where++type PluginAPI = Int -> String+action :: PluginAPI+action i = show i+
+ testsuite/pdynload/bayley1/prog/Main.hs view
@@ -0,0 +1,4 @@+module Main where+import Load+main = testload+
+ testsuite/pdynload/null/Makefile view
@@ -0,0 +1,4 @@++TEST=   pdynload/null+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/null/Plugin.hs view
@@ -0,0 +1,5 @@+module Plugin where++import API++resource = D 1
+ testsuite/pdynload/null/api/API.hs view
@@ -0,0 +1,5 @@++module API where++data Num t => Interface t = D t+
+ testsuite/pdynload/null/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+-- import System.Plugins.Utils+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e-> mapM_ putStrLn e++   where f = do v     <- load "../Plugin.o" ["../api"] [] "resource"+                --  (i,_) <- exec "ghc" ["--numeric-version"]+                --  mapM_ putStrLn i+                putStrLn "done."+
+ testsuite/pdynload/null/prog/expected view
@@ -0,0 +1,1 @@+done.
+ testsuite/pdynload/numclass/Makefile view
@@ -0,0 +1,4 @@++TEST=   pdynload/numclass+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/numclass/Plugin.hs view
@@ -0,0 +1,5 @@+module Plugin where++-- import API++resource = "error"
+ testsuite/pdynload/numclass/api/API.hs view
@@ -0,0 +1,5 @@++module API where++data Num t => Interface t = D t+
+ testsuite/pdynload/numclass/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeFailure _   -> putStrLn "make failed"+                MakeSuccess _ _ -> do {++       ;v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface Integer" "resource"+       ;case v of+          LoadSuccess _ a -> let D i = snd a in putStrLn $ show i+          _               -> putStrLn "wrong types"++       }
+ testsuite/pdynload/numclass/prog/expected view
@@ -0,0 +1,1 @@+wrong types
+ testsuite/pdynload/poly/Makefile view
@@ -0,0 +1,5 @@++TEST=pdynload/poly++TOP=../../..+include ../../build.mk
+ testsuite/pdynload/poly/Plugin.hs view
@@ -0,0 +1,9 @@+module Plugin where++import Data.Generics.Schemes++import API++resource = rsrc { +     field = id listify+}
+ testsuite/pdynload/poly/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}+-- a really nasty type:++module API where++import Data.Generics++data Interface = Interface { field :: Typeable r => (r -> Bool) -> GenericQ [r] }++rsrc :: Interface+rsrc = Interface { field = listify }+
+ testsuite/pdynload/poly/prog/Main.hs view
@@ -0,0 +1,17 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e   -> mapM_ putStrLn e++  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+               case v of+                 LoadSuccess _ a  -> putStrLn "loaded .. yay!"+                 _                -> putStrLn "wrong types"
+ testsuite/pdynload/poly/prog/expected view
@@ -0,0 +1,1 @@+loaded .. yay!
+ testsuite/pdynload/poly1/Makefile view
@@ -0,0 +1,4 @@+TEST=   pdynload/poly1+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/poly1/Plugin.hs view
@@ -0,0 +1,5 @@+module Plugin where++import API++resource = plugin { function = (+) }
+ testsuite/pdynload/poly1/api/API.hs view
@@ -0,0 +1,9 @@+module API where++data Interface = Interface { +        function :: (Num a) => a -> a -> a+}++plugin :: Interface+plugin = Interface  { function = error "no function defined" }+
+ testsuite/pdynload/poly1/prog/Main.hs view
@@ -0,0 +1,18 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e -> mapM_ putStrLn e++   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+                case v of+                  LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2+                  _               -> putStrLn "wrong types"+
+ testsuite/pdynload/poly1/prog/expected view
@@ -0,0 +1,1 @@+3
+ testsuite/pdynload/should_fail0/Makefile view
@@ -0,0 +1,4 @@+TEST=   pdynload/should_fail0+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/should_fail0/Plugin.hs view
@@ -0,0 +1,9 @@+module Plugin where++import API++resource = 0xBAD :: Int++-- resource = tiny { +--     field = "hello strange world"+-- }
+ testsuite/pdynload/should_fail0/api/API.hs view
@@ -0,0 +1,13 @@+{-# OPTIONS -fglasgow-exts #-}+-- ^ needed to derive Typeable++module API where++import Data.Dynamic++data Interface = Interface { field :: String }+   deriving (Show)++rsrc :: Interface+rsrc = Interface { field = "default value" }+
+ testsuite/pdynload/should_fail0/prog/Main.hs view
@@ -0,0 +1,18 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e -> mapM_ putStrLn e+    where +       f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+              case v of+                LoadSuccess _ a  -> putStrLn "loaded .. yay!"+                _              -> putStrLn "wrong types"+
+ testsuite/pdynload/should_fail0/prog/expected view
@@ -0,0 +1,1 @@+wrong types
+ testsuite/pdynload/should_fail1/Makefile view
@@ -0,0 +1,5 @@+# Missing class constraint... can't do that in Clean++TEST=   pdynload/should_fail1+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/should_fail1/Plugin.hs view
@@ -0,0 +1,5 @@+module Plugin where++data I = I Int++resource = I 1
+ testsuite/pdynload/should_fail1/api/API.hs view
@@ -0,0 +1,8 @@++module API where++newtype Interface = I Int++rsrc :: Interface+rsrc = I 1+
+ testsuite/pdynload/should_fail1/prog/Main.hs view
@@ -0,0 +1,17 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e -> mapM_ putStrLn e++   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+                case v of+                  LoadSuccess _ a -> putStrLn "loaded .. yay!"+                  _               -> putStrLn "wrong types"
+ testsuite/pdynload/should_fail1/prog/expected view
@@ -0,0 +1,1 @@+wrong types
+ testsuite/pdynload/small/Makefile view
@@ -0,0 +1,4 @@+TEST=   pdynload/small+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/small/Plugin.hs view
@@ -0,0 +1,5 @@+module Plugin where++import API++resource = plugin { function = "good" }
+ testsuite/pdynload/small/api/API.hs view
@@ -0,0 +1,9 @@+module API where++data Interface = Interface { +        function :: String+}++plugin :: Interface+plugin = Interface  { function = "goodbye" }+
+ testsuite/pdynload/small/prog/Main.hs view
@@ -0,0 +1,18 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e -> mapM_ putStrLn e++   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+                case v of+                  LoadSuccess _ a  -> putStrLn "loaded .. yay!"+                  _                -> putStrLn "wrong types"+
+ testsuite/pdynload/small/prog/expected view
@@ -0,0 +1,1 @@+loaded .. yay!
+ testsuite/pdynload/spj1/Makefile view
@@ -0,0 +1,5 @@++TEST=pdynload/spj1++TOP=../../..+include ../../build.mk
+ testsuite/pdynload/spj1/Plugin.hs view
@@ -0,0 +1,17 @@+module Plugin where++-- user doesn't import the API+-- and provides a polymorphic value++-- import API+-- resource :: Interface++--+-- should pass type check, and dump core+--+-- resource :: Num a => a++-- import API++resource :: Num a => a+resource = 7
+ testsuite/pdynload/spj1/api/API.hs view
@@ -0,0 +1,9 @@++module API where++-- data Interface = Interface { field :: Int }++-- newtype Interface = Interface Int++type Interface = Int+
+ testsuite/pdynload/spj1/dont_test view
+ testsuite/pdynload/spj1/prog/Main.hs view
@@ -0,0 +1,17 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e   -> mapM_ putStrLn e++  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+               case v of+                 LoadSuccess _ (a :: Interface) -> print $ a -- will crash+                 LoadFailure es     -> putStrLn $ show es
+ testsuite/pdynload/spj1/prog/expected view
+ testsuite/pdynload/spj2/Makefile view
@@ -0,0 +1,5 @@++TEST=pdynload/spj1++TOP=../../..+include ../../build.mk
+ testsuite/pdynload/spj2/Plugin.hs view
@@ -0,0 +1,13 @@+module Plugin where++-- user doesn't import the API+-- and provides a polymorphic value++import API+resource :: Interface++--+-- should pass type check, and dump core+--+-- resource :: Num a => a+resource = 7
+ testsuite/pdynload/spj2/api/API.hs view
@@ -0,0 +1,6 @@++module API where++-- simple type+type Interface = Int+
+ testsuite/pdynload/spj2/prog/Main.hs view
@@ -0,0 +1,17 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e   -> mapM_ putStrLn e++  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+               case v of+                 LoadSuccess _ (a :: Interface) -> putStrLn $ show a -- will crash+                 LoadFailure es     -> putStrLn $ show es
+ testsuite/pdynload/spj2/prog/expected view
@@ -0,0 +1,1 @@+7
+ testsuite/pdynload/spj3/Makefile view
@@ -0,0 +1,3 @@+TEST=   pdynload/spj3+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/spj3/Plugin.hs view
@@ -0,0 +1,5 @@+module Plugin where++import API++resource = plugin { function = (+) :: Int -> Int -> Int }
+ testsuite/pdynload/spj3/api/API.hs view
@@ -0,0 +1,9 @@+module API where++data Interface = Interface { +        function :: (Num a) => a -> a -> a+}++plugin :: Interface+plugin = Interface  { function = error "no function defined" }+
+ testsuite/pdynload/spj3/prog/Main.hs view
@@ -0,0 +1,18 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e -> mapM_ putStrLn e++   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+                case v of+                  LoadSuccess _ a -> let fn = function a in putStrLn $ show $ 1 `fn` 2+                  _               -> putStrLn "wrong types"+
+ testsuite/pdynload/spj3/prog/expected view
@@ -0,0 +1,8 @@++../Plugin.hs:5:+    Cannot unify the type-signature variable `a' with the type `Int'+	Expected type: a -> a -> a+	Inferred type: Int -> Int -> Int+    When checking the type signature of the expression:+	  (+) :: Int -> Int -> Int+    In the `function' field of a record
+ testsuite/pdynload/spj3/prog/expected.604 view
@@ -0,0 +1,9 @@++../Plugin.hs:5:31:+    Couldn't match the rigid variable `a' against `Int'+      `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a'+			at ../Plugin.hs:5:11-56+      Expected type: a -> a -> a+      Inferred type: Int -> Int -> Int+    In the expression: (+) :: Int -> Int -> Int+    In the `function' field of a record
+ testsuite/pdynload/spj3/prog/expected.605 view
@@ -0,0 +1,9 @@++../Plugin.hs:5:31:+    Couldn't match the rigid variable `a' against `Int'+      `a' is bound by the polymorphic type `forall a. (Num a) => a -> a -> a'+			at ../Plugin.hs:5:11-56+      Expected type: a -> a -> a+      Inferred type: Int -> Int -> Int+    In the expression: (+) :: Int -> Int -> Int+    In the `function' field of a record
+ testsuite/pdynload/spj4/Makefile view
@@ -0,0 +1,5 @@++TEST=pdynload/spj4++TOP=../../..+include ../../build.mk
+ testsuite/pdynload/spj4/Plugin.hs view
@@ -0,0 +1,16 @@+module Plugin where++-- user doesn't import the API+-- and provides a polymorphic value++-- import API+-- resource :: Interface++--+-- should pass type check, and dump core+--+-- resource :: Num a => a++import API++resource = Interface { field = 7 :: Num a => a }
+ testsuite/pdynload/spj4/api/API.hs view
@@ -0,0 +1,5 @@++module API where++newtype Interface = Interface { field :: Int }+
+ testsuite/pdynload/spj4/prog/Main.hs view
@@ -0,0 +1,17 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e   -> error "there was a type error"++  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+               case v of+                 LoadSuccess _ (a :: Interface) -> print $ field a -- will crash+                 LoadFailure es  -> mapM_ putStrLn es
+ testsuite/pdynload/spj4/prog/expected view
@@ -0,0 +1,1 @@+7
+ testsuite/pdynload/typealias/Makefile view
@@ -0,0 +1,5 @@+# Missing class constraint... can't do that in Clean++TEST=   pdynload/typealias+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/typealias/Plugin.hs view
@@ -0,0 +1,3 @@+module Plugin where++resource = 1 :: Int
+ testsuite/pdynload/typealias/api/API.hs view
@@ -0,0 +1,8 @@++module API where++type Interface = Int++rsrc :: Interface+rsrc = 1+
+ testsuite/pdynload/typealias/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e -> mapM_ putStrLn e++  where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+               case v of+                  LoadSuccess _ a  -> putStrLn "loaded .. yay!"+                  _           -> putStrLn "wrong types"++
+ testsuite/pdynload/typealias/prog/expected view
@@ -0,0 +1,1 @@+loaded .. yay!
+ testsuite/pdynload/univquant/Makefile view
@@ -0,0 +1,4 @@+TEST=   pdynload/univquant+EXTRA_OBJS=Plugin.o+TOP=../../..+include ../../build.mk
+ testsuite/pdynload/univquant/Plugin.hs view
@@ -0,0 +1,8 @@+module Plugin where++import API++resource = plugin { function = my_id }++my_id :: forall a. a -> a+my_id x = x
+ testsuite/pdynload/univquant/api/API.hs view
@@ -0,0 +1,9 @@+module API where++data Interface = Interface { +        function :: forall a. a -> a+}++plugin :: Interface+plugin = Interface  { function = id }+
+ testsuite/pdynload/univquant/prog/Main.hs view
@@ -0,0 +1,17 @@++import System.Plugins+import API++src     = "../Plugin.hs"+wrap    = "../Wrapper.hs"+apipath = "../api"++main = do status <- make src ["-i"++apipath]+          case status of+                MakeSuccess _ _ -> f+                MakeFailure e   -> mapM_ putStrLn e++   where f = do v <- pdynload "../Plugin.o" ["../api"] [] "API.Interface" "resource"+                case v of+                  LoadSuccess _ a  -> putStrLn "loaded .. yay!"+                  _             -> putStrLn "wrong types"
+ testsuite/pdynload/univquant/prog/expected view
@@ -0,0 +1,1 @@+loaded .. yay!
+ testsuite/pkgconf/null/Makefile view
@@ -0,0 +1,16 @@+all:+	@echo "test disabled"++#true_api::+#	( cd api ;\+#	$(GHC) -Onot $(EXTRAFLAGS) -c $(API).hs ;\+#	$(RM) -f libHSapi.a ;\+#	$(AR) cq libHSapi.a API.o ;\+#	$(RANLIB) libHSapi.a ;\+#	$(LD) -r $(LD_X) $(WHOLE_ARCHIVE_FLAG) -o HSapi.o libHSapi.a ;\+#	rm API.o ;\+#	echo [] > package.conf ;\+#	env PREFIX=`pwd` $(GHC_PKG) -f package.conf -u < package.conf.in )+#	$(GHC) -package-conf ${TOP}/plugins.conf.inplace -package plugins \+#		-package-conf api/package.conf            -package api \+#		-O $(EXTRAFLAGS) -c Null.hs
+ testsuite/pkgconf/null/Null.hs view
@@ -0,0 +1,6 @@+module Null ( resource )  where++import API++resource = plugin { a = 7 }+
+ testsuite/pkgconf/null/api/API.hs view
@@ -0,0 +1,10 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++data Null = Null { a, b :: Int }+   deriving Show++plugin :: Null+plugin = Null { a = 42 , b = 1 }+
+ testsuite/pkgconf/null/api/package.conf.in view
@@ -0,0 +1,18 @@+Package {+        name            = "api",+        auto            = False,++        import_dirs     = [ "${PREFIX}" ],+        library_dirs    = [ "${PREFIX}" ],+        hs_libraries    = [ "HSapi" ],++        include_dirs    = [],+        c_includes      = [],+        source_dirs     = [],+        extra_libraries = [],+        package_deps    = [],+        extra_ghc_opts  = [],+        extra_cc_opts   = [],+        extra_ld_opts   = []+}+
+ testsuite/pkgconf/null/dont_test view
+ testsuite/pkgconf/null/prog/Main.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -cpp #-}++#include "../../../../config.h"++import System.Plugins+import API++main = do +    let includes = TOP ++ "/testsuite/load/null/api"+    (_,v) <- load "../Null.o" ["."] ["../api/package.conf"] "resource"+    putStrLn ( show (a v) )+
+ testsuite/plugs/plugs/Main.hs view
@@ -0,0 +1,69 @@+--+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)+--++import System.Eval.Haskell+import System.Plugins.Load++import System.Exit              ( ExitCode(..), exitWith )+import System.IO+import System.Console.Readline  ( readline, addHistory )++symbol = "resource"++main = do+        putStrLn banner +        putStr "Loading package base" >> hFlush stdout+        loadPackage "base" +        putStr " ... linking ... " >> hFlush stdout+        resolveObjs (return ())+        putStrLn "done"++        shell []++shell :: [String] -> IO ()+shell imps = do +        s <- readline "plugs> "+        cmd <- case s of +                Nothing          -> exitWith ExitSuccess+                Just (':':'q':_) -> exitWith ExitSuccess+                Just s           -> addHistory s >> return s+        imps' <- run cmd imps+        shell imps'++run :: String -> [String] -> IO [String]+run ""   is = return is+run ":?" is = putStrLn help >> return is++run ":l" _             = return []+run (':':'l':' ':m) is = return (m:is)++run (':':'t':' ':s) is = do +        ty <- typeOf s is+        when (not $ null ty) (putStrLn $ s ++ " :: " ++ ty)+        return is++run (':':_) is = putStrLn help >> return is++run s is = do +        s <- unsafeEval ("show $ "++s) is+        when (isJust s) (putStrLn (fromJust s))+        return is++banner = "\ +\           __                          \n\+\    ____  / /_  ______ ______          \n\+\   / __ \\/ / / / / __ `/ ___/     PLugin User's GHCi System, for Haskell 98\n\+\  / /_/ / / /_/ / /_/ (__  )      http://www.cse.unsw.edu.au/~dons/hs-plugins\n\+\ / .___/_/\\__,_/\\__, /____/       Type :? for help     \n\+\/_/            /____/                  \n"++help = "\+\Commands :\n\ +\  <expr>               evaluate expression\n\ +\  :t <expr>            show type of expression (monomorphic only)\n\ +\  :l module            bring module in to scope\n\ +\  :l                   clear module list\n\ +\  :quit                quit\n\ +\  :?                   display this list of commands"
+ testsuite/plugs/plugs/Makefile view
@@ -0,0 +1,28 @@+GHCFLAGS=   -O+PKGFLAGS+=  -package plugins -package readline++all: build++build:+	@$(GHC) $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) Main.hs -o plugs+check: build+	@(if [ -f "expected" ] ;\+	  then \+		actual_out="/tmp/hs-plugins-actual.out.$$$$"	   ;\+		diff_out="/tmp/hs-plugins.diff.$$$$"		   ;\+		cat test.in | ./plugs > $$actual_out  2>&1 || true ;\+		diff -u expected $$actual_out > $$diff_out || true ;\+		if [ -s "$$diff_out" ] ; then \+			echo "failed with:"	;\+			cat "$$diff_out" | sed '1,3d' ;\+		else \+			echo "ok." 	;\+		fi ;\+		rm $$actual_out 	;\+	 else \+		cat test.in | ./plugs 2>&1 || true ;\+	 fi)+clean:+	rm -rf *.hi *.o *~ *.dep ./plugs++include ../../../config.mk
+ testsuite/plugs/plugs/expected view
@@ -0,0 +1,9 @@+           __                          +    ____  / /_  ______ ______          +   / __ \/ / / / / __ `/ ___/     PLugin User's GHCi System, for Haskell 98+  / /_/ / / /_/ / /_/ (__  )      http://www.cse.unsw.edu.au/~dons/hs-plugins+ / .___/_/\__,_/\__, /____/       Type :? for help     +/_/            /____/                  ++Loading package base ... linking ... plugs> plugs> done+453973694165307953197296969697410619233826
+ testsuite/plugs/plugs/test.in view
@@ -0,0 +1,2 @@+let fibs = 1 : 1 : zipWith (+) fibs (tail fibs) in fibs !! 200+:quit
+ testsuite/plugs/runplugs/Main.hs view
@@ -0,0 +1,57 @@+--+-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)+--++--+-- | Runplugs: use hs-plugins to run a Haskell expression under+-- controlled conditions.+--+import System.Eval.Haskell             (unsafeEval)++import Data.Char                (chr)+import Data.Maybe               (isJust, fromJust)+import Control.Monad++import System.Random+import System.Exit              (exitWith, ExitCode(ExitSuccess))+import System.IO                (getContents, putStrLn)+import System.Posix.Resource    (setResourceLimit,+			         Resource(ResourceCPUTime), +                                 ResourceLimits(ResourceLimits),+			         ResourceLimit(ResourceLimit))++import qualified Control.Exception (catch)++rlimit = ResourceLimit 3++context = prehier ++ datas ++ qualifieds ++ controls++prehier = ["Char", "List", "Maybe", "Numeric", "Random" ]++qualifieds = ["qualified Data.Map as M"+             ,"qualified Data.Set as S"+             ,"qualified Data.IntSet as I"]++datas   = map ("Data." ++) [+                "Bits", "Bool", "Char", "Dynamic", "Either", +                "Graph", "Int", "Ix", "List",+                "Maybe", "Ratio", "Tree", "Tuple", "Typeable", "Word" +              ]++controls = map ("Control." ++) ["Monad", "Monad.Reader", "Monad.Fix", "Arrow"]++main = do+    setResourceLimit ResourceCPUTime (ResourceLimits rlimit rlimit)+    s <- getLine+    when (not . null $ s) $ do+        x <- sequence (take 3 (repeat $ getStdRandom (randomR (97,122)) >>= return . chr))+        s <- unsafeEval ("let { "++x+++                         " = \n# 1 \"<irc>\"\n"++s+++                         "\n} in take 2048 (show "++x+++                         ")") context+        when (isJust s) $ Control.Exception.catch +                    (putStrLn $ fromJust s)+                    (\e -> putStrLn $ "Exception: " ++ show e )+    exitWith ExitSuccess+
+ testsuite/plugs/runplugs/Makefile view
@@ -0,0 +1,30 @@+GHCFLAGS=   -Onot $(GHC_EXTRA_OPTS)+PKGFLAGS=   -package posix+PKGFLAGS+=  -package plugins++all: build++build:+	@$(GHC) $(GHCFLAGS) $(PKGFLAGS) $(EXTRAFLAGS) Main.hs -o runplugs+include ../../../config.mk+check: build+	@(if [ -f "expected" ] ;\+	  then \+		actual_out="/tmp/hs-plugins-actual.out.$$$$"	   ;\+		diff_out="/tmp/hs-plugins.diff.$$$$"		   ;\+		cat test.in | ./runplugs > $$actual_out  2>&1 || true ;\+		diff -u expected $$actual_out > $$diff_out || true ;\+		if [ -s "$$diff_out" ] ; then \+			echo "failed with:"	;\+			cat "$$diff_out" | sed '1,3d' ;\+		else \+			echo "ok." 	;\+		fi ;\+		rm $$actual_out 	;\+	 else \+		cat test.in | ./runplugs 2>&1 || true ;\+	 fi)+clean:+	rm -rf *.hi *.o *~ *.dep ./runplugs++include ../../../config.mk
+ testsuite/plugs/runplugs/expected view
@@ -0,0 +1,1 @@+453973694165307953197296969697410619233826
+ testsuite/plugs/runplugs/test.in view
@@ -0,0 +1,1 @@+let fibs = 1 : 1 : zipWith (+) fibs (tail fibs) in fibs !! 200
+ testsuite/reload/null/Makefile view
@@ -0,0 +1,4 @@+TEST=   reload/null+EXTRA_OBJS=Null.o+TOP=../../..+include ../../build.mk
+ testsuite/reload/null/Null.hs view
@@ -0,0 +1,11 @@+module Null ( resource, resource_dyn )  where++import API+import Data.Dynamic+import Prelude hiding (null)++resource = null++-- ! this has to be special: it can't be overridden by the user.+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/reload/null/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Null = Null { a, b :: Int }+   deriving (Typeable, Show)++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/reload/null/prog/Main.hs view
@@ -0,0 +1,19 @@++import System.Plugins+import API++-- an example where we just want to load an object and run it++main = do +    m_v <- load "../Null.o" ["../api"] [] "resource"+    (m,v) <- case m_v of+        LoadSuccess m v -> return (m,v)+        _               -> error "load failed"+    putStrLn ( show (a v) )++    m_v <- reload m "resource"   -- get a new version+    v' <- case m_v of+        LoadSuccess _ v -> return v+        _               -> error "load failed"+    putStrLn ( show (a v') )+
+ testsuite/reload/null/prog/expected view
@@ -0,0 +1,2 @@+42+42
+ testsuite/shell/shell/API.hs view
@@ -0,0 +1,8 @@+module API where++-- the interface between the app and the plugin+data Interface = Interface { function :: String -> String }++-- default values for the interface+plugin :: Interface+plugin = Interface { function = id }
+ testsuite/shell/shell/Main.hs view
@@ -0,0 +1,85 @@+--+-- a simple shell for loading plugins and evaluating their functions+-- ++import System.Plugins+import API++import Data.Either+import Data.Char+import Control.Monad            ( when )+import System.Console.Readline  ( readline )+import System.Exit              ( ExitCode(..), exitWith )+++source = "Plugin.hs"+stub   = "Plugin.stub"++sym = "resource"++main = do+        status <- makeWith source stub []+        p <- case status of+                MakeFailure e -> mapM_ putStrLn e >> error "failed to compile"+                MakeSuccess _ obj -> do+                        m_v <- load obj ["."] [] sym+                        case m_v of+                                LoadSuccess m v -> return (m,v)+                                LoadFailure e   -> do mapM_ putStrLn e+                                                      error "failed to load"+        shell p++    where+        shell p@(m,v) = do ++            s <- readline "> "+            cmd <- case s of +                Nothing   -> exitWith ExitSuccess+                Just ":q" -> exitWith ExitSuccess+                Just s    -> return (chomp s)++            status <- makeWith source stub []   +            case status of +                MakeFailure e -> do +                    mapM_ putStrLn e+                    shell p     -- print error and back to prompt++                MakeSuccess NotReq o ->  do+                    p' <- eval cmd p+                    shell p'    -- eval str again++                MakeSuccess ReComp o -> do+                    m_v' <- reload m sym+                    case m_v' of+                        LoadFailure e    -> mapM_ putStrLn e >> error "failed to load"+                        LoadSuccess _ v' -> do+                                let p' = (m,v')+                                p'' <- eval cmd p'+                                shell p''++--+-- shell commands+--+eval "" p = return p++eval ":clear" p = do+        let loop i = when (i < 40) (do putStr "\n" ; loop $! i+1)+        loop 0+        return p++eval ":?"  p     = do+        putStrLn$"\":?\"\n"       +++                 "\":quit\"\n"    +++                 "\":clear\"\n"   +++                 "\"foo\""+        return p++eval s (m,v) = putStrLn ((function v) s) >> return (m,v)++--+-- strip trailing whitespace+--+chomp :: String -> String+chomp [] = []+chomp s | isSpace (last s) = chomp $! init s+        | otherwise        = s
+ testsuite/shell/shell/Makefile view
@@ -0,0 +1,2 @@+TOP=../../..+include ../../eval.mk
+ testsuite/shell/shell/Plugin.hs view
@@ -0,0 +1,5 @@++resource = plugin { +        function = map toUpper+}+
+ testsuite/shell/shell/Plugin.stub view
@@ -0,0 +1,19 @@+--+-- this is a "stub" file, containing default syntax we don't+-- want the user to have to write+--+-- for example, it constrains the module name and force the API to be+-- imported++module Plugin ( resource ) where++import API+import Data.Char+import Data.List++-- this is a default definition of 'resource'. it will be overridden+-- by anything the user writes. useful for default values++resource :: Interface+resource = plugin+
+ testsuite/shell/shell/README view
@@ -0,0 +1,23 @@+$ make+$ ./a.out +Compiling plugin ... done+Loading package base ... linking ... done+Loading objects API Plugin ... done+> ?+"?"+"quit"+"clear"+"filter foo"+> filter adf adsf+fsda fda+> filter asd faSDFADSF+FSDAFDSaf dsa++-- at this point I edit the plugin and save the source++> filter asfdaSDFASD+Compiling plugin ... done+Reloading Plugin ... done+DSAFDSADFSA++-- it compiled and reloaded it for me. nice.
+ testsuite/shell/shell/dont_test view
+ testsuite/shell/simple/Main.hs view
@@ -0,0 +1,41 @@+import System.Plugins+import StringProcessorAPI+import System.Console.Readline+import System.Exit++source = "Plugin.hs"+stub   = "Plugin.stub"+symbol = "resource"++main = do s <- makeWith source stub []+          o <- case s of+                MakeSuccess _ obj -> do+                        ls <- load obj ["."] [] symbol+                        case ls of LoadSuccess m v -> return (m,v)+                                   LoadFailure err -> error "load failed"+                MakeFailure e -> mapM_ putStrLn e >> error "compile failed"+          shell o++shell o@(m,plugin) = do +        s <- readline "> "+        cmd <- case s of +                Nothing          -> exitWith ExitSuccess+                Just (':':'q':_) -> exitWith ExitSuccess+                Just s           -> addHistory s >> return s++        s  <- makeWith source stub []   -- maybe recompile the source+        o' <- case s of+                MakeSuccess ReComp o -> do +                        ls <- reload m symbol+                        case ls of LoadSuccess m' v' -> return (m',v')+                                   LoadFailure err   -> error "reload failed"+                MakeSuccess NotReq _ -> return o+                MakeFailure e -> mapM_ putStrLn e >> shell o+        eval cmd o'+        shell o'++eval ":?" _ = putStrLn ":?\n:q\n<string>"++eval s (_,plugin) = let fn = (stringProcessor plugin) in putStrLn (fn s)++
+ testsuite/shell/simple/Makefile view
@@ -0,0 +1,6 @@+OBJS=StringProcessorAPI.o+TOP=../../..+include ../../eval.mk++#all:+#	@echo test disabled
+ testsuite/shell/simple/Plugin.hs view
@@ -0,0 +1,5 @@+import Char++resource = plugin { +        stringProcessor = map toUpper+}
+ testsuite/shell/simple/Plugin.stub view
@@ -0,0 +1,19 @@+--+-- this is a "stub" file, containing default syntax we don't+-- want the user to have to write+--+-- for example, it constrains the module name and force the API to be+-- imported++module Plugin ( resource ) where++import StringProcessorAPI+import Data.Char+import Data.List++-- this is a default definition of 'resource'. it will be overridden+-- by anything the user writes. useful for default values++resource :: Interface+resource = plugin+
+ testsuite/shell/simple/README view
@@ -0,0 +1,23 @@+$ make+$ ./a.out +Compiling plugin ... done+Loading package base ... linking ... done+Loading objects API Plugin ... done+> ?+"?"+"quit"+"clear"+"filter foo"+> filter adf adsf+fsda fda+> filter asd faSDFADSF+FSDAFDSaf dsa++-- at this point I edit the plugin and save the source++> filter asfdaSDFASD+Compiling plugin ... done+Reloading Plugin ... done+DSAFDSADFSA++-- it compiled and reloaded it for me. nice.
+ testsuite/shell/simple/StringProcessorAPI.hs view
@@ -0,0 +1,8 @@+module StringProcessorAPI where++data Interface = Interface { +        stringProcessor :: String -> String +}++plugin :: Interface+plugin = Interface { stringProcessor = id }
+ testsuite/shell/simple/dont_test view
+ testsuite/unload/null/Makefile view
@@ -0,0 +1,4 @@+TEST=   unload/null+EXTRA_OBJS=Null.o+TOP=../../..+include ../../build.mk
+ testsuite/unload/null/Null.hs view
@@ -0,0 +1,11 @@+module Null ( resource, resource_dyn )  where++import API+import Data.Dynamic+import Prelude hiding (null)++resource = null++-- ! this has to be special: it can't be overridden by the user.+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/unload/null/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Null = Null { a, b :: Int }+   deriving (Typeable, Show)++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/unload/null/prog/Main.hs view
@@ -0,0 +1,11 @@++import System.Plugins+import API++-- an example where we just want to load an object and run it++main = do +    m_v   <- load "../Null.o" ["../api"] [] "resource"+    case m_v of+        LoadFailure _   -> error "load failed"+        LoadSuccess m v -> do putStrLn ( show (a v) ) ; unload m
+ testsuite/unload/null/prog/expected view
@@ -0,0 +1,1 @@+42
+ testsuite/unload/sjwtrap/Makefile view
@@ -0,0 +1,4 @@+TEST=   unload/sjwtrap+EXTRA_OBJS=Null.o+TOP=../../..+include ../../build.mk
+ testsuite/unload/sjwtrap/Null.hs view
@@ -0,0 +1,6 @@+module Null where++import qualified Prelude+import API++resource = null
+ testsuite/unload/sjwtrap/api/API.hs view
@@ -0,0 +1,9 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++data Null = Null { a, b :: Int }++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/unload/sjwtrap/prog/Main.hs view
@@ -0,0 +1,15 @@++import System.Plugins+import API++--+-- what happens if we try to use code that has been unloaded?+--++main = do +    m_v   <- load "../Null.o" ["../api"] [] "resource"+    (m,v) <- case m_v of+        LoadSuccess m v -> return (m,v)+        _               -> error "load failed"+    putStrLn ( show (a v) )+    unload m
+ testsuite/unload/sjwtrap/prog/expected view
@@ -0,0 +1,1 @@+42
+ testsuite/unloadAll/null/Dep.hs view
@@ -0,0 +1,7 @@+module Dep ( resource )  where++import API+import Data.Dynamic+import Prelude hiding (null)++resource = null
+ testsuite/unloadAll/null/Makefile view
@@ -0,0 +1,4 @@+TEST=   unloadAll/null+EXTRA_OBJS=Dep.o Null.o+TOP=../../..+include ../../build.mk
+ testsuite/unloadAll/null/Null.hs view
@@ -0,0 +1,12 @@+module Null ( resource )  where++import API+import Data.Dynamic+import Prelude hiding (null)+import qualified Dep++resource = Dep.resource++-- ! this has to be special: it can't be overridden by the user.+resource_dyn :: Dynamic+resource_dyn = toDyn resource
+ testsuite/unloadAll/null/api/API.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS -fglasgow-exts #-}++module API where++import Data.Dynamic++data Null = Null { a, b :: Int }+   deriving (Typeable, Show)++null :: Null+null = Null { a = 42 , b = 1 }+
+ testsuite/unloadAll/null/prog/Main.hs view
@@ -0,0 +1,15 @@++import System.Plugins+import API++-- an example where we just want to load an object and run it++main = do +    m_v   <- load_ "../Null.o" ["../api",".."] "resource"+    t     <- load_ "../Dep.o" ["../api"] "resource"+    case m_v of+        LoadFailure err -> error (unlines err)+        LoadSuccess m v -> do putStrLn ( show (a v) ) ; unloadAll m -- unloads Null.o but not Dep.o since we're still using it.+    case t of+        LoadFailure err -> error (unlines err)+        LoadSuccess m v -> do putStrLn ( show (a v) ) ; unloadAll m
+ testsuite/unloadAll/null/prog/expected view
@@ -0,0 +1,2 @@+42+42