cpphs 1.11 → 1.20.10
raw patch · 132 files changed
Files
- CHANGELOG +0/−159
- CHANGELOG.md +232/−0
- LICENCE-GPL +1/−1
- LICENCE-LGPL +1/−1
- LICENCE-commercial +29/−0
- Language/Preprocessor/Cpphs.hs +11/−3
- Language/Preprocessor/Cpphs/CppIfdef.hs +278/−140
- Language/Preprocessor/Cpphs/HashDefine.hs +44/−26
- Language/Preprocessor/Cpphs/MacroPass.hs +73/−24
- Language/Preprocessor/Cpphs/Options.hs +38/−32
- Language/Preprocessor/Cpphs/Position.hs +11/−3
- Language/Preprocessor/Cpphs/ReadFirst.hs +45/−18
- Language/Preprocessor/Cpphs/RunCpphs.hs +62/−10
- Language/Preprocessor/Cpphs/SymTab.hs +11/−5
- Language/Preprocessor/Cpphs/Tokenise.hs +16/−6
- Language/Preprocessor/Unlit.hs +7/−6
- Makefile +0/−56
- README +0/−50
- README.md +60/−0
- Text/ParserCombinators/HuttonMeijer.hs +0/−218
- cpphs.cabal +101/−44
- cpphs.compat +0/−48
- cpphs.hs +18/−13
- cpphs.hugs +0/−2
- docs/design +0/−29
- docs/index.html +254/−14
- new/TimeCompat.hs +2/−0
- tests/Arr.lhs +0/−683
- tests/HsOpenGLExt.h +0/−31
- tests/MachDeps.h +0/−0
- tests/Storable.hs +0/−246
- tests/Test.hsc +0/−11
- tests/chains +0/−16
- tests/comments +0/−3
- tests/config.h +0/−0
- tests/cpp +0/−9
- tests/elif +0/−10
- tests/endcode-a +0/−3
- tests/endcode-b +0/−4
- tests/expect1 +0/−36
- tests/expect10 +0/−15
- tests/expect11 +0/−3
- tests/expect12 +0/−5
- tests/expect13 +0/−20
- tests/expect14 +0/−4
- tests/expect15 +0/−6
- tests/expect15a +0/−6
- tests/expect16 +0/−30
- tests/expect17 +0/−2
- tests/expect18 +0/−1
- tests/expect19 +0/−6
- tests/expect2 +0/−36
- tests/expect20 +0/−17
- tests/expect21 +0/−6
- tests/expect22 +0/−13
- tests/expect23 +0/−2
- tests/expect24 +0/−15
- tests/expect25 +0/−15
- tests/expect26 +0/−17
- tests/expect27 +0/−17
- tests/expect28 +0/−4
- tests/expect29 +0/−12
- tests/expect3 +0/−36
- tests/expect30 +0/−685
- tests/expect31 +0/−11
- tests/expect32 +0/−2
- tests/expect33 +0/−1
- tests/expect34 +0/−11
- tests/expect35 +0/−12
- tests/expect36 +0/−12
- tests/expect36a +0/−12
- tests/expect36b +0/−13
- tests/expect37 +0/−11
- tests/expect37a +0/−11
- tests/expect38 +0/−8
- tests/expect39 +0/−5
- tests/expect4 +0/−39
- tests/expect40 +0/−8
- tests/expect40a +0/−7
- tests/expect41 +0/−6
- tests/expect42 +0/−5
- tests/expect43 +0/−6
- tests/expect44 +0/−4
- tests/expect44a +0/−4
- tests/expect45 +0/−8
- tests/expect46 +0/−7
- tests/expect47 +0/−5
- tests/expect48 +0/−6
- tests/expect49 +0/−5
- tests/expect5 +0/−35
- tests/expect50 +0/−9
- tests/expect6 +0/−10
- tests/expect7 +0/−297
- tests/expect8 +0/−37
- tests/expect9 +0/−16
- tests/fasta +0/−7
- tests/fasta2 +0/−6
- tests/hashjoin +0/−5
- tests/igloo +0/−10
- tests/igloo2 +0/−11
- tests/igloo3 +0/−11
- tests/igloo3a +0/−11
- tests/igloo3b +0/−12
- tests/igloo4 +0/−10
- tests/igloo4a +0/−10
- tests/inclusion +0/−1
- tests/incomplete +0/−1
- tests/indirect +0/−2
- tests/indirect-a +0/−2
- tests/linepragma +0/−5
- tests/mauke +0/−7
- tests/mauke2 +0/−4
- tests/multiline +0/−10
- tests/nastyhack +0/−16
- tests/nestcomment +0/−7
- tests/numbers +0/−29
- tests/param +0/−5
- tests/parens +0/−5
- tests/pragma +0/−1
- tests/precedence +0/−3
- tests/preinclude +0/−1
- tests/recursive +0/−4
- tests/ross +0/−19
- tests/runtests +0/−71
- tests/specialinclude +0/−5
- tests/specials +0/−5
- tests/stringise +0/−2
- tests/symbolvalue +0/−3
- tests/testfile +0/−34
- tests/text +0/−14
- tests/undef.hs +0/−4
- tests/wrongline +0/−4
− CHANGELOG
@@ -1,159 +0,0 @@-Version 1.11-------------- * API change: runCpphs, cppIfdef, and macroPass are now in the IO monad.--Version 1.10------------- * New command-line option: "--linepragma"- It converts #line droppings into {-# LINE #-}.--Version 1.9------------- * Bugfix for #undef.--Version 1.8------------- * Bugfix for off-by-one error in line numbers with --include=file.--Version 1.7------------- * Bugfix in interaction of --unlit with \end{code}--Version 1.6------------- * New command-line option: "--include=filename".- * New command-line option: "--strip-eol" for comment-stripping.- * Line pragmas can have filenames containing spaces.--Version 1.5------------- * Parametrised macro-calls now permitted in #ifdef's.- * Recursive textual expansion now permitted in #ifdef's.- * Better options-handling when used as a library.- * Various small bugfixes--Version 1.4------------- * Added a "--pragma" option to retain #pragma in the output.- * Fixed a number of obscure corner cases involving the interaction of- multiple features e.g. foo##__LINE__.- * Added the "--nowarn" option.--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.
+ CHANGELOG.md view
@@ -0,0 +1,232 @@+Version 1.20.10+---------------++_Andreas Abel, 2025-09-14_++ * Drop support for GHC 7.+ * Remove cabal flag `old-locale`.+ * Compatibility with `{-# LANGUAGE RecordDotSyntax #-}` (Lennart Augustsson).+ * Build tested with GHC 8.0 - 9.14 alpha1.++Version 1.20+------------+ * bugfixes for `#if defined(FOO) && FOO(a,b)`+ * (1.20.1): fix version number+ * (1.20.2): ensure all input/output is UTF8, regardless of locale+ * (1.20.3): detect an absolute windows path with a drive letter in a #include+ * (1.20.4): more windows path handling+ * (1.20.5): revert change in 1.20.4+ * (1.20.6): minor bugfix for crash in obscure corner case+ * (1.20.7): bugfix for windows drive letter in #include+ * (1.20.8): another bugfix for windows drive letter in #include++Version 1.19+------------+ * expose more of the cpphs API+ * allow the static linking exception to the LGPL+ * (1.19.1): don't warn about trailing comments in #ifdefs+ * (1.19.2): fix build error+ * (1.19.3): bugfix for hlint ticket #161 - interaction of --unlit/--linepragma++Version 1.18+------------+ * better lexing of Template Haskell single quotes (thanks to Stefan Wehr)+ * (1.18.1): fix incomplete pattern match+ * (1.18.2): bugfix for erroneous boolean intepretation of some macro+ expansions in #if clauses+ * (1.18.3): further rewrites of the #if expression parser+ * (1.18.4): fix the accidental flipping of comment-stripping behaviour+ with --cpp -traditional flags+ * (1.18.5): fix a bug with windows filepath directory separators in a+ #include+ * (1.18.6): bugfix to reject a macro usage with different arity than+ its definition+ * (1.18.7): bugfix to accept a #include with absolute filepath+ * (1.18.8): fix version number+ * (1.18.9): accept #if defined foo as well as #if defined(foo)++Version 1.17+------------+ * recursively evaluate #if expressions after macro expansion (fix)+ * (1.17.1): report the right version with cpphs --version++Version 1.16+------------+ * fix interaction of runCpphsReturningSymTab with --nomacro++Version 1.15+------------+ * Fix the interaction of --nomacro with --strip.+ * Fix the error message received when # appears without a command.++Version 1.14+------------+ * New API to return symbol table after processing.++Version 1.13+------------+ * Accept -U cmdline option for compatibility with cpp.++Version 1.12+------------+ * Allow it to build with ghc-7.2.++Version 1.11+------------+ * API change: runCpphs, cppIfdef, and macroPass are now in the IO monad.++Version 1.10+-----------+ * New command-line option: "--linepragma"+ It converts #line droppings into {-# LINE #-}.++Version 1.9+-----------+ * Bugfix for #undef.++Version 1.8+-----------+ * Bugfix for off-by-one error in line numbers with --include=file.++Version 1.7+-----------+ * Bugfix in interaction of --unlit with \end{code}++Version 1.6+-----------+ * New command-line option: "--include=filename".+ * New command-line option: "--strip-eol" for comment-stripping.+ * Line pragmas can have filenames containing spaces.++Version 1.5+-----------+ * Parametrised macro-calls now permitted in #ifdef's.+ * Recursive textual expansion now permitted in #ifdef's.+ * Better options-handling when used as a library.+ * Various small bugfixes++Version 1.4+-----------+ * Added a "--pragma" option to retain #pragma in the output.+ * Fixed a number of obscure corner cases involving the interaction of+ multiple features e.g. foo##__LINE__.+ * Added the "--nowarn" option.++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-GPL view
@@ -2,7 +2,7 @@ Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc.- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed.
LICENCE-LGPL view
@@ -2,7 +2,7 @@ Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc.- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed.
+ LICENCE-commercial view
@@ -0,0 +1,29 @@+Commercial licence for cpphs.++Copyright 2004-2010, Malcolm Wallace (malcolm.wallace@me.com)+All rights reserved.++* This software, built from original unmodified sources, may be used for+ any purpose whatsoever, without restriction.++* Redistribution in binary form, without modification, is permitted+ provided that the above copyright notice, these conditions and the+ following disclaimer are reproduced in the documentation and/or other+ materials provided with the distribution.++* Redistribution in source form, with or without modification, is not+ permitted under this license.++THIS SOFTWARE IS PROVIDED BY Malcolm Wallace+AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL+Malcolm Wallace OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.+
Language/Preprocessor/Cpphs.hs view
@@ -12,15 +12,23 @@ ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs- ( runCpphs, cppIfdef, macroPass, CpphsOptions(..), BoolOptions(..)+ ( runCpphs, runCpphsPass1, runCpphsPass2, runCpphsReturningSymTab+ , cppIfdef, tokenise, WordStyle(..)+ , macroPass, macroPassReturningSymTab+ , CpphsOptions(..), BoolOptions(..) , parseOptions, defaultCpphsOptions, defaultBoolOptions , module Language.Preprocessor.Cpphs.Position ) where import Language.Preprocessor.Cpphs.CppIfdef(cppIfdef)-import Language.Preprocessor.Cpphs.MacroPass(macroPass)-import Language.Preprocessor.Cpphs.RunCpphs(runCpphs)+import Language.Preprocessor.Cpphs.MacroPass(macroPass+ ,macroPassReturningSymTab)+import Language.Preprocessor.Cpphs.RunCpphs(runCpphs+ ,runCpphsPass1+ ,runCpphsPass2+ ,runCpphsReturningSymTab) import Language.Preprocessor.Cpphs.Options (CpphsOptions(..), BoolOptions(..), parseOptions ,defaultCpphsOptions,defaultBoolOptions) import Language.Preprocessor.Cpphs.Position+import Language.Preprocessor.Cpphs.Tokenise
Language/Preprocessor/Cpphs/CppIfdef.hs view
@@ -3,23 +3,23 @@ -- 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] -> Options- -- -> String -> IO [(Posn,String)]+ ( cppIfdef -- :: FilePath -> [(String,String)] -> [String] -> Options+ -- -> String -> IO [(Posn,String)] ) where +import Text.Parse import Language.Preprocessor.Cpphs.SymTab-import Text.ParserCombinators.HuttonMeijer import Language.Preprocessor.Cpphs.Position (Posn,newfile,newline,newlines ,cppline,cpp2hask,newpos) import Language.Preprocessor.Cpphs.ReadFirst (readFirst)@@ -28,110 +28,119 @@ import Language.Preprocessor.Cpphs.HashDefine(HashDefine(..),parseHashDefine ,expandMacro) import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro)-import Char (isDigit)-import Numeric (readHex,readOct,readDec)+import Data.Char (isDigit,isSpace,isAlphaNum)+import Data.List (intercalate,isPrefixOf)+import Numeric (readHex,readOct,readDec) import System.IO.Unsafe (unsafeInterleaveIO)-import IO (hPutStrLn,stderr)-+import System.IO (hPutStrLn,stderr)+import Control.Monad (when) -- | 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- -> BoolOptions -- ^ Options controlling output style- -> String -- ^ The input file content- -> IO [(Posn,String)] -- ^ The file after processing (in lines)+cppIfdef :: FilePath -- ^ File for error reports+ -> [(String,String)] -- ^ Pre-defined symbols and their values+ -> [String] -- ^ Search path for \#includes+ -> BoolOptions -- ^ Options controlling output style+ -> String -- ^ The input file content+ -> IO [(Posn,String)] -- ^ The file after processing (in lines) cppIfdef fp syms search options =- cpp posn defs search options Keep . (cppline posn:) . linesCpp+ cpp posn defs search options (Keep []) . initial . linesCpp where posn = newfile fp defs = preDefine options syms+ initial = if literate options then id else (cppline posn:) -- Previous versions had a very simple symbol table mapping strings -- to strings. Now the #ifdef pass uses a more elaborate table, in -- particular to deal with parameterised macros in conditionals. -- | Internal state for whether lines are being kept or dropped.--- In @Drop n b@, @n@ is the depth of nesting, @b@ is whether+-- In @Drop n b ps@, @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+-- @elif@'s, and @ps@ is the stack of positions of open @#if@ contexts,+-- used for error messages in case EOF is reached too soon.+data KeepState = Keep [Posn] | Drop Int Bool [Posn] -- | Return just the list of lines that the real cpp would decide to keep. cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState -> [String] -> IO [(Posn,String)]++cpp _ _ _ _ (Keep ps) [] | not (null ps) = do+ hPutStrLn stderr $ "Unmatched #if: positions of open context are:\n"+++ unlines (map show ps)+ return [] cpp _ _ _ _ _ [] = return [] -cpp p syms path options Keep (l@('#':x):xs) =+cpp p syms path options (Keep ps) (l@('#':x):xs) = let ws = words x- cmd = head ws- line = tail ws- sym = head (tail ws)- rest = tail (tail ws)+ cmd = if null ws then "" else head ws+ line = if null ws then [] else tail ws+ sym = if null line then "" else head line+ rest = if null line then [] else tail line def = defineMacro options (sym++" "++ maybe "1" id (un rest)) un v = if null v then Nothing else Just (unwords v)- keepIf p = if p then Keep else (Drop 1 False)+ keepIf b = if b then Keep (p:ps) else Drop 1 False (p:ps) skipn syms' retain ud xs' = let n = 1 + length (filter (=='\n') l) in (if macros options && retain then emitOne (p,reslash l) else emitMany (replicate n (p,""))) $ cpp (newlines n p) syms' path options ud xs' in case cmd of- "define" -> skipn (insertST def syms) True Keep xs- "undef" -> skipn (deleteST sym syms) True Keep xs- "ifndef" -> skipn syms False (keepIf (not (definedST sym syms))) xs- "ifdef" -> skipn syms False (keepIf (definedST sym syms)) xs- "if" -> skipn syms False- (keepIf (gatherDefined p syms (unwords line))) xs- "else" -> skipn syms False (Drop 1 False) xs- "elif" -> skipn syms False (Drop 1 True) xs- "endif" -> skipn syms False Keep xs- "pragma" -> skipn syms True Keep xs- ('!':_) -> skipn syms False Keep xs -- \#!runhs scripts- "include"-> do (inc,content) <- readFirst (file syms (unwords line))+ "define" -> skipn (insertST def syms) True (Keep ps) xs+ "undef" -> skipn (deleteST sym syms) True (Keep ps) xs+ "ifndef" -> skipn syms False (keepIf (not (definedST sym syms))) xs+ "ifdef" -> skipn syms False (keepIf (definedST sym syms)) xs+ "if" -> do b <- gatherDefined p syms (unwords line)+ skipn syms False (keepIf b) xs+ "else" -> skipn syms False (Drop 1 False ps) xs+ "elif" -> skipn syms False (Drop 1 True ps) xs+ "endif" | null ps ->+ do hPutStrLn stderr $ "Unmatched #endif at "++show p+ return []+ "endif" -> skipn syms False (Keep (tail ps)) xs+ "pragma" -> skipn syms True (Keep ps) xs+ ('!':_) -> skipn syms False (Keep ps) xs -- \#!runhs scripts+ "include"-> do (inc,content) <- readFirst (file syms (unwords line)) p path (warnings options)- cpp p syms path options Keep (("#line 1 "++show inc)- : linesCpp content+ cpp p syms path options (Keep ps)+ (("#line 1 "++show inc): linesCpp content ++ cppline (newline p): xs)- "warning"-> if warnings options then+ "warning"-> if warnings options then do hPutStrLn stderr (l++"\nin "++show p)- skipn syms False Keep xs- else skipn syms False Keep xs- "error" -> error (l++"\nin "++show p)- "line" | all isDigit sym- -> (if locations options && hashline options then emitOne (p,l)+ skipn syms False (Keep ps) xs+ else skipn syms False (Keep ps) xs+ "error" -> error (l++"\nin "++show p)+ "line" | all isDigit sym+ -> (if locations options && hashline options then emitOne (p,l) else if locations options then emitOne (p,cpp2hask l) else id) $ cpp (newpos (read sym) (un rest) p)- syms path options Keep xs- n | all isDigit n- -> (if locations options && hashline options then emitOne (p,l)+ syms path options (Keep ps) xs+ n | all isDigit n && not (null n)+ -> (if locations options && hashline options then emitOne (p,l) else if locations options then emitOne (p,cpp2hask l) else id) $- cpp (newpos (read n) (un (tail ws)) p)- syms path options Keep xs+ cpp (newpos (read n) (un (tail ws)) p)+ syms path options (Keep ps) xs | otherwise- -> if warnings options then- do hPutStrLn stderr ("Warning: unknown directive #"++n- ++"\nin "++show p)- emitOne (p,l) $- cpp (newline p) syms path options Keep xs- else emitOne (p,l) $- cpp (newline p) syms path options Keep xs+ -> do when (warnings options) $+ hPutStrLn stderr ("Warning: unknown directive #"++n+ ++"\nin "++show p)+ emitOne (p,l) $+ cpp (newline p) syms path options (Keep ps) xs -cpp p syms path options (Drop n b) (('#':x):xs) =+cpp p syms path options (Drop n b ps) (('#':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- delif s | n==1 && not b && gatherDefined p syms s- = Keep- | otherwise = Drop n b+ cmd = if null ws then "" else head ws+ delse | n==1 && b = Drop 1 b ps+ | n==1 = Keep ps+ | otherwise = Drop n b ps+ dend | n==1 = Keep (tail ps)+ | otherwise = Drop (n-1) b (tail ps)+ delif v | n==1 && not b && v+ = Keep ps+ | otherwise = Drop n b ps skipn ud xs' = let n' = 1 + length (filter (=='\n') x) in emitMany (replicate n' (p,"")) $@@ -139,17 +148,21 @@ in if cmd == "ifndef" || cmd == "if" ||- cmd == "ifdef" then skipn (Drop (n+1) b) xs- else if cmd == "elif" then skipn (delif (unwords (tail ws))) xs- else if cmd == "else" then skipn delse xs- else if cmd == "endif" then skipn dend xs- else skipn (Drop n b) xs- -- define, undef, include, error, warning, pragma, line+ cmd == "ifdef" then skipn (Drop (n+1) b (p:ps)) xs+ else if cmd == "elif" then do v <- gatherDefined p syms (unwords (tail ws))+ skipn (delif v) xs+ else if cmd == "else" then skipn delse xs+ else if cmd == "endif" then+ if null ps then do hPutStrLn stderr $ "Unmatched #endif at "++show p+ return []+ else skipn dend xs+ else skipn (Drop n b ps) xs+ -- define, undef, include, error, warning, pragma, line -cpp p syms path options Keep (x:xs) =+cpp p syms path options (Keep ps) (x:xs) = let p' = newline p in seq p' $- emitOne (p,x) $ cpp p' syms path options Keep xs-cpp p syms path options d@(Drop _ _) (_:xs) =+ emitOne (p,x) $ cpp p' syms path options (Keep ps) xs+cpp p syms path options d@(Drop _ _ _) (_:xs) = let p' = newline p in seq p' $ emitOne (p,"") $ cpp p' syms path options d xs @@ -164,52 +177,142 @@ -----gatherDefined :: Posn -> SymTab HashDefine -> String -> Bool+gatherDefined :: Posn -> SymTab HashDefine -> String -> IO 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)+ case runParser (preExpand st) inp of+ (Left msg, _) -> error ("Cannot expand #if directive in file "++show p+ ++":\n "++msg)+ (Right s, xs) -> do+-- hPutStrLn stderr $ "Expanded #if at "++show p++" is:\n "++s+ when (any (not . isSpace) xs) $+ hPutStrLn stderr ("Warning: trailing characters after #if"+ ++" macro expansion in file "++show p++": "++xs) -parseBoolExp :: SymTab HashDefine -> Parser Bool-parseBoolExp st =- do a <- parseExp1 st- skip (string "||")- b <- first (skip (parseBoolExp st))- return (a || b)- +++- parseExp1 st+ case runParser parseBoolExp s of+ (Left msg, _) -> error ("Cannot parse #if directive in file "++show p+ ++":\n "++msg)+ (Right b, xs) -> do when (any (not . isSpace) xs && notComment xs) $+ hPutStrLn stderr+ ("Warning: trailing characters after #if"+ ++" directive in file "++show p++": "++xs)+ return b -parseExp1 :: SymTab HashDefine -> Parser Bool-parseExp1 st =- do a <- parseExp0 st- skip (string "&&")- b <- first (skip (parseExp1 st))- return (a && b)- +++- parseExp0 st+notComment = not . ("//"`isPrefixOf`) . dropWhile isSpace -parseExp0 :: SymTab HashDefine -> Parser Bool-parseExp0 st =- do skip (string "defined")- sym <- parens parseSym- return (definedST sym st)- +++- do parens (parseBoolExp st)- +++- do skip (char '!')- a <- parseExp0 st++-- | The preprocessor must expand all macros (recursively) before evaluating+-- the conditional.+preExpand :: SymTab HashDefine -> TextParser String+preExpand st =+ do eof+ return ""+ <|>+ do a <- many1 (satisfy notIdent)+ commit $ pure (a++) `apply` preExpand st+ <|>+ do b <- expandSymOrCall st+ commit $ pure (b++) `apply` preExpand st++-- | Expansion of symbols.+expandSymOrCall :: SymTab HashDefine -> TextParser String+expandSymOrCall st =+ do sym <- parseSym+ if sym=="defined" then do arg <- skip parseSym; convert sym [arg]+ <|>+ do arg <- skip $ parenthesis (do x <- skip parseSym;+ skip (return x))+ convert sym [arg]+ <|> convert sym []+ else+ ( do args <- parenthesis (commit $ fragment `sepBy` skip (isWord ","))+ args' <- flip mapM args $ \arg->+ case runParser (preExpand st) arg of+ (Left msg, _) -> fail msg+ (Right s, _) -> return s+ convert sym args'+ <|> convert sym []+ )+ where+ fragment = many1 (satisfy (`notElem`",)"))+ convert "defined" [arg] =+ case lookupST arg st of+ Nothing | all isDigit arg -> return arg+ Nothing -> return "0"+ Just (a@AntiDefined{}) -> return "0"+ Just (a@SymbolReplacement{}) -> return "1"+ Just (a@MacroExpansion{}) -> return "1"+ convert sym args =+ case lookupST sym st of+ Nothing -> if null args then return sym+ else return "0"+ -- else fail (disp sym args++" is not a defined macro")+ Just (a@SymbolReplacement{}) -> do reparse (replacement a)+ return ""+ Just (a@MacroExpansion{}) -> do reparse (expandMacro a args False)+ return ""+ Just (a@AntiDefined{}) ->+ if null args then return sym+ else return "0"+ -- else fail (disp sym args++" explicitly undefined with -U")+ disp sym args = let len = length args+ chars = map (:[]) ['a'..'z']+ in sym ++ if null args then ""+ else "("++intercalate "," (take len chars)++")"++parseBoolExp :: TextParser Bool+parseBoolExp =+ do a <- parseExp1+ bs <- many (do skip (isWord "||")+ commit $ skip parseBoolExp)+ return $ foldr (||) a bs++parseExp1 :: TextParser Bool+parseExp1 =+ do a <- parseExp0+ bs <- many (do skip (isWord "&&")+ commit $ skip parseExp1)+ return $ foldr (&&) a bs++parseExp0 :: TextParser Bool+parseExp0 =+ do skip (isWord "!")+ a <- commit $ parseExp0 return (not a)- +++- do sym1 <- parseSymOrCall st- op <- parseOp st- sym2 <- parseSymOrCall st- return (op (safeRead sym1) (safeRead sym2))- +++- do sym <- parseSymOrCall st- case safeRead sym of+ <|>+ do val1 <- parseArithExp1+ op <- parseCmpOp+ val2 <- parseArithExp1+ return (val1 `op` val2)+ <|>+ do sym <- parseArithExp1+ case sym of 0 -> return False _ -> return True+ <|>+ do parenthesis (commit parseBoolExp)++parseArithExp1 :: TextParser Integer+parseArithExp1 =+ do val1 <- parseArithExp0+ ( do op <- parseArithOp1+ val2 <- parseArithExp1+ return (val1 `op` val2)+ <|> return val1 )+ <|>+ do parenthesis parseArithExp1++parseArithExp0 :: TextParser Integer+parseArithExp0 =+ do val1 <- parseNumber+ ( do op <- parseArithOp0+ val2 <- parseArithExp0+ return (val1 `op` val2)+ <|> return val1 )+ <|>+ do parenthesis parseArithExp0++parseNumber :: TextParser Integer+parseNumber = fmap safeRead $ skip parseSym where safeRead s = case s of@@ -221,53 +324,87 @@ [] -> 0 :: Integer ((n,_):_) -> n :: Integer -parseOp :: SymTab HashDefine -> Parser (Integer -> Integer -> Bool)-parseOp _ =- do skip (string ">=")+parseCmpOp :: TextParser (Integer -> Integer -> Bool)+parseCmpOp =+ do skip (isWord ">=") return (>=)- +++- do skip (char '>')+ <|>+ do skip (isWord ">") return (>)- +++- do skip (string "<=")+ <|>+ do skip (isWord "<=") return (<=)- +++- do skip (char '<')+ <|>+ do skip (isWord "<") return (<)- +++- do skip (string "==")+ <|>+ do skip (isWord "==") return (==)- +++- do skip (string "!=")+ <|>+ do skip (isWord "!=") return (/=) -parseSymOrCall :: SymTab HashDefine -> Parser String+parseArithOp1 :: TextParser (Integer -> Integer -> Integer)+parseArithOp1 =+ do skip (isWord "+")+ return (+)+ <|>+ do skip (isWord "-")+ return (-)++parseArithOp0 :: TextParser (Integer -> Integer -> Integer)+parseArithOp0 =+ do skip (isWord "*")+ return (*)+ <|>+ do skip (isWord "/")+ return (div)+ <|>+ do skip (isWord "%")+ return (rem)++-- | Return the expansion of the symbol (if there is one).+parseSymOrCall :: SymTab HashDefine -> TextParser String parseSymOrCall st = do sym <- skip parseSym- args <- parens (parseSymOrCall st `sepby` skip (char ','))- return (convert sym args)- ++++ args <- parenthesis (commit $ parseSymOrCall st `sepBy` skip (isWord ","))+ return $ convert sym args+ <|> do sym <- skip parseSym- return (convert sym [])+ return $ convert sym [] where convert sym args = case lookupST sym st of Nothing -> sym Just (a@SymbolReplacement{}) -> recursivelyExpand st (replacement a)- Just (a@MacroExpansion{}) -> expandMacro a args False+ Just (a@MacroExpansion{}) -> recursivelyExpand st (expandMacro a args False) Just (a@AntiDefined{}) -> name a recursivelyExpand :: SymTab HashDefine -> String -> String recursivelyExpand st inp =- case papply (parseSymOrCall st) inp of- [(b,_)] -> b- _ -> inp+ case runParser (parseSymOrCall st) inp of+ (Left msg, _) -> inp+ (Right s, _) -> s -parseSym :: Parser String-parseSym = many1 (alphanum+++char '\''+++char '`')+parseSym :: TextParser String+parseSym = many1 (satisfy (\c-> isAlphaNum c || c`elem`"'`_"))+ `onFail`+ do xs <- allAsString+ fail $ "Expected an identifier, got \""++xs++"\"" -parens p = bracket (skip (char '(')) (skip p) (skip (char ')'))+notIdent :: Char -> Bool+notIdent c = not (isAlphaNum c || c`elem`"'`_") +skip :: TextParser a -> TextParser a+skip p = many (satisfy isSpace) >> p++-- | The standard "parens" parser does not work for us here. Define our own.+parenthesis :: TextParser a -> TextParser a+parenthesis p = do isWord "("+ x <- p+ isWord ")"+ return x+ -- | Determine filename in \#include file :: SymTab HashDefine -> String -> String file st name =@@ -276,3 +413,4 @@ ('<':ns) -> init ns _ -> let ex = recursivelyExpand st name in if ex == name then name else file st ex+
Language/Preprocessor/Cpphs/HashDefine.hs view
@@ -10,44 +10,45 @@ -- -- What structures are declared in a \#define. ------------------------------------------------------------------------------ + module Language.Preprocessor.Cpphs.HashDefine ( HashDefine(..) , ArgOrText(..) , expandMacro , parseHashDefine+ , simplifyHashDefines ) where -import Char (isSpace)-import List (intersperse)+import Data.Char (isSpace)+import Data.List (intercalate) data HashDefine- = LineDrop- { name :: String }- | Pragma- { name :: String }+ = LineDrop+ { name :: String }+ | Pragma+ { name :: String } | AntiDefined- { name :: String- , linebreaks :: Int- }- | SymbolReplacement- { name :: String- , replacement :: String- , linebreaks :: Int- }- | MacroExpansion- { name :: String- , arguments :: [String]- , expansion :: [(ArgOrText,String)]- , linebreaks :: Int- }+ { name :: String+ , linebreaks :: Int+ }+ | 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 }+ { 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),@@ -59,12 +60,18 @@ 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 (Arg,s) = maybe ("") id (lookup s env)+ replace (Str,s) = maybe (str "") str (lookup s env) replace (Text,s) = if layout then s else filter (/='\n') s str s = '"':s++"\""+ checkArity | length (arguments macro) == 1 && length parameters <= 1+ || length (arguments macro) == length parameters = id+ | otherwise = error ("macro "++name macro++" expected "+++ show (length (arguments macro))+++ " arguments, but was given "+++ show (length parameters)) in- concatMap replace (expansion macro)+ checkArity $ concatMap replace (expansion macro) -- | Parse a \#define, or \#undef, ignoring other \# directives parseHashDefine :: Bool -> [String] -> Maybe HashDefine@@ -93,7 +100,7 @@ macroHead sym args (var:xs) = (macroHead sym (var:args) . skip) xs macroHead sym args [] = error ("incomplete macro definition:\n" ++" #define "++sym++"("- ++concat (intersperse "," args))+ ++intercalate "," args) classifyRhs args ("#":x:xs) | ansi && x `elem` args = (Str,x): classifyRhs args xs@@ -109,3 +116,14 @@ count = length . filter (=='\n') . concat chop = reverse . dropWhile (all isSpace) . reverse +-- | Pretty-print hash defines to a simpler format, as key-value pairs.+simplifyHashDefines :: [HashDefine] -> [(String,String)]+simplifyHashDefines = concatMap simp+ where+ simp hd@LineDrop{} = []+ simp hd@Pragma{} = []+ simp hd@AntiDefined{} = []+ simp hd@SymbolReplacement{} = [(name hd, replacement hd)]+ simp hd@MacroExpansion{} = [(name hd++"("++intercalate "," (arguments hd)+ ++")"+ ,concatMap snd (expansion hd))]
Language/Preprocessor/Cpphs/MacroPass.hs view
@@ -16,41 +16,76 @@ ( macroPass , preDefine , defineMacro+ , macroPassReturningSymTab ) where -import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro)+import Language.Preprocessor.Cpphs.HashDefine (HashDefine(..), expandMacro+ , simplifyHashDefines) import Language.Preprocessor.Cpphs.Tokenise (tokenise, WordStyle(..) , parseMacroCall) import Language.Preprocessor.Cpphs.SymTab (SymTab, lookupST, insertST- , emptyST)+ , emptyST, flattenST) import Language.Preprocessor.Cpphs.Position (Posn, newfile, filename, lineno) import Language.Preprocessor.Cpphs.Options (BoolOptions(..)) import System.IO.Unsafe (unsafeInterleaveIO) import Control.Monad ((=<<))-import Time (getClockTime, toCalendarTime, formatCalendarTime)-import Locale (defaultTimeLocale)+--import System.Time (getClockTime, toCalendarTime, formatCalendarTime)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import TimeCompat (defaultTimeLocale) noPos :: Posn noPos = newfile "preDefined" -- | Walk through the document, replacing calls of macros with the expanded RHS.-macroPass :: [(String,String)] -- ^ Pre-defined symbols and their values- -> BoolOptions -- ^ Options that alter processing style- -> [(Posn,String)] -- ^ The input file content- -> IO String -- ^ The file after processing+macroPass :: [(String,String)] -- ^ Pre-defined symbols and their values+ -> BoolOptions -- ^ Options that alter processing style+ -> [(Posn,String)] -- ^ The input file content+ -> IO String -- ^ The file after processing macroPass syms options =- fmap (safetail -- to remove extra "\n" inserted below- . concat)+ fmap (safetail -- to remove extra "\n" inserted below+ . concat+ . onlyRights) . macroProcess (pragma options) (layout options) (lang options) (preDefine options syms) . tokenise (stripEol options) (stripC89 options) (ansi options) (lang options)- . ((noPos,""):) -- ensure recognition of "\n#" at start of file+ . ((noPos,""):) -- ensure recognition of "\n#" at start of file where safetail [] = [] safetail (_:xs) = xs +-- | auxiliary+onlyRights :: [Either a b] -> [b]+onlyRights = concatMap (\x->case x of Right t-> [t]; Left _-> [];) +-- | Walk through the document, replacing calls of macros with the expanded RHS.+-- Additionally returns the active symbol table after processing.+macroPassReturningSymTab+ :: [(String,String)] -- ^ Pre-defined symbols and their values+ -> BoolOptions -- ^ Options that alter processing style+ -> [(Posn,String)] -- ^ The input file content+ -> IO (String,[(String,String)])+ -- ^ The file and symbol table after processing+macroPassReturningSymTab syms options =+ fmap (mapFst (safetail -- to remove extra "\n" inserted below+ . concat)+ . walk)+ . macroProcess (pragma options) (layout options) (lang options)+ (preDefine options syms)+ . tokenise (stripEol options) (stripC89 options)+ (ansi options) (lang options)+ . ((noPos,""):) -- ensure recognition of "\n#" at start of file+ where+ safetail [] = []+ safetail (_:xs) = xs+ walk (Right x: rest) = let (xs, foo) = walk rest+ in (x:xs, foo)+ walk (Left x: []) = ( [] , simplifyHashDefines (flattenST x) )+ walk (Left x: rest) = walk rest+ mapFst f (a,b) = (f a, b)++ -- | Turn command-line definitions (from @-D@) into 'HashDefine's. preDefine :: BoolOptions -> [(String,String)] -> SymTab HashDefine preDefine options defines =@@ -73,9 +108,12 @@ -- All valid identifiers are checked for the presence of a definition -- of that name in the symbol table, and if so, expanded appropriately. -- (Bool arguments are: keep pragmas? retain layout? haskell language?)+-- The result lazily intersperses output text with symbol tables. Lines+-- are emitted as they are encountered. A symbol table is emitted after+-- each change to the defined symbols, and always at the end of processing. macroProcess :: Bool -> Bool -> Bool -> SymTab HashDefine -> [WordStyle]- -> IO [String]-macroProcess _ _ _ _ [] = return []+ -> IO [Either (SymTab HashDefine) String]+macroProcess _ _ _ st [] = return [Left st] macroProcess p y l st (Other x: ws) = emit x $ macroProcess p y l st ws macroProcess p y l st (Cmd Nothing: ws) = emit "\n" $ macroProcess p y l st ws macroProcess p y l st (Cmd (Just (LineDrop x)): ws)@@ -85,20 +123,27 @@ | pragma = emit "\n" $ emit x $ macroProcess pragma y l st ws | otherwise = emit "\n" $ macroProcess pragma y l st ws macroProcess p layout lang st (Cmd (Just hd): ws) =- let n = 1 + linebreaks hd in+ let n = 1 + linebreaks hd+ newST = insertST (name hd, hd) st+ in emit (replicate n '\n') $- macroProcess p layout lang (insertST (name hd, hd) st) ws+ emitSymTab newST $+ macroProcess p layout lang newST ws macroProcess pr layout lang st (Ident p x: ws) = case x of "__FILE__" -> emit (show (filename p))$ macroProcess pr layout lang st ws "__LINE__" -> emit (show (lineno p)) $ macroProcess pr layout lang st ws "__DATE__" -> do w <- return .- formatCalendarTime defaultTimeLocale "\"%d %b %Y\""- =<< toCalendarTime =<< getClockTime+ -- formatCalendarTime defaultTimeLocale "\"%d %b %Y\""+ -- =<< toCalendarTime =<< getClockTime+ formatTime defaultTimeLocale "\"%d %b %Y\""+ =<< getCurrentTime emit w $ macroProcess pr layout lang st ws "__TIME__" -> do w <- return .- formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""- =<< toCalendarTime =<< getClockTime+ -- formatCalendarTime defaultTimeLocale "\"%H:%M:%S\""+ -- =<< toCalendarTime =<< getClockTime+ formatTime defaultTimeLocale "\"%H:%M:%S\""+ =<< getCurrentTime emit w $ macroProcess pr layout lang st ws _ -> case lookupST x st of@@ -122,9 +167,9 @@ Just (args,ws') -> if length args /= length (arguments hd) then emit x $ macroProcess pr layout lang st ws- else do args' <- mapM (fmap concat .- macroProcess pr layout- lang st)+ else do args' <- mapM (fmap (concat . onlyRights)+ . macroProcess pr layout+ lang st) args -- one-level expansion only: -- emit (expandMacro hd args' layout) $@@ -136,6 +181,10 @@ ++ ws') -- | Useful helper function.-emit :: a -> IO [a] -> IO [a]+emit :: a -> IO [Either b a] -> IO [Either b a] emit x io = do xs <- unsafeInterleaveIO io- return (x:xs)+ return (Right x:xs)+-- | Useful helper function.+emitSymTab :: b -> IO [Either b a] -> IO [Either b a]+emitSymTab x io = do xs <- unsafeInterleaveIO io+ return (Left x:xs)
Language/Preprocessor/Cpphs/Options.hs view
@@ -17,20 +17,21 @@ , parseOptions , defaultCpphsOptions , defaultBoolOptions+ , trailing ) where -import Maybe-import List (isPrefixOf)+import Data.Maybe+import Data.List (isPrefixOf) -- | Cpphs options structure.-data CpphsOptions = CpphsOptions - { infiles :: [FilePath]- , outfiles :: [FilePath]- , defines :: [(String,String)]- , includes :: [String]- , preInclude:: [FilePath] -- ^ Files to #include before anything else- , boolopts :: BoolOptions- }+data CpphsOptions = CpphsOptions+ { infiles :: [FilePath]+ , outfiles :: [FilePath]+ , defines :: [(String,String)]+ , includes :: [String]+ , preInclude:: [FilePath] -- ^ Files to \#include before anything else+ , boolopts :: BoolOptions+ } deriving (Show) -- | Default options. defaultCpphsOptions :: CpphsOptions@@ -41,18 +42,18 @@ -- | Options representable as Booleans. data BoolOptions = BoolOptions- { macros :: Bool -- ^ Leave \#define and \#undef in output of ifdef?- , locations :: Bool -- ^ Place #line droppings in output?- , hashline :: Bool -- ^ Write #line or {-# LINE #-} ?- , pragma :: Bool -- ^ Keep #pragma in final output?- , stripEol :: Bool -- ^ Remove C eol (\/\/) comments everywhere?- , stripC89 :: Bool -- ^ Remove C inline (\/**\/) comments everywhere?- , lang :: Bool -- ^ Lex input as Haskell code?- , ansi :: Bool -- ^ Permit stringise \# and catenate \#\# operators?- , layout :: Bool -- ^ Retain newlines in macro expansions?- , literate :: Bool -- ^ Remove literate markup?- , warnings :: Bool -- ^ Issue warnings?- }+ { macros :: Bool -- ^ Leave \#define and \#undef in output of ifdef?+ , locations :: Bool -- ^ Place \#line droppings in output?+ , hashline :: Bool -- ^ Write \#line or {-\# LINE \#-} ?+ , pragma :: Bool -- ^ Keep \#pragma in final output?+ , stripEol :: Bool -- ^ Remove C eol (\/\/) comments everywhere?+ , stripC89 :: Bool -- ^ Remove C inline (\/**\/) comments everywhere?+ , lang :: Bool -- ^ Lex input as Haskell code?+ , ansi :: Bool -- ^ Permit stringise \# and catenate \#\# operators?+ , layout :: Bool -- ^ Retain newlines in macro expansions?+ , literate :: Bool -- ^ Remove literate markup?+ , warnings :: Bool -- ^ Issue warnings?+ } deriving (Show) -- | Default settings of boolean options. defaultBoolOptions :: BoolOptions@@ -80,6 +81,7 @@ | Macro (String,String) | Path String | PreInclude FilePath+ | IgnoredForCompatibility deriving (Eq, Show) flags :: [(String, RawOption)]@@ -103,11 +105,15 @@ where a = lookup x flags rawOption ('-':'D':xs) = Just $ Macro (s, if null d then "1" else tail d) where (s,d) = break (=='=') xs+rawOption ('-':'U':xs) = Just $ IgnoredForCompatibility rawOption ('-':'I':xs) = Just $ Path $ trailing "/\\" xs rawOption xs | "--include="`isPrefixOf`xs = Just $ PreInclude (drop 10 xs) rawOption _ = Nothing +-- | Trim trailing elements of the second list that match any from+-- the first list. Typically used to remove trailing forward\/back+-- slashes from a directory path. trailing :: (Eq a) => [a] -> [a] -> [a] trailing xs = reverse . dropWhile (`elem`xs) . reverse @@ -115,17 +121,17 @@ boolOpts :: [RawOption] -> BoolOptions boolOpts opts = BoolOptions- { macros = not (NoMacro `elem` opts)- , locations = not (NoLine `elem` opts)- , hashline = not (LinePragma `elem` opts)- , pragma = Pragma `elem` opts- , stripEol = StripEol`elem` opts- , stripC89 = StripEol`elem` opts || Strip `elem` opts+ { macros = not (NoMacro `elem` opts)+ , locations = not (NoLine `elem` opts)+ , hashline = not (LinePragma `elem` opts)+ , pragma = Pragma `elem` opts+ , stripEol = StripEol`elem` opts+ , stripC89 = StripEol`elem` opts || Strip `elem` opts , lang = not (Text `elem` opts)- , ansi = Ansi `elem` opts- , layout = Layout `elem` opts- , literate = Unlit `elem` opts- , warnings = not (SuppressWarnings `elem` opts)+ , ansi = Ansi `elem` opts+ , layout = Layout `elem` opts+ , literate = Unlit `elem` opts+ , warnings = not (SuppressWarnings `elem` opts) } -- | Parse all command-line options.
Language/Preprocessor/Cpphs/Position.hs view
@@ -17,9 +17,10 @@ , addcol, newline, tab, newlines, newpos , cppline, haskline, cpp2hask , filename, lineno, directory+ , cleanPath ) where -import List (isPrefixOf)+import Data.List (isPrefixOf) -- | Source positions contain a filename, line, column, and an -- inclusion point, which is itself another source position,@@ -38,7 +39,7 @@ -- | Constructor. Argument is filename. newfile :: String -> Posn-newfile name = Pn name 1 1 Nothing+newfile name = Pn (cleanPath name) 1 1 Nothing -- | Increment column number by given quantity. addcol :: Int -> Posn -> Posn@@ -88,7 +89,8 @@ cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE " ++unwords (tail (words line)) ++" #-}"- + | otherwise = line+ -- | Strip non-directory suffix from file name (analogous to the shell -- command of the same name). dirname :: String -> String@@ -96,3 +98,9 @@ where safetail [] = [] safetail (_:x) = x +-- | Sigh. Mixing Windows filepaths with unix is bad. Make sure there is a+-- canonical path separator.+cleanPath :: FilePath -> FilePath+cleanPath [] = []+cleanPath ('\\':cs) = '/': cleanPath cs+cleanPath (c:cs) = c: cleanPath cs
Language/Preprocessor/Cpphs/ReadFirst.hs view
@@ -3,7 +3,7 @@ -- Module : ReadFirst -- Copyright : 2004 Malcolm Wallace -- Licence : LGPL--- +-- -- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk> -- Stability : experimental -- Portability : All@@ -13,41 +13,68 @@ module Language.Preprocessor.Cpphs.ReadFirst ( readFirst+ , readFileUTF8+ , writeFileUTF8 ) where -import IO (hPutStrLn, stderr)-import Directory (doesFileExist)-import List (intersperse)-import Monad (when)-import Language.Preprocessor.Cpphs.Position (Posn,directory)+import System.IO+import System.Directory (doesFileExist)+import Data.List (intersperse)+import Control.Exception as E+import Control.Monad (when)+import Language.Preprocessor.Cpphs.Position (Posn,directory,cleanPath) -- | 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- -> Bool -- ^ report warnings?- -> IO ( FilePath+readFirst :: String -- ^ filename+ -> Posn -- ^ inclusion point+ -> [String] -- ^ search path+ -> Bool -- ^ report warnings?+ -> IO ( FilePath , String- ) -- ^ discovered filepath, and file contents+ ) -- ^ discovered filepath, and file contents readFirst name demand path warn =- try (cons dd (".":path))+ case name of+ -- Windows drive in absolute path+ c:':':'\\':nm-> try nm (Just (c:':':[])) [""]+ c:':':'/':nm -> try nm (Just (c:':':[])) [""]+ -- Windows drive in relative path+ c:':':nm -> try nm (Just (c:':':[])) (cons dd (".":path))+ -- unix-like absolute path+ '/':nm -> try nm Nothing [""]+ -- any relative path+ _ -> try name Nothing (cons dd (".":path)) where dd = directory demand cons x xs = if null x then xs else x:xs- try [] = do+ try name _ [] = do when warn $ hPutStrLn stderr ("Warning: Can't find file \""++name ++"\" in directories\n\t" ++concat (intersperse "\n\t" (cons dd (".":path))) ++"\n Asked for by: "++show demand) return ("missing file: "++name,"")- try (p:ps) = do- let file = p++'/':name+ try name drive (p:ps) = do+ let file = (maybe id (++) drive) $ cleanPath p++'/':cleanPath name ok <- doesFileExist file- if not ok then try ps- else do content <- readFile file+ if not ok then try name drive ps+ else do content <- readFileUTF8 file return (file,content)++readFileUTF8 :: FilePath -> IO String+readFileUTF8 file = do+ h <- openFile file ReadMode+ (do utf8r <- mkTextEncoding "UTF-8//ROUNDTRIP"+ hSetEncoding h utf8r+ hGetContents h) `E.onException` (hClose h)++writeFileUTF8 :: FilePath -> String -> IO ()+writeFileUTF8 f txt = withFile f WriteMode $ \hdl->+ do utf8r <- mkTextEncoding "UTF-8//ROUNDTRIP"+ hSetEncoding hdl utf8r+ hPutStr hdl txt+ `E.onException` (hClose hdl)+
Language/Preprocessor/Cpphs/RunCpphs.hs view
@@ -2,29 +2,81 @@ -- 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.+-- This file is LGPL (relicensed from the GPL by Malcolm Wallace, October 2011). -}-module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs ) where+module Language.Preprocessor.Cpphs.RunCpphs ( runCpphs+ , runCpphsPass1+ , runCpphsPass2+ , runCpphsReturningSymTab+ ) where import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef)-import Language.Preprocessor.Cpphs.MacroPass(macroPass)-import Language.Preprocessor.Cpphs.Options (CpphsOptions(..), BoolOptions(..))+import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)+import Language.Preprocessor.Cpphs.Options (CpphsOptions(..), BoolOptions(..)+ ,trailing)+import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise)+import Language.Preprocessor.Cpphs.Position (cleanPath, Posn) import Language.Preprocessor.Unlit as Unlit (unlit) runCpphs :: CpphsOptions -> FilePath -> String -> IO String runCpphs options filename input = do+ pass1 <- runCpphsPass1 options filename input+ runCpphsPass2 (boolopts options) (defines options) filename pass1++runCpphsPass1 :: CpphsOptions -> FilePath -> String -> IO [(Posn,String)]+runCpphsPass1 options' filename input = do+ let options= options'{ includes= map (trailing "\\/") (includes options') } let bools = boolopts options preInc = case preInclude options of [] -> ""- is -> concatMap (\f->"#include \""++f++"\"\n") is - ++ "#line 1 \""++filename++"\"\n"+ is -> concatMap (\f->"#include \""++f++"\"\n") is+ ++ "#line 1 \""++cleanPath filename++"\"\n" pass1 <- cppIfdef filename (defines options) (includes options) bools (preInc++input)- pass2 <- macroPass (defines options) bools pass1- let result= if not (macros bools) then unlines (map snd pass1) else pass2- pass3 = if literate bools then Unlit.unlit filename else id+ return pass1 +runCpphsPass2 :: BoolOptions -> [(String,String)] -> FilePath -> [(Posn,String)] -> IO String+runCpphsPass2 bools defines filename pass1 = do+ pass2 <- macroPass defines bools pass1+ let result= if not (macros bools)+ then if stripC89 bools || stripEol bools+ then concatMap deWordStyle $+ tokenise (stripEol bools) (stripC89 bools)+ (ansi bools) (lang bools) pass1+ else unlines (map snd pass1)+ else pass2+ pass3 = if literate bools then Unlit.unlit filename else id return (pass3 result)++runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String+ -> IO (String,[(String,String)])+runCpphsReturningSymTab options' filename input = do+ let options= options'{ includes= map (trailing "\\/") (includes options') }+ let bools = boolopts options+ preInc = case preInclude options of+ [] -> ""+ is -> concatMap (\f->"#include \""++f++"\"\n") is+ ++ "#line 1 \""++cleanPath filename++"\"\n"+ (pass2,syms) <-+ if macros bools then do+ pass1 <- cppIfdef filename (defines options) (includes options)+ bools (preInc++input)+ macroPassReturningSymTab (defines options) bools pass1+ else do+ pass1 <- cppIfdef filename (defines options) (includes options)+ bools{macros=True} (preInc++input)+ (_,syms) <- macroPassReturningSymTab (defines options) bools pass1+ pass1 <- cppIfdef filename (defines options) (includes options)+ bools (preInc++input)+ let result = if stripC89 bools || stripEol bools+ then concatMap deWordStyle $+ tokenise (stripEol bools) (stripC89 bools)+ (ansi bools) (lang bools) pass1+ else init $ unlines (map snd pass1)+ return (result,syms)++ let pass3 = if literate bools then Unlit.unlit filename else id+ return (pass3 pass2, syms)+
Language/Preprocessor/Cpphs/SymTab.hs view
@@ -3,7 +3,7 @@ -- Module : SymTab -- Copyright : 2000-2004 Malcolm Wallace -- Licence : LGPL--- +-- -- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk> -- Stability : Stable -- Portability : All@@ -19,6 +19,7 @@ , deleteST , lookupST , definedST+ , flattenST , IndTree ) where @@ -31,15 +32,17 @@ deleteST :: String -> SymTab v -> SymTab v lookupST :: String -> SymTab v -> Maybe v definedST :: String -> SymTab v -> Bool+flattenST :: SymTab v -> [v] 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)+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)+definedST s ss = let vs = filter ((==s) . fst) ((itind (hash s)) ss) in (not . null) vs+flattenST ss = itfold (map snd) (++) ss ----@@ -62,10 +65,13 @@ 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 :: 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 +itfold :: (a->b) -> (b->b->b) -> IndTree a -> b+itfold leaf _fork (Leaf x) = leaf x+itfold leaf fork (Fork _ l r) = fork (itfold leaf fork l) (itfold leaf fork r) ---- -- Hash values
Language/Preprocessor/Cpphs/Tokenise.hs view
@@ -22,7 +22,7 @@ , parseMacroCall ) where -import Char+import Data.Char import Language.Preprocessor.Cpphs.HashDefine import Language.Preprocessor.Cpphs.Position @@ -106,8 +106,15 @@ haskell CLineComment " " 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 Any acc p ls ('\'':'\'':xs) = emit acc $ -- TH type quote+ haskell Any "''" p ls xs+ haskell Any acc p ls ('\'':xs@('\\':_)) = emit acc $ -- escaped char literal haskell (String '\'') "'" p ls xs+ haskell Any acc p ls ('\'':x:'\'':xs) = emit acc $ -- character literal+ emit ['\'', x, '\''] $+ haskell Any [] p ls xs+ haskell Any acc p ls ('\'':xs) = emit acc $ -- TH name quote+ haskell Any "'" 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 $@@ -146,7 +153,7 @@ 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 CComment acc p ls (x:xs) = haskell CComment (white x:acc) p ls xs haskell CLineComment acc p ls xs@('\n':_)= emit acc $ haskell Any [] p ls xs haskell CLineComment acc p ls (_:xs) = haskell CLineComment (' ':acc) p ls xs@@ -197,7 +204,7 @@ 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+ lexcpp (NestComment n) w l ls (x:xs) = lexcpp (NestComment n) (white x:w) l ls xs lexcpp mode w l ((p,l'):ls) [] = cpp mode next w l p ls ('\n':l') lexcpp _ _ _ [] [] = []@@ -228,7 +235,7 @@ plaintext Any [] p ls xs 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 CComment acc p ls (x:xs) = plaintext CComment (white x:acc) p ls xs plaintext CLineComment acc p ls xs@('\n':_) = emit acc $ plaintext Any [] p ls xs plaintext CLineComment acc p ls (_:xs)= plaintext CLineComment (' ':acc)@@ -242,6 +249,10 @@ symbol x = x `elem` ":!#$%&*+./<=>?@\\^|-~" single x = x `elem` "(),[];{}" space x = x `elem` " \t"+ -- conversion of comment text to whitespace+ white '\n' = '\n'+ white '\r' = '\r'+ white _ = ' ' -- emit a token (if there is one) from the accumulator emit "" = id emit xs = (Other (reverse xs):)@@ -268,4 +279,3 @@ args n w acc (x@(Other _) :xs) = args n (x:w) acc xs args _ _ _ _ = Nothing addone w acc = reverse (skip w): acc-
Language/Preprocessor/Unlit.hs view
@@ -2,8 +2,8 @@ -- version 1.2, appendix C. module Language.Preprocessor.Unlit (unlit) where -import Char-import List (isPrefixOf)+import Data.Char+import Data.List (isPrefixOf) data Classified = Program String | Blank | Comment | Include Int String | Pre String@@ -14,13 +14,14 @@ where allProg [] = [] -- Should give an error message, -- but I have no good position information. allProg (('\\':x):xs) | "end{code}"`isPrefixOf`x = Blank : classify xs- allProg (x:xs) = Program x:allProg xs+ allProg (x:xs) = Program x:allProg xs classify (('>':x):xs) = Program (' ':x) : classify xs classify (('#':x):xs) = (case words x of (line:rest) | all isDigit line -> Include (read line) (unwords rest) _ -> Pre x ) : classify xs+--classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs classify (x:xs) | all isSpace x = Blank:classify xs classify (x:xs) = Comment:classify xs @@ -64,8 +65,8 @@ 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' ('\^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
@@ -1,56 +0,0 @@-LIBRARY = cpphs-VERSION = 1.11--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]*--HC = ghc-HFLAGS =-HEAP =-HOSTSTRIP = strip--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 -anchor -html $$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)- $(HOSTSTRIP) $@
− README
@@ -1,50 +0,0 @@-This directory contains 'cpphs', a simplified but robust-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]- [ --include=file ]*- [ --nomacro | --noline | --nowarn | --strip | --strip-eol |- --pragma | --text | --hashes | --layout | --unlit |- --linepragma ]*- [ --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-2010 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
+ README.md view
@@ -0,0 +1,60 @@+[](http://hackage.haskell.org/package/cpphs)+[](https://www.stackage.org/package/cpphs)+[](https://stackage.org/nightly/package/cpphs)+[](https://github.com/haskell-pkg-janitors/cpphs/actions)++cpphs+=====++A liberalised re-implementation of `cpp`, the C pre-processor.++`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.++Usage+-----++ cpphs [filename | -Dsym | -Dsym=val | -Ipath]+ [-Ofile]+ [ --include=file ]*+ [ --nomacro | --noline | --nowarn | --strip | --strip-eol |+ --pragma | --text | --hashes | --layout | --unlit |+ --linepragma ]*+ [ --cpp compatopts ]++For fuller details, see [docs/index.html](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+---------++(c) 2004-2017 Malcolm Wallace (Malcolm.Wallace@me.com)+++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.++If you have a commercial use for cpphs, and feel the terms of the (L)GPL+are too onerous, you have the option of distributing unmodified binaries+(only, not sources) under the terms of a different licence (see+LICENCE-commercial).+++Website+-------++Description see: https://hackage.haskell.org/package/cpphs++Old homepage: https://archives.haskell.org/projects.haskell.org/cpphs/
− Text/ParserCombinators/HuttonMeijer.hs
@@ -1,218 +0,0 @@--------------------------------------------------------------------------------- |--- 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
@@ -1,52 +1,109 @@+Cabal-Version: 1.18 Name: cpphs-Version: 1.11-Copyright: 2004-2010, Malcolm Wallace-Build-Depends: base < 6, haskell98+Version: 1.20.10+Copyright: 2004-2017, Malcolm Wallace 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/+Author: Malcolm Wallace <Malcolm.Wallace@me.com>+Maintainer: Andreas Abel+-- homepage:+bug-reports: https://github.com/haskell-pkg-janitors/cpphs/issues 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.+ 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.+ .+ Old homepage: <https://archives.haskell.org/projects.haskell.org/cpphs/> Category: Development Build-type: Simple-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+Extra-Doc-Files:+ README.md+ LICENCE-GPL+ LICENCE-commercial+ CHANGELOG.md+ docs/cpphs.1+ docs/index.html++tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2++Source-Repository head+ Type: git+ Location: https://github.com/haskell-pkg-janitors/cpphs.git++Library+ Hs-Source-Dirs: . new++ Build-Depends:+ -- GHC-shipped libraries+ base >= 4.9 && < 5+ , directory < 1.4+ , time >= 1.5 && < 2+ -- Other libraries+ , polyparse >= 1.13 && < 1.14++ 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+ TimeCompat++ default-language: Haskell2010++Executable cpphs+ Hs-Source-Dirs: . new+ Main-Is: cpphs.hs++ Build-Depends:+ -- GHC-shipped libraries+ base >= 4.9 && < 5+ , directory < 1.4+ , time >= 1.5 && < 2+ -- Other libraries+ , polyparse >= 1.13 && < 1.14++ 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+ TimeCompat++ default-language: Haskell2010
− cpphs.compat
@@ -1,48 +0,0 @@-#!/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
@@ -11,21 +11,27 @@ -} module Main where -import System ( getArgs, getProgName, exitWith, ExitCode(..) )-import Maybe+import System.Environment ( getArgs, getProgName)+import System.Exit ( exitWith, ExitCode(..) )+import Data.Maybe import Language.Preprocessor.Cpphs ( runCpphs, CpphsOptions(..), parseOptions )-import IO ( stdout, IOMode(WriteMode), openFile, hPutStr, hFlush, hClose )-import Monad ( when )-import List ( isPrefixOf )+import Language.Preprocessor.Cpphs.ReadFirst ( readFileUTF8, writeFileUTF8 )+import System.IO ( stdin, stdout, stderr, hFlush, hSetEncoding, utf8 )+import Control.Monad ( when )+import Data.List ( isPrefixOf ) version :: String-version = "1.11"+version = "1.20.9" main :: IO () main = do+ hSetEncoding stdin utf8+ hSetEncoding stdout utf8+ hSetEncoding stderr utf8+ args <- getArgs args <- return $ if "--cpp" `elem` args then convertArgs args else args- + prog <- getProgName when ("--version" `elem` args) (do putStrLn (prog++" "++version)@@ -43,7 +49,7 @@ ins = infiles options outs = outfiles options out = listToMaybe outs- + when (isLeft parsedArgs) (do putStrLn $ "Unknown option "++fromLeft parsedArgs ++", for valid options try "++prog++" --help\n"@@ -59,10 +65,10 @@ execute :: CpphsOptions -> Maybe FilePath -> Maybe FilePath -> IO () execute opts ofile infile = let (filename, readIt) = case infile of- Just x -> (x, readFile x)+ Just x -> (x, readFileUTF8 x) Nothing -> ("stdin", getContents) output Nothing x = do putStr x; hFlush stdout- output (Just f) x = writeFile f x+ output (Just f) x = writeFileUTF8 f x in do contents <- readIt transformed <- runCpphs opts filename contents output ofile transformed@@ -82,7 +88,7 @@ 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@@ -100,11 +106,10 @@ 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" | traditional e && strip e] ++ ["--strip-eol" | not (traditional e) && strip e] ++ [infile e] ++ ["-O" ++ outfile e | outfile e /= "-"]-
− cpphs.hugs
@@ -1,2 +0,0 @@-#!/bin/sh-runhugs cpphs.hs --noline -D__HASKELL98__ -D__HUGS__ "$@"
− docs/design
@@ -1,29 +0,0 @@-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
@@ -198,13 +198,11 @@ <b>Current stable version:</b> <p>-cpphs-1.11, release date 2010.01.31<br>+cpphs-1.20.8, release date 2017-06-22<br> By HTTP:-<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.11.tar.gz">.tar.gz</a>,-<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.11.zip">.zip</a>, <a href="http://hackage.haskell.org/package/cpphs">Hackage</a>. <ul>-<li> Major API change: runCpphs, cppIfdef and macroPass are now in the IO monad.+<li> (1.20.8) another bugfix for windows drive letters in #includes. </ul> <p>@@ -213,12 +211,12 @@ 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+ darcs get http://code.haskell.org/cpphs </pre>-(Users on Windows or MacOS filesystems need to use the-<tt>--partial</tt> flag.) The source tree and version history can+(Users on Windows or MacOS filesystems may 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>.+<a href="http://www.cs.york.ac.uk/fp/darcs/">darcsweb</a>. --> What's new, over and above the latest stable release? <ul> <li> Nothing since last release.@@ -228,6 +226,246 @@ <b>Older versions:</b> <p>+cpphs-1.20.8, release date 2017-06-22<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> (1.20.8) another bugfix for windows drive letters in #includes.+<li> (1.20.7) bugfix for windows drive letters in #includes.+<li> (1.20.6) minor bugfix to avoid a crash in an obscure corner case+</ul>++<p>+cpphs-1.20.5, release date 2017-04-11<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> (1.20.5) reverts the changes in 1.20.4+</ul>++<p>+cpphs-1.20.4, release date 2017-02-27<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> (1.20.4) more windows path handling+</ul>++<p>+cpphs-1.20.3, release date 2017-02-06<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> (1.20.3) detect an absolute windows path with a drive letter in a #include+</ul>++<p>+cpphs-1.20.2, release date 2016-09-05<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> (1.20.2) ensure all input/output is UTF8, regardless of locale+</ul>++<p>+cpphs-1.20, release date 2016-03-04<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> bugfix for #if defined(FOO) && FOO(a,b)+<li> (1.20.1) fix version number+</ul>++<p>+cpphs-1.19.3, release date 2015-08-23<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> bugfix for hlint ticket #161, for+ the interaction of --unlit and --linepragma options+</ul>++<p>+cpphs-1.19.2, release date 2015-07-31<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> fix build error+</ul>++<p>+cpphs-1.19.1, release date 2015-07-30<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> don't warn about trailing comments in #ifdefs+</ul>++<p>+cpphs-1.19, release date 2015-03-30<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> expose more of the API+</ul>++<p>+cpphs-1.18.9, release date 2015-02-19<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> accept "#if defined foo" as well as "#if defined(foo)"+</ul>++<p>+cpphs-1.18.8, release date 2015-01-20<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> fix version number+</ul>++<p>+cpphs-1.18.7, release date 2015.01.17<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> bugfix to accept a #include with absolute filepath+</ul>++<p>+cpphs-1.18.6, release date 2014.10.17<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> bugfix to reject a macro usage with different arity than its definition+</ul>++<p>+cpphs-1.18.5, release date 2014.06.26<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> fix a bug related to windows filepath directory separators in #includes+</ul>++<p>+cpphs-1.18.4, release date 2014.03.22<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> fix the accidental flipping of comment-stripping behaviour+ with --cpp -traditional flags.+</ul>++<p>+cpphs-1.18.3, release date 2014.03.03<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> further rewrites of the #if expression parser, for better error messages,+ support for integer operations, and fewer precedence bugs+</ul>++<p>+cpphs-1.18.2, release date 2014.02.24<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> bugfix for erroneous boolean interpretation of some macro+ expansions in #if clauses+</ul>++<p>+cpphs-1.18.1, release date 2014.02.18<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> fix for incomplete pattern-match+</ul>++<p>+cpphs-1.18, release date 2014.02.04<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Better lexing of Template Haskell single quotes. (Thanks to Stephan Wehr)+</ul>++<p>+cpphs-1.17.1, release date 2013.08.18<br>+By HTTP:+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> (minor) Report the correct version number with <tt>cpphs --version</tt>+</ul>++<p>+cpphs-1.17, release date 2013.08.16<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.17.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Recursively evaluate #if expressions after macro expansion (bugfix).+</ul>++<p>+cpphs-1.16, release date 2013.01.22<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.16.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Fix the interaction of runCpphsReturningSymTab with --nomacro.+</ul>++<p>+cpphs-1.15, release date 2012.11.30<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.15.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Fix the interaction of --nomacro with --strip.+<li> Fix the error message received when # appears without a command.+</ul>++<p>+cpphs-1.14, release date 2012.07.11<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.14.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> New API to return symbol table after processing.+</ul>++<p>+cpphs-1.13, release date 2011.09.26<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.13.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Accept the -U commandline option for compatibility with cpp.+</ul>++<p>+cpphs-1.12, release date 2011.06.26<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.12.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Compatibility fixes for ghc-7.2.+</ul>++<p>+cpphs-1.11, release date 2010.01.31<br>+By HTTP:+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.11.tar.gz">.tar.gz</a>,+<a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.11.zip">.zip</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> Major API change: runCpphs, cppIfdef and macroPass are now in the IO monad.+</ul>++<p> cpphs-1.10, release date 2010.01.30<br> By HTTP: <a href="http://www.cs.york.ac.uk/fp/cpphs/cpphs-1.10.tar.gz">.tar.gz</a>,@@ -570,18 +808,20 @@ 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> +<li> <a href="mailto:Malcolm.Wallace@me.com">+ Malcolm.Wallace@me.com</a> </ul> -<p><b>Copyright:</b> © 2004-2010 Malcolm Wallace,-except for ParseLib (Copyright © 1995 Graham Hutton and Erik Meijer)+<p><b>Copyright:</b> © 2004-2016 Malcolm Wallace <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+for more details), with a special exception for static linking (see file <a href="COPYRIGHT">COPYRIGHT</a>. 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>).+(see file <a href="LICENCE-GPL">LICENCE-GPL</a>). If you have a+commercial use for cpphs and find the terms of the (L)GPL too onerous,+you can instead choose to distribute unmodified binaries (not source),+under the terms of <a href="LICENCE-commercial">LICENCE-commercial</a> <p> This software comes with no warranty. Use at your own risk.
+ new/TimeCompat.hs view
@@ -0,0 +1,2 @@+module TimeCompat (defaultTimeLocale) where+import Data.Time.Format (defaultTimeLocale)
− tests/Arr.lhs
@@ -1,683 +0,0 @@-\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
@@ -1,31 +0,0 @@-/* ------------------------------------------------------------------------------ *- * 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
− tests/Storable.hs
@@ -1,246 +0,0 @@-{-# 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
@@ -1,11 +0,0 @@-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
@@ -1,16 +0,0 @@-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/comments
@@ -1,3 +0,0 @@-here is an ordinary C comment: /* comment here */-and here is a C++-style end-of-line comment: // comment here-this line has no comments
− tests/config.h
− tests/cpp
@@ -1,9 +0,0 @@-#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
@@ -1,10 +0,0 @@-#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/endcode-a
@@ -1,3 +0,0 @@-\hidden{-\begin{code}-\end{code}}
− tests/endcode-b
@@ -1,4 +0,0 @@-\hidden{-\begin{code}-\end{code}-}
− tests/expect1
@@ -1,36 +0,0 @@-#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
@@ -1,15 +0,0 @@-#line 1 "multiline"-----5 back to ordinary text.-#line 1 "./inclusion"-hello world, this is an inclusion--#line 7 "multiline"-7 hello again-8 some more-9 aLongMacroDefinition(a,b)-10 end-
− tests/expect11
@@ -1,3 +0,0 @@-#line 1 "stringise"--This is "abcd ef" foo abcd ef
− tests/expect12
@@ -1,5 +0,0 @@-#line 1 "recursive"----D D D D D D D D
− tests/expect13
@@ -1,20 +0,0 @@-#line 1 "ross"- -- ----f = 4-- -----g = do { putStr "Hello "; putStrLn "World" }-- ---h = 4
− tests/expect14
@@ -1,4 +0,0 @@-#line 1 "precedence"---
− tests/expect15
@@ -1,6 +0,0 @@-#line 1 "indirect"--#line 1 "./inclusion"-hello world, this is an inclusion--#line 3 "indirect"
− tests/expect15a
@@ -1,6 +0,0 @@-#line 1 "indirect-a"--#line 1 "./inclusion"-hello world, this is an inclusion--#line 3 "indirect-a"
− tests/expect16
@@ -1,30 +0,0 @@-#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
@@ -1,2 +0,0 @@-#line 1 "pragma"-
− tests/expect18
@@ -1,1 +0,0 @@-
− tests/expect19
@@ -1,6 +0,0 @@-#line 1 "parens"-----yes
− tests/expect2
@@ -1,36 +0,0 @@-#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
@@ -1,17 +0,0 @@-#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
@@ -1,6 +0,0 @@-#line 1 "specials"--line 2-line 3-line 4 Error "horrible" at line 4 of file "specials"-line 5
− tests/expect22
@@ -1,13 +0,0 @@-#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 4 "specialinclude"-4-5
− tests/expect23
@@ -1,2 +0,0 @@-#line 1 "incomplete"-incomplete
− tests/expect24
@@ -1,15 +0,0 @@-#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
@@ -1,15 +0,0 @@-#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
@@ -1,17 +0,0 @@-#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
@@ -1,17 +0,0 @@-#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 = "6.2.2"
− tests/expect28
@@ -1,4 +0,0 @@-#line 1 "symbolvalue"--the symbol is defined as 1-
− tests/expect29
@@ -1,12 +0,0 @@-#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
@@ -1,36 +0,0 @@-#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
@@ -1,685 +0,0 @@-#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
@@ -1,11 +0,0 @@-#line 1 "elif"---import System.IO.Unsafe (unsafePerformIO)-------
− tests/expect32
@@ -1,2 +0,0 @@-#line 1 "pragma"-#pragma ident "@(#)time.h 1.39 99/08/10 SMI"
− tests/expect33
@@ -1,1 +0,0 @@-#pragma ident "@(#)time.h 1.39 99/08/10 SMI"
− tests/expect34
@@ -1,11 +0,0 @@-#line 1 "igloo"----1---foo---
− tests/expect35
@@ -1,12 +0,0 @@-#line 1 "igloo2"----baz-1---foo---
− tests/expect36
@@ -1,12 +0,0 @@-#line 1 "igloo3"----quux-FOOFOO-----bar-
− tests/expect36a
@@ -1,12 +0,0 @@-#line 1 "igloo3a"----quux-FOOFOO-----bar-
− tests/expect36b
@@ -1,13 +0,0 @@-#line 1 "igloo3b"-----quux-11---foo---
− tests/expect37
@@ -1,11 +0,0 @@-#line 1 "igloo4"---wibble-11---foo---
− tests/expect37a
@@ -1,11 +0,0 @@-#line 1 "igloo4a"---wibble-11---foo---
− tests/expect38
@@ -1,8 +0,0 @@-#line 1 "mauke"-------main = print 7 -- should print 7
− tests/expect39
@@ -1,5 +0,0 @@-#line 1 "mauke2"----4
− tests/expect4
@@ -1,39 +0,0 @@-#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 22 "testfile"----25------31 third branch of elif--33-34 end of file-
− tests/expect40
@@ -1,8 +0,0 @@-#line 1 "fasta"-------b7 = unsafeVisualize(foo)
− tests/expect40a
@@ -1,7 +0,0 @@-#line 1 "fasta2"------b6 = unsafeVisualize(foo)
− tests/expect41
@@ -1,6 +0,0 @@-#line 1 "hashjoin"-----2
− tests/expect42
@@ -1,5 +0,0 @@-#line 1 "wrongline"--2-#line 20 "foo"-20
− tests/expect43
@@ -1,6 +0,0 @@-#line 1 "param"-----11 -- gcc gives BARBAR, cpphs gives 11
− tests/expect44
@@ -1,4 +0,0 @@-#line 1 "comments"-here is an ordinary C comment: -and here is a C++-style end-of-line comment: // comment here-this line has no comments
− tests/expect44a
@@ -1,4 +0,0 @@-#line 1 "comments"-here is an ordinary C comment: -and here is a C++-style end-of-line comment: -this line has no comments
− tests/expect45
@@ -1,8 +0,0 @@-#line 1 "nestcomment"-{---foo-----}
− tests/expect46
@@ -1,7 +0,0 @@-#line 1 "preinclude"-#line 1 "./inclusion"-hello world, this is an inclusion--#line 2 "preinclude"-#line 1 "preinclude"-something arbitrary
− tests/expect47
@@ -1,5 +0,0 @@-#line 1 "endcode-a"----
− tests/expect48
@@ -1,6 +0,0 @@-#line 1 "endcode-b"-----
− tests/expect49
@@ -1,5 +0,0 @@-#line 1 "undef.hs"--wibble 3--this is FOO
− tests/expect5
@@ -1,35 +0,0 @@-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/expect50
@@ -1,9 +0,0 @@-{-# LINE 1 "linepragma" #-}-{-# LINE 1 "./inclusion" #-}-hello world, this is an inclusion--{-# LINE 2 "linepragma" #-}-{-# LINE 2 "linepragma" #-}--{-# LINE 3 "linepragma" #-}-
− tests/expect6
@@ -1,10 +0,0 @@-#line 1 "cpp"-------x ++ y = X' * 0 * y .(foo), Xprime --// /*
− tests/expect7
@@ -1,297 +0,0 @@-#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 40 "Storable.hs"-#line 1 "./config.h"-#line 41 "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
@@ -1,37 +0,0 @@-#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
@@ -1,16 +0,0 @@-#line 1 "multiline"-----5 back to ordinary text.-#line 1 "./inclusion"-hello world, this is an inclusion--#line 7 "multiline"-7 hello again-8 some more-9 some line here; - and some more; - finish now-10 end
− tests/fasta
@@ -1,7 +0,0 @@-#define XCONCAT(a, b) a##b-#define CONCAT(a, b) XCONCAT(a, b)-#define PS(val) () <- trace (val) (return ())-#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)-#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)--V(foo)
− tests/fasta2
@@ -1,6 +0,0 @@-#define XCONCAT(a, b) a##b-#define CONCAT(a, b) XCONCAT(a, b)-#define PS(val) () <- trace (val) (return ())-#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)-#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)-V(foo)
− tests/hashjoin
@@ -1,5 +0,0 @@-#define FOO 1-#define BAR FOO##FOO-#define FOOFOO 2--BAR
− tests/igloo
@@ -1,10 +0,0 @@-#define FOO 1-#define BAR FOO--BAR--#if BAR == 1-foo-#else-bar-#endif
− tests/igloo2
@@ -1,11 +0,0 @@-#define FOO 1-#define BAZ(x) x--baz-BAZ(1)--#if BAZ(1) == 1-foo-#else-bar-#endif
− tests/igloo3
@@ -1,11 +0,0 @@-#define FOO 1-#define QUUX FOO ## FOO--quux-QUUX--#if QUUX == 11-foo-#else-bar-#endif
− tests/igloo3a
@@ -1,11 +0,0 @@-#define FOO 1-#define QUUX FOO##FOO--quux-QUUX--#if QUUX == 11-foo-#else-bar-#endif
− tests/igloo3b
@@ -1,12 +0,0 @@-#define FOO 1-#define QUUX(a) a ## a-#define WIBBLE QUUX(FOO)--quux-WIBBLE--#if WIBBLE == 11-foo-#else-bar-#endif
− tests/igloo4
@@ -1,10 +0,0 @@-#define WIBBLE 1 ## 1--wibble-WIBBLE--#if WIBBLE == 11-foo-#else-bar-#endif
− tests/igloo4a
@@ -1,10 +0,0 @@-#define WIBBLE 1##1--wibble-WIBBLE--#if WIBBLE == 11-foo-#else-bar-#endif
− tests/inclusion
@@ -1,1 +0,0 @@-hello world, this is an inclusion
− tests/incomplete
@@ -1,1 +0,0 @@-incomplete
− tests/indirect
@@ -1,2 +0,0 @@-#define F "inclusion"-#include F
− tests/indirect-a
@@ -1,2 +0,0 @@-#define F(f) in##f-#include F(clusion)
− tests/linepragma
@@ -1,5 +0,0 @@-#include "inclusion"-#line 2 "linepragma"--#line 3 "linepragma"-
− tests/mauke
@@ -1,7 +0,0 @@-#define X /\-* comment */ main--#define Y _\-_LINE__--X = print Y -- should print 7
− tests/mauke2
@@ -1,4 +0,0 @@-#define foo _\-_LINE__--foo
− tests/multiline
@@ -1,10 +0,0 @@-#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
@@ -1,16 +0,0 @@-#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/nestcomment
@@ -1,7 +0,0 @@-{--#if 1-foo-#else-bar-#endif--}
− tests/numbers
@@ -1,29 +0,0 @@-#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/param
@@ -1,5 +0,0 @@-#define FOO 1-#define BAR FOO-#define JOIN(f) f##f--JOIN(BAR) -- gcc gives BARBAR, cpphs gives 11
− tests/parens
@@ -1,5 +0,0 @@-#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \- || ( defined(__NHC__) && __NHC__ >= 117 )-#define FINALIZERPTR yes-#endif-FINALIZERPTR
− tests/pragma
@@ -1,1 +0,0 @@-#pragma ident "@(#)time.h 1.39 99/08/10 SMI" /* SVr4.0 1.18 */
− tests/precedence
@@ -1,3 +0,0 @@-#if !0 && 0-boolean operator precedence is wrong-#endif
− tests/preinclude
@@ -1,1 +0,0 @@-something arbitrary
− tests/recursive
@@ -1,4 +0,0 @@-#define C D D-#define B C C-#define A B B-A
− tests/ross
@@ -1,19 +0,0 @@-/* 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
@@ -1,71 +0,0 @@-#!/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 --hashes indirect-a" expect15a-runtest "$CPPHS numbers" expect16-runtest "$CPPHS pragma" expect17 # see also test 32-runtest "$CPPHS --noline pragma" expect18 # see also test 33-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-runtest "$CPPHS --pragma pragma" expect32-runtest "$CPPHS --pragma --noline pragma" expect33-runtest "$CPPHS igloo" expect34-runtest "$CPPHS igloo2" expect35-runtest "$CPPHS --hashes igloo3" expect36-runtest "$CPPHS --hashes igloo3a" expect36a-runtest "$CPPHS --hashes igloo3b" expect36b-runtest "$CPPHS --hashes igloo4" expect37-runtest "$CPPHS --hashes igloo4a" expect37a-runtest "$CPPHS mauke" expect38-runtest "$CPPHS mauke2" expect39-runtest "$CPPHS --hashes fasta" expect40-runtest "$CPPHS --hashes fasta2" expect40a-runtest "$CPPHS --hashes hashjoin" expect41-runtest "$CPPHS wrongline" expect42-runtest "$CPPHS --hashes param" expect43-runtest "$CPPHS --strip comments" expect44-runtest "$CPPHS --strip-eol comments" expect44a-runtest "$CPPHS nestcomment" expect45-runtest "$CPPHS --include=inclusion preinclude" expect46-runtest "$CPPHS --unlit endcode-a" expect47-runtest "$CPPHS --unlit endcode-b" expect48-runtest "$CPPHS undef.hs" expect49-runtest "$CPPHS --linepragma linepragma" expect50-exit $FAIL
− tests/specialinclude
@@ -1,5 +0,0 @@-1-2-#include "specials"-4-5
− tests/specials
@@ -1,5 +0,0 @@-#define error(s) Error #s at line __LINE__ of file __FILE__-line 2-line 3-line 4 error(horrible)-line 5
− tests/stringise
@@ -1,2 +0,0 @@-#define foo(x) This is #x foo x-foo(abcd ef)
− tests/symbolvalue
@@ -1,3 +0,0 @@-#if XXX-the symbol is defined as XXX-#endif
− tests/testfile
@@ -1,34 +0,0 @@-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
@@ -1,14 +0,0 @@-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)".
− tests/undef.hs
@@ -1,4 +0,0 @@-#define FOO 3-wibble FOO-#undef FOO-this is FOO
− tests/wrongline
@@ -1,4 +0,0 @@-#define whereami __LINE__-whereami-#line 20 "foo"-__LINE__