cpphs 1.16 → 1.17

raw patch · 120 files changed

+34/−3192 lines, 120 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• Language/Preprocessor/Cpphs/CppIfdef.hs +1/−1
• Language/Preprocessor/Cpphs/Options.hs +8/−4
• Language/Preprocessor/Cpphs/RunCpphs.hs +6/−3
• Makefile +0/−56
• cpphs.cabal +2/−2
• cpphs.compat +0/−48
• cpphs.hugs +0/−2
• docs/design +0/−29
• docs/index.html +13/−3
• 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/expect51 +0/−7
• tests/expect52 +0/−8
• tests/expect53 +0/−7
• tests/expect54 +0/−7
• 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/nomacro +0/−6
• 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/−75
• 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

@@ -1,3 +1,7 @@+Version 1.17+------------+  * recursively evaluate #if expressions after macro expansion (fix)+ Version 1.16 ------------   * fix interaction of runCpphsReturningSymTab with --nomacro

@@ -265,7 +265,7 @@       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

@@ -17,6 +17,7 @@   , parseOptions   , defaultCpphsOptions   , defaultBoolOptions+  , trailing   ) where  import Data.Maybe@@ -28,7 +29,7 @@     , outfiles	:: [FilePath]     , defines	:: [(String,String)]     , includes	:: [String]-    , preInclude:: [FilePath]	-- ^ Files to #include before anything else+    , preInclude:: [FilePath]	-- ^ Files to \#include before anything else     , boolopts	:: BoolOptions     } @@ -42,9 +43,9 @@ -- | 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?+    , 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?@@ -110,6 +111,9 @@             = 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 

@@ -10,13 +10,15 @@  import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef) import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab)-import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..))+import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..)+                                            ,trailing) import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise) import Language.Preprocessor.Unlit as Unlit (unlit)   runCpphs :: CpphsOptions -> FilePath -> String -> IO String-runCpphs options filename input = do+runCpphs options' filename input = do+  let options= options'{ includes= map (trailing "\\/") (includes options') }   let bools  = boolopts options       preInc = case preInclude options of                  [] -> ""@@ -39,7 +41,8 @@  runCpphsReturningSymTab :: CpphsOptions -> FilePath -> String              -> IO (String,[(String,String)])-runCpphsReturningSymTab options filename input = do+runCpphsReturningSymTab options' filename input = do+  let options= options'{ includes= map (trailing "\\/") (includes options') }   let bools  = boolopts options       preInc = case preInclude options of                  [] -> ""

@@ -1,56 +0,0 @@-LIBRARY = cpphs-VERSION = 1.16--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) $@

@@ -1,6 +1,6 @@ Name: cpphs-Version: 1.16-Copyright: 2004-2012, Malcolm Wallace+Version: 1.17+Copyright: 2004-2013, Malcolm Wallace License: LGPL License-File: LICENCE-LGPL Cabal-Version: >= 1.6

@@ -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 "$@"`

@@ -1,2 +0,0 @@-#!/bin/sh-runhugs cpphs.hs --noline -D__HASKELL98__ -D__HUGS__ "$@"

@@ -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

@@ -198,12 +198,12 @@ <b>Current stable version:</b>  <p>-cpphs-1.16, release date 2013.01.22<br>+cpphs-1.17, release date 2013.08.16<br> By HTTP:-<a href="http://code.haskell.org/cpphs/cpphs-1.16.tar.gz">.tar.gz</a>,+<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> Fix the interaction of runCpphsReturningSymTab with --nomacro.+<li> Recursively evaluate #if expressions after macro expansion (bugfix). </ul>  <p>@@ -226,6 +226,16 @@ <p> <b>Older versions:</b> +++<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>

@@ -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}

@@ -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 ())

@@ -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

@@ -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;}--}-

@@ -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

@@ -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

@@ -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' --//  /*

@@ -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

@@ -1,3 +0,0 @@-\hidden{-\begin{code}-\end{code}}

@@ -1,4 +0,0 @@-\hidden{-\begin{code}-\end{code}-}

@@ -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-

@@ -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-

@@ -1,3 +0,0 @@-#line 1 "stringise"--This is "abcd ef" foo abcd ef

@@ -1,5 +0,0 @@-#line 1 "recursive"----D D D D D D D D

@@ -1,20 +0,0 @@-#line 1 "ross"-                                                         --                           ----f = 4--                                                             -----g = do { putStr "Hello ";   putStrLn "World" }--                          ---h = 4

@@ -1,4 +0,0 @@-#line 1 "precedence"---

@@ -1,6 +0,0 @@-#line 1 "indirect"--#line 1 "./inclusion"-hello world, this is an inclusion--#line 3 "indirect"

@@ -1,6 +0,0 @@-#line 1 "indirect-a"--#line 1 "./inclusion"-hello world, this is an inclusion--#line 3 "indirect-a"

@@ -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-

@@ -1,2 +0,0 @@-#line 1 "pragma"-

@@ -1,1 +0,0 @@-

@@ -1,6 +0,0 @@-#line 1 "parens"-----yes

@@ -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-

@@ -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---

@@ -1,6 +0,0 @@-#line 1 "specials"--line 2-line 3-line 4  Error "horrible" at line 4 of file "specials"-line 5

@@ -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

@@ -1,2 +0,0 @@-#line 1 "incomplete"-incomplete

@@ -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)".

@@ -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.".

@@ -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"

@@ -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"

@@ -1,4 +0,0 @@-#line 1 "symbolvalue"--the symbol is defined as 1-

@@ -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;}--}-

@@ -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-

@@ -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# #) }--

@@ -1,11 +0,0 @@-#line 1 "elif"---import System.IO.Unsafe (unsafePerformIO)-------

@@ -1,2 +0,0 @@-#line 1 "pragma"-#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"                

@@ -1,1 +0,0 @@-#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"                

@@ -1,11 +0,0 @@-#line 1 "igloo"----1---foo---

@@ -1,12 +0,0 @@-#line 1 "igloo2"----baz-1---foo---

@@ -1,12 +0,0 @@-#line 1 "igloo3"----quux-FOOFOO-----bar-

@@ -1,12 +0,0 @@-#line 1 "igloo3a"----quux-FOOFOO-----bar-

@@ -1,13 +0,0 @@-#line 1 "igloo3b"-----quux-11---foo---

@@ -1,11 +0,0 @@-#line 1 "igloo4"---wibble-11---foo---

@@ -1,11 +0,0 @@-#line 1 "igloo4a"---wibble-11---foo---

@@ -1,8 +0,0 @@-#line 1 "mauke"-------main = print 7 -- should print 7

@@ -1,5 +0,0 @@-#line 1 "mauke2"----4

@@ -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-

@@ -1,8 +0,0 @@-#line 1 "fasta"-------b7 = unsafeVisualize(foo)

@@ -1,7 +0,0 @@-#line 1 "fasta2"------b6 = unsafeVisualize(foo)

@@ -1,6 +0,0 @@-#line 1 "hashjoin"-----2

@@ -1,5 +0,0 @@-#line 1 "wrongline"--2-#line 20 "foo"-20

@@ -1,6 +0,0 @@-#line 1 "param"-----11	-- gcc gives BARBAR, cpphs gives 11

@@ -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

@@ -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

@@ -1,8 +0,0 @@-#line 1 "nestcomment"-{---foo-----}

@@ -1,7 +0,0 @@-#line 1 "preinclude"-#line 1 "./inclusion"-hello world, this is an inclusion--#line 2 "preinclude"-#line 1 "preinclude"-something arbitrary

@@ -1,5 +0,0 @@-#line 1 "endcode-a"----

@@ -1,6 +0,0 @@-#line 1 "endcode-b"-----

@@ -1,5 +0,0 @@-#line 1 "undef.hs"--wibble 3--this is FOO

@@ -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

@@ -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" #-}-

@@ -1,7 +0,0 @@-#line 1 "nomacro"-This file is intended to show the interaction of --nomacro with --strip-which was broken up until cpphs-1.14.--Here is a line with some comment // to eol-Here is a line with some C89 comment /* inlined */ with more text after it.-Here is a line that uses 1 but it should look like uppercase foo, not 1.

@@ -1,8 +0,0 @@-#line 1 "nomacro"-This file is intended to show the interaction of --nomacro with --strip-which was broken up until cpphs-1.14.--Here is a line with some comment // to eol-Here is a line with some C89 comment /* inlined */ with more text after it.-Here is a line that uses FOO but it should look like uppercase foo, not 1.-

@@ -1,7 +0,0 @@-#line 1 "nomacro"-This file is intended to show the interaction of --nomacro with --strip-which was broken up until cpphs-1.14.--Here is a line with some comment          -Here is a line with some C89 comment               with more text after it.-Here is a line that uses FOO but it should look like uppercase foo, not 1.

@@ -1,7 +0,0 @@-#line 1 "nomacro"-This file is intended to show the interaction of --nomacro with --strip-which was broken up until cpphs-1.14.--Here is a line with some comment          -Here is a line with some C89 comment               with more text after it.-Here is a line that uses 1 but it should look like uppercase foo, not 1.

@@ -1,10 +0,0 @@-#line 1 "cpp"-------x ++ y = X' * 0 * y .(foo), Xprime --//  /*

@@ -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 }--

@@ -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 #-}

@@ -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

@@ -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)

@@ -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)

@@ -1,5 +0,0 @@-#define FOO 1-#define BAR FOO##FOO-#define FOOFOO 2--BAR

@@ -1,10 +0,0 @@-#define FOO 1-#define BAR FOO--BAR--#if BAR == 1-foo-#else-bar-#endif

@@ -1,11 +0,0 @@-#define FOO 1-#define BAZ(x) x--baz-BAZ(1)--#if BAZ(1) == 1-foo-#else-bar-#endif

@@ -1,11 +0,0 @@-#define FOO 1-#define QUUX FOO ## FOO--quux-QUUX--#if QUUX == 11-foo-#else-bar-#endif

@@ -1,11 +0,0 @@-#define FOO 1-#define QUUX FOO##FOO--quux-QUUX--#if QUUX == 11-foo-#else-bar-#endif

@@ -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

@@ -1,10 +0,0 @@-#define WIBBLE 1 ## 1--wibble-WIBBLE--#if WIBBLE == 11-foo-#else-bar-#endif

@@ -1,10 +0,0 @@-#define WIBBLE 1##1--wibble-WIBBLE--#if WIBBLE == 11-foo-#else-bar-#endif

@@ -1,1 +0,0 @@-hello world, this is an inclusion

@@ -1,1 +0,0 @@-incomplete

@@ -1,2 +0,0 @@-#define F "inclusion"-#include F

@@ -1,2 +0,0 @@-#define F(f) in##f-#include F(clusion)

@@ -1,5 +0,0 @@-#include "inclusion"-#line 2 "linepragma"--#line 3 "linepragma"-

@@ -1,7 +0,0 @@-#define X /\-* comment */ main--#define Y _\-_LINE__--X = print Y -- should print 7

@@ -1,4 +0,0 @@-#define foo _\-_LINE__--foo

@@ -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

@@ -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)

@@ -1,7 +0,0 @@-{--#if 1-foo-#else-bar-#endif--}

@@ -1,6 +0,0 @@-This file is intended to show the interaction of --nomacro with --strip-which was broken up until cpphs-1.14.-#define FOO 1-Here is a line with some comment // to eol-Here is a line with some C89 comment /* inlined */ with more text after it.-Here is a line that uses FOO but it should look like uppercase foo, not 1.

@@ -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

@@ -1,5 +0,0 @@-#define FOO 1-#define BAR FOO-#define JOIN(f)  f##f--JOIN(BAR)	-- gcc gives BARBAR, cpphs gives 11

@@ -1,5 +0,0 @@-#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \-    || ( defined(__NHC__) && __NHC__ >= 117 )-#define FINALIZERPTR yes-#endif-FINALIZERPTR

@@ -1,1 +0,0 @@-#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"   /* SVr4.0 1.18 */

@@ -1,3 +0,0 @@-#if !0 && 0-boolean operator precedence is wrong-#endif

@@ -1,1 +0,0 @@-something arbitrary

@@ -1,4 +0,0 @@-#define C D D-#define B C C-#define A B B-A

@@ -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)

@@ -1,75 +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-runtest "$CPPHS nomacro" expect51-runtest "$CPPHS --nomacro nomacro" expect52-runtest "$CPPHS --nomacro --strip-eol nomacro" expect53-runtest "$CPPHS --strip-eol nomacro" expect54-exit $FAIL

@@ -1,5 +0,0 @@-1-2-#include "specials"-4-5

@@ -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

@@ -1,2 +0,0 @@-#define foo(x)	This is #x foo x-foo(abcd ef)

@@ -1,3 +0,0 @@-#if XXX-the symbol is defined as XXX-#endif

@@ -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

@@ -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)".

@@ -1,4 +0,0 @@-#define FOO 3-wibble FOO-#undef FOO-this is FOO

@@ -1,4 +0,0 @@-#define whereami __LINE__-whereami-#line 20 "foo"-__LINE__