packages feed

cpphs (empty) → 1.3

raw patch · 82 files changed

+5726/−0 lines, 82 filesdep +basedep +haskell98build-type:Customsetup-changed

Dependencies added: base, haskell98

Files

+ CHANGELOG view
@@ -0,0 +1,118 @@+Version 1.3+-----------+  * Added a "--cpp" option for drop-in compatibility with standard cpp.+    It causes cpphs to accept standard cpp flags and translate+    them to cpphs equivalents.  Compatibility options include: -o, -ansi,+    -traditional, -stdc, -x, -include, -P, -C, -CC, -A.  The file+    behaviour is different too - if two filenames are given on the+    commandline, then the second is treated as the output location.+  * Fixed a corner-case bug in evaluating chained and overlapping #ifdefs.++Version 1.2+-----------+  * Re-arranged the source files into hierarchical libraries.+  * Exposed the library interface as an installable Cabal package, with+    Haddock documentation.+  * Added the --unlit option, for removing literate-style comments.++Version 1.1+-----------+  * Fix the .cabal way of building cpphs.+  * Update the --version reported (forgotten in 1.0, which still reports 0.9)+  * No longer throws an error when given an empty file as input.++Version 1.0+-----------+  * Add a compatibility script cpphs.compat, allowing cpphs to act as+    a drop-in replacement for cpp, e.g.+        ghc -cpp -pgmP cpphs.compat+  * Place quotes around replacements for special macros __FILE__, __DATE__,+    and __TIME__.+  * If no files are specified, read from stdin.+  * Ignore #! lines (e.g. in scripts)+  * Parse -D commandline options once only, and consistently with cpp,+    i.e. -Dfoo means foo=1+  * Fix compatibility with preprocessors like hsc2hs, which use+    non-cpp directives like #def.  They are now passed through to the+    output with a warning to stderr.++Version 0.9+-----------+  * Bugfix for ghc-6.4 -O: flush the output buffer.++Version 0.8+-----------+  * Added the --text option, to signify the input should not+    be lexed as Haskell.  This causes macros to be defined or expanded+    regardless of their location within comments, string delimiters, etc.+  * Shuffle a few files around to make it easier to say 'hmake cpphs'.+    There is also now a runhugs script to invoke cpphs nicely.++Version 0.7+-----------+  * Enable the __FILE__, __LINE__, __DATE__, and __TIME__ specials, which+    can be useful for creating DIY error messages.++Version 0.6+-----------+  * Recognise and ignore the #pragma cpp directive.+  * Fix beginning-of-file bug, where in --noline mode, a # cpp directive+    at the top of the file appeared in the output.+  * Fix chained parenthesised boolean exprs in #if, e.g.+        #if ( foo ) && ( bar )+  * Fix precedence in chained unparenthesised boolean exprs in #if, e.g.+        #if foo && bar || baz && frob+  * For better compatibility with cpp, and because otherwise+    there are certain constructs that cannot be expressed, we no+    longer permit whitespace in a <tt>#define</tt> between the+    symbolname and an opening parenthesis, e.g.+        #define f (f' id)+    Previously, this was interpreted as a parametrised macro,+    with arguments in the parens, and no expansion.  Now, the space+    indicates that this is a textual replacement, and the parenthesised+    expression is in fact the replacement.++Version 0.5+-----------+  * Added a --version flag to report the version number.+  * Renamed --stringise to --hashes, and use it to turn on ## catenation+    as well.+  * Bugfix for #if 1, previously taken as false.+  * Bugfix for --nolines: it no longer adds extra spurious newlines.+  * File inclusion now looks in the directory of the calling file.+  * Failure to find an include file is now merely a warning to stderr+    rather than an error.+  * Added a --layout flag.  Previously, line continuations in a macro+    definition were always preserved in the output, permitting use+    of the Haskell layout rule even inside a macro.  The default is now+    to remove line continuations for conformance with cpp, but the option+    of using --layout is still possible.++Version 0.4+-----------+  * New flag -Ofile to redirect output+  * Bugfix for precedence in   #if !False && False+  * Bugfix for whitespace between # and if+  * Bugfix for #define F "blah"; #include F++Version 0.3+-----------+  * Bugfix for recursive macro expansion.+  * New flag --strip to remove C comments even outside cpp directives.+  * New flag --stringise to recognise the # stringise operator in macros.++Version 0.2+-----------+  * New flag --noline to eliminate #line directives from output.+  * Add symbol-replacement and macro-expansion.+  * New flag --nomacro to turn off symbol/macro-expansion.++2004-Apr-21+-----------+  * Now accept multi-line # commands via the \ line continuation operator.+    The original file line numbering is preserved in the output by+    some tricky acrobatics.++Version 0.1+-----------+  * Initial release.
+ LICENCE-LGPL view
@@ -0,0 +1,507 @@+                  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!+
+ Language/Preprocessor/Cpphs.hs view
@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Language.Preprocessor.Cpphs+-- Copyright   :  2000-2006 Malcolm Wallace+-- Licence     :  LGPL+--+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- Include the interface that is exported+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs (runCpphs, cppIfdef, macroPass, CpphsOption(..), parseOption)  where++import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef)+import Language.Preprocessor.Cpphs.MacroPass(macroPass)+import Language.Preprocessor.Cpphs.RunCpphs(runCpphs)+import Language.Preprocessor.Cpphs.Options(CpphsOption(..), parseOption)
+ Language/Preprocessor/Cpphs/CppIfdef.hs view
@@ -0,0 +1,229 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  CppIfdef+-- Copyright   :  1999-2004 Malcolm Wallace+-- Licence     :  LGPL+-- +-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's.+-- and \#include's.+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.CppIfdef+  ( cppIfdef	-- :: FilePath -> [(String,String)] -> [String] -> Bool -> Bool+		--      -> String -> [(Posn,String)]+  ) where+++import Language.Preprocessor.Cpphs.SymTab+import Text.ParserCombinators.HuttonMeijer+-- import HashDefine+import Language.Preprocessor.Cpphs.Position  (Posn,newfile,newline,newlines,cppline,newpos)+import Language.Preprocessor.Cpphs.ReadFirst (readFirst)+import Language.Preprocessor.Cpphs.Tokenise  (linesCpp,reslash)+import Char      (isDigit)+import Numeric   (readHex,readOct,readDec)+import System.IO.Unsafe (unsafePerformIO)+import IO        (hPutStrLn,stderr)++-- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,+--   whilst taking account of \#define's and \#undef's as we encounter them.+cppIfdef :: FilePath		-- ^ File for error reports+	-> [(String,String)]	-- ^ Pre-defined symbols and their values+	-> [String]		-- ^ Search path for \#includes+	-> Bool			-- ^ Leave \#define and \#undef in output?+	-> Bool			-- ^ Place \#line droppings in output?+	-> String		-- ^ The input file content+	-> [(Posn,String)]	-- ^ The file after processing (in lines)+cppIfdef fp syms search leave locat =+    cpp posn defs search leave locat Keep . (cppline posn:) . linesCpp+  where+    posn = newfile fp+    defs = foldr insertST emptyST syms+-- Notice that the symbol table is a very simple one mapping strings+-- to strings.  This pass does not need anything more elaborate, in+-- particular it is not required to deal with any parameterised macros.+++-- | Internal state for whether lines are being kept or dropped.+--   In @Drop n b@, @n@ is the depth of nesting, @b@ is whether+--   we have already succeeded in keeping some lines in a chain of+--   @elif@'s+data KeepState = Keep | Drop Int Bool++-- | Return just the list of lines that the real cpp would decide to keep.+cpp :: Posn -> SymTab String -> [String] -> Bool -> Bool -> KeepState+       -> [String] -> [(Posn,String)]+cpp _ _ _ _ _ _ [] = []++cpp p syms path leave ln Keep (l@('#':x):xs) =+    let ws = words x+        cmd = head ws+        sym = head (tail ws)+        rest = tail (tail ws)+        val  = maybe "1" id (un rest)+        un v = if null v then Nothing else Just (unwords v)+        down = if definedST sym syms then (Drop 1 False) else Keep+        up   = if definedST sym syms then Keep else (Drop 1 False)+        keep str = if gatherDefined p syms str then Keep else (Drop 1 False)+        skipn cpp' p' syms' path' ud xs' =+            let n = 1 + length (filter (=='\n') l) in+            (if leave then ((p,reslash l):) else (replicate n (p,"") ++)) $+            cpp' (newlines n p') syms' path' leave ln ud xs'+    in case cmd of+	"define" -> skipn cpp p (insertST (sym,val) syms) path Keep xs+	"undef"  -> skipn cpp p (deleteST sym syms) path Keep xs+	"ifndef" -> skipn cpp p syms path  down xs+	"ifdef"  -> skipn cpp p syms path  up   xs+	"if"     -> skipn cpp p syms path (keep (unwords (tail ws))) xs+	"else"   -> skipn cpp p syms path (Drop 1 False) xs+	"elif"   -> skipn cpp p syms path (Drop 1 True) xs+	"endif"  -> skipn cpp p syms path  Keep xs+	"pragma" -> skipn cpp p syms path  Keep xs+        ('!':_)  -> skipn cpp p syms path Keep xs	-- \#!runhs scripts+	"include"-> let (inc,content) =+	                  unsafePerformIO (readFirst (unwords (tail ws))+                                                     p path syms)+	            in+		    cpp p syms path leave ln Keep (("#line 1 "++show inc)+                                                  : linesCpp content+                                                  ++ cppline p :"": xs)+	"warning"-> unsafePerformIO $ do+                       hPutStrLn stderr (l++"\nin "++show p)+                       return $ skipn cpp p syms path Keep xs+	"error"  -> error (l++"\nin "++show p)+	"line"   | all isDigit sym+	         -> (if ln then ((p,l):) else id) $+                    cpp (newpos (read sym) (un rest) p)+                        syms path leave ln Keep xs+	n | all isDigit n+	         -> (if ln then ((p,l):) else id) $+	            cpp (newpos (read n) (un (tail ws)) p)+                        syms path leave ln Keep xs+          | otherwise+	         -> unsafePerformIO $ do+                       hPutStrLn stderr ("Warning: unknown directive #"++n+                                        ++"\nin "++show p)+                       return $+                         ((p,l): cpp (newline p) syms path leave ln Keep xs)++cpp p syms path leave ln (Drop n b) (('#':x):xs) =+    let ws = words x+        cmd = head ws+        delse    | n==1 && b = Drop 1 b+                 | n==1      = Keep+                 | otherwise = Drop n b+        dend     | n==1      = Keep+                 | otherwise = Drop (n-1) b+        keep str | n==1      = if not b && gatherDefined p syms str then Keep+                               else (Drop 1) b+                 | otherwise = Drop n b+        skipn cpp' p' syms' path' ud xs' =+                 let n' = 1 + length (filter (=='\n') x) in+                 replicate n' (p,"")+                 ++ cpp' (newlines n' p') syms' path' leave ln ud xs'+    in+    if      cmd == "ifndef" ||+            cmd == "if"     ||+            cmd == "ifdef"  then  skipn cpp p syms path (Drop (n+1) b) xs+    else if cmd == "elif"   then  skipn cpp p syms path+                                                  (keep (unwords (tail ws))) xs+    else if cmd == "else"   then  skipn cpp p syms path delse xs+    else if cmd == "endif"  then  skipn cpp p syms path dend xs+    else skipn cpp p syms path (Drop n b) xs+	-- define, undef, include, error, warning, pragma, line++cpp p syms path leave ln Keep (x:xs) =+    let p' = newline p in seq p' $+    (p,x):  cpp p' syms path leave ln Keep xs+cpp p syms path leave ln d@(Drop _ _) (_:xs) =+    let p' = newline p in seq p' $+    (p,""): cpp p' syms path leave ln d xs+++----+gatherDefined :: Posn -> SymTab String -> String -> Bool+gatherDefined p st inp =+  case papply (parseBoolExp st) inp of+    []      -> error ("Cannot parse #if directive in file "++show p)+    [(b,_)] -> b+    _       -> error ("Ambiguous parse for #if directive in file "++show p)++parseBoolExp :: SymTab String -> Parser Bool+parseBoolExp st =+  do  a <- parseExp1 st+      skip (string "||")+      b <- first (skip (parseBoolExp st))+      return (a || b)+  ++++      parseExp1 st++parseExp1 :: SymTab String -> Parser Bool+parseExp1 st =+  do  a <- parseExp0 st+      skip (string "&&")+      b <- first (skip (parseExp1 st))+      return (a && b)+  ++++      parseExp0 st++parseExp0 :: SymTab String -> Parser Bool+parseExp0 st =+  do  skip (string "defined")+      sym <- bracket (skip (char '(')) (skip (many1 alphanum)) (skip (char ')'))+      return (definedST sym st)+  ++++  do  bracket (skip (char '(')) (parseBoolExp st) (skip (char ')'))+  ++++  do  skip (char '!')+      a <- parseExp0 st+      return (not a)+  ++++  do  sym1 <- skip (many1 alphanum)+      op <- parseOp st+      sym2 <- skip (many1 alphanum)+      let val1 = convert sym1 st+      let val2 = convert sym2 st+      return (op val1 val2)+  ++++  do  sym <- skip (many1 alphanum)+      case convert sym st of+        0 -> return False+        _ -> return True+  where+    convert sym st' =+      case lookupST sym st' of+        Nothing  -> safeRead sym+        (Just a) -> safeRead a+    safeRead s =+      case s of+        '0':'x':s' -> number readHex s'+        '0':'o':s' -> number readOct s'+        _          -> number readDec s+    number rd s =+      case rd s of+        []        -> 0 :: Integer+        ((n,_):_) -> n :: Integer++parseOp :: SymTab String -> Parser (Integer -> Integer -> Bool)+parseOp _ =+  do  skip (string ">=")+      return (>=)+  ++++  do  skip (char '>')+      return (>)+  ++++  do  skip (string "<=")+      return (<=)+  ++++  do  skip (char '<')+      return (<)+  ++++  do  skip (string "==")+      return (==)+  ++++  do  skip (string "!=")+      return (/=)
+ Language/Preprocessor/Cpphs/HashDefine.hs view
@@ -0,0 +1,100 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  HashDefine+-- Copyright   :  2004 Malcolm Wallace+-- Licence     :  LGPL+--+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- What structures are declared in a \#define.+-----------------------------------------------------------------------------+ +module Language.Preprocessor.Cpphs.HashDefine+  ( HashDefine(..)+  , ArgOrText(..)+  , expandMacro+  , parseHashDefine+  ) where++import Char (isSpace)+import List (intersperse)++data HashDefine+	= LineDrop+		{ name :: String }+	| SymbolReplacement+		{ name		:: String+		, replacement	:: String+		, linebreaks    :: Int+		}+	| MacroExpansion+		{ name		:: String+		, arguments	:: [String]+		, expansion	:: [(ArgOrText,String)]+		, linebreaks    :: Int+		}+    deriving (Eq,Show)++-- | 'smart' constructor to avoid warnings from ghc (undefined fields)+symbolReplacement :: HashDefine+symbolReplacement =+    SymbolReplacement+	 { name=undefined, replacement=undefined, linebreaks=undefined }++-- | Macro expansion text is divided into sections, each of which is classified+--   as one of three kinds: a formal argument (Arg), plain text (Text),+--   or a stringised formal argument (Str).+data ArgOrText = Arg | Text | Str deriving (Eq,Show)++-- | Expand an instance of a macro.+--   Precondition: got a match on the macro name.+expandMacro :: HashDefine -> [String] -> Bool -> String+expandMacro macro parameters layout =+    let env = zip (arguments macro) parameters+        replace (Arg,s)  = maybe (error "formal param") id (lookup s env)+        replace (Str,s)  = maybe (error "formal param") str (lookup s env)+        replace (Text,s) = if layout then s else filter (/='\n') s+        str s = '"':s++"\""+    in+    concatMap replace (expansion macro)++-- | Parse a \#define, or \#undef, ignoring other \# directives+parseHashDefine :: Bool -> [String] -> Maybe HashDefine+parseHashDefine ansi def = (command . skip) def+  where+    skip xss@(x:xs) | all isSpace x = skip xs+                    | otherwise     = xss+    skip    []      = []+    command ("line":xs)   = Just (LineDrop ("#line"++concat xs))+    command ("define":xs) = Just (((define . skip) xs) { linebreaks=count def })+    command ("undef":xs)  = Just (((undef  . skip) xs) { linebreaks=count def })+    command _             = Nothing+    undef  (sym:_)   = symbolReplacement { name=sym, replacement=sym }+    define (sym:xs)  = case {-skip-} xs of+                           ("(":ys) -> (macroHead sym [] . skip) ys+                           ys       -> symbolReplacement+                                           { name=sym+                                           , replacement=chop (skip ys) }+    macroHead sym args (",":xs) = (macroHead sym args . skip) xs+    macroHead sym args (")":xs) = MacroExpansion+                                    { name =sym , arguments = reverse args+                                    , expansion = classifyRhs args (skip xs)+                                    , linebreaks = undefined }+    macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs+    macroHead sym args []       = error ("incomplete macro definition:\n"+                                        ++"  #define "++sym++"("+                                        ++concat (intersperse "," args))+    classifyRhs args ("#":x:xs)+                          | ansi &&+                            x `elem` args    = (Str,x): classifyRhs args xs+    classifyRhs args ("##":xs)+                          | ansi             = classifyRhs args xs+    classifyRhs args (word:xs)+                          | word `elem` args = (Arg,word): classifyRhs args xs+                          | otherwise        = (Text,word): classifyRhs args xs+    classifyRhs _    []                      = []+    count = length . filter (=='\n') . concat+    chop  = concat . reverse . dropWhile (all isSpace) . reverse+
+ Language/Preprocessor/Cpphs/MacroPass.hs view
@@ -0,0 +1,113 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  MacroPass+-- Copyright   :  2004 Malcolm Wallace+-- Licence     :  LGPL+--+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- Perform a cpp.second-pass, accumulating \#define's and \#undef's,+-- whilst doing symbol replacement and macro expansion.+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.MacroPass+  ( macroPass+  , preDefine+  ) where++import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro)+import Language.Preprocessor.Cpphs.Tokenise   (tokenise, WordStyle(..), parseMacroCall)+import Language.Preprocessor.Cpphs.SymTab     (SymTab, lookupST, insertST, emptyST)+import Language.Preprocessor.Cpphs.Position   (Posn, newfile, filename, lineno)+import System.IO.Unsafe (unsafePerformIO)+import Time       (getClockTime, toCalendarTime, formatCalendarTime)+import Locale     (defaultTimeLocale)++noPos :: Posn+noPos = newfile "preDefined"++-- | Walk through the document, replacing calls of macros with their expanded RHS.+macroPass :: [(String,String)]	-- ^ Pre-defined symbols and their values+          -> Bool		-- ^ Strip C-comments?+          -> Bool		-- ^ Accept \# and \## operators?+          -> Bool		-- ^ Retain layout in macros?+          -> Bool		-- ^ Input language (Haskell\/not)+          -> [(Posn,String)]	-- ^ The input file content+          -> String		-- ^ The file after processing+macroPass syms strip hashes layout language =+    safetail		-- to remove extra "\n" inserted below+    . concat+    . macroProcess layout language (preDefine hashes language syms)+    . tokenise strip hashes language+    . ((noPos,""):)	-- ensure recognition of "\n#" at start of file+  where+    safetail [] = []+    safetail (_:xs) = xs+++-- | Turn command-line definitions (from @-D@) into 'HashDefine's.+preDefine :: Bool -> Bool -> [(String,String)] -> SymTab HashDefine+preDefine hashes lang defines =+    foldr (insertST.defval) emptyST defines+  where+    defval (s,d) =+        let (Cmd (Just hd):_) = tokenise True hashes lang+                                   [(noPos,"\n#define "++s++" "++d++"\n")]+        in (name hd, hd)+++-- | Trundle through the document, one word at a time, using the WordStyle+--   classification introduced by 'tokenise' to decide whether to expand a+--   word or macro.  Encountering a \#define or \#undef causes that symbol to+--   be overwritten in the symbol table.  Any other remaining cpp directives+--   are discarded and replaced with blanks, except for \#line markers.+--   All valid identifiers are checked for the presence of a definition+--   of that name in the symbol table, and if so, expanded appropriately.+macroProcess :: Bool -> Bool -> SymTab HashDefine -> [WordStyle] -> [String]+macroProcess _ _ _         []                    = []+macroProcess y l st (Other x: ws)                = x:    macroProcess y l st ws+macroProcess y l st (Cmd Nothing: ws)            = "\n": macroProcess y l st ws+macroProcess y l st (Cmd (Just (LineDrop x)): ws)= "\n":x:macroProcess y l st ws+macroProcess layout lang st (Cmd (Just hd): ws)  =+    let n = 1 + linebreaks hd in+    replicate n "\n" ++ macroProcess layout lang (insertST (name hd, hd) st) ws+macroProcess layout lang st (Ident p x: ws) =+    case x of+      "__FILE__" -> show (filename p): macroProcess layout lang st ws+      "__LINE__" -> show (lineno p):   macroProcess layout lang st ws+      "__DATE__" -> formatCalendarTime defaultTimeLocale "\"%d %b %Y\""+                        (unsafePerformIO (getClockTime>>=toCalendarTime)):+                                       macroProcess layout lang st ws+      "__TIME__" -> formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""+                        (unsafePerformIO (getClockTime>>=toCalendarTime)):+                                       macroProcess layout lang st ws+      _ ->+        case lookupST x st of+            Nothing -> x: macroProcess layout lang st ws+            Just hd ->+                case hd of+                    SymbolReplacement _ r _ ->+                        -- one-level expansion only:+                        -- r: macroProcess layout st ws+                        -- multi-level expansion:+                        let r' = if layout then r else filter (/='\n') r in+                        macroProcess layout lang st+                                     (tokenise True False lang [(p,r')]+                                      ++ ws)+                    MacroExpansion _ _ _ _  ->+                        case parseMacroCall ws of+                            Nothing -> x: macroProcess layout lang st ws+                            Just (args,ws') ->+                                if length args /= length (arguments hd) then+                                     x: macroProcess layout lang st ws+                                else -- one-level expansion only:+                                     -- expandMacro hd args layout:+                                     --         macroProcess layout st ws'+                                     -- multi-level expansion:+                                     macroProcess layout lang st+                                              (tokenise True False lang+                                                [(p,expandMacro hd args layout)]+                                               ++ ws')+
+ Language/Preprocessor/Cpphs/Options.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Options+-- Copyright   :  2006 Malcolm Wallace+-- Licence     :  LGPL+--+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- This module deals with Cpphs options and parsing them+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.Options(CpphsOption(..), parseOption) where++import Maybe++data CpphsOption+    = CpphsNoMacro+    | CpphsNoLine+    | CpphsText+    | CpphsStrip+    | CpphsAnsi+    | CpphsLayout+    | CpphsUnlit+    | CpphsMacro (String,String)+    | CpphsPath String+      deriving (Eq, Show)+    +    +flags :: [(String, CpphsOption)]+flags = [ ("--nomacro", CpphsNoMacro)+        , ("--noline",  CpphsNoLine)+        , ("--text",    CpphsText)+        , ("--strip",   CpphsStrip)+        , ("--hashes",  CpphsAnsi)+        , ("--layout",  CpphsLayout)+        , ("--unlit",   CpphsUnlit)+        ]+++parseOption :: String -> Maybe CpphsOption+parseOption x | isJust a = Just $ fromJust a+    where a = lookup x flags++parseOption ('-':'D':xs) = Just $ CpphsMacro (s, if null d then "1" else tail d)+    where (s,d) = break (=='=') xs+    +parseOption ('-':'I':xs) = Just $ CpphsPath $ trail "/\\" xs++parseOption _ = Nothing++trail :: (Eq a) => [a] -> [a] -> [a]+trail xs = reverse . dropWhile (`elem`xs) . reverse+
+ Language/Preprocessor/Cpphs/Position.hs view
@@ -0,0 +1,80 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Position+-- Copyright   :  2000-2004 Malcolm Wallace+-- Licence     :  LGPL+--+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- Simple file position information, with recursive inclusion points.+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.Position+  ( Posn(..)+  , newfile+  , addcol, newline, tab, newlines, newpos+  , cppline+  , filename, lineno, directory+  ) where++-- | Source positions contain a filename, line, column, and an+--   inclusion point, which is itself another source position,+--   recursively.+data Posn = Pn String !Int !Int (Maybe Posn)+        deriving (Eq)++instance Show Posn where+      showsPrec _ (Pn f l c i) = showString f .+                                 showString "  at line " . shows l .+                                 showString " col " . shows c .+                                 ( case i of+                                    Nothing -> id+                                    Just p  -> showString "\n    used by  " .+                                               shows p )++-- | Constructor+newfile :: String -> Posn+newfile name = Pn name 1 1 Nothing++-- | Updates+addcol :: Int -> Posn -> Posn+addcol n (Pn f r c i) = Pn f r (c+n) i++newline, tab :: Posn -> Posn+--newline (Pn f r _ i) = Pn f (r+1) 1 i+newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i+tab     (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i++newlines :: Int -> Posn -> Posn+newlines n (Pn f r _ i) = Pn f (r+n) 1 i++newpos :: Int -> Maybe String -> Posn -> Posn+newpos r Nothing  (Pn f _ c i) = Pn f r c i+newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i+newpos r (Just f)       (Pn _ _ c i) = Pn f r c i++-- | Projections++lineno    :: Posn -> Int+filename  :: Posn -> String+directory :: Posn -> FilePath++lineno    (Pn _ r _ _) = r+filename  (Pn f _ _ _) = f+directory (Pn f _ _ _) = dirname f+++-- | cpp-style printing+cppline :: Posn -> String+cppline (Pn f r _ _) = "#line "++show r++" "++show f++                                                                                +-- | Strip non-directory suffix from file name (analogous to the shell+--   command of the same name).+dirname :: String -> String+dirname  = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse+  where safetail [] = []+        safetail (_:x) = x+
+ Language/Preprocessor/Cpphs/ReadFirst.hs view
@@ -0,0 +1,62 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  ReadFirst+-- Copyright   :  2004 Malcolm Wallace+-- Licence     :  LGPL+-- +-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- Read the first file that matches in a list of search paths.+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.ReadFirst+  ( readFirst+  ) where++import IO        (hPutStrLn, stderr)+import Directory (doesFileExist)+import List      (intersperse)+import Language.Preprocessor.Cpphs.Position  (Posn,directory)+import Language.Preprocessor.Cpphs.SymTab    (SymTab,lookupST)++-- | Attempt to read the given file from any location within the search path.+--   The first location found is returned, together with the file content.+--   (The directory of the calling file is always searched first, then+--    the current directory, finally any specified search path.)+readFirst :: String		-- ^ filename+	-> Posn			-- ^ inclusion point+	-> [String]		-- ^ search path+	-> SymTab String	-- ^ \#defined symbols+	-> IO ( FilePath+              , String+              )			-- ^ discovered filepath, and file contents++readFirst name demand path syms =+    try (cons dd (".":path))+  where+    dd = directory demand+    cons x xs = if null x then xs else x:xs+    realname = real name syms+    try [] = do+        hPutStrLn stderr ("Warning: Can't find file \""++realname+                         ++"\" in directories\n\t"+                         ++concat (intersperse "\n\t" (cons dd (".":path)))+                         ++"\n  Asked for by: "++show demand)+        return ("missing file: "++realname,"")+    try (p:ps) = do+        let file = p++'/':realname+        ok <- doesFileExist file+        if not ok then try ps+          else do content <- readFile file+                  return (file,content)++real :: String -> SymTab String -> String+real name syms = case name of+                   ('"':ns) -> init ns+                   ('<':ns) -> init ns+                   _        -> case lookupST name syms of+                                 Nothing -> name+                                 Just f  -> real f syms+
+ Language/Preprocessor/Cpphs/RunCpphs.hs view
@@ -0,0 +1,33 @@+{-+-- The main program for cpphs, a simple C pre-processor written in Haskell.++-- Copyright (c) 2004 Malcolm Wallace+-- This file is GPL, although the libraries it uses are either standard+-- Haskell'98 or distributed under the LGPL.+-}+module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs ) where++import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)+import Language.Preprocessor.Cpphs.MacroPass(macroPass)+import Language.Preprocessor.Cpphs.Options(CpphsOption(..), parseOption)+import Language.Preprocessor.Unlit as Unlit (unlit)+++runCpphs :: [CpphsOption] -> FilePath -> String -> IO String+runCpphs opts filename input = do+  let ds = [x | CpphsMacro x <- opts]+      is = [x | CpphsPath x <- opts]+      macro = not (CpphsNoMacro `elem` opts)+      locat = not (CpphsNoLine  `elem` opts)+      lang  = not (CpphsText    `elem` opts)+      strip =      CpphsStrip   `elem` opts+      ansi  =      CpphsAnsi    `elem` opts+      layout=      CpphsLayout  `elem` opts+      unlit =      CpphsUnlit   `elem` opts++  let pass1 = cppIfdef filename ds is macro locat input+      pass2 = macroPass ds strip ansi layout lang pass1+      result = if not macro then unlines (map snd pass1) else pass2+      pass3 = if unlit then Unlit.unlit filename result else result++  return pass3
+ Language/Preprocessor/Cpphs/SymTab.hs view
@@ -0,0 +1,86 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  SymTab+-- Copyright   :  2000-2004 Malcolm Wallace+-- Licence     :  LGPL+-- +-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  Stable+-- Portability :  All+--+-- Symbol Table, based on index trees using a hash on the key.+--   Keys are always Strings.  Stored values can be any type.+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.SymTab+  ( SymTab+  , emptyST+  , insertST+  , deleteST+  , lookupST+  , definedST+  , IndTree+  ) where++-- | Symbol Table.  Stored values are polymorphic, but the keys are+--   always strings.+type SymTab v = IndTree [(String,v)]++emptyST   :: SymTab v+insertST  :: (String,v) -> SymTab v -> SymTab v+deleteST  :: String -> SymTab v -> SymTab v+lookupST  :: String -> SymTab v -> Maybe v+definedST :: String -> SymTab v -> Bool++emptyST           = itgen maxHash []+insertST (s,v) ss = itiap (hash s) ((s,v):)    ss id+deleteST  s    ss = itiap (hash s) (filter ((/=s).fst)) ss id+lookupST  s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)+                    in if null vs then Nothing+                       else (Just . snd . head) vs+definedST s    ss = let vs = filter ((==s).fst) ((itind (hash s)) ss)+                    in (not . null) vs+++----+-- | Index Trees (storing indexes at nodes).++data IndTree t = Leaf t | Fork Int (IndTree t) (IndTree t)+     deriving Show++itgen :: Int -> a -> IndTree a+itgen 1 x = Leaf x+itgen n x =+  let n' = n `div` 2+  in Fork n' (itgen n' x) (itgen (n-n') x)++itiap :: --Eval a =>+         Int -> (a->a) -> IndTree a -> (IndTree a -> b) -> b+itiap _ f (Leaf x)       k = let fx = f x in {-seq fx-} (k (Leaf fx))+itiap i f (Fork n lt rt) k =+  if i<n then+       itiap i f lt $ \lt' -> k (Fork n lt' rt)+  else itiap (i-n) f rt $ \rt' -> k (Fork n lt rt')++itind :: Int -> IndTree a -> a  +itind _ (Leaf x) = x+itind i (Fork n lt rt) = if i<n then itind i lt else itind (i-n) rt+++----+-- Hash values++maxHash :: Int -- should be prime+maxHash = 101++class Hashable a where+    hashWithMax :: Int -> a -> Int+    hash        :: a -> Int+    hash = hashWithMax maxHash++instance Enum a => Hashable [a] where+    hashWithMax m = h 0+        where h a []     = a+              h a (c:cs) = h ((17*(fromEnum c)+19*a)`rem`m) cs++----
+ Language/Preprocessor/Cpphs/Tokenise.hs view
@@ -0,0 +1,257 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Tokenise+-- Copyright   :  2004 Malcolm Wallace+-- Licence     :  LGPL+--+-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  experimental+-- Portability :  All+--+-- The purpose of this module is to lex a source file (language+-- unspecified) into tokens such that cpp can recognise a replaceable+-- symbol or macro-use, and do the right thing.+-----------------------------------------------------------------------------++module Language.Preprocessor.Cpphs.Tokenise+  ( linesCpp+  , reslash+  , tokenise+  , WordStyle(..)+  , deWordStyle+  , parseMacroCall+  ) where++import Char+import Language.Preprocessor.Cpphs.HashDefine+import Language.Preprocessor.Cpphs.Position++-- | A Mode value describes whether to tokenise a la Haskell, or a la Cpp.+--   The main difference is that in Cpp mode we should recognise line+--   continuation characters.+data Mode = Haskell | Cpp++-- | linesCpp is, broadly speaking, Prelude.lines, except that+--   on a line beginning with a \#, line continuation characters are+--   recognised.  In a line continuation, the newline character is+--   preserved, but the backslash is not.+linesCpp :: String -> [String]+linesCpp  []                 = []+linesCpp (x:xs) | x=='#'     = tok Cpp     ['#'] xs+                | otherwise  = tok Haskell [] (x:xs)+  where+    tok Cpp   acc ('\\':'\n':ys)   = tok Cpp ('\n':acc) ys+    tok _     acc ('\n':'#':ys)    = reverse acc: tok Cpp ['#'] ys+    tok _     acc ('\n':ys)        = reverse acc: tok Haskell [] ys+    tok _     acc []               = reverse acc: []+    tok mode  acc (y:ys)           = tok mode (y:acc) ys++-- | Put back the line-continuation characters.+reslash :: String -> String+reslash ('\n':xs) = '\\':'\n':reslash xs+reslash (x:xs)    = x: reslash xs+reslash   []      = []++----+-- | Submodes are required to deal correctly with nesting of lexical+--   structures.+data SubMode = Any | Pred (Char->Bool) (Posn->String->WordStyle)+             | String Char | LineComment | NestComment Int+             | CComment++-- | Each token is classified as one of Ident, Other, or Cmd:+--   * Ident is a word that could potentially match a macro name.+--   * Cmd is a complete cpp directive (\#define etc).+--   * Other is anything else.+data WordStyle = Ident Posn String | Other String | Cmd (Maybe HashDefine)+  deriving (Eq,Show)+other :: Posn -> String -> WordStyle+other _ s = Other s++deWordStyle :: WordStyle -> String+deWordStyle (Ident _ i) = i+deWordStyle (Other i)   = i+deWordStyle (Cmd _)     = "\n"++-- | tokenise is, broadly-speaking, Prelude.words, except that:+--    * the input is already divided into lines+--    * each word-like "token" is categorised as one of {Ident,Other,Cmd}+--    * \#define's are parsed and returned out-of-band using the Cmd variant+--    * All whitespace is preserved intact as tokens.+--    * C-comments are converted to white-space (depending on first param)+--    * Parens and commas are tokens in their own right.+--    * Any cpp line continuations are respected.+--   No errors can be raised.+--   The inverse of tokenise is (concatMap deWordStyle).+tokenise :: Bool -> Bool -> Bool -> [(Posn,String)] -> [WordStyle]+tokenise _     _    _     [] = []+tokenise strip ansi lang ((pos,str):pos_strs) =+    (if lang then haskell else plaintext) Any [] pos pos_strs str+ where+    -- rules to lex Haskell+  haskell :: SubMode -> String -> Posn -> [(Posn,String)]+             -> String -> [WordStyle]+  haskell Any acc p ls ('\n':'#':xs)      = emit acc $  -- emit "\n" $+                                            cpp Any haskell [] [] p ls xs+    -- warning: non-maximal munch on comment+  haskell Any acc p ls ('-':'-':xs)       = emit acc $+                                            haskell LineComment "--" p ls xs+  haskell Any acc p ls ('{':'-':xs)       = emit acc $+                                            haskell (NestComment 0) "-{" p ls xs+  haskell Any acc p ls ('/':'*':xs)|strip = emit acc $+                                            haskell CComment "  " p ls xs+  haskell Any acc p ls ('"':xs)           = emit acc $+                                            haskell (String '"') ['"'] p ls xs+  haskell Any acc p ls ('\'':xs)          = emit acc $+                                            haskell (String '\'') "'" p ls xs+  haskell Any acc p ls (x:xs) | single x  = emit acc $ emit [x] $+                                            haskell Any [] p ls xs+  haskell Any acc p ls (x:xs) | space x   = emit acc $+                                            haskell (Pred space other) [x]+                                                                        p ls xs+  haskell Any acc p ls (x:xs) | symbol x  = emit acc $+                                            haskell (Pred symbol other) [x]+                                                                        p ls xs+ -- haskell Any [] p ls (x:xs) | ident0 x  = id $+  haskell Any acc p ls (x:xs) | ident0 x  = emit acc $+                                            haskell (Pred ident1 Ident) [x]+                                                                        p ls xs+  haskell Any acc p ls (x:xs)             = haskell Any (x:acc) p ls xs++  haskell pre@(Pred pred ws) acc p ls (x:xs)+                        | pred x    = haskell pre (x:acc) p ls xs+                        | otherwise = ws p (reverse acc):+                                      haskell Any [] p ls (x:xs)+  haskell (Pred _ ws) acc p [] []   = ws p (reverse acc): []+  haskell (String c) acc p ls ('\\':x:xs)+                        | x=='\\'   = haskell (String c) ('\\':'\\':acc) p ls xs+                        | x==c      = haskell (String c) (c:'\\':acc) p ls xs+  haskell (String c) acc p ls (x:xs)+                        | x==c      = emit (c:acc) $ haskell Any [] p ls xs+                        | otherwise = haskell (String c) (x:acc) p ls xs+  haskell LineComment acc p ls xs@('\n':_) = emit acc $ haskell Any [] p ls xs+  haskell LineComment acc p ls (x:xs)      = haskell LineComment (x:acc) p ls xs+  haskell (NestComment n) acc p ls ('{':'-':xs)+                                    = haskell (NestComment (n+1))+                                                            ("-{"++acc) p ls xs+  haskell (NestComment 0) acc p ls ('-':'}':xs)+                                    = emit ("}-"++acc) $ haskell Any [] p ls xs+  haskell (NestComment n) acc p ls ('-':'}':xs)+                                    = haskell (NestComment (n-1))+                                                            ("}-"++acc) p ls xs+  haskell (NestComment n) acc p ls (x:xs) = haskell (NestComment n) (x:acc)+                                                                        p ls xs+  haskell CComment acc p ls ('*':'/':xs)  = emit ("  "++acc) $+                                            haskell Any [] p ls xs+  haskell CComment acc p ls (_:xs)        = haskell CComment (' ':acc) p ls xs+  haskell mode acc _ ((p,l):ls) []        = haskell mode acc p ls ('\n':l)+  haskell _    acc _ [] []                = emit acc $ []++  -- rules to lex Cpp+  cpp :: SubMode -> (SubMode -> String -> Posn -> [(Posn,String)]+                     -> String -> [WordStyle])+         -> String -> [String] -> Posn -> [(Posn,String)]+         -> String -> [WordStyle]+  cpp mode next word line pos remaining input =+    lexcpp mode word line remaining input+   where+    lexcpp Any w l ls ('/':'*':xs)   = lexcpp (NestComment 0) "" (w*/*l) ls xs+    lexcpp Any w l ls ('/':'/':xs)   = lexcpp LineComment "  " (w*/*l) ls xs+    lexcpp Any w l ((p,l'):ls) ('\\':[])  = cpp Any next [] ("\n":w*/*l) p ls l'+    lexcpp Any w l ls ('\\':'\n':xs) = lexcpp Any [] ("\n":w*/*l) ls xs+    lexcpp Any w l ls xs@('\n':_)    = Cmd (parseHashDefine ansi+                                                           (reverse (w*/*l))):+                                       next Any [] pos ls xs+ -- lexcpp Any w l ls ('"':xs)     = lexcpp (String '"') ['"'] (w*/*l) ls xs+ -- lexcpp Any w l ls ('\'':xs)    = lexcpp (String '\'') "'"  (w*/*l) ls xs+    lexcpp Any w l ls ('"':xs)       = lexcpp Any [] ("\"":(w*/*l)) ls xs+    lexcpp Any w l ls ('\'':xs)      = lexcpp Any [] ("'": (w*/*l)) ls xs+    lexcpp Any [] l ls (x:xs)+                    | ident0 x  = lexcpp (Pred ident1 Ident) [x] l ls xs+ -- lexcpp Any w l ls (x:xs) | ident0 x  = lexcpp (Pred ident1 Ident) [x] (w*/*l) ls xs+    lexcpp Any w l ls (x:xs)+                    | single x  = lexcpp Any [] ([x]:w*/*l) ls xs+                    | space x   = lexcpp (Pred space other) [x] (w*/*l) ls xs+                    | symbol x  = lexcpp (Pred symbol other) [x] (w*/*l) ls xs+                    | otherwise = lexcpp Any (x:w) l ls xs+    lexcpp pre@(Pred pred _) w l ls (x:xs)+                    | pred x    = lexcpp pre (x:w) l ls xs+                    | otherwise = lexcpp Any [] (w*/*l) ls (x:xs)+    lexcpp      (Pred _ _) w l [] []      = lexcpp Any [] (w*/*l) [] "\n"+    lexcpp (String c) w l ls ('\\':x:xs)+                    | x=='\\'   = lexcpp (String c) ('\\':'\\':w) l ls xs+                    | x==c      = lexcpp (String c) (c:'\\':w) l ls xs+    lexcpp (String c) w l ls (x:xs)+                    | x==c      = lexcpp Any [] ((c:w)*/*l) ls xs+                    | otherwise = lexcpp (String c) (x:w) l ls xs+    lexcpp LineComment w l ((p,l'):ls) ('\\':[])+                             = cpp LineComment next [] (('\n':w)*/*l) pos ls l'+    lexcpp LineComment w l ls ('\\':'\n':xs)+                                = lexcpp LineComment [] (('\n':w)*/*l) ls xs+    lexcpp LineComment w l ls xs@('\n':_) = lexcpp Any w l ls xs+    lexcpp LineComment w l ls (_:xs)      = lexcpp LineComment (' ':w) l ls xs+    lexcpp (NestComment _) w l ls ('*':'/':xs)+                                          = lexcpp Any [] (w*/*l) ls xs+    lexcpp (NestComment n) w l ls (_:xs)  = lexcpp (NestComment n) (' ':w) l+                                                                        ls xs+    lexcpp mode w l ((p,l'):ls) []        = cpp mode next w l pos ls ('\n':l')+    lexcpp _    _ _ []          []        = []++    -- rules to lex non-Haskell, non-cpp text+  plaintext :: SubMode -> String -> Posn -> [(Posn,String)]+            -> String -> [WordStyle]+  plaintext Any acc p ls ('\n':'#':xs)  = emit acc $  -- emit "\n" $+                                          cpp Any plaintext [] [] p ls xs+  plaintext Any acc p ls ('/':'*':xs)|strip = emit acc $+                                              plaintext CComment "  " p ls xs+  plaintext Any acc p ls (x:xs) | single x  = emit acc $ emit [x] $+                                              plaintext Any [] p ls xs+  plaintext Any acc p ls (x:xs) | space x   = emit acc $+                                              plaintext (Pred space other) [x]+                                                                        p ls xs+  plaintext Any acc p ls (x:xs) | ident0 x  = emit acc $+                                              plaintext (Pred ident1 Ident) [x]+                                                                        p ls xs+  plaintext Any acc p ls (x:xs)             = plaintext Any (x:acc) p ls xs+  plaintext pre@(Pred pred ws) acc p ls (x:xs)+                                | pred x    = plaintext pre (x:acc) p ls xs+                                | otherwise = ws p (reverse acc):+                                              plaintext Any [] p ls (x:xs)+  plaintext (Pred _ ws) acc p [] []         = ws p (reverse acc): []+  plaintext CComment acc p ls ('*':'/':xs)  = emit ("  "++acc) $+                                              plaintext Any [] p ls xs+  plaintext CComment acc p ls (_:xs)    = plaintext CComment (' ':acc) p ls xs+  plaintext mode acc _ ((p,l):ls) []    = plaintext mode acc p ls ('\n':l)+  plaintext _    acc _ [] []            = emit acc $ []++  -- predicates for lexing Haskell.+  ident0 x = isAlpha x    || x `elem` "_`"+  ident1 x = isAlphaNum x || x `elem` "'_`"+  symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~"+  single x = x `elem` "(),[];{}"+  space  x = x `elem` " \t"+  -- emit a token (if there is one) from the accumulator+  emit ""  = id+  emit xs  = (Other (reverse xs):)+  -- add a reversed word to the accumulator+  "" */* l = l+  w */* l  = reverse w : l+++-- | Parse a possible macro call, returning argument list and remaining input+parseMacroCall :: [WordStyle] -> Maybe ([String],[WordStyle])+parseMacroCall = call . skip+  where+    skip (Other x:xs) | all isSpace x = skip xs+    skip xss                          = xss+    call (Other "(":xs)   = (args (0::Int) [] [] . skip) xs+    call _                = Nothing+    args 0 w acc (Other ",":xs)   = args 0 [] (addone w acc) (skip xs)+    args n w acc (Other "(":xs)   = args (n+1) ("(":w) acc xs+    args 0 w acc (Other ")":xs)   = Just (reverse (addone w acc), xs)+    args n w acc (Other ")":xs)   = args (n-1) (")":w) acc xs+    args n w acc (Ident _ var:xs) = args n (var:w) acc xs+    args n w acc (Other var:xs)   = args n (var:w) acc xs+    args _ _ _   _                = Nothing+    addone w acc = concat (reverse (dropWhile (all isSpace) w)): acc+
+ Language/Preprocessor/Unlit.hs view
@@ -0,0 +1,70 @@+-- | Part of this code is from "Report on the Programming Language Haskell",+--   version 1.2, appendix C.+module Language.Preprocessor.Unlit (unlit) where++import Char++data Classified = Program String | Blank | Comment+                | Include Int String | Pre String++classify :: [String] -> [Classified]+classify []                = []+classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs+   where allProg [] = []  -- Should give an error message,+                          -- but I have no good position information.+         allProg (('\\':x):xs) |  x == "end{code}" = Blank : classify xs+	 allProg (x:xs) = Program x:allProg xs+classify (('>':x):xs)      = Program (' ':x) : classify xs+classify (('#':x):xs)      = (case words x of+                                (line:file:_) | all isDigit line+                                   -> Include (read line) file+                                _  -> Pre x+                             ) : classify xs+classify (x:xs) | all isSpace x = Blank:classify xs+classify (x:xs)                 = Comment:classify xs++unclassify :: Classified -> String+unclassify (Program s) = s+unclassify (Pre s)     = '#':s+unclassify (Include i f) = '#':' ':show i ++ ' ':f+unclassify Blank       = ""+unclassify Comment     = ""++-- | 'unlit' takes a filename (for error reports), and transforms the+--   given string, to eliminate the literate comments from the program text.+unlit :: FilePath -> String -> String+unlit file lhs = (unlines+                 . map unclassify+                 . adjacent file (0::Int) Blank+                 . classify) (inlines lhs)++adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]+adjacent file 0 _             (x              :xs) = x : adjacent file 1 x xs -- force evaluation of line number+adjacent file n y@(Program _) (x@Comment      :xs) = error (message file n "program" "comment")+adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f    i     y xs+adjacent file n y@(Program _) (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs+adjacent file n y@Comment     (x@(Program _)  :xs) = error (message file n "comment" "program")+adjacent file n y@Comment     (x@(Include i f):xs) = x: adjacent f    i     y xs+adjacent file n y@Comment     (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs+adjacent file n y@Blank       (x@(Include i f):xs) = x: adjacent f    i     y xs+adjacent file n y@Blank       (x@(Pre _)      :xs) = x: adjacent file (n+1) y xs+adjacent file n _             (x@next         :xs) = x: adjacent file (n+1) x xs+adjacent file n _             []                   = []++message :: String -> Int -> String -> String -> String+message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"+message []     n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"+message file   n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"+++-- Re-implementation of 'lines', for better efficiency (but decreased laziness).+-- Also, importantly, accepts non-standard DOS and Mac line ending characters.+inlines :: String -> [String]+inlines s = lines' s id+  where+  lines' []             acc = [acc []]+  lines' ('\^M':'\n':s) acc = acc [] : lines' s id	-- DOS+  lines' ('\^M':s)      acc = acc [] : lines' s id	-- MacOS+  lines' ('\n':s)       acc = acc [] : lines' s id	-- Unix+  lines' (c:s)          acc = lines' s (acc . (c:))+
+ Makefile view
@@ -0,0 +1,51 @@+LIBRARY	= cpphs+VERSION	= 1.3++DIRS	= Language/Preprocessor/Cpphs \+	  Text/ParserCombinators++SRCS	= Language/Preprocessor/Cpphs.hs \+          Language/Preprocessor/Cpphs/CppIfdef.hs \+          Language/Preprocessor/Cpphs/HashDefine.hs \+          Language/Preprocessor/Cpphs/MacroPass.hs \+          Language/Preprocessor/Cpphs/Options.hs \+          Language/Preprocessor/Cpphs/Position.hs \+          Language/Preprocessor/Cpphs/ReadFirst.hs \+          Language/Preprocessor/Cpphs/RunCpphs.hs \+          Language/Preprocessor/Cpphs/SymTab.hs \+          Language/Preprocessor/Cpphs/Tokenise.hs \+          Language/Preprocessor/Unlit.hs \+          Text/ParserCombinators/HuttonMeijer.hs \+          cpphs.hs++AUX	= README LICENCE* CHANGELOG $(LIBRARY).cabal Setup.hs Makefile \+	  cpphs.hugs cpphs.compat \+	  tests/[A-BD-Z]* tests/[a-np-z]* \+	  docs/[a-z]*++all: $(LIBRARY)+package:+	tar cf tmp.tar $(SRCS) $(AUX)+	mkdir $(LIBRARY)-$(VERSION)+	cd $(LIBRARY)-$(VERSION); tar xf ../tmp.tar+	tar zcf $(LIBRARY)-$(VERSION).tar.gz $(LIBRARY)-$(VERSION)+	zip -r $(LIBRARY)-$(VERSION).zip $(LIBRARY)-$(VERSION)+	rm -r tmp.tar $(LIBRARY)-$(VERSION)+haddock: $(SRCS)+	mkdir -p docs/$(LIBRARY)+	for dir in $(DIRS); do mkdir -p docs/$(LIBRARY)/$$dir; done+	for file in $(SRCS); \+	    do HsColour -anchorHTML $$file \+	          >docs/$(LIBRARY)/`dirname $$file`/`basename $$file .hs`.html;\+	    done+	haddock --html --title=$(LIBRARY) \+	    --odir=docs/$(LIBRARY) --package=$(LIBRARY) \+	    --source-module="%{MODULE/.//}.html" \+	    --source-entity="%{MODULE/.//}.html#%{NAME}" \+	    $(SRCS)++++$(LIBRARY): $(SRCS)+	$(HC) $(HFLAGS) $(HEAP) -o $@  $(SRCS)+	$(STRIP) $@
+ README view
@@ -0,0 +1,47 @@+This directory contains 'cpphs', a simplified re-implementation of cpp,+the C pre-processor, in Haskell.++TO BUILD+--------+Just use+    hmake cpphs [-package base]+or+    ghc --make cpphs [-o cpphs]		#  -o needed for ghc <= 6.4.1 ]+or+    runhugs cpphs	# or rename the script cpphs.hugs to cpphs+++USAGE+-----+	cpphs  [filename | -Dsym | -Dsym=val | -Ipath]+  [-Ofile]+               [--nomacro|--noline|--strip|--text|--hashes|--layout|--unlit]*+               [ --cpp compatopts ]++For fuller details, see docs/index.html++If you want to use cpphs as a completely drop-in replacement for the+real cpp, that is, to accept the same arguments, and have broadly+the same behaviour in response to them, then use the --cpp compatibility+option.+++COPYRIGHT+---------+Copyright (c) 2004-2006 Malcolm Wallace (Malcolm.Wallace@cs.york.ac.uk)+except for Text.ParserCombinators.HuttonMeijer (Copyright (c) 1995+Graham Hutton and Erik Meijer).+++LICENCE+-------+These library modules are distributed under the terms of the LGPL.+The application module 'cpphs.hs' is GPL.++This software comes with no warranty.  Use at your own risk.+++WEBSITE+-------+http://haskell.org/cpphs/+http://www.cs.york.ac.uk/fp/cpphs/+darcs get http://www.cs.york.ac.uk/fp/darcs/cpphs
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/ParserCombinators/HuttonMeijer.hs view
@@ -0,0 +1,218 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  ParseLib+-- Copyright   :  ...+-- Copyright   :  Graham Hutton (University of Nottingham), Erik Meijer (University of Utrecht)+-- +-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+-- Stability   :  Stable+-- Portability :  All+--+--                  A LIBRARY OF MONADIC PARSER COMBINATORS+-- +--                               29th July 1996+-- +--                  Graham Hutton               Erik Meijer+--             University of Nottingham    University of Utrecht+-- +-- This Haskell script defines a library of parser combinators, and is+-- taken from sections 1-6 of our article "Monadic Parser Combinators".+-- Some changes to the library have been made in the move from Gofer+-- to Haskell:+-- +--    * Do notation is used in place of monad comprehension notation;+-- +--    * The parser datatype is defined using "newtype", to avoid the overhead+--      of tagging and untagging parsers with the P constructor.+-----------------------------------------------------------------------------+++module Text.ParserCombinators.HuttonMeijer+   (Parser(..), item, first, papply, (+++), sat, {-tok,-} many, many1,+    sepby, sepby1, chainl,+    chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper,+    letter, alphanum, string, ident, nat, int, spaces, comment, junk,+    skip, token, natural, integer, symbol, identifier) where++import Char+import Monad++infixr 5 +++++type Token = Char++---------------------------------------------------------+-- | The parser monad++newtype Parser a   = P ([Token] -> [(a,[Token])])++instance Functor Parser where+   -- map         :: (a -> b) -> (Parser a -> Parser b)+   fmap f (P p)    = P (\inp -> [(f v, out) | (v,out) <- p inp])++instance Monad Parser where+   -- return      :: a -> Parser a+   return v        = P (\inp -> [(v,inp)])++   -- >>=         :: Parser a -> (a -> Parser b) -> Parser b+   (P p) >>= f     = P (\inp -> concat [papply (f v) out | (v,out) <- p inp])++   -- fail        :: String -> Parser a+   fail _          = P (\_ -> [])++instance MonadPlus Parser where+   -- mzero       :: Parser a+   mzero           = P (\_ -> [])++   -- mplus       :: Parser a -> Parser a -> Parser a+   (P p) `mplus` (P q)  = P (\inp -> (p inp ++ q inp))++-- ------------------------------------------------------------+-- * Other primitive parser combinators+-- ------------------------------------------------------------++item               :: Parser Token+item                = P (\inp -> case inp of+                                   []     -> []+                                   (x:xs) -> [(x,xs)])++first             :: Parser a -> Parser a+first (P p)        = P (\inp -> case p inp of+                                   []    -> []+                                   (x:_) -> [x])++papply            :: Parser a -> [Token] -> [(a,[Token])]+papply (P p) inp   = p inp++-- ------------------------------------------------------------+-- * Derived combinators+-- ------------------------------------------------------------++(+++)             :: Parser a -> Parser a -> Parser a+p +++ q            = first (p `mplus` q)++sat               :: (Token -> Bool) -> Parser Token+sat p              = do {x <- item; if p x then return x else mzero}++--tok               :: Token -> Parser Token+--tok t              = do {x <- item; if t==snd x then return t else mzero}++many              :: Parser a -> Parser [a]+many p             = many1 p +++ return []+--many p           = force (many1 p +++ return [])++many1             :: Parser a -> Parser [a]+many1 p            = do {x <- p; xs <- many p; return (x:xs)}++sepby             :: Parser a -> Parser b -> Parser [a]+p `sepby` sep      = (p `sepby1` sep) +++ return []++sepby1            :: Parser a -> Parser b -> Parser [a]+p `sepby1` sep     = do {x <- p; xs <- many (do {sep; p}); return (x:xs)}++chainl            :: Parser a -> Parser (a -> a -> a) -> a -> Parser a+chainl p op v      = (p `chainl1` op) +++ return v++chainl1           :: Parser a -> Parser (a -> a -> a) -> Parser a+p `chainl1` op     = do {x <- p; rest x}+                     where+                        rest x = do {f <- op; y <- p; rest (f x y)}+                                 +++ return x++chainr            :: Parser a -> Parser (a -> a -> a) -> a -> Parser a+chainr p op v      = (p `chainr1` op) +++ return v++chainr1           :: Parser a -> Parser (a -> a -> a) -> Parser a+p `chainr1` op     = do {x <- p; rest x}+                     where+                        rest x = do {f <- op; y <- p `chainr1` op; return (f x y)}+                                 +++ return x++ops               :: [(Parser a, b)] -> Parser b+ops xs             = foldr1 (+++) [do {p; return op} | (p,op) <- xs]++bracket           :: Parser a -> Parser b -> Parser c -> Parser b+bracket open p close = do {open; x <- p; close; return x}++-- ------------------------------------------------------------+-- * Useful parsers+-- ------------------------------------------------------------++char              :: Char -> Parser Char+char x             = sat (\y -> x == y)++digit             :: Parser Char+digit              = sat isDigit++lower             :: Parser Char+lower              = sat isLower++upper             :: Parser Char+upper              = sat isUpper++letter            :: Parser Char+letter             = sat isAlpha++alphanum          :: Parser Char+alphanum           = sat isAlphaNum +++ char '_'++string            :: String -> Parser String+string ""          = return ""+string (x:xs)      = do {char x; string xs; return (x:xs)}++ident             :: Parser String+ident              = do {x <- lower; xs <- many alphanum; return (x:xs)}++nat               :: Parser Int+nat                = do {x <- digit; return (fromEnum x - fromEnum '0')} `chainl1` return op+                     where+                        m `op` n = 10*m + n++int               :: Parser Int+int                = do {char '-'; n <- nat; return (-n)} +++ nat++-- ------------------------------------------------------------+-- * Lexical combinators+-- ------------------------------------------------------------++spaces            :: Parser ()+spaces             = do {many1 (sat isSpace); return ()}++comment           :: Parser ()+--comment            = do {string "--"; many (sat (\x -> x /= '\n')); return ()}+--comment            = do +--                       _ <- string "--"+--                       _ <- many (sat (\x -> x /= '\n'))+--                       return ()+comment            = do+                       bracket (string "/*") (many item) (string "*/")+                       return ()++junk              :: Parser ()+junk               = do {many (spaces +++ comment); return ()}++skip              :: Parser a -> Parser a+skip p             = do {junk; p}++token             :: Parser a -> Parser a+token p            = do {v <- p; junk; return v}++-- ------------------------------------------------------------+-- * Token parsers+-- ------------------------------------------------------------++natural           :: Parser Int+natural            = token nat++integer           :: Parser Int+integer            = token int++symbol            :: String -> Parser String+symbol xs          = token (string xs)++identifier        :: [String] -> Parser String+identifier ks      = token (do {x <- ident;+                                if not (elem x ks) then return x+                                else return mzero})++------------------------------------------------------------------------------
+ cpphs.cabal view
@@ -0,0 +1,51 @@+Name: cpphs+Version: 1.3+Copyright: 2004-6, Malcolm Wallace+Build-Depends: base, haskell98+License: LGPL+License-File: LICENCE-LGPL+Author: Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+Maintainer: Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+Homepage: http://haskell.org/cpphs/+Synopsis: A liberalised re-implementation of cpp, the C pre-processor.+Description:+	Cpphs is a re-implementation of the C pre-processor that is both+	more compatible with Haskell, and itself written in Haskell so+	that it can be distributed with compilers.+	.+	This version of the C pre-processor is pretty-much+	feature-complete and compatible with traditional (K&R)+	pre-processors.  Additional features include: a plain-text mode;+	an option to unlit literate code files; and an option to turn+	off macro-expansion.+Category: Development+Exposed-Modules:+	Language.Preprocessor.Cpphs+	Language.Preprocessor.Unlit+Other-Modules:+	Language.Preprocessor.Cpphs.CppIfdef,+	Language.Preprocessor.Cpphs.HashDefine,+	Language.Preprocessor.Cpphs.MacroPass,+	Language.Preprocessor.Cpphs.Options,+	Language.Preprocessor.Cpphs.Position,+	Language.Preprocessor.Cpphs.ReadFirst,+	Language.Preprocessor.Cpphs.RunCpphs,+	Language.Preprocessor.Cpphs.SymTab,+	Language.Preprocessor.Cpphs.Tokenise,+	Text.ParserCombinators.HuttonMeijer++Executable: cpphs+Main-Is: cpphs.hs+Other-Modules:+	Language.Preprocessor.Cpphs+	Language.Preprocessor.Unlit+	Language.Preprocessor.Cpphs.CppIfdef,+	Language.Preprocessor.Cpphs.HashDefine,+	Language.Preprocessor.Cpphs.MacroPass,+	Language.Preprocessor.Cpphs.Options,+	Language.Preprocessor.Cpphs.Position,+	Language.Preprocessor.Cpphs.ReadFirst,+	Language.Preprocessor.Cpphs.RunCpphs,+	Language.Preprocessor.Cpphs.SymTab,+	Language.Preprocessor.Cpphs.Tokenise,+	Text.ParserCombinators.HuttonMeijer
+ cpphs.compat view
@@ -0,0 +1,48 @@+#!/bin/sh+#	A minimal compatibility script to make cpphs accept the same+#	arguments as real cpp, wherever possible.+CPPHS=/usr/malcolm/Haskell/cpphs/cpphs++processArgs () {+  TRADITIONAL=no+  STRIP=yes+  INFILE="-"+  OUTFILE="-"+  while test "$1" != ""+  do+    case $1 in+      -D)            shift; echo -D$1 ;;+      -D*)           echo $1 ;;+      -U)            shift; echo -U$1 ;;+      -U*)           echo $1 ;;+      -I)            shift; echo -I$1 ;;+      -I*)           echo $1 ;;+      -o)            shift; echo -O$1 ;;+      -o*)           echo -O`echo $1 | cut -c3-` ;;+      -std*)         ;;		# ignore language spec+      -x)            shift ;;	# ignore language spec+      -ansi*)        TRADITIONAL=no ;;+      -traditional*) TRADITIONAL=yes ;;+      -include)      shift; echo $1 ;;+      -P)            echo --noline ;;+      -C)            STRIP=no ;;+      -CC)           STRIP=no ;;+      -A)            shift ;;	# strip assertions+      --help)        echo $1 ;;+      -version)      echo -$1 ;;+      --version)     echo $1 ;;+      -*)            ;;	# strip all other flags+      *)     if [ "$INFILE" = "-" ]+             then INFILE=$1+             else OUTFILE=$1+             fi ;;+    esac+    if test "$1" != ""; then shift; fi+  done+  if [ "$TRADITIONAL" = "no" ]; then echo "--hashes";   fi+  if [ "$STRIP" = "yes" ];      then echo "--strip";    fi+  echo $INFILE+  if [ "$OUTFILE" != "-" ];     then echo "-O$OUTFILE"; fi+}++exec $CPPHS `processArgs "$@"`
+ cpphs.hs view
@@ -0,0 +1,129 @@+{-+-- The main program wrapper for cpphs, a simple C pre-processor+-- written in Haskell.++-- Author: Malcolm Wallace, 2004+-- This file is licensed under the GPL.  Note however, that all other+-- modules used by it are either distributed under the LGPL, or are Haskell'98.+--+-- Thus, when compiled as a standalone executable, this program will fall+-- under the GPL.+-}+module Main where++import System ( getArgs, getProgName, exitWith, ExitCode(..) )+import Maybe+import Language.Preprocessor.Cpphs ( runCpphs, CpphsOption, parseOption )+import IO     ( stdout, IOMode(WriteMode), openFile, hPutStr, hFlush, hClose )+import Monad  ( when )+import List   ( isPrefixOf )+++version :: String+version = "1.3"+++main :: IO ()+main = do+  args <- getArgs+  args <- return $ if "--cpp" `elem` args then convertArgs args else args+  +  prog <- getProgName+  when ("--version" `elem` args)+       (do putStrLn (prog++" "++version)+           exitWith ExitSuccess)+  when ("--help" `elem` args)+       (do putStrLn ("Usage: "++prog+                ++" [file ...] [ -Dsym | -Dsym=val | -Ipath ]*  [-Ofile]\n"+                ++"\t\t[--nomacro] [--noline] [--text]"+                ++" [--strip] [--hashes] [--layout]"+                ++" [--unlit] [--cpp]")+           exitWith ExitSuccess)++  let parsedArgs = parseOptions args+      Right (opts, ins, outs) = parsedArgs+      out = listToMaybe outs+  +  when (isLeft parsedArgs)+       (do putStrLn $ "Unknown option, for valid options try "+                      ++prog++" --help\n"++fromLeft parsedArgs+           exitWith (ExitFailure 1))+  when (length outs > 1)+       (do putStrLn $ "At most one output file (-O) can be specified"+           exitWith (ExitFailure 2))+  if null ins then execute opts out Nothing+              else mapM_ (execute opts out) (map Just ins)+++isLeft (Left _) = True+isLeft _ = False++fromLeft (Left x) = x++-- | Parse the list of options+--   Return either Right (options, input files, output files)+--   or Left invalid flag+parseOptions :: [String] -> Either String ([CpphsOption], [FilePath], [FilePath])+parseOptions xs = f ([], [], []) xs+  where+    f (opts, ins, outs) (('-':'O':x):xs) = f (opts, ins, x:outs) xs+    f (opts, ins, outs) (x@('-':_):xs) = case parseOption x of+                                           Nothing -> Left x+                                           Just a  -> f (a:opts, ins, outs) xs+    f (opts, ins, outs) (x:xs) = f (opts, x:ins, outs) xs+    f (opts, ins, outs) []     = Right (reverse opts, reverse ins, reverse outs)+++-- | Parse a list of options, remaining compatible with cpp if possible+--   Based on a shell script cpphs.compat+data ConvertArgs = ConvertArgs {traditional :: Bool, strip :: Bool, infile :: String, outfile :: String}++convertArgs :: [String] -> [String]+convertArgs xs = f (ConvertArgs False True "-" "-") xs+    where+        flg = "DUI"+    +        f e (['-',r]:x:xs) | r `elem` flg = ('-':r:x) : f e xs+        f e (x@('-':r:_):xs) | r `elem` flg = x : f e xs+        f e ("-o":x:xs) = ('-':'O':x) : f e xs+        f e (('-':'o':x):xs) = ('-':'O':drop 2 x) : f e xs+        f e (('-':x):xs) | "ansi" `isPrefixOf` x = f e{traditional=False} xs+                         | "traditional" `isPrefixOf` x = f e{traditional=True} xs+                         | "std" `isPrefixOf` x = f e xs -- ignore language spec+        f e ("-x":x:xs) = f e xs -- ignore langauge spec+        f e ("-include":x:xs) = x : f e xs+        f e ("-P":xs) = "--noline" : f e xs+        f e (x:xs) | x == "-C" || x == "-CC" = f e{strip=False} xs+        f e ("-A":x:xs) = f e xs -- strip assertions+        f e ("--help":xs) = "--help" : f e xs+        f e ("--version":xs) = "--version" : f e xs+        f e ("-version":xs) = "--version" : f e xs+        f e (('-':x):xs) = f e xs -- strip all other flags+        f e (x:xs) = f (if infile e == "-" then e{infile=x} else e{outfile=x}) xs+        +        f e [] = ["--hashes" | not (traditional e)] +++                 ["--strip" | strip e] +++                 [infile e] +++                 ["-O" ++ outfile e | outfile e /= "-"]++++-- | Execute the preprocessor,+--   using the given options; an output path; and an input path.+--   If the filepath is Nothing then default to stdout\/stdin as appropriate.+execute :: [CpphsOption] -> Maybe FilePath -> Maybe FilePath -> IO ()+execute opts output input =+  let (filename, action) =+        case input of+          Just x -> (x, readFile x)+          Nothing -> ("stdin", getContents)+  in+  do contents <- action+     result <- runCpphs opts filename contents+     case output of+       Nothing -> do putStr result+                     hFlush stdout+       Just x  -> do h <- openFile x WriteMode+                     hPutStr h result+                     hFlush h+                     hClose h
+ cpphs.hugs view
@@ -0,0 +1,2 @@+#!/bin/sh+runhugs cpphs.hs --noline -D__HASKELL98__ -D__HUGS__ "$@"
+ docs/cpphs.1 view
@@ -0,0 +1,276 @@+.TH CPPHS 1 2004-10-01 "cpphs version 0.9" "User Manual"++.SH NAME+cpphs \- liberalised cpp-a-like preprocessor for Haskell++.SH SYNOPSIS+.B cpphs+[\fIFILENAME\fR|\fIOPTION\fR]...++.SH DESCRIPTION+.ds c \fIcpphs\fP+\*c is a liberalised re-implementation of+.B cpp (1),+the C pre-processor, in and for Haskell.+.PP+Why re-implement cpp?  Rightly or wrongly, the C pre-processor is+widely used in Haskell source code.  It enables conditional compilation+for different compilers, different versions of the same compiler,+and different OS platforms.  It is also occasionally used for its+macro language, which can enable certain forms of platform-specific+detail-filling, such as the tedious boilerplate generation of instance+definitions and FFI declarations.  However, there are two problems with+cpp, aside from the obvious aesthetic ones:+.IP+For some Haskell systems, notably Hugs on Windows, a true cpp+is not available by default.+.IP+Even for the other Haskell systems, the common cpp provided by+the gcc 3.x series is changing subtly in ways that are+incompatible with Haskell's syntax.  There have always been+problems with, for instance, string gaps, and prime characters+in identifiers.  These problems are only going to get worse.+.PP+So, it seemed right to attempt to provide an alternative to cpp,+both more compatible with Haskell, and itself written in Haskell so+that it can be distributed with compilers.+.PP+\*c is pretty-much feature-complete,+and compatible with the+.B \-traditional+style of cpp.+It has two modes:+.IP+conditional compilation only (\fB\-\-nomacro\fR),+.IP+and full macro-expansion (default).+.PP+In+.B \-\-nomacro+mode, \*c performs only conditional compilation actions, i.e.+\fB#include\fR's, \fB#if\fR's, and \fB#ifdef\fR's are processed+according to text-replacement+definitions (both command-line and internal), but no parameterised+macro expansion is performed.  In full compatibility mode (the+default), textual replacements and macro expansions are also processed+in the remaining body of non-cpp text.+.PP+Working Features:+.TP+.B #ifdef+simple conditional compilation+.TP+.B #if+the full boolean language of defined(), &&, ||, ==, etc.+.TP+.B #elif+chained conditionals+.TP+.B #define+in-line definitions (text replacements and macros)+.TP+.B #undef+in-line revocation of definitions+.TP+.B #include+file inclusion+.TP+.B #line+line number directives+.TP+.B \\\\n+line continuations within all # directives+.TP+.B /**/+token catenation within a macro definition+.TP+.B ##+ANSI-style token catenation+.TP+.B #+ANSI-style token stringisation+.TP+.B __FILE__+special text replacement for DIY error messages+.TP+.B __LINE__+special text replacement for DIY error messages+.TP+.B __DATE__+special text replacement+.TP+.B __TIME__+special text replacement+.PP+Macro expansion is recursive.  Redefinition of a macro name does not+generate a warning.  Macros can be defined on the command-line with+.B \-D+just like textual replacements.  Macro names are permitted to be+Haskell identifiers e.g. with the prime \(ga and backtick \(aa characters,+which is slightly looser than in C, but they still may not include+operator symbols.+.PP+Numbering of lines in the output is preserved so that any later+processor can give meaningful error messages.  When a file is+\fB#include\fR'd, \*c inserts+.B #line+directives for the same reason. Numbering should be correct+even in the presence of line continuations. If you don't want+.B #line+directives in the final output, use the+.B \-\-noline+option.+.PP+Any syntax errors in cpp directives gives a message to stderr and+halts the program.  Failure to find a #include'd file produces a+warning to stderr, but processing continues.+.PP+You can give any number of filenames on the command-line.  The+results are catenated on standard output.+.TP+.B \-D\fIsym\fR+define a textual replacement (default value is 1)+.TP+.B \-Dsym=\fIval\fR+define a textual replacement with a specific value+.TP+.B \-I\fIpath\fR+add a directory to the search path for #include's+.TP+.B \-O\fIfile\fR+specify a file for output (default is stdout)+.TP+.B \-\-nomacro+only process #ifdef's and #include's,+                      do not expand macros+.TP+.B \-\-noline+remove #line droppings from the output+.TP+.B \-\-strip+convert C-style comments to whitespace, even outside+                      cpp directives+.TP+.B \-\-hashes+recognise the ANSI # stringise operator, and ## for+                      token catenation, within macros+.TP+.B \-\-text+treat the input as plain text, not Haskell code+.TP+.B \-\-layout+preserve newlines within macro expansions+.TP+.B \-\-unlit+remove literate-style comments+.TP+.B \-\-version+report version number of cpphs and stop+.PP+There are NO textual replacements defined by default.  (Normal cpp+usually has definitions for machine, OS, etc.  These could easily+be added to the cpphs source code if you wish.)  The search path is+searched in order of the+.B \-I+options, except that the directory of the+calling file, then the current directory, are always searched first.+Again, there is no default search path (and again, this could easily+be changed).++.SH "DIFFERENCES FROM CPP"+.PP+In general, cpphs is based on the+.B \-traditional+behaviour, not ANSI C, and has the following main differences from the+standard cpp.++.B General+.PP+The+.B #+that introduces any cpp directive must be in the first+column of a line (whereas ANSI permits whitespace before the+.B #+).+.PP+Generates the+.B "#line \fIn\fR \(dq\fIfilename\fR\(dq"+syntax, not the+.B "# \fIn\fR \(dq\fIfilename\fR\(dq"+variant.+.PP+C comments are only removed from within cpp directives.  They are+not stripped from other text.  Consider for instance that in+Haskell, all of the following are valid operator symbols:+.B /*  */  */*+However, you can turn on C-comment removal with the+.B \-\-strip+option.++.B Macro language+.PP+Accepts+.B /**/+for token-pasting in a macro definition.+However,+.B /* */+(with any text between the open/close comment) inserts whitespace.+.PP+The ANSI+.B ##+token-pasting operator is available with+the+.B \-\-hashes+flag.  This is to avoid misinterpreting+any valid Haskell operator of the same name.+.PP+Replaces a macro formal parameter with the actual, even inside a+string (double or single quoted).  This is \-traditional behaviour,+not supported in ANSI.+.PP+Recognises the+.B #+stringisation operator in a macro+definition only if you use the+.B \-\-hashes+option.  (It is+an ANSI addition, only needed because quoted stringisation (above)+is prohibited by ANSI.)+.PP+Preserves whitespace within a textual replacement definition+exactly (modulo newlines), but leading and trailing space is eliminated.+.PP+Preserves whitespace within a macro definition (and trailing it)+exactly (modulo newlines), but leading space is eliminated.+.PP+Preserves whitespace within macro call arguments exactly+(including newlines), but leading and trailing space is eliminated.+.PP+With the+.B \-\-layout+option, line continuations in a textual+replacement or macro definition are preserved as line-breaks in the+macro call.  (Useful for layout-sensitive code in Haskell.)++.SH BUGS+Bug reports, and any other feedback, should be sent to+Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>+.SH COPYRIGHT+Copyright \(co 2004-2005 Malcolm Wallace,+except for ParseLib (Copyright \(co 1995 Graham Hutton and Erik Meijer).+.PP+The library modules in cpphs are distributed under+the terms of the LGPL. If that's a problem for you, contact me to make+other arrangements. The application module+.B Main.hs+itself is GPL.+.SH "SEE ALSO"+.BR cpp (1)++.SH AUTHOR++This manual page was written, based on \fBindex.html\fR,+by Ian Lynagh <igloo@debian.org> for the Debian+system (but may be used by others).++
+ docs/design view
@@ -0,0 +1,29 @@+Design for hspp++First pass:+-----------+  * traverse the file,+      - processing #if's and #ifdef's+      - reading #include's and recursively doing this pass on them+      - leaving #line's behind+      - whilst taking account of #define's and #undef's+  * only needs to look at lines beginning with a #+  * should discard C-style comments?  (no)+  * DO NOT gather the #define's for macros - their sequence matters!++pass1 :: SymTab -> String -> String++Second pass:+------------+  * traverse the residual file,+      - keeping track of #define'd macros+      - expanding #define'd macros when an instance is encountered+  * needs a whitespace-preserving tokeniser with odd rules to+    cover e.g. token concatenation.  Within Haskell, quotation marks start+    strings, haskell comments are preserved.  Within a cpp directive,+    quotation marks do not start a string, and C-style comments are+    converted to whitespace.+  * Line continuation characters are tricky; probably should only+    be recognised within a macro definition, not in ordinary code.++pass2 :: SymTab -> String -> String
+ docs/index.html view
@@ -0,0 +1,484 @@+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">+<html>+<head>+<title>+  cpphs+</title>+</head>+ +<body bgcolor='#ffffff'>++<center>+<h1>cpphs</h1>+<table><tr><td width=200 align=center>+<a href="#what">What is cpphs?</a><br>+<a href="#how">How do I use it?</a><br>+<a href="#download">Downloads</a><br>+</td><td width=200 align=center>+<a href="#diff">Differences to cpp</a><br>+<a href="#library">cpphs as a library</a><br>+<a href="#who">Contacts</a><br>+</td></tr></table>+</center>+<hr>++<center><h3><a name="what">What is cpphs?</a></h3></center>+<p>+<b>cpphs</b> is a liberalised re-implementation of+<a href="http://gcc.gnu.org/onlinedocs/gcc-2.95.3/cpp.html">cpp</a>,+the C pre-processor, in <a href="http://haskell.org/">Haskell</a>.++<p>+Why re-implement cpp?  Rightly or wrongly, the C pre-processor is+widely used in Haskell source code.  It enables conditional compilation+for different compilers, different versions of the same compiler,+and different OS platforms.  It is also occasionally used for its+macro language, which can enable certain forms of platform-specific+detail-filling, such as the tedious boilerplate generation of instance+definitions and FFI declarations.  However, there are two problems with+cpp, aside from the obvious aesthetic ones:+<ul>+  <li> For some Haskell systems, notably Hugs on Windows, a true cpp+       is not available by default.+  <li> Even for the other Haskell systems, the common cpp provided by+       the gcc 3.x and 4.x series has changed subtly in ways that are+       incompatible with Haskell's syntax.  There have always been+       problems with, for instance, string gaps, and prime characters+       in identifiers.  These problems are only going to get worse.+</ul>+So, it seemed right to provide an alternative to cpp, both more+compatible with Haskell, and itself written in Haskell so that it+can be distributed with compilers.++<p>+This version of the C pre-processor is pretty-much feature-complete,+and compatible with the <tt>-traditional</tt> style.+It has two main modes:+<ul>+  <li> conditional compilation only (--nomacro),+  <li> and full macro-expansion (default).+</ul>+In <tt>--nomacro</tt> mode, cpphs performs only conditional+compilation actions, namely <tt>#include</tt>'s, <tt>#if</tt>'s,+and <tt>#ifdef</tt>'s are processed according to text-replacement+definitions (both command-line and internal), but no parameterised+macro expansion is performed.  In full compatibility mode (the+default), textual replacements and macro expansions are also processed+in the remaining body of non-cpp text.++<p>+Source language features:+<table border=0 align=center>+<tr><td>#ifdef</td>  <td>simple conditional compilation</td></tr>+<tr><td>#if</td>     <td>the full boolean language of defined(),+                     &amp;&amp;, ||, ==, etc.</td></tr>+<tr><td>#elif</td>   <td>chained conditionals</td></tr>+<tr><td>#define</td> <td>in-line definitions (text replacements and macros)</td></tr>+<tr><td>#undef</td>  <td>in-line revocation of definitions</td></tr>+<tr><td>#include</td><td>file inclusion</td></tr>+<tr><td>#line</td>   <td>line number directives</td></tr>+<tr><td>\\n</td>     <td>line continuations within all # directives</td></tr>+<tr><td>/**/</td>    <td>token catenation within a macro definition</td></tr>+<tr><td>##</td>      <td>ANSI-style token catenation</td></tr>+<tr><td>#</td>       <td>ANSI-style token stringisation</td></tr>+<tr><td>__FILE__</td><td>special text replacement for DIY error messages</td></tr>+<tr><td>__LINE__</td><td>special text replacement for DIY error messages</td></tr>+<tr><td>__DATE__</td><td>special text replacement</td></tr>+<tr><td>__TIME__</td><td>special text replacement</td></tr>+</table>++<p>+Macro expansion is recursive.  Redefinition of a macro name does not+generate a warning.  Macros can be defined on the command-line with+-D just like textual replacements.  Macro names are permitted to be+Haskell identifiers e.g. with the prime ' and backtick ` characters,+which is slightly looser than in C, but they still may not include+operator symbols.++<p>+Numbering of lines in the output is preserved so that any later+processor can give meaningful error messages.  When a file is+<tt>#include</tt>'d, cpphs inserts <tt>#line</tt> directives for the+same reason.  Numbering should be correct even in the presence of+line continuations.  If you don't want <tt>#line</tt> directives in+the final output, use the <tt>--noline</tt> option.++<p>+Any syntax error in a cpp directive gives a warning message to stderr.+Failure to find a #include'd file also produces a warning to stderr.  In+both cases, processing continues on the rest of the input.++<hr>+<center><h3><a name="how">How do I use it?</a></h3></center>+<p>+<center><pre>+Usage: cpphs  [ filename | -Dsym | -Dsym=val | -Ipath ]+  [-Ofile]+              [--nomacro|--noline|--strip|--text|--hashes|--layout|--unlit]*+              [ --cpp compatopts ]+       cpphs --version                                             +</pre></center>+<p>+You can give any number of filenames on the command-line.  The results+are catenated on standard output.  (Macro definitions in one file do not+carry over into the next.)  If no filename is given, cpphs reads from+standard input.++<p>+Options:+<table border=0 align=center>+<tr><td>-Dsym</td>+    <td>define a textual replacement (default value is 1)</td></tr>+<tr><td>-Dsym=val</td>+    <td>define a textual replacement with a specific value</td></tr>+<tr><td>-Dsym(args)=val</td>+    <td>define a macro with arguments</td></tr>+<tr><td>-Ipath</td>+    <td>add a directory to the search path for #include's</td></tr>+<tr><td>-Ofile</td>+    <td>specify a file for output (default is stdout)</td></tr>+<tr><td>--nomacro</td>+    <td>only process #ifdef's and #include's, do not expand macros</td></tr>+<tr><td>--noline</td>+    <td>remove #line droppings from the output</td></tr>+<tr><td>--strip</td>+    <td>convert C-style comments to whitespace, even outside+                      cpp directives</td></tr>+<tr><td>--hashes</td>+    <td>recognise the ANSI # stringise operator, and ## for+                      token catenation, within macros</td></tr>+<tr><td>--text</td>+    <td>treat input as plain text, not Haskell code</td></tr>+<tr><td>--layout</td>+    <td>preserve newlines within macro expansions</td></tr>+<tr><td>--unlit</td>+    <td>unlit literate source code</td></tr>+<tr><td>--cpp compatopts</td>+    <td>accept standard cpp options: -o, -x, -ansi, -traditional,+                                     -P, -C, -A, etc</td></tr>+<tr><td>--version</td>+    <td>report version number of cpphs and stop</td></tr>+</table>++<p>+There are NO textual replacements defined by default.  (Normal cpp+usually has definitions for machine, OS, etc.  You can easily create+a wrapper script if you need these.) The search path is searched in+order of the -I options, except that the directory of the calling file,+then the current directory, are always searched first.  Again, there+is no default search path (unless you define one via a wrapper script).+++<hr>+<center><h3><a name="download">Downloads</a></h3></center>++<p>+<b>Current stable version:</b>+<p>+cpphs-1.3, release date 2006.10.09<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.3.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.3.zip">.zip</a>.+<a href="http://www.cs.york.ac.uk/fp/cpphs-1.3-win32.zip">Windows binary</a>,+<a href="http://www.haskell.org/fedora/">Fedora package</a>,+<a href="http://packages.gentoo.org/packages/?category=dev-haskell;name=cpphs">Gentoo package</a>,+<a href="http://www.freshports.org/devel/hs-cpphs/">FreeBSD port</a>,+<a href="http://www.openbsd.org/cgi-bin/cvsweb/ports/devel/cpphs/">OpenBSD port</a>.+<ul>+<li> Added a "--cpp" option for drop-in compatibility with standard cpp.+     It causes cpphs to accept standard cpp flags and translate+     them to cpphs equivalents.  Compatibility options include: -o, -ansi,+     -traditional, -stdc, -x, -include, -P, -C, -CC, -A.  The file+     behaviour is different too - if two filenames are given on the+     commandline, then the second is treated as the output location.+<li> Fixed a corner-case bug in evaluating chained and overlapping #ifdefs.+</ul>++<p>+<b>Development:</b>+<p>+The current <a href="http://darcs.net/">darcs</a> repository of+cpphs is available at+<pre>+    darcs get http://www.cs.york.ac.uk/fp/darcs/cpphs+</pre>+(Users on Windows or MacOS filesystems need to use the+<tt>--partial</tt> flag.)  The source tree and version history can+be browsed on-line through+<a href="http://www.cs.york.ac.uk/fp/darcs/">darcsweb</a>.++<p>+<b>Older versions:</b>+<p>+cpphs-1.2, release date 2006.05.04<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.2.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.2.zip">.zip</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs-1.2-win32.zip">Windows binary</a>.+<ul>+<li> Re-arranged the source files into hierarchical libraries.+<li> Exposed the library interface as an installable Cabal package, with+     Haddock documentation.+<li> Added the --unlit option, for removing literate-style comments.+</ul>++<p>+cpphs-1.1, release date 2005.10.14<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.1.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.1.zip">.zip</a>.+<ul>+<li> Fixed the .cabal way of building cpphs.+<li> Update the --version reported (forgotten in 1.0, which still+     mistakenly reports 0.9).+<li> No longer throws an error on an empty file.+</ul>++<p>+cpphs-1.0, release date 2005.10.05<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.0.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.0.zip">.zip</a>.+<ul>+<li> Included the <tt>cpphs.compat</tt> script for argument+     compatibility with the original <em>cpp</em>.+<li> Placed quotes around replacements for special macros __FILE__, __DATE__,+     and __TIME__.+<li> If no files are specified, read from stdin.+<li> Ignore #! lines (e.g. in scripts)+<li> Parse -D commandline options consistently with cpp,+     i.e. -Dfoo means foo=1+<li> Fix compatibility with preprocessors like hsc2hs, which use+     non-cpp directives like #def.  They are now passed through to the+     output with a warning to stderr.+</ul>++<p>+cpphs-0.9, release date 2005.03.17<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.9.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.9.zip">.zip</a>.+<ul>+<li> Bugfix for <tt>ghc-6.4 -O</tt>: flush output buffer.+</ul>++<p>+cpphs-0.8, release date 2004.11.14<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.8.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.8.zip">.zip</a>.+<ul>+<li> Added the <tt>--text</tt> option, to signify the input should not+     be lexed as Haskell.  This causes macros to be defined or expanded+     regardless of their location within comments, string delimiters, etc.+<li> Shuffled some source files around - there is now a runhugs script+     to invoke cpphs nicely.+</ul>++<p>+cpphs-0.7, release date 2004.09.01<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.7.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.7.zip">.zip</a>.+<ul>+<li> Enable the <tt>__FILE__</tt>, <tt>__LINE__</tt>, <tt>__DATE__</tt>,+     and <tt>__TIME__</tt> specials, which can be useful for creating+     DIY error messages.+</ul>++<p>+cpphs-0.6, release date 2004.07.30<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.6.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.6.zip">.zip</a>.+<ul>+<li> Recognise and ignore the <tt>#pragma</tt> cpp directive.+<li> Fix beginning-of-file bug, where in <tt>--noline</tt> mode, a+     <tt>#line</tt> cpp directive appeared at the top of the output file.+<li> Fix chained parenthesised boolean exprs in <tt>#if</tt>, e.g.+        <pre>#if ( foo ) &amp;&amp; ( bar )</pre>+<li> Fix precedence in chained unparenthesised boolean exprs in+     <tt>#if</tt>, e.g.+        <pre>#if foo &amp;&amp; bar || baz &amp;&amp; frob</pre>+<li> For better compatibility with cpp, and because otherwise+     there are certain constructs that cannot be expressed, we no+     longer permit whitespace in a <tt>#define</tt> between the+     symbolname and an opening parenthesis, e.g.  +     <pre>#define f (f' id)</pre>.  Previously, this was interpreted+     as a parametrised macro, with arguments in the parens, and+     no expansion.  Now, the space indicates that this is a textual+     replacement, and the parenthesised expression is in fact the+     replacement.+</ul>++<p>+cpphs-0.5, release date 2004.06.07<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.5.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.5.zip">.zip</a>.+<ul>+<li> Added a --version flag to report the version number.+<li> Renamed --stringise to --hashes, and use it to turn on ## catenation+     as well.+<li> Bugfix for <tt>#if 1</tt>, previously interpreted as false.+<li> Bugfix for --nolines: it no longer adds extra spurious newlines.+<li> File inclusion now looks in the directory of the calling file.+<li> Failure to find an include file is now merely a warning to stderr+     rather than an error.+<li> Added a --layout flag.  Previously, line continuations in a macro+     definition were always preserved in the output, permitting use+     of the Haskell layout rule even inside a macro.  The default is now+     to remove line continuations for conformance with cpp, but the option+     of using --layout is still possible.+</ul>++<p>+cpphs-0.4, release date 2004.05.19<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.4.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.4.zip">.zip</a>.+<ul>+<li> New flag -Ofile to redirect output+<li> Bugfix for precedence of ! in #if !False &amp;&amp; False+<li> Bugfix for whitespace permitted between # and if+<li> Bugfix for <tt>#define F "blah";  #include F</tt>+</ul>++<p>+cpphs-0.3, release date 2004.05.18<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.3.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.3.zip">.zip</a>.+<p>+Fix recursive macro expansion bug.  Added option to strip C comments.+Added option to recognise the # stringise operator.++<p>+cpphs-0.2, release date 2004.05.15<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.2.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.2.zip">.zip</a>.+<p>+Implements textual replacement and macro expansion.++<p>+cpphs-0.1, release date 2004.04.07<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.1.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-0.1.zip">.zip</a>.+<p>+Initial release: implements conditional compilation and file inclusion only.+++<p>+<b>Building instructions</b>+<p>+To build cpphs, use+<pre>    hmake cpphs [-package base]+</pre>+or+<pre>    ghc --make cpphs [-o cpphs]+</pre>+or+<pre>    mv cpphs.hugs cpphs	# a simple runhugs script+</pre>++<p>+You will notice that the command-line arguments for <em>cpphs</em>+are not the same as for the original <em>cpp</em>.  If you want+to use <em>cpphs</em> as a completely drop-in replacement for+the real <em>cpp</em>, that is, to accept the same arguments, and+have broadly the same behaviour in response to them, then use the+<tt>--cpp</tt> compatibility option as the first commandline flag.+++<hr>+<center><h3><a name="diff">Differences from cpp</a></h3></center>+<p>+In general, cpphs is based on the <tt>-traditional</tt> behaviour, not+ANSI C, and has the following main differences from the standard cpp.++<p>+<b>General</b>+<ul>+<li> The <tt>#</tt> that introduces any cpp directive must be in the first+     column of a line (whereas ANSI permits whitespace before the <tt>#</tt>).+<li> Generates the <tt>#line n "filename"</tt> syntax, not the <tt># n+     "filename"</tt> variant.+<li> C comments are only removed from within cpp directives.  They are+     not stripped from other text.  Consider for instance that in+     Haskell, all of the following are valid operator symbols:  <tt>/*+     */  */*</tt>   However, you can turn on C-comment removal with the+     <tt>--strip</tt> option.+<li> Macros are never expanded within Haskell comments, strings,+     or character constants, unless you give the <tt>--text</tt> option to+     disable lexing the input as Haskell.+<li> Macros are always expanded recursively, unlike ANSI, which detects+     and prevents self-recursion.  For instance, <tt>#define foo x:foo</tt>+     expands <tt>foo</tt> once only to <tt>x:foo</tt> in ANSI, but in cpphs+     it becomes an infinite list <tt>x:x:x:x:...</tt>, i.e. cpphs does not+     terminate.+</ul>+<p>+<b>Macro definition language</b>+<ul>+<li> Accepts <tt>/**/</tt> for token-pasting in a macro definition.+     However, <tt>/* */</tt> (with any text between the open/close+     comment) inserts whitespace.+<li> The ANSI <tt>##</tt> token-pasting operator is available with+     the <tt>--hashes</tt> flag.  This is to avoid misinterpreting+     any valid Haskell operator of the same name.+<li> Replaces a macro formal parameter with the actual, even inside a+     string (double or single quoted).  This is -traditional behaviour,+     not supported in ANSI.+<li> Recognises the <tt>#</tt> stringisation operator in a macro+     definition only if you use the <tt>--hashes</tt> option.  (It is+     an ANSI addition, only needed because quoted stringisation (above)+     is prohibited by ANSI.)+<li> Preserves whitespace within a textual replacement definition+     exactly (modulo newlines), but leading and trailing space is eliminated.+<li> Preserves whitespace within a macro definition (and trailing it)+     exactly (modulo newlines), but leading space is eliminated.+<li> Preserves whitespace within macro call arguments exactly+     (including newlines), but leading and trailing space is eliminated.+<li> With the <tt>--layout</tt> option, line continuations in a textual+     replacement or macro definition are preserved as line-breaks in the+     macro call.  (Useful for layout-sensitive code in Haskell.)+</ul>++<hr>+<center><h3><a name="library">cpphs as a library</a></h3></center>+<p>+You can use cpphs as a library from within a Haskell program.  The main+interface is in <tt>Language.Preprocessor.Cpphs</tt>.  Haddock+documentation is <a href="cpphs/">here</a>.  To make the library+available to your haskell compiler, you must install the cpphs package+using Cabal.++<hr>+<center><h3><a name="who">Contacts</a></h3></center>+<p>+I am interested in hearing your feedback on cpphs.  Bug reports+especially welcome.  You can send feature requests too, but I won't+guarantee to implement them if they depart much from the ordinary+cpp's behaviour.  Please mail+<ul>+<li>    <a href="mailto:Malcolm.Wallace@cs.york.ac.uk">+        Malcolm.Wallace@cs.york.ac.uk</a> +</ul>++<p><b>Copyright:</b> &copy; 2004-2006 Malcolm Wallace,+except for ParseLib (Copyright &copy; 1995 Graham Hutton and Erik Meijer)++<p><b>License:</b> The library modules in cpphs are distributed under+the terms of the LGPL (see file <a href="LICENCE-LGPL">LICENCE-LGPL</a>+for more details).  If that's a problem for you, contact me to make+other arrangements.  The application module 'cpphs.hs' itself is GPL+(see file <a href="LICENCE-GPL">LICENCE-GPL</a>).++<p>+This software comes with no warranty.  Use at your own risk.++<hr>+ +</body>+</html>
+ tests/Arr.lhs view
@@ -0,0 +1,683 @@+\begin{code}+{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Arr+-- Copyright   :  (c) The University of Glasgow, 1994-2000+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC extensions)+--+-- GHC\'s array implementation.+-- +-----------------------------------------------------------------------------++-- #hide+module GHC.Arr where++import {-# SOURCE #-} GHC.Err ( error )+import GHC.Enum+import GHC.Num+import GHC.ST+import GHC.Base+import GHC.List+import GHC.Show++infixl 9  !, //++default ()+\end{code}+++%*********************************************************+%*							*+\subsection{The @Ix@ class}+%*							*+%*********************************************************++\begin{code}+-- | The 'Ix' class is used to map a contiguous subrange of values in+-- a type onto integers.  It is used primarily for array indexing+-- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").+--+-- The first argument @(l,u)@ of each of these operations is a pair+-- specifying the lower and upper bounds of a contiguous subrange of values.+--+-- An implementation is entitled to assume the following laws about these+-- operations:+--+-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@+--+-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@+--+-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@+--+-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@+--+-- Minimal complete instance: 'range', 'index' and 'inRange'.+--+class (Ord a) => Ix a where+    -- | The list of values in the subrange defined by a bounding pair.+    range		:: (a,a) -> [a]+    -- | The position of a subscript in the subrange.+    index		:: (a,a) -> a -> Int+    -- | Like 'index', but without checking that the value is in range.+    unsafeIndex		:: (a,a) -> a -> Int+    -- | Returns 'True' the given subscript lies in the range defined+    -- the bounding pair.+    inRange		:: (a,a) -> a -> Bool+    -- | The size of the subrange defined by a bounding pair.+    rangeSize		:: (a,a) -> Int+    -- | like 'rangeSize', but without checking that the upper bound is+    -- in range.+    unsafeRangeSize     :: (a,a) -> Int++	-- Must specify one of index, unsafeIndex+    index b i | inRange b i = unsafeIndex b i	+	      | otherwise   = error "Error in array index"+    unsafeIndex b i = index b i++    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1+		       | otherwise   = 0	-- This case is only here to+						-- check for an empty range+	-- NB: replacing (inRange b h) by (l <= h) fails for+	--     tuples.  E.g.  (1,2) <= (2,1) but the range is empty++    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1+\end{code}++Note that the following is NOT right+	rangeSize (l,h) | l <= h    = index b h + 1+			| otherwise = 0++Because it might be the case that l<h, but the range+is nevertheless empty.  Consider+	((1,2),(2,1))+Here l<h, but the second index ranges from 2..1 and+hence is empty++%*********************************************************+%*							*+\subsection{Instances of @Ix@}+%*							*+%*********************************************************++\begin{code}+-- abstract these errors from the relevant index functions so that+-- the guts of the function will be small enough to inline.++{-# NOINLINE indexError #-}+indexError :: Show a => (a,a) -> a -> String -> b+indexError rng i tp+  = error (showString "Ix{" . showString tp . showString "}.index: Index " .+           showParen True (showsPrec 0 i) .+	   showString " out of range " $+	   showParen True (showsPrec 0 rng) "")++----------------------------------------------------------------------+instance  Ix Char  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = fromEnum i - fromEnum m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Char"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance  Ix Int  where+    {-# INLINE range #-}+	-- The INLINE stops the build in the RHS from getting inlined,+	-- so that callers can fuse with the result of range+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = i - m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Int"++    {-# INLINE inRange #-}+    inRange (I# m,I# n) (I# i) =  m <=# i && i <=# n++----------------------------------------------------------------------+instance  Ix Integer  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i   = fromInteger (i - m)++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Integer"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance Ix Bool where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Bool"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix Ordering where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Ordering"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix () where+    {-# INLINE range #-}+    range   ((), ())    = [()]+    {-# INLINE unsafeIndex #-}+    unsafeIndex   ((), ()) () = 0+    {-# INLINE inRange #-}+    inRange ((), ()) () = True+    {-# INLINE index #-}+    index b i = unsafeIndex b i++----------------------------------------------------------------------+instance (Ix a, Ix b) => Ix (a, b) where -- as derived+    {-# SPECIALISE instance Ix (Int,Int) #-}++    {- INLINE range #-}+    range ((l1,l2),(u1,u2)) =+      [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]++    {- INLINE unsafeIndex #-}+    unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =+      unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2++    {- INLINE inRange #-}+    inRange ((l1,l2),(u1,u2)) (i1,i2) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where+    {-# SPECIALISE instance Ix (Int,Int,Int) #-}++    range ((l1,l2,l3),(u1,u2,u3)) =+        [(i1,i2,i3) | i1 <- range (l1,u1),+                      i2 <- range (l2,u2),+                      i3 <- range (l3,u3)]++    unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))++    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where+    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =+      [(i1,i2,i3,i4) | i1 <- range (l1,u1),+                       i2 <- range (l2,u2),+                       i3 <- range (l3,u3),+                       i4 <- range (l4,u4)]++    unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1)))++    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4++    -- Default method for index++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where+    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =+      [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),+                          i2 <- range (l2,u2),+                          i3 <- range (l3,u3),+                          i4 <- range (l4,u4),+                          i5 <- range (l5,u5)]++    unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))))++    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4 && +      inRange (l5,u5) i5++    -- Default method for index+\end{code}++%*********************************************************+%*							*+\subsection{The @Array@ types}+%*							*+%*********************************************************++\begin{code}+type IPr = (Int, Int)++-- | The type of immutable non-strict (boxed) arrays+-- with indices in @i@ and elements in @e@.+data Ix i => Array     i e = Array   !i !i (Array# e)++-- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type+-- arguments are as follows:+--+--  * @s@: the state variable argument for the 'ST' type+--+--  * @i@: the index type of the array (should be an instance of 'Ix')+--+--  * @e@: the element type of the array.+--+data         STArray s i e = STArray !i !i (MutableArray# s e)+	-- No Ix context for STArray.  They are stupid,+	-- and force an Ix context on the equality instance.++-- Just pointer equality on mutable arrays:+instance Eq (STArray s i e) where+    STArray _ _ arr1# == STArray _ _ arr2# =+        sameMutableArray# arr1# arr2#+\end{code}+++%*********************************************************+%*							*+\subsection{Operations on immutable arrays}+%*							*+%*********************************************************++\begin{code}+{-# NOINLINE arrEleBottom #-}+arrEleBottom :: a+arrEleBottom = error "(Array.!): undefined array element"++-- | Construct an array with the specified bounds and containing values+-- for given indices within these bounds.+--+-- The array is undefined (i.e. bottom) if any index in the list is+-- out of bounds.  The Haskell 98 Report further specifies that if any+-- two associations in the list have the same index, the value at that+-- index is undefined (i.e. bottom).  However in GHC's implementation,+-- the value at such an index is the value part of the last association+-- with that index in the list.+--+-- Because the indices must be checked for these errors, 'array' is+-- strict in the bounds argument and in the indices of the association+-- list, but nonstrict in the values.  Thus, recurrences such as the+-- following are possible:+--+-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])+--+-- Not every index within the bounds of the array need appear in the+-- association list, but the values associated with indices that do not+-- appear will be undefined (i.e. bottom).+--+-- If, in any dimension, the lower bound is greater than the upper bound,+-- then the array is legal, but empty.  Indexing an empty array always+-- gives an array-bounds error, but 'bounds' still yields the bounds+-- with which the array was constructed.+{-# INLINE array #-}+array :: Ix i+	=> (i,i)	-- ^ a pair of /bounds/, each of the index type+			-- of the array.  These bounds are the lowest and+			-- highest indices in the array, in that order.+			-- For example, a one-origin vector of length+			-- '10' has bounds '(1,10)', and a one-origin '10'+			-- by '10' matrix has bounds '((1,1),(10,10))'.+	-> [(i, e)]	-- ^ a list of /associations/ of the form+			-- (/index/, /value/).  Typically, this list will+			-- be expressed as a comprehension.  An+			-- association '(i, x)' defines the value of+			-- the array at index 'i' to be 'x'.+	-> Array i e+array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeArray #-}+unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e+unsafeArray (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    foldr (fill marr#) (done l u marr#) ies s2# }})++{-# INLINE fill #-}+fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a+fill marr# (I# i#, e) next s1# =+    case writeArray# marr# i# e s1#     of { s2# ->+    next s2# }++{-# INLINE done #-}+done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)+done l u marr# s1# =+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++-- This is inefficient and I'm not sure why:+-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)+-- The code below is better. It still doesn't enable foldr/build+-- transformation on the list of elements; I guess it's impossible+-- using mechanisms currently available.++-- | Construct an array from a pair of bounds and a list of values in+-- index order.+{-# INLINE listArray #-}+listArray :: Ix i => (i,i) -> [e] -> Array i e+listArray (l,u) es = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let fillFromList i# xs s3# | i# ==# n# = s3#+                               | otherwise = case xs of+            []   -> s3#+            y:ys -> case writeArray# marr# i# y s3# of { s4# ->+                    fillFromList (i# +# 1#) ys s4# } in+    case fillFromList 0# es s2#         of { s3# ->+    done l u marr# s3# }}})++-- | The value at the given index in an array.+{-# INLINE (!) #-}+(!) :: Ix i => Array i e -> i -> e+arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)++{-# INLINE unsafeAt #-}+unsafeAt :: Ix i => Array i e -> Int -> e+unsafeAt (Array _ _ arr#) (I# i#) =+    case indexArray# arr# i# of (# e #) -> e++-- | The bounds with which an array was constructed.+{-# INLINE bounds #-}+bounds :: Ix i => Array i e -> (i,i)+bounds (Array l u _) = (l,u)++-- | The list of indices of an array in ascending order.+{-# INLINE indices #-}+indices :: Ix i => Array i e -> [i]+indices (Array l u _) = range (l,u)++-- | The list of elements of an array in index order.+{-# INLINE elems #-}+elems :: Ix i => Array i e -> [e]+elems arr@(Array l u _) =+    [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]++-- | The list of associations of an array in index order.+{-# INLINE assocs #-}+assocs :: Ix i => Array i e -> [(i, e)]+assocs arr@(Array l u _) =+    [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]++-- | The 'accumArray' deals with repeated indices in the association+-- list using an /accumulating function/ which combines the values of+-- associations with the same index.+-- For example, given a list of values of some index type, @hist@+-- produces a histogram of the number of occurrences of each index within+-- a specified range:+--+-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b+-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]+--+-- If the accumulating function is strict, then 'accumArray' is strict in+-- the values, as well as the indices, in the association list.  Thus,+-- unlike ordinary arrays built with 'array', accumulated arrays should+-- not in general be recursive.+{-# INLINE accumArray #-}+accumArray :: Ix i+	=> (e -> a -> e)	-- ^ accumulating function+	-> e			-- ^ initial value+	-> (i,i)		-- ^ bounds of the array+	-> [(i, a)]		-- ^ association list+	-> Array i e+accumArray f init (l,u) ies =+    unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccumArray #-}+unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e+unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    foldr (adjust f marr#) (done l u marr#) ies s2# }})++{-# INLINE adjust #-}+adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b+adjust f marr# (I# i#, new) next s1# =+    case readArray# marr# i# s1#        of { (# s2#, old #) ->+    case writeArray# marr# i# (f old new) s2# of { s3# ->+    next s3# }}++-- | Constructs an array identical to the first argument except that it has+-- been updated by the associations in the right argument.+-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then+--+-- > m//[((i,i), 0) | i <- [1..n]]+--+-- is the same matrix, except with the diagonal zeroed.+--+-- Repeated indices in the association list are handled as for 'array':+-- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),+-- but GHC's implementation uses the last association for each index.+{-# INLINE (//) #-}+(//) :: Ix i => Array i e -> [(i, e)] -> Array i e+arr@(Array l u _) // ies =+    unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeReplace #-}+unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e+unsafeReplace arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (fill marr#) (done l u marr#) ies))++-- | @'accum' f@ takes an array and an association list and accumulates+-- pairs from the list into the array with the accumulating function @f@.+-- Thus 'accumArray' can be defined using 'accum':+--+-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])+--+{-# INLINE accum #-}+accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e+accum f arr@(Array l u _) ies =+    unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccum #-}+unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e+unsafeAccum f arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (adjust f marr#) (done l u marr#) ies))++{-# INLINE amap #-}+amap :: Ix i => (a -> b) -> Array i a -> Array i b+amap f arr@(Array l u _) =+    unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]++-- | 'ixmap' allows for transformations on array indices.+-- It may be thought of as providing function composition on the right+-- with the mapping that the original array embodies.+--+-- A similar transformation of array values may be achieved using 'fmap'+-- from the 'Array' instance of the 'Functor' class.+{-# INLINE ixmap #-}+ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e+ixmap (l,u) f arr =+    unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]++{-# INLINE eqArray #-}+eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool+eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else+    l1 == l2 && u1 == u2 &&+    and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]++{-# INLINE cmpArray #-}+cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering+cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++{-# INLINE cmpIntArray #-}+cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering+cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else+    if rangeSize (l2,u2) == 0 then GT else+    case compare l1 l2 of+        EQ    -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]+        other -> other+    where+    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of+        EQ    -> rest+        other -> other++{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}+\end{code}+++%*********************************************************+%*							*+\subsection{Array instances}+%*							*+%*********************************************************++\begin{code}+instance Ix i => Functor (Array i) where+    fmap = amap++instance (Ix i, Eq e) => Eq (Array i e) where+    (==) = eqArray++instance (Ix i, Ord e) => Ord (Array i e) where+    compare = cmpArray++instance (Ix a, Show a, Show b) => Show (Array a b) where+    showsPrec p a =+        showParen (p > appPrec) $+        showString "array " .+        showsPrec appPrec1 (bounds a) .+        showChar ' ' .+        showsPrec appPrec1 (assocs a)+	-- Precedence of 'array' is the precedence of application++-- The Read instance is in GHC.Read+\end{code}+++%*********************************************************+%*							*+\subsection{Operations on mutable arrays}+%*							*+%*********************************************************++Idle ADR question: What's the tradeoff here between flattening these+datatypes into @STArray ix ix (MutableArray# s elt)@ and using+it as is?  As I see it, the former uses slightly less heap and+provides faster access to the individual parts of the bounds while the+code used has the benefit of providing a ready-made @(lo, hi)@ pair as+required by many array-related functions.  Which wins? Is the+difference significant (probably not).++Idle AJG answer: When I looked at the outputted code (though it was 2+years ago) it seems like you often needed the tuple, and we build+it frequently. Now we've got the overloading specialiser things+might be different, though.++\begin{code}+{-# INLINE newSTArray #-}+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)+newSTArray (l,u) init = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }}++{-# INLINE boundsSTArray #-}+boundsSTArray :: STArray s i e -> (i,i)  +boundsSTArray (STArray l u _) = (l,u)++{-# INLINE readSTArray #-}+readSTArray :: Ix i => STArray s i e -> i -> ST s e+readSTArray marr@(STArray l u _) i =+    unsafeReadSTArray marr (index (l,u) i)++{-# INLINE unsafeReadSTArray #-}+unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e+unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->+    readArray# marr# i# s1#++{-# INLINE writeSTArray #-}+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () +writeSTArray marr@(STArray l u _) i e =+    unsafeWriteSTArray marr (index (l,u) i) e++{-# INLINE unsafeWriteSTArray #-}+unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () +unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->+    case writeArray# marr# i# e s1#     of { s2# ->+    (# s2#, () #) }+\end{code}+++%*********************************************************+%*							*+\subsection{Moving between mutable and immutable}+%*							*+%*********************************************************++\begin{code}+freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+freezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr'# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case readArray# marr# i# s3# of { (# s4#, e #) ->+            case writeArray# marr'# i# e s4# of { s5# ->+            copy (i# +# 1#) s5# }} in+    case copy 0# s2#                    of { s3# ->+    case unsafeFreezeArray# marr'# s3#  of { (# s4#, arr# #) ->+    (# s4#, Array l u arr# #) }}}}++{-# INLINE unsafeFreezeSTArray #-}+unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+thawSTArray (Array l u arr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case indexArray# arr# i#    of { (# e #) ->+            case writeArray# marr# i# e s3# of { s4# ->+            copy (i# +# 1#) s4# }} in+    case copy 0# s2#                    of { s3# ->+    (# s3#, STArray l u marr# #) }}}++{-# INLINE unsafeThawSTArray #-}+unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->+    case unsafeThawArray# arr# s1#      of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }+\end{code}
+ tests/HsOpenGLExt.h view
@@ -0,0 +1,31 @@+/* -----------------------------------------------------------------------------+ *+ * Module      :  GL extension support for Graphics.Rendering.OpenGL+ * Copyright   :  (c) Sven Panne 2002-2004+ * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)+ * + * Maintainer  :  sven.panne@aedion.de+ * Stability   :  provisional+ * Portability :  portable+ *+ * This header should only define preprocessor macros!+ *+ * -------------------------------------------------------------------------- */++#ifndef HSOPENGLEXT_H+#define HSOPENGLEXT_H++/* NOTE: The macro must immediately start with the foreign declaration,+   otherwise the magic mangler (hack_foreign) in the Hugs build system+   doesn't recognize it. */+#define EXTENSION_ENTRY(_msg,_entry,_ty) \+foreign import CALLCONV unsafe "dynamic" dyn_/**/_entry :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (_ty) ; \+_entry :: (_ty) ; \+_entry = dyn_##_entry ptr_##_entry ; \+ptr_/**/_entry :: FunPtr a ; \+ptr_/**/_entry = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress (_msg) ("_entry")) ; \+{-# NOINLINE ptr_/**/_entry #-}++#endif++EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddEXT,GLdouble -> IO ())
+ tests/MachDeps.h view
+ tests/Storable.hs view
@@ -0,0 +1,246 @@+{-# OPTIONS -fno-implicit-prelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Storable+-- Copyright   :  (c) The FFI task force 2001+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The module "Foreign.Storable" provides most elementary support for+-- marshalling and is part of the language-independent portion of the+-- Foreign Function Interface (FFI), and will normally be imported via+-- the "Foreign" module.+--+-----------------------------------------------------------------------------++module Foreign.Storable+	( Storable(+	     sizeOf,         -- :: a -> Int+	     alignment,      -- :: a -> Int+	     peekElemOff,    -- :: Ptr a -> Int      -> IO a+	     pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()+	     peekByteOff,    -- :: Ptr b -> Int      -> IO a+	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()+	     peek,           -- :: Ptr a             -> IO a+	     poke)           -- :: Ptr a        -> a -> IO ()+        ) where+++#ifdef __NHC__+import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr+               ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)+#else++import Control.Monad		( liftM )++#include "MachDeps.h"+#include "config.h"++#ifdef __GLASGOW_HASKELL__+import GHC.Storable+import GHC.Stable	( StablePtr )+import GHC.Num+import GHC.Int+import GHC.Word+import GHC.Stable+import GHC.Ptr+import GHC.Float+import GHC.Err+import GHC.IOBase+import GHC.Base+#else+import Data.Int+import Data.Word+import Foreign.Ptr+import Foreign.StablePtr+#endif++#ifdef __HUGS__+import Hugs.Prelude+import Hugs.Storable+#endif++{- |+The member functions of this class facilitate writing values of+primitive types to raw memory (which may have been allocated with the+above mentioned routines) and reading values from blocks of raw+memory.  The class, furthermore, includes support for computing the+storage requirements and alignment restrictions of storable types.++Memory addresses are represented as values of type @'Ptr' a@, for some+@a@ which is an instance of class 'Storable'.  The type argument to+'Ptr' helps provide some valuable type safety in FFI code (you can\'t+mix pointers of different types without an explicit cast), while+helping the Haskell type system figure out which marshalling method is+needed for a given pointer.++All marshalling between Haskell and a foreign language ultimately+boils down to translating Haskell data structures into the binary+representation of a corresponding data structure of the foreign+language and vice versa.  To code this marshalling in Haskell, it is+necessary to manipulate primtive data types stored in unstructured+memory blocks.  The class 'Storable' facilitates this manipulation on+all types for which it is instantiated, which are the standard basic+types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',+'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',+'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",+as well as 'Ptr'.++Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',+'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and+'pokeByteOff'.+-}++class Storable a where++   sizeOf      :: a -> Int+   -- ^ Computes the storage requirements (in bytes) of the argument.+   -- The value of the argument is not used.++   alignment   :: a -> Int+   -- ^ Computes the alignment constraint of the argument.  An+   -- alignment constraint @x@ is fulfilled by any address divisible+   -- by @x@.  The value of the argument is not used.++   peekElemOff :: Ptr a -> Int      -> IO a+   -- ^       Read a value from a memory area regarded as an array+   --         of values of the same kind.  The first argument specifies+   --         the start address of the array and the second the index into+   --         the array (the first element of the array has index+   --         @0@).  The following equality holds,+   -- +   -- > peekElemOff addr idx = IOExts.fixIO $ \result ->+   -- >   peek (addr `plusPtr` (idx * sizeOf result))+   --+   --         Note that this is only a specification, not+   --         necessarily the concrete implementation of the+   --         function.++   pokeElemOff :: Ptr a -> Int -> a -> IO ()+   -- ^       Write a value to a memory area regarded as an array of+   --         values of the same kind.  The following equality holds:+   -- +   -- > pokeElemOff addr idx x = +   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x++   peekByteOff :: Ptr b -> Int      -> IO a+   -- ^       Read a value from a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > peekByteOff addr off = peek (addr `plusPtr` off)++   pokeByteOff :: Ptr b -> Int -> a -> IO ()+   -- ^       Write a value to a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x+  +   peek        :: Ptr a      -> IO a+   -- ^ Read a value from the given memory location.+   --+   --  Note that the peek and poke functions might require properly+   --  aligned addresses to function correctly.  This is architecture+   --  dependent; thus, portable code should ensure that when peeking or+   --  poking values of some type @a@, the alignment+   --  constraint for @a@, as given by the function+   --  'alignment' is fulfilled.++   poke        :: Ptr a -> a -> IO ()+   -- ^ Write the given value to the given memory location.  Alignment+   -- restrictions might apply; see 'peek'.+ +   -- circular default instances+#ifdef __GLASGOW_HASKELL__+   peekElemOff = peekElemOff_ undefined+      where peekElemOff_ :: a -> Ptr a -> Int -> IO a+            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)+#else+   peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)+#endif+   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val++   peekByteOff ptr off = peek (ptr `plusPtr` off)+   pokeByteOff ptr off = poke (ptr `plusPtr` off)++   peek ptr = peekElemOff ptr 0+   poke ptr = pokeElemOff ptr 0++#ifndef __GLASGOW_HASKELL__+sizeOfPtr :: Storable a => Ptr a -> a -> Int+sizeOfPtr px x = sizeOf x+#endif++-- System-dependent, but rather obvious instances++instance Storable Bool where+   sizeOf _          = sizeOf (undefined::HTYPE_INT)+   alignment _       = alignment (undefined::HTYPE_INT)+   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i+   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)++#define STORABLE(T,size,align,read,write)	\+instance Storable (T) where {			\+    sizeOf    _ = size;				\+    alignment _ = align;			\+    peekElemOff = read;				\+    pokeElemOff = write }++#ifdef __GLASGOW_HASKELL__+STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,+	 readWideCharOffPtr,writeWideCharOffPtr)+#elif defined(__HUGS__)+STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,+	 readCharOffPtr,writeCharOffPtr)+#endif++STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,+	 readIntOffPtr,writeIntOffPtr)++#ifdef __GLASGOW_HASKELL__+STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,+	 readWordOffPtr,writeWordOffPtr)+#endif++STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,+	 readPtrOffPtr,writePtrOffPtr)++STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,+	 readFunPtrOffPtr,writeFunPtrOffPtr)++STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,+	 readStablePtrOffPtr,writeStablePtrOffPtr)++STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,+	 readFloatOffPtr,writeFloatOffPtr)++STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,+	 readDoubleOffPtr,writeDoubleOffPtr)++STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,+	 readWord8OffPtr,writeWord8OffPtr)++STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,+	 readWord16OffPtr,writeWord16OffPtr)++STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,+	 readWord32OffPtr,writeWord32OffPtr)++STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,+	 readWord64OffPtr,writeWord64OffPtr)++STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,+	 readInt8OffPtr,writeInt8OffPtr)++STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,+	 readInt16OffPtr,writeInt16OffPtr)++STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,+	 readInt32OffPtr,writeInt32OffPtr)++STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,+	 readInt64OffPtr,writeInt64OffPtr)++#endif
+ tests/Test.hsc view
@@ -0,0 +1,11 @@+module Test where++main :: IO ()+main = putStrLn "shows a cpphs+hsc2hs bug with comments"++#def inline int that_one_will_work(void) {return 42;}++{-+#def inline int cpphs_will_stumble(void) {return 42;}+-}+
+ tests/chains view
@@ -0,0 +1,16 @@+For this test, assume that all of e,f,g,h are defined.+Also that c,d are defined, a,b are not.+If cpphs does operator precedence wrongly in infix chains, the final+conditional will be interpreted wrongly.++#if defined(a) || defined(b) || defined(c) || defined(d)+chained || OK+#endif+#if defined(e) && defined(f) && defined(g) && defined(h)+chained && OK+#endif+#if defined(a) && defined(b) || defined(c) && defined(d)+mixed chain of || and && OK+#else+mixed chain of || and && BROKEN+#endif
+ tests/config.h view
+ tests/cpp view
@@ -0,0 +1,9 @@+#define /**/ ++ `mplus`		// not expected to work+#define 0   mzero		// not expected to work+#define x0  X'			// should work+#define x'  Xprime		// should work+#define `foo` .(foo)/**/,	// bizarreness++x ++ y = x0 * 0 * y `foo` x' ++//  /*
+ tests/elif view
@@ -0,0 +1,10 @@+#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \+    ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)+import System.IO.Unsafe (unsafePerformIO)+#elif defined(__GLASGOW_HASKELL__)+import IOExts (unsafePerformIO)+#elif defined(__NHC__)+import IOExtras (unsafePerformIO)+#elif defined(__HBC__)+import UnsafePerformIO+#endif
+ tests/expect1 view
@@ -0,0 +1,36 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++++23 no inclusion, this is an else clause++25++++++31 third branch of elif++33+34 end of file+
+ tests/expect10 view
@@ -0,0 +1,16 @@+#line 1 "multiline"+++++5 back to ordinary text.+#line 1 "./inclusion"+hello world, this is an inclusion++#line 6 "multiline"++7 hello again+8 some more+9 aLongMacroDefinition(a,b)+10 end+
+ tests/expect11 view
@@ -0,0 +1,3 @@+#line 1 "stringise"++This is "abcd ef" foo abcd ef
+ tests/expect12 view
@@ -0,0 +1,5 @@+#line 1 "recursive"++++D D D D D D D D
+ tests/expect13 view
@@ -0,0 +1,20 @@+#line 1 "ross"+                                                         ++                           ++++f = 4++                                                             +++++g = do { putStr "Hello ";   putStrLn "World" }++                          +++h = 4
+ tests/expect14 view
@@ -0,0 +1,4 @@+#line 1 "precedence"+++
+ tests/expect15 view
@@ -0,0 +1,7 @@+#line 1 "indirect"++#line 1 "./inclusion"+hello world, this is an inclusion++#line 2 "indirect"+
+ tests/expect16 view
@@ -0,0 +1,30 @@+#line 1 "numbers"++number (1) in if++++++++number (0) in if++++++rejected false hex number in if++++real hex number (0x1) in if++++++++hex number (0x00) in if+
+ tests/expect17 view
@@ -0,0 +1,2 @@+#line 1 "pragma"+
+ tests/expect18 view
@@ -0,0 +1,1 @@+
+ tests/expect19 view
@@ -0,0 +1,5 @@+#line 1 "parens"++++yes
+ tests/expect2 view
@@ -0,0 +1,36 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++++23 no inclusion, this is an else clause++25++27 no elif++++++33+34 end of file+
+ tests/expect20 view
@@ -0,0 +1,17 @@+#line 1 "chains"+For this test, assume that all of 1,1,1,1 are defined.+Also that 1,1 are defined, a,b are not.+If cpphs does operator precedence wrongly in infix chains, the final+conditional will be interpreted wrongly.+++chained || OK+++chained && OK+++mixed chain of || and && OK+++
+ tests/expect21 view
@@ -0,0 +1,6 @@+#line 1 "specials"++line 2+line 3+line 4  Error "horrible" at line 4 of file "specials"+line 5
+ tests/expect22 view
@@ -0,0 +1,14 @@+#line 1 "specialinclude"+1+2+#line 1 "./specials"++line 2+line 3+line 4  Error "horrible" at line 4 of file "./specials"+line 5++#line 3 "specialinclude"++4+5
+ tests/expect23 view
@@ -0,0 +1,2 @@+#line 1 "incomplete"+incomplete
+ tests/expect24 view
@@ -0,0 +1,15 @@+#line 1 "text"+Here is some ordinary text with embedded Haskell-ish constructs,+that should however /not/ be interpreted as Haskell if the --text+option is given to cpphs.  For instance, here is a Haskell comment+including a cpp definition: {-+#  define FOO bar+and now we end the comment: -}   and try out the definition:  FOO+Likewise, double and single quotes no longer delimit strings or chars: "+#  define BAZ FOO+and what do we have here?: "  ' BAZ  '+++Also, in text-mode, macros should be expanded inside Haskell comments:+    -- expand(this,other,that)+and strings "expand(this,other,that)".
+ tests/expect25 view
@@ -0,0 +1,15 @@+#line 1 "text"+Here is some ordinary text with embedded Haskell-ish constructs,+that should however /not/ be interpreted as Haskell if the --text+option is given to cpphs.  For instance, here is a Haskell comment+including a cpp definition: {-++and now we end the comment: -}   and try out the definition:  bar+Likewise, double and single quotes no longer delimit strings or chars: "++and what do we have here?: "  ' bar  '+++Also, in text-mode, macros should be expanded inside Haskell comments:+    -- Some text including this, the other, and that.+and strings "Some text including this, the other, and that.".
+ tests/expect26 view
@@ -0,0 +1,17 @@+#line 1 "nastyhack"++-- hackery to convice cpp to splice 6.2.2 into a string+version :: String+version = tail "\ +    \ 6.2.2"++version2 = "6.2.2"+++version3 = "6.2.2"+++version4 = #6.2.2+++version5 = "6.2.2"
+ tests/expect27 view
@@ -0,0 +1,17 @@+#line 1 "nastyhack"++-- hackery to convice cpp to splice GHC_PKG_VERSION into a string+version :: String+version = tail "\ +    \ GHC_PKG_VERSION"++version2 = "GHC_PKG_VERSION"+++version3 = "GHC_PKG_VERSION"+++version4 = #6.2.2+++version5 = "GHC_PKG_VERSION"
+ tests/expect28 view
@@ -0,0 +1,4 @@+#line 1 "symbolvalue"++the symbol is defined as 1+
+ tests/expect29 view
@@ -0,0 +1,12 @@+#line 1 "Test.hsc"+module Test where++main :: IO ()+main = putStrLn "shows a cpphs+hsc2hs bug with comments"++++{-+#def inline int cpphs_will_stumble(void) {return 42;}+-}+
+ tests/expect3 view
@@ -0,0 +1,36 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++++23 no inclusion, this is an else clause++25++++29 this is an elif++++33+34 end of file+
+ tests/expect30 view
@@ -0,0 +1,685 @@+#line 1 "Arr.lhs"++{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Arr+-- Copyright   :  (c) The University of Glasgow, 1994-2000+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC extensions)+--+-- GHC\'s array implementation.+-- +-----------------------------------------------------------------------------++-- #hide+module GHC.Arr where++import {-# SOURCE #-} GHC.Err ( error )+import GHC.Enum+import GHC.Num+import GHC.ST+import GHC.Base+import GHC.List+import GHC.Show++infixl 9  !, //++default ()+++++++++++-- | The 'Ix' class is used to map a contiguous subrange of values in+-- a type onto integers.  It is used primarily for array indexing+-- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").+--+-- The first argument @(l,u)@ of each of these operations is a pair+-- specifying the lower and upper bounds of a contiguous subrange of values.+--+-- An implementation is entitled to assume the following laws about these+-- operations:+--+-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@+--+-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@+--+-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@+--+-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@+--+-- Minimal complete instance: 'range', 'index' and 'inRange'.+--+class (Ord a) => Ix a where+    -- | The list of values in the subrange defined by a bounding pair.+    range		:: (a,a) -> [a]+    -- | The position of a subscript in the subrange.+    index		:: (a,a) -> a -> Int+    -- | Like 'index', but without checking that the value is in range.+    unsafeIndex		:: (a,a) -> a -> Int+    -- | Returns 'True' the given subscript lies in the range defined+    -- the bounding pair.+    inRange		:: (a,a) -> a -> Bool+    -- | The size of the subrange defined by a bounding pair.+    rangeSize		:: (a,a) -> Int+    -- | like 'rangeSize', but without checking that the upper bound is+    -- in range.+    unsafeRangeSize     :: (a,a) -> Int++	-- Must specify one of index, unsafeIndex+    index b i | inRange b i = unsafeIndex b i	+	      | otherwise   = error "Error in array index"+    unsafeIndex b i = index b i++    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1+		       | otherwise   = 0	-- This case is only here to+						-- check for an empty range+	-- NB: replacing (inRange b h) by (l <= h) fails for+	--     tuples.  E.g.  (1,2) <= (2,1) but the range is empty++    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1++++++++++++++++++++-- abstract these errors from the relevant index functions so that+-- the guts of the function will be small enough to inline.++{-# NOINLINE indexError #-}+indexError :: Show a => (a,a) -> a -> String -> b+indexError rng i tp+  = error (showString "Ix{" . showString tp . showString "}.index: Index " .+           showParen True (showsPrec 0 i) .+	   showString " out of range " $+	   showParen True (showsPrec 0 rng) "")++----------------------------------------------------------------------+instance  Ix Char  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = fromEnum i - fromEnum m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Char"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance  Ix Int  where+    {-# INLINE range #-}+	-- The INLINE stops the build in the RHS from getting inlined,+	-- so that callers can fuse with the result of range+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = i - m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Int"++    {-# INLINE inRange #-}+    inRange (I# m,I# n) (I# i) =  m <=# i && i <=# n++----------------------------------------------------------------------+instance  Ix Integer  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i   = fromInteger (i - m)++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Integer"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance Ix Bool where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Bool"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix Ordering where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Ordering"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix () where+    {-# INLINE range #-}+    range   ((), ())    = [()]+    {-# INLINE unsafeIndex #-}+    unsafeIndex   ((), ()) () = 0+    {-# INLINE inRange #-}+    inRange ((), ()) () = True+    {-# INLINE index #-}+    index b i = unsafeIndex b i++----------------------------------------------------------------------+instance (Ix a, Ix b) => Ix (a, b) where -- as derived+    {-# SPECIALISE instance Ix (Int,Int) #-}++    {- INLINE range #-}+    range ((l1,l2),(u1,u2)) =+      [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]++    {- INLINE unsafeIndex #-}+    unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =+      unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2++    {- INLINE inRange #-}+    inRange ((l1,l2),(u1,u2)) (i1,i2) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where+    {-# SPECIALISE instance Ix (Int,Int,Int) #-}++    range ((l1,l2,l3),(u1,u2,u3)) =+        [(i1,i2,i3) | i1 <- range (l1,u1),+                      i2 <- range (l2,u2),+                      i3 <- range (l3,u3)]++    unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))++    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where+    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =+      [(i1,i2,i3,i4) | i1 <- range (l1,u1),+                       i2 <- range (l2,u2),+                       i3 <- range (l3,u3),+                       i4 <- range (l4,u4)]++    unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1)))++    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4++    -- Default method for index++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where+    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =+      [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),+                          i2 <- range (l2,u2),+                          i3 <- range (l3,u3),+                          i4 <- range (l4,u4),+                          i5 <- range (l5,u5)]++    unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))))++    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4 && +      inRange (l5,u5) i5++    -- Default method for index++++++++++type IPr = (Int, Int)++-- | The type of immutable non-strict (boxed) arrays+-- with indices in @i@ and elements in @e@.+data Ix i => Array     i e = Array   !i !i (Array# e)++-- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type+-- arguments are as follows:+--+--  * @s@: the state variable argument for the 'ST' type+--+--  * @i@: the index type of the array (should be an instance of 'Ix')+--+--  * @e@: the element type of the array.+--+data         STArray s i e = STArray !i !i (MutableArray# s e)+	-- No Ix context for STArray.  They are stupid,+	-- and force an Ix context on the equality instance.++-- Just pointer equality on mutable arrays:+instance Eq (STArray s i e) where+    STArray _ _ arr1# == STArray _ _ arr2# =+        sameMutableArray# arr1# arr2#+++++++++++{-# NOINLINE arrEleBottom #-}+arrEleBottom :: a+arrEleBottom = error "(Array.!): undefined array element"++-- | Construct an array with the specified bounds and containing values+-- for given indices within these bounds.+--+-- The array is undefined (i.e. bottom) if any index in the list is+-- out of bounds.  The Haskell 98 Report further specifies that if any+-- two associations in the list have the same index, the value at that+-- index is undefined (i.e. bottom).  However in GHC's implementation,+-- the value at such an index is the value part of the last association+-- with that index in the list.+--+-- Because the indices must be checked for these errors, 'array' is+-- strict in the bounds argument and in the indices of the association+-- list, but nonstrict in the values.  Thus, recurrences such as the+-- following are possible:+--+-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])+--+-- Not every index within the bounds of the array need appear in the+-- association list, but the values associated with indices that do not+-- appear will be undefined (i.e. bottom).+--+-- If, in any dimension, the lower bound is greater than the upper bound,+-- then the array is legal, but empty.  Indexing an empty array always+-- gives an array-bounds error, but 'bounds' still yields the bounds+-- with which the array was constructed.+{-# INLINE array #-}+array :: Ix i+	=> (i,i)	-- ^ a pair of /bounds/, each of the index type+			-- of the array.  These bounds are the lowest and+			-- highest indices in the array, in that order.+			-- For example, a one-origin vector of length+			-- '10' has bounds '(1,10)', and a one-origin '10'+			-- by '10' matrix has bounds '((1,1),(10,10))'.+	-> [(i, e)]	-- ^ a list of /associations/ of the form+			-- (/index/, /value/).  Typically, this list will+			-- be expressed as a comprehension.  An+			-- association '(i, x)' defines the value of+			-- the array at index 'i' to be 'x'.+	-> Array i e+array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeArray #-}+unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e+unsafeArray (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    foldr (fill marr#) (done l u marr#) ies s2# }})++{-# INLINE fill #-}+fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a+fill marr# (I# i#, e) next s1# =+    case writeArray# marr# i# e s1#     of { s2# ->+    next s2# }++{-# INLINE done #-}+done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)+done l u marr# s1# =+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++-- This is inefficient and I'm not sure why:+-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)+-- The code below is better. It still doesn't enable foldr/build+-- transformation on the list of elements; I guess it's impossible+-- using mechanisms currently available.++-- | Construct an array from a pair of bounds and a list of values in+-- index order.+{-# INLINE listArray #-}+listArray :: Ix i => (i,i) -> [e] -> Array i e+listArray (l,u) es = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let fillFromList i# xs s3# | i# ==# n# = s3#+                               | otherwise = case xs of+            []   -> s3#+            y:ys -> case writeArray# marr# i# y s3# of { s4# ->+                    fillFromList (i# +# 1#) ys s4# } in+    case fillFromList 0# es s2#         of { s3# ->+    done l u marr# s3# }}})++-- | The value at the given index in an array.+{-# INLINE (!) #-}+(!) :: Ix i => Array i e -> i -> e+arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)++{-# INLINE unsafeAt #-}+unsafeAt :: Ix i => Array i e -> Int -> e+unsafeAt (Array _ _ arr#) (I# i#) =+    case indexArray# arr# i# of (# e #) -> e++-- | The bounds with which an array was constructed.+{-# INLINE bounds #-}+bounds :: Ix i => Array i e -> (i,i)+bounds (Array l u _) = (l,u)++-- | The list of indices of an array in ascending order.+{-# INLINE indices #-}+indices :: Ix i => Array i e -> [i]+indices (Array l u _) = range (l,u)++-- | The list of elements of an array in index order.+{-# INLINE elems #-}+elems :: Ix i => Array i e -> [e]+elems arr@(Array l u _) =+    [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]++-- | The list of associations of an array in index order.+{-# INLINE assocs #-}+assocs :: Ix i => Array i e -> [(i, e)]+assocs arr@(Array l u _) =+    [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]++-- | The 'accumArray' deals with repeated indices in the association+-- list using an /accumulating function/ which combines the values of+-- associations with the same index.+-- For example, given a list of values of some index type, @hist@+-- produces a histogram of the number of occurrences of each index within+-- a specified range:+--+-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b+-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]+--+-- If the accumulating function is strict, then 'accumArray' is strict in+-- the values, as well as the indices, in the association list.  Thus,+-- unlike ordinary arrays built with 'array', accumulated arrays should+-- not in general be recursive.+{-# INLINE accumArray #-}+accumArray :: Ix i+	=> (e -> a -> e)	-- ^ accumulating function+	-> e			-- ^ initial value+	-> (i,i)		-- ^ bounds of the array+	-> [(i, a)]		-- ^ association list+	-> Array i e+accumArray f init (l,u) ies =+    unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccumArray #-}+unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e+unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    foldr (adjust f marr#) (done l u marr#) ies s2# }})++{-# INLINE adjust #-}+adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b+adjust f marr# (I# i#, new) next s1# =+    case readArray# marr# i# s1#        of { (# s2#, old #) ->+    case writeArray# marr# i# (f old new) s2# of { s3# ->+    next s3# }}++-- | Constructs an array identical to the first argument except that it has+-- been updated by the associations in the right argument.+-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then+--+-- > m//[((i,i), 0) | i <- [1..n]]+--+-- is the same matrix, except with the diagonal zeroed.+--+-- Repeated indices in the association list are handled as for 'array':+-- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),+-- but GHC's implementation uses the last association for each index.+{-# INLINE (//) #-}+(//) :: Ix i => Array i e -> [(i, e)] -> Array i e+arr@(Array l u _) // ies =+    unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeReplace #-}+unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e+unsafeReplace arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (fill marr#) (done l u marr#) ies))++-- | @'accum' f@ takes an array and an association list and accumulates+-- pairs from the list into the array with the accumulating function @f@.+-- Thus 'accumArray' can be defined using 'accum':+--+-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])+--+{-# INLINE accum #-}+accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e+accum f arr@(Array l u _) ies =+    unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccum #-}+unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e+unsafeAccum f arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (adjust f marr#) (done l u marr#) ies))++{-# INLINE amap #-}+amap :: Ix i => (a -> b) -> Array i a -> Array i b+amap f arr@(Array l u _) =+    unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]++-- | 'ixmap' allows for transformations on array indices.+-- It may be thought of as providing function composition on the right+-- with the mapping that the original array embodies.+--+-- A similar transformation of array values may be achieved using 'fmap'+-- from the 'Array' instance of the 'Functor' class.+{-# INLINE ixmap #-}+ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e+ixmap (l,u) f arr =+    unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]++{-# INLINE eqArray #-}+eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool+eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else+    l1 == l2 && u1 == u2 &&+    and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]++{-# INLINE cmpArray #-}+cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering+cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++{-# INLINE cmpIntArray #-}+cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering+cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else+    if rangeSize (l2,u2) == 0 then GT else+    case compare l1 l2 of+        EQ    -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]+        other -> other+    where+    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of+        EQ    -> rest+        other -> other++{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}+++++++++++instance Ix i => Functor (Array i) where+    fmap = amap++instance (Ix i, Eq e) => Eq (Array i e) where+    (==) = eqArray++instance (Ix i, Ord e) => Ord (Array i e) where+    compare = cmpArray++instance (Ix a, Show a, Show b) => Show (Array a b) where+    showsPrec p a =+        showParen (p > appPrec) $+        showString "array " .+        showsPrec appPrec1 (bounds a) .+        showChar ' ' .+        showsPrec appPrec1 (assocs a)+	-- Precedence of 'array' is the precedence of application++-- The Read instance is in GHC.Read++++++++++++++++++++++++{-# INLINE newSTArray #-}+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)+newSTArray (l,u) init = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }}++{-# INLINE boundsSTArray #-}+boundsSTArray :: STArray s i e -> (i,i)  +boundsSTArray (STArray l u _) = (l,u)++{-# INLINE readSTArray #-}+readSTArray :: Ix i => STArray s i e -> i -> ST s e+readSTArray marr@(STArray l u _) i =+    unsafeReadSTArray marr (index (l,u) i)++{-# INLINE unsafeReadSTArray #-}+unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e+unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->+    readArray# marr# i# s1#++{-# INLINE writeSTArray #-}+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () +writeSTArray marr@(STArray l u _) i e =+    unsafeWriteSTArray marr (index (l,u) i) e++{-# INLINE unsafeWriteSTArray #-}+unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () +unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->+    case writeArray# marr# i# e s1#     of { s2# ->+    (# s2#, () #) }+++++++++++freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+freezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr'# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case readArray# marr# i# s3# of { (# s4#, e #) ->+            case writeArray# marr'# i# e s4# of { s5# ->+            copy (i# +# 1#) s5# }} in+    case copy 0# s2#                    of { s3# ->+    case unsafeFreezeArray# marr'# s3#  of { (# s4#, arr# #) ->+    (# s4#, Array l u arr# #) }}}}++{-# INLINE unsafeFreezeSTArray #-}+unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+thawSTArray (Array l u arr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case indexArray# arr# i#    of { (# e #) ->+            case writeArray# marr# i# e s3# of { s4# ->+            copy (i# +# 1#) s4# }} in+    case copy 0# s2#                    of { s3# ->+    (# s3#, STArray l u marr# #) }}}++{-# INLINE unsafeThawSTArray #-}+unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->+    case unsafeThawArray# arr# s1#      of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }++
+ tests/expect31 view
@@ -0,0 +1,10 @@+#line 1 "elif"++import System.IO.Unsafe (unsafePerformIO)+++++++
+ tests/expect4 view
@@ -0,0 +1,40 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++#line 1 "./inclusion"+hello world, this is an inclusion++#line 21 "testfile"+++++25++++++31 third branch of elif++33+34 end of file+
+ tests/expect5 view
@@ -0,0 +1,36 @@+1 top of file++3++5 0 is defined++7++++11++++15++++19++hello world, this is an inclusion++++++25++++++31 third branch of elif++33+34 end of file
+ tests/expect6 view
@@ -0,0 +1,10 @@+#line 1 "cpp"+++++++x ++ y = X' * 0 * y .(foo), Xprime ++//  /*
+ tests/expect7 view
@@ -0,0 +1,299 @@+#line 1 "Storable.hs"+{-# OPTIONS -fno-implicit-prelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Storable+-- Copyright   :  (c) The FFI task force 2001+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The module "Foreign.Storable" provides most elementary support for+-- marshalling and is part of the language-independent portion of the+-- Foreign Function Interface (FFI), and will normally be imported via+-- the "Foreign" module.+--+-----------------------------------------------------------------------------++module Foreign.Storable+	( Storable(+	     sizeOf,         -- :: a -> Int+	     alignment,      -- :: a -> Int+	     peekElemOff,    -- :: Ptr a -> Int      -> IO a+	     pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()+	     peekByteOff,    -- :: Ptr b -> Int      -> IO a+	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()+	     peek,           -- :: Ptr a             -> IO a+	     poke)           -- :: Ptr a        -> a -> IO ()+        ) where++++++++import Control.Monad		( liftM )++#line 1 "./MachDeps.h"+#line 39 "Storable.hs"++#line 1 "./config.h"+#line 40 "Storable.hs"++++import GHC.Storable+import GHC.Stable	( StablePtr )+import GHC.Num+import GHC.Int+import GHC.Word+import GHC.Stable+import GHC.Ptr+import GHC.Float+import GHC.Err+import GHC.IOBase+import GHC.Base+++++++++++++{- |+The member functions of this class facilitate writing values of+primitive types to raw memory (which may have been allocated with the+above mentioned routines) and reading values from blocks of raw+memory.  The class, furthermore, includes support for computing the+storage requirements and alignment restrictions of storable types.++Memory addresses are represented as values of type @'Ptr' a@, for some+@a@ which is an instance of class 'Storable'.  The type argument to+'Ptr' helps provide some valuable type safety in FFI code (you can\'t+mix pointers of different types without an explicit cast), while+helping the Haskell type system figure out which marshalling method is+needed for a given pointer.++All marshalling between Haskell and a foreign language ultimately+boils down to translating Haskell data structures into the binary+representation of a corresponding data structure of the foreign+language and vice versa.  To code this marshalling in Haskell, it is+necessary to manipulate primtive data types stored in unstructured+memory blocks.  The class 'Storable' facilitates this manipulation on+all types for which it is instantiated, which are the standard basic+types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',+'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',+'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",+as well as 'Ptr'.++Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',+'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and+'pokeByteOff'.+-}++class Storable a where++   sizeOf      :: a -> Int+   -- ^ Computes the storage requirements (in bytes) of the argument.+   -- The value of the argument is not used.++   alignment   :: a -> Int+   -- ^ Computes the alignment constraint of the argument.  An+   -- alignment constraint @x@ is fulfilled by any address divisible+   -- by @x@.  The value of the argument is not used.++   peekElemOff :: Ptr a -> Int      -> IO a+   -- ^       Read a value from a memory area regarded as an array+   --         of values of the same kind.  The first argument specifies+   --         the start address of the array and the second the index into+   --         the array (the first element of the array has index+   --         @0@).  The following equality holds,+   -- +   -- > peekElemOff addr idx = IOExts.fixIO $ \result ->+   -- >   peek (addr `plusPtr` (idx * sizeOf result))+   --+   --         Note that this is only a specification, not+   --         necessarily the concrete implementation of the+   --         function.++   pokeElemOff :: Ptr a -> Int -> a -> IO ()+   -- ^       Write a value to a memory area regarded as an array of+   --         values of the same kind.  The following equality holds:+   -- +   -- > pokeElemOff addr idx x = +   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x++   peekByteOff :: Ptr b -> Int      -> IO a+   -- ^       Read a value from a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > peekByteOff addr off = peek (addr `plusPtr` off)++   pokeByteOff :: Ptr b -> Int -> a -> IO ()+   -- ^       Write a value to a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x+  +   peek        :: Ptr a      -> IO a+   -- ^ Read a value from the given memory location.+   --+   --  Note that the peek and poke functions might require properly+   --  aligned addresses to function correctly.  This is architecture+   --  dependent; thus, portable code should ensure that when peeking or+   --  poking values of some type @a@, the alignment+   --  constraint for @a@, as given by the function+   --  'alignment' is fulfilled.++   poke        :: Ptr a -> a -> IO ()+   -- ^ Write the given value to the given memory location.  Alignment+   -- restrictions might apply; see 'peek'.+ +   -- circular default instances++   peekElemOff = peekElemOff_ undefined+      where peekElemOff_ :: a -> Ptr a -> Int -> IO a+            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)++++   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val++   peekByteOff ptr off = peek (ptr `plusPtr` off)+   pokeByteOff ptr off = poke (ptr `plusPtr` off)++   peek ptr = peekElemOff ptr 0+   poke ptr = pokeElemOff ptr 0+++++++-- System-dependent, but rather obvious instances++instance Storable Bool where+   sizeOf _          = sizeOf (undefined::HTYPE_INT)+   alignment _       = alignment (undefined::HTYPE_INT)+   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i+   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)++++++++++instance Storable (Char) where {			+    sizeOf    _ = SIZEOF_INT32;				+    alignment _ = ALIGNMENT_INT32;			+    peekElemOff = readWideCharOffPtr;				+    pokeElemOff = writeWideCharOffPtr }++++++instance Storable (Int) where {			+    sizeOf    _ = SIZEOF_HSINT;				+    alignment _ = ALIGNMENT_HSINT;			+    peekElemOff = readIntOffPtr;				+    pokeElemOff = writeIntOffPtr }+++instance Storable (Word) where {			+    sizeOf    _ = SIZEOF_HSWORD;				+    alignment _ = ALIGNMENT_HSWORD;			+    peekElemOff = readWordOffPtr;				+    pokeElemOff = writeWordOffPtr }+++instance Storable ((Ptr a)) where {			+    sizeOf    _ = SIZEOF_HSPTR;				+    alignment _ = ALIGNMENT_HSPTR;			+    peekElemOff = readPtrOffPtr;				+    pokeElemOff = writePtrOffPtr }++instance Storable ((FunPtr a)) where {			+    sizeOf    _ = SIZEOF_HSFUNPTR;				+    alignment _ = ALIGNMENT_HSFUNPTR;			+    peekElemOff = readFunPtrOffPtr;				+    pokeElemOff = writeFunPtrOffPtr }++instance Storable ((StablePtr a)) where {			+    sizeOf    _ = SIZEOF_HSSTABLEPTR;				+    alignment _ = ALIGNMENT_HSSTABLEPTR;			+    peekElemOff = readStablePtrOffPtr;				+    pokeElemOff = writeStablePtrOffPtr }++instance Storable (Float) where {			+    sizeOf    _ = SIZEOF_HSFLOAT;				+    alignment _ = ALIGNMENT_HSFLOAT;			+    peekElemOff = readFloatOffPtr;				+    pokeElemOff = writeFloatOffPtr }++instance Storable (Double) where {			+    sizeOf    _ = SIZEOF_HSDOUBLE;				+    alignment _ = ALIGNMENT_HSDOUBLE;			+    peekElemOff = readDoubleOffPtr;				+    pokeElemOff = writeDoubleOffPtr }++instance Storable (Word8) where {			+    sizeOf    _ = SIZEOF_WORD8;				+    alignment _ = ALIGNMENT_WORD8;			+    peekElemOff = readWord8OffPtr;				+    pokeElemOff = writeWord8OffPtr }++instance Storable (Word16) where {			+    sizeOf    _ = SIZEOF_WORD16;				+    alignment _ = ALIGNMENT_WORD16;			+    peekElemOff = readWord16OffPtr;				+    pokeElemOff = writeWord16OffPtr }++instance Storable (Word32) where {			+    sizeOf    _ = SIZEOF_WORD32;				+    alignment _ = ALIGNMENT_WORD32;			+    peekElemOff = readWord32OffPtr;				+    pokeElemOff = writeWord32OffPtr }++instance Storable (Word64) where {			+    sizeOf    _ = SIZEOF_WORD64;				+    alignment _ = ALIGNMENT_WORD64;			+    peekElemOff = readWord64OffPtr;				+    pokeElemOff = writeWord64OffPtr }++instance Storable (Int8) where {			+    sizeOf    _ = SIZEOF_INT8;				+    alignment _ = ALIGNMENT_INT8;			+    peekElemOff = readInt8OffPtr;				+    pokeElemOff = writeInt8OffPtr }++instance Storable (Int16) where {			+    sizeOf    _ = SIZEOF_INT16;				+    alignment _ = ALIGNMENT_INT16;			+    peekElemOff = readInt16OffPtr;				+    pokeElemOff = writeInt16OffPtr }++instance Storable (Int32) where {			+    sizeOf    _ = SIZEOF_INT32;				+    alignment _ = ALIGNMENT_INT32;			+    peekElemOff = readInt32OffPtr;				+    pokeElemOff = writeInt32OffPtr }++instance Storable (Int64) where {			+    sizeOf    _ = SIZEOF_INT64;				+    alignment _ = ALIGNMENT_INT64;			+    peekElemOff = readInt64OffPtr;				+    pokeElemOff = writeInt64OffPtr }++
+ tests/expect8 view
@@ -0,0 +1,37 @@+#line 1 "HsOpenGLExt.h"+/* -----------------------------------------------------------------------------+ *+ * Module      :  GL extension support for Graphics.Rendering.OpenGL+ * Copyright   :  (c) Sven Panne 2002-2004+ * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)+ * + * Maintainer  :  sven.panne@aedion.de+ * Stability   :  provisional+ * Portability :  portable+ *+ * This header should only define preprocessor macros!+ *+ * -------------------------------------------------------------------------- */+++++/* NOTE: The macro must immediately start with the foreign declaration,+   otherwise the magic mangler (hack_foreign) in the Hugs build system+   doesn't recognize it. */+++++++++++foreign import ccall unsafe "dynamic" dyn_glFogCoorddEXT :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (GLdouble -> IO ()) ; +glFogCoorddEXT :: (GLdouble -> IO ()) ; +glFogCoorddEXT = dyn_glFogCoorddEXT ptr_glFogCoorddEXT ; +ptr_glFogCoorddEXT :: FunPtr a ; +ptr_glFogCoorddEXT = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress ("GL_EXT_fog_coord or OpenGL 1.4") ("glFogCoorddEXT")) ; +{-# NOINLINE ptr_glFogCoorddEXT #-}
+ tests/expect9 view
@@ -0,0 +1,17 @@+#line 1 "multiline"+++++5 back to ordinary text.+#line 1 "./inclusion"+hello world, this is an inclusion++#line 6 "multiline"++7 hello again+8 some more+9 some line here;	+	and some more;	+	finish now+10 end
+ tests/inclusion view
@@ -0,0 +1,1 @@+hello world, this is an inclusion
+ tests/incomplete view
@@ -0,0 +1,1 @@+incomplete
+ tests/indirect view
@@ -0,0 +1,2 @@+#define F "inclusion"+#include F
+ tests/multiline view
@@ -0,0 +1,10 @@+#define aLongMacroDefinition(x,y)	\+	some line here;	\+	and some more;	\+	finish now+5 back to ordinary text.+#include "inclusion"+7 hello again+8 some more+9 aLongMacroDefinition(a,b)+10 end
+ tests/nastyhack view
@@ -0,0 +1,16 @@+#define GHC_PKG_VERSION 6.2.2+-- hackery to convice cpp to splice GHC_PKG_VERSION into a string+version :: String+version = tail "\ +    \ GHC_PKG_VERSION"++version2 = "GHC_PKG_VERSION"++#define v3 "GHC_PKG_VERSION"+version3 = v3++#define stringify(s) #s+version4 = stringify(GHC_PKG_VERSION)++#define stringify2(s) "s"+version5 = stringify2(GHC_PKG_VERSION)
+ tests/numbers view
@@ -0,0 +1,29 @@+#if 1+number (1) in if+#else+rejected number (1) in if+#endif++#if 0+wrongly accepted number (0) in if+#else+number (0) in if+#endif++#if eaf+false hex number in if+#else+rejected false hex number in if+#endif++#if 0x1+real hex number (0x1) in if+#else+rejected real hex number (0x1) in if+#endif++#if 0x00+wrongly accepted real hex number (0x00) in if+#else+hex number (0x00) in if+#endif
+ tests/parens view
@@ -0,0 +1,5 @@+#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \+    || ( defined(__NHC__) && __NHC__ >= 117 )+#define FINALIZERPTR yes+#endif+FINALIZERPTR
+ tests/pragma view
@@ -0,0 +1,1 @@+#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"   /* SVr4.0 1.18 */
+ tests/precedence view
@@ -0,0 +1,3 @@+#if !0 && 0+boolean operator precedence is wrong+#endif
+ tests/recursive view
@@ -0,0 +1,4 @@+#define C D D+#define B C C+#define A B B+A
+ tests/ross view
@@ -0,0 +1,19 @@+/* 1. C comments should be deleted by the preprocessor */++/* 2. repeated expansion */+#define FOO 4+#define BAR FOO++f = BAR++/* 3. continuation lines in macros shouldn't give newlines */+#define LONG_MACRO \+{ putStr "Hello "; \+  putStrLn "World" }++g = do LONG_MACRO++/* 4. projection macros */+#define MACRO(x) x++h = MACRO(FOO)
+ tests/runtests view
@@ -0,0 +1,46 @@+#!/bin/sh+CPPHS=${1:-"../cpphs"}+FAIL=0++runtest() {+  if $1 >out 2>/dev/null && diff $2 out >/dev/null+  then echo "passed: " $1+  else FAIL=$?+       echo "FAILED: ($2) " $1+  fi+}++if $CPPHS </dev/null; then echo -n "passed: "; else echo -n "FAILED: "; fi+echo " $CPPHS </dev/null"+runtest "$CPPHS --nomacro testfile" expect1+runtest "$CPPHS --nomacro -Dnoelif testfile" expect2+runtest "$CPPHS --nomacro -Delif testfile" expect3+runtest "$CPPHS --nomacro -Dinclude testfile" expect4+runtest "$CPPHS --noline -Dinclude testfile" expect5+runtest "$CPPHS cpp" expect6+runtest "$CPPHS -D__GLASGOW_HASKELL__ --layout Storable.hs " expect7+runtest "$CPPHS -DCALLCONV=ccall --hashes --layout HsOpenGLExt.h" expect8+runtest "$CPPHS --layout multiline" expect9+runtest "$CPPHS --nomacro multiline" expect10+runtest "$CPPHS --hashes stringise" expect11+runtest "$CPPHS recursive" expect12+runtest "$CPPHS --strip ross" expect13+runtest "$CPPHS precedence" expect14+runtest "$CPPHS indirect" expect15+runtest "$CPPHS numbers" expect16+runtest "$CPPHS pragma" expect17+runtest "$CPPHS --noline pragma" expect18+runtest "$CPPHS -D__NHC__=117 parens" expect19+runtest "$CPPHS -Dc -Dd -De -Df -Dg -Dh chains" expect20+runtest "$CPPHS --hashes specials" expect21+runtest "$CPPHS --hashes specialinclude" expect22+runtest "$CPPHS incomplete" expect23+runtest "$CPPHS text" expect24+runtest "$CPPHS --text text" expect25+runtest "$CPPHS --text nastyhack" expect26+runtest "$CPPHS nastyhack" expect27+runtest "$CPPHS -DXXX symbolvalue" expect28+runtest "$CPPHS Test.hsc" expect29+runtest "$CPPHS --unlit Arr.lhs" expect30+runtest "$CPPHS -D__NHC__=118 elif" expect31+exit $FAIL
+ tests/specialinclude view
@@ -0,0 +1,5 @@+1+2+#include "specials"+4+5
+ tests/specials view
@@ -0,0 +1,5 @@+#define error(s)	Error #s at line __LINE__ of file __FILE__+line 2+line 3+line 4  error(horrible)+line 5
+ tests/stringise view
@@ -0,0 +1,2 @@+#define foo(x)	This is #x foo x+foo(abcd ef)
+ tests/symbolvalue view
@@ -0,0 +1,3 @@+#if XXX+the symbol is defined as XXX+#endif
+ tests/testfile view
@@ -0,0 +1,34 @@+1 top of file+#define X 0+3+#ifdef X+5 X is defined+#endif+7+#if X+9 X is non-zero+#endif+11+#if error+#error "error message goes here"+#endif+15+#if warning+#warning "warning message goes here"+#endif+19+#if include+#include "inclusion"+#else+23 no inclusion, this is an else clause+#endif+25+#if noelif+27 no elif+#elif elif+29 this is an elif+#else+31 third branch of elif+#endif+33+34 end of file
+ tests/text view
@@ -0,0 +1,14 @@+Here is some ordinary text with embedded Haskell-ish constructs,+that should however /not/ be interpreted as Haskell if the --text+option is given to cpphs.  For instance, here is a Haskell comment+including a cpp definition: {-+#  define FOO bar+and now we end the comment: -}   and try out the definition:  FOO+Likewise, double and single quotes no longer delimit strings or chars: "+#  define BAZ FOO+and what do we have here?: "  ' BAZ  '++#  define expand(a,b,c)	  Some text including a, the b, and c.+Also, in text-mode, macros should be expanded inside Haskell comments:+    -- expand(this,other,that)+and strings "expand(this,other,that)".