packages feed

cpphs 1.14 → 1.15

raw patch · 122 files changed

+3235/−17 lines, 122 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG view
@@ -1,3 +1,8 @@+Version 1.15+------------+  * Fix the interaction of --nomacro with --strip.+  * Fix the error message received when # appears without a command.+ Version 1.14 ------------   * New API to return symbol table after processing.
Language/Preprocessor/Cpphs/CppIfdef.hs view
@@ -32,6 +32,7 @@ import Numeric   (readHex,readOct,readDec) import System.IO.Unsafe (unsafeInterleaveIO) import System.IO        (hPutStrLn,stderr)+import Control.Monad (when)   -- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,@@ -71,7 +72,7 @@  cpp p syms path options (Keep ps) (l@('#':x):xs) =     let ws = words x-        cmd = head ws+        cmd = if null ws then "" else head ws         line = tail ws         sym  = head (tail ws)         rest = tail (tail ws)@@ -115,24 +116,22 @@                      else id) $                     cpp (newpos (read sym) (un rest) p)                         syms path options (Keep ps) xs-	n | all isDigit n+	n | all isDigit n && not (null n) 	         -> (if locations options && hashline options then emitOne (p,l)                      else if locations options then emitOne (p,cpp2hask l)                      else id) $ 	            cpp (newpos (read n) (un (tail ws)) p)                         syms path options (Keep ps) xs           | otherwise-	         -> if warnings options then-                      do hPutStrLn stderr ("Warning: unknown directive #"++n-                                           ++"\nin "++show p)-                         emitOne (p,l) $-                                 cpp (newline p) syms path options (Keep ps) xs-                    else emitOne (p,l) $-                                 cpp (newline p) syms path options (Keep ps) xs+	         -> do when (warnings options) $+                           hPutStrLn stderr ("Warning: unknown directive #"++n+                                             ++"\nin "++show p)+                       emitOne (p,l) $+                               cpp (newline p) syms path options (Keep ps) xs  cpp p syms path options (Drop n b ps) (('#':x):xs) =     let ws = words x-        cmd = head ws+        cmd = if null ws then "" else head ws         delse    | n==1 && b = Drop 1 b ps                  | n==1      = Keep ps                  | otherwise = Drop n b ps
Language/Preprocessor/Cpphs/RunCpphs.hs view
@@ -11,6 +11,7 @@ import Language.Preprocessor.Cpphs.CppIfdef (cppIfdef) import Language.Preprocessor.Cpphs.MacroPass(macroPass,macroPassReturningSymTab) import Language.Preprocessor.Cpphs.Options  (CpphsOptions(..), BoolOptions(..))+import Language.Preprocessor.Cpphs.Tokenise (deWordStyle, tokenise) import Language.Preprocessor.Unlit as Unlit (unlit)  @@ -25,7 +26,13 @@   pass1 <- cppIfdef filename (defines options) (includes options) bools                     (preInc++input)   pass2 <- macroPass (defines options) bools pass1-  let result= if not (macros bools) then unlines (map snd pass1) else pass2+  let result= if not (macros bools)+              then if   stripC89 bools || stripEol bools+                   then concatMap deWordStyle $+                        tokenise (stripC89 bools) (stripEol bools)+                                 (ansi bools) (lang bools) pass1+                   else unlines (map snd pass1)+              else pass2       pass3 = if literate bools then Unlit.unlit filename else id    return (pass3 result)@@ -42,7 +49,13 @@   pass1 <- cppIfdef filename (defines options) (includes options) bools                     (preInc++input)   (pass2,syms) <- macroPassReturningSymTab (defines options) bools pass1-  let result= if not (macros bools) then unlines (map snd pass1) else pass2+  let result= if not (macros bools)+              then if   stripC89 bools || stripEol bools+                   then concatMap deWordStyle $+                        tokenise (stripC89 bools) (stripEol bools)+                                 (ansi bools) (lang bools) pass1+                   else unlines (map snd pass1)+              else pass2       pass3 = if literate bools then Unlit.unlit filename else id    return (pass3 result, syms)
+ Makefile view
@@ -0,0 +1,56 @@+LIBRARY = cpphs+VERSION = 1.15++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) $@
cpphs.cabal view
@@ -1,5 +1,5 @@ Name: cpphs-Version: 1.14+Version: 1.15 Copyright: 2004-2012, Malcolm Wallace License: LGPL License-File: LICENCE-LGPL
+ cpphs.compat view
@@ -0,0 +1,48 @@+#!/bin/sh+#	A minimal compatibility script to make cpphs accept the same+#	arguments as real cpp, wherever possible.+CPPHS=/usr/malcolm/Haskell/cpphs/cpphs++processArgs () {+  TRADITIONAL=no+  STRIP=yes+  INFILE="-"+  OUTFILE="-"+  while test "$1" != ""+  do+    case $1 in+      -D)            shift; echo -D$1 ;;+      -D*)           echo $1 ;;+      -U)            shift; echo -U$1 ;;+      -U*)           echo $1 ;;+      -I)            shift; echo -I$1 ;;+      -I*)           echo $1 ;;+      -o)            shift; echo -O$1 ;;+      -o*)           echo -O`echo $1 | cut -c3-` ;;+      -std*)         ;;		# ignore language spec+      -x)            shift ;;	# ignore language spec+      -ansi*)        TRADITIONAL=no ;;+      -traditional*) TRADITIONAL=yes ;;+      -include)      shift; echo $1 ;;+      -P)            echo --noline ;;+      -C)            STRIP=no ;;+      -CC)           STRIP=no ;;+      -A)            shift ;;	# strip assertions+      --help)        echo $1 ;;+      -version)      echo -$1 ;;+      --version)     echo $1 ;;+      -*)            ;;	# strip all other flags+      *)     if [ "$INFILE" = "-" ]+             then INFILE=$1+             else OUTFILE=$1+             fi ;;+    esac+    if test "$1" != ""; then shift; fi+  done+  if [ "$TRADITIONAL" = "no" ]; then echo "--hashes";   fi+  if [ "$STRIP" = "yes" ];      then echo "--strip";    fi+  echo $INFILE+  if [ "$OUTFILE" != "-" ];     then echo "-O$OUTFILE"; fi+}++exec $CPPHS `processArgs "$@"`
cpphs.hs view
@@ -20,7 +20,7 @@ import Data.List   ( isPrefixOf )  version :: String-version = "1.14"+version = "1.15"  main :: IO () main = do
+ cpphs.hugs view
@@ -0,0 +1,2 @@+#!/bin/sh+runhugs cpphs.hs --noline -D__HASKELL98__ -D__HUGS__ "$@"
+ docs/design view
@@ -0,0 +1,29 @@+Design for hspp++First pass:+-----------+  * traverse the file,+      - processing #if's and #ifdef's+      - reading #include's and recursively doing this pass on them+      - leaving #line's behind+      - whilst taking account of #define's and #undef's+  * only needs to look at lines beginning with a #+  * should discard C-style comments?  (no)+  * DO NOT gather the #define's for macros - their sequence matters!++pass1 :: SymTab -> String -> String++Second pass:+------------+  * traverse the residual file,+      - keeping track of #define'd macros+      - expanding #define'd macros when an instance is encountered+  * needs a whitespace-preserving tokeniser with odd rules to+    cover e.g. token concatenation.  Within Haskell, quotation marks start+    strings, haskell comments are preserved.  Within a cpp directive,+    quotation marks do not start a string, and C-style comments are+    converted to whitespace.+  * Line continuation characters are tricky; probably should only+    be recognised within a macro definition, not in ordinary code.++pass2 :: SymTab -> String -> String
docs/index.html view
@@ -198,12 +198,13 @@ <b>Current stable version:</b>  <p>-cpphs-1.14, release date 2012.07.11<br>+cpphs-1.15, release date 2012.11.30<br> By HTTP:-<a href="http://code.haskell.org/cpphs/cpphs-1.14.tar.gz">.tar.gz</a>,+<a href="http://code.haskell.org/cpphs/cpphs-1.15.tar.gz">.tar.gz</a>, <a href="http://hackage.haskell.org/package/cpphs">Hackage</a>. <ul>-<li> New API to return symbol table after processing.+<li> Fix the interaction of --nomacro with --strip.+<li> Fix the error message received when # appears without a command. </ul>  <p>@@ -226,6 +227,15 @@ <p> <b>Older versions:</b> ++<p>+cpphs-1.14, release date 2012.07.11<br>+By HTTP:+<a href="http://code.haskell.org/cpphs/cpphs-1.14.tar.gz">.tar.gz</a>,+<a href="http://hackage.haskell.org/package/cpphs">Hackage</a>.+<ul>+<li> New API to return symbol table after processing.+</ul>  <p> cpphs-1.13, release date 2011.09.26<br>
+ tests/Arr.lhs view
@@ -0,0 +1,683 @@+\begin{code}+{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Arr+-- Copyright   :  (c) The University of Glasgow, 1994-2000+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC extensions)+--+-- GHC\'s array implementation.+-- +-----------------------------------------------------------------------------++-- #hide+module GHC.Arr where++import {-# SOURCE #-} GHC.Err ( error )+import GHC.Enum+import GHC.Num+import GHC.ST+import GHC.Base+import GHC.List+import GHC.Show++infixl 9  !, //++default ()+\end{code}+++%*********************************************************+%*							*+\subsection{The @Ix@ class}+%*							*+%*********************************************************++\begin{code}+-- | The 'Ix' class is used to map a contiguous subrange of values in+-- a type onto integers.  It is used primarily for array indexing+-- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").+--+-- The first argument @(l,u)@ of each of these operations is a pair+-- specifying the lower and upper bounds of a contiguous subrange of values.+--+-- An implementation is entitled to assume the following laws about these+-- operations:+--+-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@+--+-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@+--+-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@+--+-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@+--+-- Minimal complete instance: 'range', 'index' and 'inRange'.+--+class (Ord a) => Ix a where+    -- | The list of values in the subrange defined by a bounding pair.+    range		:: (a,a) -> [a]+    -- | The position of a subscript in the subrange.+    index		:: (a,a) -> a -> Int+    -- | Like 'index', but without checking that the value is in range.+    unsafeIndex		:: (a,a) -> a -> Int+    -- | Returns 'True' the given subscript lies in the range defined+    -- the bounding pair.+    inRange		:: (a,a) -> a -> Bool+    -- | The size of the subrange defined by a bounding pair.+    rangeSize		:: (a,a) -> Int+    -- | like 'rangeSize', but without checking that the upper bound is+    -- in range.+    unsafeRangeSize     :: (a,a) -> Int++	-- Must specify one of index, unsafeIndex+    index b i | inRange b i = unsafeIndex b i	+	      | otherwise   = error "Error in array index"+    unsafeIndex b i = index b i++    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1+		       | otherwise   = 0	-- This case is only here to+						-- check for an empty range+	-- NB: replacing (inRange b h) by (l <= h) fails for+	--     tuples.  E.g.  (1,2) <= (2,1) but the range is empty++    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1+\end{code}++Note that the following is NOT right+	rangeSize (l,h) | l <= h    = index b h + 1+			| otherwise = 0++Because it might be the case that l<h, but the range+is nevertheless empty.  Consider+	((1,2),(2,1))+Here l<h, but the second index ranges from 2..1 and+hence is empty++%*********************************************************+%*							*+\subsection{Instances of @Ix@}+%*							*+%*********************************************************++\begin{code}+-- abstract these errors from the relevant index functions so that+-- the guts of the function will be small enough to inline.++{-# NOINLINE indexError #-}+indexError :: Show a => (a,a) -> a -> String -> b+indexError rng i tp+  = error (showString "Ix{" . showString tp . showString "}.index: Index " .+           showParen True (showsPrec 0 i) .+	   showString " out of range " $+	   showParen True (showsPrec 0 rng) "")++----------------------------------------------------------------------+instance  Ix Char  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = fromEnum i - fromEnum m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Char"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance  Ix Int  where+    {-# INLINE range #-}+	-- The INLINE stops the build in the RHS from getting inlined,+	-- so that callers can fuse with the result of range+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = i - m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Int"++    {-# INLINE inRange #-}+    inRange (I# m,I# n) (I# i) =  m <=# i && i <=# n++----------------------------------------------------------------------+instance  Ix Integer  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i   = fromInteger (i - m)++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Integer"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance Ix Bool where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Bool"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix Ordering where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Ordering"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix () where+    {-# INLINE range #-}+    range   ((), ())    = [()]+    {-# INLINE unsafeIndex #-}+    unsafeIndex   ((), ()) () = 0+    {-# INLINE inRange #-}+    inRange ((), ()) () = True+    {-# INLINE index #-}+    index b i = unsafeIndex b i++----------------------------------------------------------------------+instance (Ix a, Ix b) => Ix (a, b) where -- as derived+    {-# SPECIALISE instance Ix (Int,Int) #-}++    {- INLINE range #-}+    range ((l1,l2),(u1,u2)) =+      [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]++    {- INLINE unsafeIndex #-}+    unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =+      unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2++    {- INLINE inRange #-}+    inRange ((l1,l2),(u1,u2)) (i1,i2) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where+    {-# SPECIALISE instance Ix (Int,Int,Int) #-}++    range ((l1,l2,l3),(u1,u2,u3)) =+        [(i1,i2,i3) | i1 <- range (l1,u1),+                      i2 <- range (l2,u2),+                      i3 <- range (l3,u3)]++    unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))++    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where+    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =+      [(i1,i2,i3,i4) | i1 <- range (l1,u1),+                       i2 <- range (l2,u2),+                       i3 <- range (l3,u3),+                       i4 <- range (l4,u4)]++    unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1)))++    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4++    -- Default method for index++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where+    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =+      [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),+                          i2 <- range (l2,u2),+                          i3 <- range (l3,u3),+                          i4 <- range (l4,u4),+                          i5 <- range (l5,u5)]++    unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))))++    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4 && +      inRange (l5,u5) i5++    -- Default method for index+\end{code}++%*********************************************************+%*							*+\subsection{The @Array@ types}+%*							*+%*********************************************************++\begin{code}+type IPr = (Int, Int)++-- | The type of immutable non-strict (boxed) arrays+-- with indices in @i@ and elements in @e@.+data Ix i => Array     i e = Array   !i !i (Array# e)++-- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type+-- arguments are as follows:+--+--  * @s@: the state variable argument for the 'ST' type+--+--  * @i@: the index type of the array (should be an instance of 'Ix')+--+--  * @e@: the element type of the array.+--+data         STArray s i e = STArray !i !i (MutableArray# s e)+	-- No Ix context for STArray.  They are stupid,+	-- and force an Ix context on the equality instance.++-- Just pointer equality on mutable arrays:+instance Eq (STArray s i e) where+    STArray _ _ arr1# == STArray _ _ arr2# =+        sameMutableArray# arr1# arr2#+\end{code}+++%*********************************************************+%*							*+\subsection{Operations on immutable arrays}+%*							*+%*********************************************************++\begin{code}+{-# NOINLINE arrEleBottom #-}+arrEleBottom :: a+arrEleBottom = error "(Array.!): undefined array element"++-- | Construct an array with the specified bounds and containing values+-- for given indices within these bounds.+--+-- The array is undefined (i.e. bottom) if any index in the list is+-- out of bounds.  The Haskell 98 Report further specifies that if any+-- two associations in the list have the same index, the value at that+-- index is undefined (i.e. bottom).  However in GHC's implementation,+-- the value at such an index is the value part of the last association+-- with that index in the list.+--+-- Because the indices must be checked for these errors, 'array' is+-- strict in the bounds argument and in the indices of the association+-- list, but nonstrict in the values.  Thus, recurrences such as the+-- following are possible:+--+-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])+--+-- Not every index within the bounds of the array need appear in the+-- association list, but the values associated with indices that do not+-- appear will be undefined (i.e. bottom).+--+-- If, in any dimension, the lower bound is greater than the upper bound,+-- then the array is legal, but empty.  Indexing an empty array always+-- gives an array-bounds error, but 'bounds' still yields the bounds+-- with which the array was constructed.+{-# INLINE array #-}+array :: Ix i+	=> (i,i)	-- ^ a pair of /bounds/, each of the index type+			-- of the array.  These bounds are the lowest and+			-- highest indices in the array, in that order.+			-- For example, a one-origin vector of length+			-- '10' has bounds '(1,10)', and a one-origin '10'+			-- by '10' matrix has bounds '((1,1),(10,10))'.+	-> [(i, e)]	-- ^ a list of /associations/ of the form+			-- (/index/, /value/).  Typically, this list will+			-- be expressed as a comprehension.  An+			-- association '(i, x)' defines the value of+			-- the array at index 'i' to be 'x'.+	-> Array i e+array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeArray #-}+unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e+unsafeArray (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    foldr (fill marr#) (done l u marr#) ies s2# }})++{-# INLINE fill #-}+fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a+fill marr# (I# i#, e) next s1# =+    case writeArray# marr# i# e s1#     of { s2# ->+    next s2# }++{-# INLINE done #-}+done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)+done l u marr# s1# =+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++-- This is inefficient and I'm not sure why:+-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)+-- The code below is better. It still doesn't enable foldr/build+-- transformation on the list of elements; I guess it's impossible+-- using mechanisms currently available.++-- | Construct an array from a pair of bounds and a list of values in+-- index order.+{-# INLINE listArray #-}+listArray :: Ix i => (i,i) -> [e] -> Array i e+listArray (l,u) es = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let fillFromList i# xs s3# | i# ==# n# = s3#+                               | otherwise = case xs of+            []   -> s3#+            y:ys -> case writeArray# marr# i# y s3# of { s4# ->+                    fillFromList (i# +# 1#) ys s4# } in+    case fillFromList 0# es s2#         of { s3# ->+    done l u marr# s3# }}})++-- | The value at the given index in an array.+{-# INLINE (!) #-}+(!) :: Ix i => Array i e -> i -> e+arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)++{-# INLINE unsafeAt #-}+unsafeAt :: Ix i => Array i e -> Int -> e+unsafeAt (Array _ _ arr#) (I# i#) =+    case indexArray# arr# i# of (# e #) -> e++-- | The bounds with which an array was constructed.+{-# INLINE bounds #-}+bounds :: Ix i => Array i e -> (i,i)+bounds (Array l u _) = (l,u)++-- | The list of indices of an array in ascending order.+{-# INLINE indices #-}+indices :: Ix i => Array i e -> [i]+indices (Array l u _) = range (l,u)++-- | The list of elements of an array in index order.+{-# INLINE elems #-}+elems :: Ix i => Array i e -> [e]+elems arr@(Array l u _) =+    [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]++-- | The list of associations of an array in index order.+{-# INLINE assocs #-}+assocs :: Ix i => Array i e -> [(i, e)]+assocs arr@(Array l u _) =+    [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]++-- | The 'accumArray' deals with repeated indices in the association+-- list using an /accumulating function/ which combines the values of+-- associations with the same index.+-- For example, given a list of values of some index type, @hist@+-- produces a histogram of the number of occurrences of each index within+-- a specified range:+--+-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b+-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]+--+-- If the accumulating function is strict, then 'accumArray' is strict in+-- the values, as well as the indices, in the association list.  Thus,+-- unlike ordinary arrays built with 'array', accumulated arrays should+-- not in general be recursive.+{-# INLINE accumArray #-}+accumArray :: Ix i+	=> (e -> a -> e)	-- ^ accumulating function+	-> e			-- ^ initial value+	-> (i,i)		-- ^ bounds of the array+	-> [(i, a)]		-- ^ association list+	-> Array i e+accumArray f init (l,u) ies =+    unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccumArray #-}+unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e+unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    foldr (adjust f marr#) (done l u marr#) ies s2# }})++{-# INLINE adjust #-}+adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b+adjust f marr# (I# i#, new) next s1# =+    case readArray# marr# i# s1#        of { (# s2#, old #) ->+    case writeArray# marr# i# (f old new) s2# of { s3# ->+    next s3# }}++-- | Constructs an array identical to the first argument except that it has+-- been updated by the associations in the right argument.+-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then+--+-- > m//[((i,i), 0) | i <- [1..n]]+--+-- is the same matrix, except with the diagonal zeroed.+--+-- Repeated indices in the association list are handled as for 'array':+-- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),+-- but GHC's implementation uses the last association for each index.+{-# INLINE (//) #-}+(//) :: Ix i => Array i e -> [(i, e)] -> Array i e+arr@(Array l u _) // ies =+    unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeReplace #-}+unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e+unsafeReplace arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (fill marr#) (done l u marr#) ies))++-- | @'accum' f@ takes an array and an association list and accumulates+-- pairs from the list into the array with the accumulating function @f@.+-- Thus 'accumArray' can be defined using 'accum':+--+-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])+--+{-# INLINE accum #-}+accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e+accum f arr@(Array l u _) ies =+    unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccum #-}+unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e+unsafeAccum f arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (adjust f marr#) (done l u marr#) ies))++{-# INLINE amap #-}+amap :: Ix i => (a -> b) -> Array i a -> Array i b+amap f arr@(Array l u _) =+    unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]++-- | 'ixmap' allows for transformations on array indices.+-- It may be thought of as providing function composition on the right+-- with the mapping that the original array embodies.+--+-- A similar transformation of array values may be achieved using 'fmap'+-- from the 'Array' instance of the 'Functor' class.+{-# INLINE ixmap #-}+ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e+ixmap (l,u) f arr =+    unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]++{-# INLINE eqArray #-}+eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool+eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else+    l1 == l2 && u1 == u2 &&+    and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]++{-# INLINE cmpArray #-}+cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering+cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++{-# INLINE cmpIntArray #-}+cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering+cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else+    if rangeSize (l2,u2) == 0 then GT else+    case compare l1 l2 of+        EQ    -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]+        other -> other+    where+    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of+        EQ    -> rest+        other -> other++{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}+\end{code}+++%*********************************************************+%*							*+\subsection{Array instances}+%*							*+%*********************************************************++\begin{code}+instance Ix i => Functor (Array i) where+    fmap = amap++instance (Ix i, Eq e) => Eq (Array i e) where+    (==) = eqArray++instance (Ix i, Ord e) => Ord (Array i e) where+    compare = cmpArray++instance (Ix a, Show a, Show b) => Show (Array a b) where+    showsPrec p a =+        showParen (p > appPrec) $+        showString "array " .+        showsPrec appPrec1 (bounds a) .+        showChar ' ' .+        showsPrec appPrec1 (assocs a)+	-- Precedence of 'array' is the precedence of application++-- The Read instance is in GHC.Read+\end{code}+++%*********************************************************+%*							*+\subsection{Operations on mutable arrays}+%*							*+%*********************************************************++Idle ADR question: What's the tradeoff here between flattening these+datatypes into @STArray ix ix (MutableArray# s elt)@ and using+it as is?  As I see it, the former uses slightly less heap and+provides faster access to the individual parts of the bounds while the+code used has the benefit of providing a ready-made @(lo, hi)@ pair as+required by many array-related functions.  Which wins? Is the+difference significant (probably not).++Idle AJG answer: When I looked at the outputted code (though it was 2+years ago) it seems like you often needed the tuple, and we build+it frequently. Now we've got the overloading specialiser things+might be different, though.++\begin{code}+{-# INLINE newSTArray #-}+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)+newSTArray (l,u) init = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }}++{-# INLINE boundsSTArray #-}+boundsSTArray :: STArray s i e -> (i,i)  +boundsSTArray (STArray l u _) = (l,u)++{-# INLINE readSTArray #-}+readSTArray :: Ix i => STArray s i e -> i -> ST s e+readSTArray marr@(STArray l u _) i =+    unsafeReadSTArray marr (index (l,u) i)++{-# INLINE unsafeReadSTArray #-}+unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e+unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->+    readArray# marr# i# s1#++{-# INLINE writeSTArray #-}+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () +writeSTArray marr@(STArray l u _) i e =+    unsafeWriteSTArray marr (index (l,u) i) e++{-# INLINE unsafeWriteSTArray #-}+unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () +unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->+    case writeArray# marr# i# e s1#     of { s2# ->+    (# s2#, () #) }+\end{code}+++%*********************************************************+%*							*+\subsection{Moving between mutable and immutable}+%*							*+%*********************************************************++\begin{code}+freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+freezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr'# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case readArray# marr# i# s3# of { (# s4#, e #) ->+            case writeArray# marr'# i# e s4# of { s5# ->+            copy (i# +# 1#) s5# }} in+    case copy 0# s2#                    of { s3# ->+    case unsafeFreezeArray# marr'# s3#  of { (# s4#, arr# #) ->+    (# s4#, Array l u arr# #) }}}}++{-# INLINE unsafeFreezeSTArray #-}+unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+thawSTArray (Array l u arr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case indexArray# arr# i#    of { (# e #) ->+            case writeArray# marr# i# e s3# of { s4# ->+            copy (i# +# 1#) s4# }} in+    case copy 0# s2#                    of { s3# ->+    (# s3#, STArray l u marr# #) }}}++{-# INLINE unsafeThawSTArray #-}+unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->+    case unsafeThawArray# arr# s1#      of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }+\end{code}
+ tests/HsOpenGLExt.h view
@@ -0,0 +1,31 @@+/* -----------------------------------------------------------------------------+ *+ * Module      :  GL extension support for Graphics.Rendering.OpenGL+ * Copyright   :  (c) Sven Panne 2002-2004+ * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)+ * + * Maintainer  :  sven.panne@aedion.de+ * Stability   :  provisional+ * Portability :  portable+ *+ * This header should only define preprocessor macros!+ *+ * -------------------------------------------------------------------------- */++#ifndef HSOPENGLEXT_H+#define HSOPENGLEXT_H++/* NOTE: The macro must immediately start with the foreign declaration,+   otherwise the magic mangler (hack_foreign) in the Hugs build system+   doesn't recognize it. */+#define EXTENSION_ENTRY(_msg,_entry,_ty) \+foreign import CALLCONV unsafe "dynamic" dyn_/**/_entry :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (_ty) ; \+_entry :: (_ty) ; \+_entry = dyn_##_entry ptr_##_entry ; \+ptr_/**/_entry :: FunPtr a ; \+ptr_/**/_entry = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress (_msg) ("_entry")) ; \+{-# NOINLINE ptr_/**/_entry #-}++#endif++EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddEXT,GLdouble -> IO ())
+ tests/MachDeps.h view
+ tests/Storable.hs view
@@ -0,0 +1,246 @@+{-# OPTIONS -fno-implicit-prelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Storable+-- Copyright   :  (c) The FFI task force 2001+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The module "Foreign.Storable" provides most elementary support for+-- marshalling and is part of the language-independent portion of the+-- Foreign Function Interface (FFI), and will normally be imported via+-- the "Foreign" module.+--+-----------------------------------------------------------------------------++module Foreign.Storable+	( Storable(+	     sizeOf,         -- :: a -> Int+	     alignment,      -- :: a -> Int+	     peekElemOff,    -- :: Ptr a -> Int      -> IO a+	     pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()+	     peekByteOff,    -- :: Ptr b -> Int      -> IO a+	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()+	     peek,           -- :: Ptr a             -> IO a+	     poke)           -- :: Ptr a        -> a -> IO ()+        ) where+++#ifdef __NHC__+import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr+               ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)+#else++import Control.Monad		( liftM )++#include "MachDeps.h"+#include "config.h"++#ifdef __GLASGOW_HASKELL__+import GHC.Storable+import GHC.Stable	( StablePtr )+import GHC.Num+import GHC.Int+import GHC.Word+import GHC.Stable+import GHC.Ptr+import GHC.Float+import GHC.Err+import GHC.IOBase+import GHC.Base+#else+import Data.Int+import Data.Word+import Foreign.Ptr+import Foreign.StablePtr+#endif++#ifdef __HUGS__+import Hugs.Prelude+import Hugs.Storable+#endif++{- |+The member functions of this class facilitate writing values of+primitive types to raw memory (which may have been allocated with the+above mentioned routines) and reading values from blocks of raw+memory.  The class, furthermore, includes support for computing the+storage requirements and alignment restrictions of storable types.++Memory addresses are represented as values of type @'Ptr' a@, for some+@a@ which is an instance of class 'Storable'.  The type argument to+'Ptr' helps provide some valuable type safety in FFI code (you can\'t+mix pointers of different types without an explicit cast), while+helping the Haskell type system figure out which marshalling method is+needed for a given pointer.++All marshalling between Haskell and a foreign language ultimately+boils down to translating Haskell data structures into the binary+representation of a corresponding data structure of the foreign+language and vice versa.  To code this marshalling in Haskell, it is+necessary to manipulate primtive data types stored in unstructured+memory blocks.  The class 'Storable' facilitates this manipulation on+all types for which it is instantiated, which are the standard basic+types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',+'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',+'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",+as well as 'Ptr'.++Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',+'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and+'pokeByteOff'.+-}++class Storable a where++   sizeOf      :: a -> Int+   -- ^ Computes the storage requirements (in bytes) of the argument.+   -- The value of the argument is not used.++   alignment   :: a -> Int+   -- ^ Computes the alignment constraint of the argument.  An+   -- alignment constraint @x@ is fulfilled by any address divisible+   -- by @x@.  The value of the argument is not used.++   peekElemOff :: Ptr a -> Int      -> IO a+   -- ^       Read a value from a memory area regarded as an array+   --         of values of the same kind.  The first argument specifies+   --         the start address of the array and the second the index into+   --         the array (the first element of the array has index+   --         @0@).  The following equality holds,+   -- +   -- > peekElemOff addr idx = IOExts.fixIO $ \result ->+   -- >   peek (addr `plusPtr` (idx * sizeOf result))+   --+   --         Note that this is only a specification, not+   --         necessarily the concrete implementation of the+   --         function.++   pokeElemOff :: Ptr a -> Int -> a -> IO ()+   -- ^       Write a value to a memory area regarded as an array of+   --         values of the same kind.  The following equality holds:+   -- +   -- > pokeElemOff addr idx x = +   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x++   peekByteOff :: Ptr b -> Int      -> IO a+   -- ^       Read a value from a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > peekByteOff addr off = peek (addr `plusPtr` off)++   pokeByteOff :: Ptr b -> Int -> a -> IO ()+   -- ^       Write a value to a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x+  +   peek        :: Ptr a      -> IO a+   -- ^ Read a value from the given memory location.+   --+   --  Note that the peek and poke functions might require properly+   --  aligned addresses to function correctly.  This is architecture+   --  dependent; thus, portable code should ensure that when peeking or+   --  poking values of some type @a@, the alignment+   --  constraint for @a@, as given by the function+   --  'alignment' is fulfilled.++   poke        :: Ptr a -> a -> IO ()+   -- ^ Write the given value to the given memory location.  Alignment+   -- restrictions might apply; see 'peek'.+ +   -- circular default instances+#ifdef __GLASGOW_HASKELL__+   peekElemOff = peekElemOff_ undefined+      where peekElemOff_ :: a -> Ptr a -> Int -> IO a+            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)+#else+   peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)+#endif+   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val++   peekByteOff ptr off = peek (ptr `plusPtr` off)+   pokeByteOff ptr off = poke (ptr `plusPtr` off)++   peek ptr = peekElemOff ptr 0+   poke ptr = pokeElemOff ptr 0++#ifndef __GLASGOW_HASKELL__+sizeOfPtr :: Storable a => Ptr a -> a -> Int+sizeOfPtr px x = sizeOf x+#endif++-- System-dependent, but rather obvious instances++instance Storable Bool where+   sizeOf _          = sizeOf (undefined::HTYPE_INT)+   alignment _       = alignment (undefined::HTYPE_INT)+   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i+   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)++#define STORABLE(T,size,align,read,write)	\+instance Storable (T) where {			\+    sizeOf    _ = size;				\+    alignment _ = align;			\+    peekElemOff = read;				\+    pokeElemOff = write }++#ifdef __GLASGOW_HASKELL__+STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,+	 readWideCharOffPtr,writeWideCharOffPtr)+#elif defined(__HUGS__)+STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,+	 readCharOffPtr,writeCharOffPtr)+#endif++STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,+	 readIntOffPtr,writeIntOffPtr)++#ifdef __GLASGOW_HASKELL__+STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,+	 readWordOffPtr,writeWordOffPtr)+#endif++STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,+	 readPtrOffPtr,writePtrOffPtr)++STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,+	 readFunPtrOffPtr,writeFunPtrOffPtr)++STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,+	 readStablePtrOffPtr,writeStablePtrOffPtr)++STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,+	 readFloatOffPtr,writeFloatOffPtr)++STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,+	 readDoubleOffPtr,writeDoubleOffPtr)++STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,+	 readWord8OffPtr,writeWord8OffPtr)++STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,+	 readWord16OffPtr,writeWord16OffPtr)++STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,+	 readWord32OffPtr,writeWord32OffPtr)++STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,+	 readWord64OffPtr,writeWord64OffPtr)++STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,+	 readInt8OffPtr,writeInt8OffPtr)++STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,+	 readInt16OffPtr,writeInt16OffPtr)++STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,+	 readInt32OffPtr,writeInt32OffPtr)++STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,+	 readInt64OffPtr,writeInt64OffPtr)++#endif
+ tests/Test.hsc view
@@ -0,0 +1,11 @@+module Test where++main :: IO ()+main = putStrLn "shows a cpphs+hsc2hs bug with comments"++#def inline int that_one_will_work(void) {return 42;}++{-+#def inline int cpphs_will_stumble(void) {return 42;}+-}+
+ tests/chains view
@@ -0,0 +1,16 @@+For this test, assume that all of e,f,g,h are defined.+Also that c,d are defined, a,b are not.+If cpphs does operator precedence wrongly in infix chains, the final+conditional will be interpreted wrongly.++#if defined(a) || defined(b) || defined(c) || defined(d)+chained || OK+#endif+#if defined(e) && defined(f) && defined(g) && defined(h)+chained && OK+#endif+#if defined(a) && defined(b) || defined(c) && defined(d)+mixed chain of || and && OK+#else+mixed chain of || and && BROKEN+#endif
+ tests/comments view
@@ -0,0 +1,3 @@+here is an ordinary C comment:			/* comment here */+and here is a C++-style end-of-line comment:	// comment here+this line has no comments
+ tests/config.h view
+ tests/cpp view
@@ -0,0 +1,9 @@+#define /**/ ++ `mplus`		// not expected to work+#define 0   mzero		// not expected to work+#define x0  X'			// should work+#define x'  Xprime		// should work+#define `foo` .(foo)/**/,	// bizarreness++x ++ y = x0 * 0 * y `foo` x' ++//  /*
+ tests/elif view
@@ -0,0 +1,10 @@+#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \+    ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)+import System.IO.Unsafe (unsafePerformIO)+#elif defined(__GLASGOW_HASKELL__)+import IOExts (unsafePerformIO)+#elif defined(__NHC__)+import IOExtras (unsafePerformIO)+#elif defined(__HBC__)+import UnsafePerformIO+#endif
+ tests/emptyhashes view
@@ -0,0 +1,5 @@+this is a test with a hash on a line of its own+#+with no command after it.+#define FOO+and ending here
+ tests/endcode-a view
@@ -0,0 +1,3 @@+\hidden{+\begin{code}+\end{code}}
+ tests/endcode-b view
@@ -0,0 +1,4 @@+\hidden{+\begin{code}+\end{code}+}
+ tests/expect1 view
@@ -0,0 +1,36 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++++23 no inclusion, this is an else clause++25++++++31 third branch of elif++33+34 end of file+
+ tests/expect10 view
@@ -0,0 +1,15 @@+#line 1 "multiline"+++++5 back to ordinary text.+#line 1 "./inclusion"+hello world, this is an inclusion++#line 7 "multiline"+7 hello again+8 some more+9 aLongMacroDefinition(a,b)+10 end+
+ tests/expect11 view
@@ -0,0 +1,3 @@+#line 1 "stringise"++This is "abcd ef" foo abcd ef
+ tests/expect12 view
@@ -0,0 +1,5 @@+#line 1 "recursive"++++D D D D D D D D
+ tests/expect13 view
@@ -0,0 +1,20 @@+#line 1 "ross"+                                                         ++                           ++++f = 4++                                                             +++++g = do { putStr "Hello ";   putStrLn "World" }++                          +++h = 4
+ tests/expect14 view
@@ -0,0 +1,4 @@+#line 1 "precedence"+++
+ tests/expect15 view
@@ -0,0 +1,6 @@+#line 1 "indirect"++#line 1 "./inclusion"+hello world, this is an inclusion++#line 3 "indirect"
+ tests/expect15a view
@@ -0,0 +1,6 @@+#line 1 "indirect-a"++#line 1 "./inclusion"+hello world, this is an inclusion++#line 3 "indirect-a"
+ tests/expect16 view
@@ -0,0 +1,30 @@+#line 1 "numbers"++number (1) in if++++++++number (0) in if++++++rejected false hex number in if++++real hex number (0x1) in if++++++++hex number (0x00) in if+
+ tests/expect17 view
@@ -0,0 +1,2 @@+#line 1 "pragma"+
+ tests/expect18 view
@@ -0,0 +1,1 @@+
+ tests/expect19 view
@@ -0,0 +1,6 @@+#line 1 "parens"+++++yes
+ tests/expect2 view
@@ -0,0 +1,36 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++++23 no inclusion, this is an else clause++25++27 no elif++++++33+34 end of file+
+ tests/expect20 view
@@ -0,0 +1,17 @@+#line 1 "chains"+For this test, assume that all of 1,1,1,1 are defined.+Also that 1,1 are defined, a,b are not.+If cpphs does operator precedence wrongly in infix chains, the final+conditional will be interpreted wrongly.+++chained || OK+++chained && OK+++mixed chain of || and && OK+++
+ tests/expect21 view
@@ -0,0 +1,6 @@+#line 1 "specials"++line 2+line 3+line 4  Error "horrible" at line 4 of file "specials"+line 5
+ tests/expect22 view
@@ -0,0 +1,13 @@+#line 1 "specialinclude"+1+2+#line 1 "./specials"++line 2+line 3+line 4  Error "horrible" at line 4 of file "./specials"+line 5++#line 4 "specialinclude"+4+5
+ tests/expect23 view
@@ -0,0 +1,2 @@+#line 1 "incomplete"+incomplete
+ tests/expect24 view
@@ -0,0 +1,15 @@+#line 1 "text"+Here is some ordinary text with embedded Haskell-ish constructs,+that should however /not/ be interpreted as Haskell if the --text+option is given to cpphs.  For instance, here is a Haskell comment+including a cpp definition: {-+#  define FOO bar+and now we end the comment: -}   and try out the definition:  FOO+Likewise, double and single quotes no longer delimit strings or chars: "+#  define BAZ FOO+and what do we have here?: "  ' BAZ  '+++Also, in text-mode, macros should be expanded inside Haskell comments:+    -- expand(this,other,that)+and strings "expand(this,other,that)".
+ tests/expect25 view
@@ -0,0 +1,15 @@+#line 1 "text"+Here is some ordinary text with embedded Haskell-ish constructs,+that should however /not/ be interpreted as Haskell if the --text+option is given to cpphs.  For instance, here is a Haskell comment+including a cpp definition: {-++and now we end the comment: -}   and try out the definition:  bar+Likewise, double and single quotes no longer delimit strings or chars: "++and what do we have here?: "  ' bar  '+++Also, in text-mode, macros should be expanded inside Haskell comments:+    -- Some text including this, the other, and that.+and strings "Some text including this, the other, and that.".
+ tests/expect26 view
@@ -0,0 +1,17 @@+#line 1 "nastyhack"++-- hackery to convice cpp to splice 6.2.2 into a string+version :: String+version = tail "\ +    \ 6.2.2"++version2 = "6.2.2"+++version3 = "6.2.2"+++version4 = #6.2.2+++version5 = "6.2.2"
+ tests/expect27 view
@@ -0,0 +1,17 @@+#line 1 "nastyhack"++-- hackery to convice cpp to splice GHC_PKG_VERSION into a string+version :: String+version = tail "\ +    \ GHC_PKG_VERSION"++version2 = "GHC_PKG_VERSION"+++version3 = "GHC_PKG_VERSION"+++version4 = #6.2.2+++version5 = "6.2.2"
+ tests/expect28 view
@@ -0,0 +1,4 @@+#line 1 "symbolvalue"++the symbol is defined as 1+
+ tests/expect29 view
@@ -0,0 +1,12 @@+#line 1 "Test.hsc"+module Test where++main :: IO ()+main = putStrLn "shows a cpphs+hsc2hs bug with comments"++++{-+#def inline int cpphs_will_stumble(void) {return 42;}+-}+
+ tests/expect3 view
@@ -0,0 +1,36 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++++23 no inclusion, this is an else clause++25++++29 this is an elif++++33+34 end of file+
+ tests/expect30 view
@@ -0,0 +1,685 @@+#line 1 "Arr.lhs"++{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  GHC.Arr+-- Copyright   :  (c) The University of Glasgow, 1994-2000+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  cvs-ghc@haskell.org+-- Stability   :  internal+-- Portability :  non-portable (GHC extensions)+--+-- GHC\'s array implementation.+-- +-----------------------------------------------------------------------------++-- #hide+module GHC.Arr where++import {-# SOURCE #-} GHC.Err ( error )+import GHC.Enum+import GHC.Num+import GHC.ST+import GHC.Base+import GHC.List+import GHC.Show++infixl 9  !, //++default ()+++++++++++-- | The 'Ix' class is used to map a contiguous subrange of values in+-- a type onto integers.  It is used primarily for array indexing+-- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").+--+-- The first argument @(l,u)@ of each of these operations is a pair+-- specifying the lower and upper bounds of a contiguous subrange of values.+--+-- An implementation is entitled to assume the following laws about these+-- operations:+--+-- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@+--+-- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@+--+-- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@+--+-- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@+--+-- Minimal complete instance: 'range', 'index' and 'inRange'.+--+class (Ord a) => Ix a where+    -- | The list of values in the subrange defined by a bounding pair.+    range		:: (a,a) -> [a]+    -- | The position of a subscript in the subrange.+    index		:: (a,a) -> a -> Int+    -- | Like 'index', but without checking that the value is in range.+    unsafeIndex		:: (a,a) -> a -> Int+    -- | Returns 'True' the given subscript lies in the range defined+    -- the bounding pair.+    inRange		:: (a,a) -> a -> Bool+    -- | The size of the subrange defined by a bounding pair.+    rangeSize		:: (a,a) -> Int+    -- | like 'rangeSize', but without checking that the upper bound is+    -- in range.+    unsafeRangeSize     :: (a,a) -> Int++	-- Must specify one of index, unsafeIndex+    index b i | inRange b i = unsafeIndex b i	+	      | otherwise   = error "Error in array index"+    unsafeIndex b i = index b i++    rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1+		       | otherwise   = 0	-- This case is only here to+						-- check for an empty range+	-- NB: replacing (inRange b h) by (l <= h) fails for+	--     tuples.  E.g.  (1,2) <= (2,1) but the range is empty++    unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1++++++++++++++++++++-- abstract these errors from the relevant index functions so that+-- the guts of the function will be small enough to inline.++{-# NOINLINE indexError #-}+indexError :: Show a => (a,a) -> a -> String -> b+indexError rng i tp+  = error (showString "Ix{" . showString tp . showString "}.index: Index " .+           showParen True (showsPrec 0 i) .+	   showString " out of range " $+	   showParen True (showsPrec 0 rng) "")++----------------------------------------------------------------------+instance  Ix Char  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = fromEnum i - fromEnum m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Char"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance  Ix Int  where+    {-# INLINE range #-}+	-- The INLINE stops the build in the RHS from getting inlined,+	-- so that callers can fuse with the result of range+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i = i - m++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Int"++    {-# INLINE inRange #-}+    inRange (I# m,I# n) (I# i) =  m <=# i && i <=# n++----------------------------------------------------------------------+instance  Ix Integer  where+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (m,_n) i   = fromInteger (i - m)++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Integer"++    inRange (m,n) i	=  m <= i && i <= n++----------------------------------------------------------------------+instance Ix Bool where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Bool"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix Ordering where -- as derived+    {-# INLINE range #-}+    range (m,n) = [m..n]++    {-# INLINE unsafeIndex #-}+    unsafeIndex (l,_) i = fromEnum i - fromEnum l++    index b i | inRange b i =  unsafeIndex b i+	      | otherwise   =  indexError b i "Ordering"++    inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u++----------------------------------------------------------------------+instance Ix () where+    {-# INLINE range #-}+    range   ((), ())    = [()]+    {-# INLINE unsafeIndex #-}+    unsafeIndex   ((), ()) () = 0+    {-# INLINE inRange #-}+    inRange ((), ()) () = True+    {-# INLINE index #-}+    index b i = unsafeIndex b i++----------------------------------------------------------------------+instance (Ix a, Ix b) => Ix (a, b) where -- as derived+    {-# SPECIALISE instance Ix (Int,Int) #-}++    {- INLINE range #-}+    range ((l1,l2),(u1,u2)) =+      [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]++    {- INLINE unsafeIndex #-}+    unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =+      unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2++    {- INLINE inRange #-}+    inRange ((l1,l2),(u1,u2)) (i1,i2) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3)  where+    {-# SPECIALISE instance Ix (Int,Int,Int) #-}++    range ((l1,l2,l3),(u1,u2,u3)) =+        [(i1,i2,i3) | i1 <- range (l1,u1),+                      i2 <- range (l2,u2),+                      i3 <- range (l3,u3)]++    unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))++    inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3++    -- Default method for index++----------------------------------------------------------------------+instance  (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4)  where+    range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =+      [(i1,i2,i3,i4) | i1 <- range (l1,u1),+                       i2 <- range (l2,u2),+                       i3 <- range (l3,u3),+                       i4 <- range (l4,u4)]++    unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1)))++    inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4++    -- Default method for index++instance  (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5)  where+    range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =+      [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),+                          i2 <- range (l2,u2),+                          i3 <- range (l3,u3),+                          i4 <- range (l4,u4),+                          i5 <- range (l5,u5)]++    unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (+      unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (+      unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (+      unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (+      unsafeIndex (l1,u1) i1))))++    inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =+      inRange (l1,u1) i1 && inRange (l2,u2) i2 &&+      inRange (l3,u3) i3 && inRange (l4,u4) i4 && +      inRange (l5,u5) i5++    -- Default method for index++++++++++type IPr = (Int, Int)++-- | The type of immutable non-strict (boxed) arrays+-- with indices in @i@ and elements in @e@.+data Ix i => Array     i e = Array   !i !i (Array# e)++-- | Mutable, boxed, non-strict arrays in the 'ST' monad.  The type+-- arguments are as follows:+--+--  * @s@: the state variable argument for the 'ST' type+--+--  * @i@: the index type of the array (should be an instance of 'Ix')+--+--  * @e@: the element type of the array.+--+data         STArray s i e = STArray !i !i (MutableArray# s e)+	-- No Ix context for STArray.  They are stupid,+	-- and force an Ix context on the equality instance.++-- Just pointer equality on mutable arrays:+instance Eq (STArray s i e) where+    STArray _ _ arr1# == STArray _ _ arr2# =+        sameMutableArray# arr1# arr2#+++++++++++{-# NOINLINE arrEleBottom #-}+arrEleBottom :: a+arrEleBottom = error "(Array.!): undefined array element"++-- | Construct an array with the specified bounds and containing values+-- for given indices within these bounds.+--+-- The array is undefined (i.e. bottom) if any index in the list is+-- out of bounds.  The Haskell 98 Report further specifies that if any+-- two associations in the list have the same index, the value at that+-- index is undefined (i.e. bottom).  However in GHC's implementation,+-- the value at such an index is the value part of the last association+-- with that index in the list.+--+-- Because the indices must be checked for these errors, 'array' is+-- strict in the bounds argument and in the indices of the association+-- list, but nonstrict in the values.  Thus, recurrences such as the+-- following are possible:+--+-- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])+--+-- Not every index within the bounds of the array need appear in the+-- association list, but the values associated with indices that do not+-- appear will be undefined (i.e. bottom).+--+-- If, in any dimension, the lower bound is greater than the upper bound,+-- then the array is legal, but empty.  Indexing an empty array always+-- gives an array-bounds error, but 'bounds' still yields the bounds+-- with which the array was constructed.+{-# INLINE array #-}+array :: Ix i+	=> (i,i)	-- ^ a pair of /bounds/, each of the index type+			-- of the array.  These bounds are the lowest and+			-- highest indices in the array, in that order.+			-- For example, a one-origin vector of length+			-- '10' has bounds '(1,10)', and a one-origin '10'+			-- by '10' matrix has bounds '((1,1),(10,10))'.+	-> [(i, e)]	-- ^ a list of /associations/ of the form+			-- (/index/, /value/).  Typically, this list will+			-- be expressed as a comprehension.  An+			-- association '(i, x)' defines the value of+			-- the array at index 'i' to be 'x'.+	-> Array i e+array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeArray #-}+unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e+unsafeArray (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    foldr (fill marr#) (done l u marr#) ies s2# }})++{-# INLINE fill #-}+fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a+fill marr# (I# i#, e) next s1# =+    case writeArray# marr# i# e s1#     of { s2# ->+    next s2# }++{-# INLINE done #-}+done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)+done l u marr# s1# =+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++-- This is inefficient and I'm not sure why:+-- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)+-- The code below is better. It still doesn't enable foldr/build+-- transformation on the list of elements; I guess it's impossible+-- using mechanisms currently available.++-- | Construct an array from a pair of bounds and a list of values in+-- index order.+{-# INLINE listArray #-}+listArray :: Ix i => (i,i) -> [e] -> Array i e+listArray (l,u) es = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let fillFromList i# xs s3# | i# ==# n# = s3#+                               | otherwise = case xs of+            []   -> s3#+            y:ys -> case writeArray# marr# i# y s3# of { s4# ->+                    fillFromList (i# +# 1#) ys s4# } in+    case fillFromList 0# es s2#         of { s3# ->+    done l u marr# s3# }}})++-- | The value at the given index in an array.+{-# INLINE (!) #-}+(!) :: Ix i => Array i e -> i -> e+arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)++{-# INLINE unsafeAt #-}+unsafeAt :: Ix i => Array i e -> Int -> e+unsafeAt (Array _ _ arr#) (I# i#) =+    case indexArray# arr# i# of (# e #) -> e++-- | The bounds with which an array was constructed.+{-# INLINE bounds #-}+bounds :: Ix i => Array i e -> (i,i)+bounds (Array l u _) = (l,u)++-- | The list of indices of an array in ascending order.+{-# INLINE indices #-}+indices :: Ix i => Array i e -> [i]+indices (Array l u _) = range (l,u)++-- | The list of elements of an array in index order.+{-# INLINE elems #-}+elems :: Ix i => Array i e -> [e]+elems arr@(Array l u _) =+    [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]++-- | The list of associations of an array in index order.+{-# INLINE assocs #-}+assocs :: Ix i => Array i e -> [(i, e)]+assocs arr@(Array l u _) =+    [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]++-- | The 'accumArray' deals with repeated indices in the association+-- list using an /accumulating function/ which combines the values of+-- associations with the same index.+-- For example, given a list of values of some index type, @hist@+-- produces a histogram of the number of occurrences of each index within+-- a specified range:+--+-- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b+-- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]+--+-- If the accumulating function is strict, then 'accumArray' is strict in+-- the values, as well as the indices, in the association list.  Thus,+-- unlike ordinary arrays built with 'array', accumulated arrays should+-- not in general be recursive.+{-# INLINE accumArray #-}+accumArray :: Ix i+	=> (e -> a -> e)	-- ^ accumulating function+	-> e			-- ^ initial value+	-> (i,i)		-- ^ bounds of the array+	-> [(i, a)]		-- ^ association list+	-> Array i e+accumArray f init (l,u) ies =+    unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccumArray #-}+unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e+unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    foldr (adjust f marr#) (done l u marr#) ies s2# }})++{-# INLINE adjust #-}+adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b+adjust f marr# (I# i#, new) next s1# =+    case readArray# marr# i# s1#        of { (# s2#, old #) ->+    case writeArray# marr# i# (f old new) s2# of { s3# ->+    next s3# }}++-- | Constructs an array identical to the first argument except that it has+-- been updated by the associations in the right argument.+-- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then+--+-- > m//[((i,i), 0) | i <- [1..n]]+--+-- is the same matrix, except with the diagonal zeroed.+--+-- Repeated indices in the association list are handled as for 'array':+-- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),+-- but GHC's implementation uses the last association for each index.+{-# INLINE (//) #-}+(//) :: Ix i => Array i e -> [(i, e)] -> Array i e+arr@(Array l u _) // ies =+    unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeReplace #-}+unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e+unsafeReplace arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (fill marr#) (done l u marr#) ies))++-- | @'accum' f@ takes an array and an association list and accumulates+-- pairs from the list into the array with the accumulating function @f@.+-- Thus 'accumArray' can be defined using 'accum':+--+-- > accumArray f z b = accum f (array b [(i, z) | i <- range b])+--+{-# INLINE accum #-}+accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e+accum f arr@(Array l u _) ies =+    unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]++{-# INLINE unsafeAccum #-}+unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e+unsafeAccum f arr@(Array l u _) ies = runST (do+    STArray _ _ marr# <- thawSTArray arr+    ST (foldr (adjust f marr#) (done l u marr#) ies))++{-# INLINE amap #-}+amap :: Ix i => (a -> b) -> Array i a -> Array i b+amap f arr@(Array l u _) =+    unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]++-- | 'ixmap' allows for transformations on array indices.+-- It may be thought of as providing function composition on the right+-- with the mapping that the original array embodies.+--+-- A similar transformation of array values may be achieved using 'fmap'+-- from the 'Array' instance of the 'Functor' class.+{-# INLINE ixmap #-}+ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e+ixmap (l,u) f arr =+    unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]++{-# INLINE eqArray #-}+eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool+eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else+    l1 == l2 && u1 == u2 &&+    and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]++{-# INLINE cmpArray #-}+cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering+cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)++{-# INLINE cmpIntArray #-}+cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering+cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =+    if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else+    if rangeSize (l2,u2) == 0 then GT else+    case compare l1 l2 of+        EQ    -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]+        other -> other+    where+    cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of+        EQ    -> rest+        other -> other++{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}+++++++++++instance Ix i => Functor (Array i) where+    fmap = amap++instance (Ix i, Eq e) => Eq (Array i e) where+    (==) = eqArray++instance (Ix i, Ord e) => Ord (Array i e) where+    compare = cmpArray++instance (Ix a, Show a, Show b) => Show (Array a b) where+    showsPrec p a =+        showParen (p > appPrec) $+        showString "array " .+        showsPrec appPrec1 (bounds a) .+        showChar ' ' .+        showsPrec appPrec1 (assocs a)+	-- Precedence of 'array' is the precedence of application++-- The Read instance is in GHC.Read++++++++++++++++++++++++{-# INLINE newSTArray #-}+newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)+newSTArray (l,u) init = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# init s1#          of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }}++{-# INLINE boundsSTArray #-}+boundsSTArray :: STArray s i e -> (i,i)  +boundsSTArray (STArray l u _) = (l,u)++{-# INLINE readSTArray #-}+readSTArray :: Ix i => STArray s i e -> i -> ST s e+readSTArray marr@(STArray l u _) i =+    unsafeReadSTArray marr (index (l,u) i)++{-# INLINE unsafeReadSTArray #-}+unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e+unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->+    readArray# marr# i# s1#++{-# INLINE writeSTArray #-}+writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () +writeSTArray marr@(STArray l u _) i e =+    unsafeWriteSTArray marr (index (l,u) i) e++{-# INLINE unsafeWriteSTArray #-}+unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s () +unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->+    case writeArray# marr# i# e s1#     of { s2# ->+    (# s2#, () #) }+++++++++++freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+freezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr'# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case readArray# marr# i# s3# of { (# s4#, e #) ->+            case writeArray# marr'# i# e s4# of { s5# ->+            copy (i# +# 1#) s5# }} in+    case copy 0# s2#                    of { s3# ->+    case unsafeFreezeArray# marr'# s3#  of { (# s4#, arr# #) ->+    (# s4#, Array l u arr# #) }}}}++{-# INLINE unsafeFreezeSTArray #-}+unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)+unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->+    case unsafeFreezeArray# marr# s1#   of { (# s2#, arr# #) ->+    (# s2#, Array l u arr# #) }++thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+thawSTArray (Array l u arr#) = ST $ \s1# ->+    case rangeSize (l,u)                of { I# n# ->+    case newArray# n# arrEleBottom s1#  of { (# s2#, marr# #) ->+    let copy i# s3# | i# ==# n# = s3#+                    | otherwise =+            case indexArray# arr# i#    of { (# e #) ->+            case writeArray# marr# i# e s3# of { s4# ->+            copy (i# +# 1#) s4# }} in+    case copy 0# s2#                    of { s3# ->+    (# s3#, STArray l u marr# #) }}}++{-# INLINE unsafeThawSTArray #-}+unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)+unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->+    case unsafeThawArray# arr# s1#      of { (# s2#, marr# #) ->+    (# s2#, STArray l u marr# #) }++
+ tests/expect31 view
@@ -0,0 +1,11 @@+#line 1 "elif"+++import System.IO.Unsafe (unsafePerformIO)+++++++
+ tests/expect32 view
@@ -0,0 +1,2 @@+#line 1 "pragma"+#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"                
+ tests/expect33 view
@@ -0,0 +1,1 @@+#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"                
+ tests/expect34 view
@@ -0,0 +1,11 @@+#line 1 "igloo"++++1+++foo+++
+ tests/expect35 view
@@ -0,0 +1,12 @@+#line 1 "igloo2"++++baz+1+++foo+++
+ tests/expect36 view
@@ -0,0 +1,12 @@+#line 1 "igloo3"++++quux+FOOFOO+++++bar+
+ tests/expect36a view
@@ -0,0 +1,12 @@+#line 1 "igloo3a"++++quux+FOOFOO+++++bar+
+ tests/expect36b view
@@ -0,0 +1,13 @@+#line 1 "igloo3b"+++++quux+11+++foo+++
+ tests/expect37 view
@@ -0,0 +1,11 @@+#line 1 "igloo4"+++wibble+11+++foo+++
+ tests/expect37a view
@@ -0,0 +1,11 @@+#line 1 "igloo4a"+++wibble+11+++foo+++
+ tests/expect38 view
@@ -0,0 +1,8 @@+#line 1 "mauke"+++++++main = print 7 -- should print 7
+ tests/expect39 view
@@ -0,0 +1,5 @@+#line 1 "mauke2"++++4
+ tests/expect4 view
@@ -0,0 +1,39 @@+#line 1 "testfile"+1 top of file++3++5 X is defined++7++++11++++15++++19++#line 1 "./inclusion"+hello world, this is an inclusion++#line 22 "testfile"++++25++++++31 third branch of elif++33+34 end of file+
+ tests/expect40 view
@@ -0,0 +1,8 @@+#line 1 "fasta"+++++++b7 = unsafeVisualize(foo)
+ tests/expect40a view
@@ -0,0 +1,7 @@+#line 1 "fasta2"++++++b6 = unsafeVisualize(foo)
+ tests/expect41 view
@@ -0,0 +1,6 @@+#line 1 "hashjoin"+++++2
+ tests/expect42 view
@@ -0,0 +1,5 @@+#line 1 "wrongline"++2+#line 20 "foo"+20
+ tests/expect43 view
@@ -0,0 +1,6 @@+#line 1 "param"+++++11	-- gcc gives BARBAR, cpphs gives 11
+ tests/expect44 view
@@ -0,0 +1,4 @@+#line 1 "comments"+here is an ordinary C comment:			                  +and here is a C++-style end-of-line comment:	// comment here+this line has no comments
+ tests/expect44a view
@@ -0,0 +1,4 @@+#line 1 "comments"+here is an ordinary C comment:			                  +and here is a C++-style end-of-line comment:	               +this line has no comments
+ tests/expect45 view
@@ -0,0 +1,8 @@+#line 1 "nestcomment"+{-++foo++++-}
+ tests/expect46 view
@@ -0,0 +1,7 @@+#line 1 "preinclude"+#line 1 "./inclusion"+hello world, this is an inclusion++#line 2 "preinclude"+#line 1 "preinclude"+something arbitrary
+ tests/expect47 view
@@ -0,0 +1,5 @@+#line 1 "endcode-a"++++
+ tests/expect48 view
@@ -0,0 +1,6 @@+#line 1 "endcode-b"+++++
+ tests/expect49 view
@@ -0,0 +1,5 @@+#line 1 "undef.hs"++wibble 3++this is FOO
+ tests/expect5 view
@@ -0,0 +1,35 @@+1 top of file++3++5 0 is defined++7++++11++++15++++19++hello world, this is an inclusion+++++25++++++31 third branch of elif++33+34 end of file
+ tests/expect50 view
@@ -0,0 +1,9 @@+{-# LINE 1 "linepragma" #-}+{-# LINE 1 "./inclusion" #-}+hello world, this is an inclusion++{-# LINE 2 "linepragma" #-}+{-# LINE 2 "linepragma" #-}++{-# LINE 3 "linepragma" #-}+
+ tests/expect51 view
@@ -0,0 +1,7 @@+#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.
+ tests/expect52 view
@@ -0,0 +1,8 @@+#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.+
+ tests/expect53 view
@@ -0,0 +1,7 @@+#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.
+ tests/expect54 view
@@ -0,0 +1,7 @@+#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.
+ tests/expect6 view
@@ -0,0 +1,10 @@+#line 1 "cpp"+++++++x ++ y = X' * 0 * y .(foo), Xprime ++//  /*
+ tests/expect7 view
@@ -0,0 +1,297 @@+#line 1 "Storable.hs"+{-# OPTIONS -fno-implicit-prelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Foreign.Storable+-- Copyright   :  (c) The FFI task force 2001+-- License     :  see libraries/base/LICENSE+-- +-- Maintainer  :  ffi@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The module "Foreign.Storable" provides most elementary support for+-- marshalling and is part of the language-independent portion of the+-- Foreign Function Interface (FFI), and will normally be imported via+-- the "Foreign" module.+--+-----------------------------------------------------------------------------++module Foreign.Storable+	( Storable(+	     sizeOf,         -- :: a -> Int+	     alignment,      -- :: a -> Int+	     peekElemOff,    -- :: Ptr a -> Int      -> IO a+	     pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()+	     peekByteOff,    -- :: Ptr b -> Int      -> IO a+	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()+	     peek,           -- :: Ptr a             -> IO a+	     poke)           -- :: Ptr a        -> a -> IO ()+        ) where++++++++import Control.Monad		( liftM )++#line 1 "./MachDeps.h"+#line 40 "Storable.hs"+#line 1 "./config.h"+#line 41 "Storable.hs"+++import GHC.Storable+import GHC.Stable	( StablePtr )+import GHC.Num+import GHC.Int+import GHC.Word+import GHC.Stable+import GHC.Ptr+import GHC.Float+import GHC.Err+import GHC.IOBase+import GHC.Base+++++++++++++{- |+The member functions of this class facilitate writing values of+primitive types to raw memory (which may have been allocated with the+above mentioned routines) and reading values from blocks of raw+memory.  The class, furthermore, includes support for computing the+storage requirements and alignment restrictions of storable types.++Memory addresses are represented as values of type @'Ptr' a@, for some+@a@ which is an instance of class 'Storable'.  The type argument to+'Ptr' helps provide some valuable type safety in FFI code (you can\'t+mix pointers of different types without an explicit cast), while+helping the Haskell type system figure out which marshalling method is+needed for a given pointer.++All marshalling between Haskell and a foreign language ultimately+boils down to translating Haskell data structures into the binary+representation of a corresponding data structure of the foreign+language and vice versa.  To code this marshalling in Haskell, it is+necessary to manipulate primtive data types stored in unstructured+memory blocks.  The class 'Storable' facilitates this manipulation on+all types for which it is instantiated, which are the standard basic+types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',+'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',+'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",+as well as 'Ptr'.++Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',+'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and+'pokeByteOff'.+-}++class Storable a where++   sizeOf      :: a -> Int+   -- ^ Computes the storage requirements (in bytes) of the argument.+   -- The value of the argument is not used.++   alignment   :: a -> Int+   -- ^ Computes the alignment constraint of the argument.  An+   -- alignment constraint @x@ is fulfilled by any address divisible+   -- by @x@.  The value of the argument is not used.++   peekElemOff :: Ptr a -> Int      -> IO a+   -- ^       Read a value from a memory area regarded as an array+   --         of values of the same kind.  The first argument specifies+   --         the start address of the array and the second the index into+   --         the array (the first element of the array has index+   --         @0@).  The following equality holds,+   -- +   -- > peekElemOff addr idx = IOExts.fixIO $ \result ->+   -- >   peek (addr `plusPtr` (idx * sizeOf result))+   --+   --         Note that this is only a specification, not+   --         necessarily the concrete implementation of the+   --         function.++   pokeElemOff :: Ptr a -> Int -> a -> IO ()+   -- ^       Write a value to a memory area regarded as an array of+   --         values of the same kind.  The following equality holds:+   -- +   -- > pokeElemOff addr idx x = +   -- >   poke (addr `plusPtr` (idx * sizeOf x)) x++   peekByteOff :: Ptr b -> Int      -> IO a+   -- ^       Read a value from a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > peekByteOff addr off = peek (addr `plusPtr` off)++   pokeByteOff :: Ptr b -> Int -> a -> IO ()+   -- ^       Write a value to a memory location given by a base+   --         address and offset.  The following equality holds:+   --+   -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x+  +   peek        :: Ptr a      -> IO a+   -- ^ Read a value from the given memory location.+   --+   --  Note that the peek and poke functions might require properly+   --  aligned addresses to function correctly.  This is architecture+   --  dependent; thus, portable code should ensure that when peeking or+   --  poking values of some type @a@, the alignment+   --  constraint for @a@, as given by the function+   --  'alignment' is fulfilled.++   poke        :: Ptr a -> a -> IO ()+   -- ^ Write the given value to the given memory location.  Alignment+   -- restrictions might apply; see 'peek'.+ +   -- circular default instances++   peekElemOff = peekElemOff_ undefined+      where peekElemOff_ :: a -> Ptr a -> Int -> IO a+            peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)++++   pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val++   peekByteOff ptr off = peek (ptr `plusPtr` off)+   pokeByteOff ptr off = poke (ptr `plusPtr` off)++   peek ptr = peekElemOff ptr 0+   poke ptr = pokeElemOff ptr 0+++++++-- System-dependent, but rather obvious instances++instance Storable Bool where+   sizeOf _          = sizeOf (undefined::HTYPE_INT)+   alignment _       = alignment (undefined::HTYPE_INT)+   peekElemOff p i   = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i+   pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)++++++++++instance Storable (Char) where {			+    sizeOf    _ = SIZEOF_INT32;				+    alignment _ = ALIGNMENT_INT32;			+    peekElemOff = readWideCharOffPtr;				+    pokeElemOff = writeWideCharOffPtr }++++++instance Storable (Int) where {			+    sizeOf    _ = SIZEOF_HSINT;				+    alignment _ = ALIGNMENT_HSINT;			+    peekElemOff = readIntOffPtr;				+    pokeElemOff = writeIntOffPtr }+++instance Storable (Word) where {			+    sizeOf    _ = SIZEOF_HSWORD;				+    alignment _ = ALIGNMENT_HSWORD;			+    peekElemOff = readWordOffPtr;				+    pokeElemOff = writeWordOffPtr }+++instance Storable ((Ptr a)) where {			+    sizeOf    _ = SIZEOF_HSPTR;				+    alignment _ = ALIGNMENT_HSPTR;			+    peekElemOff = readPtrOffPtr;				+    pokeElemOff = writePtrOffPtr }++instance Storable ((FunPtr a)) where {			+    sizeOf    _ = SIZEOF_HSFUNPTR;				+    alignment _ = ALIGNMENT_HSFUNPTR;			+    peekElemOff = readFunPtrOffPtr;				+    pokeElemOff = writeFunPtrOffPtr }++instance Storable ((StablePtr a)) where {			+    sizeOf    _ = SIZEOF_HSSTABLEPTR;				+    alignment _ = ALIGNMENT_HSSTABLEPTR;			+    peekElemOff = readStablePtrOffPtr;				+    pokeElemOff = writeStablePtrOffPtr }++instance Storable (Float) where {			+    sizeOf    _ = SIZEOF_HSFLOAT;				+    alignment _ = ALIGNMENT_HSFLOAT;			+    peekElemOff = readFloatOffPtr;				+    pokeElemOff = writeFloatOffPtr }++instance Storable (Double) where {			+    sizeOf    _ = SIZEOF_HSDOUBLE;				+    alignment _ = ALIGNMENT_HSDOUBLE;			+    peekElemOff = readDoubleOffPtr;				+    pokeElemOff = writeDoubleOffPtr }++instance Storable (Word8) where {			+    sizeOf    _ = SIZEOF_WORD8;				+    alignment _ = ALIGNMENT_WORD8;			+    peekElemOff = readWord8OffPtr;				+    pokeElemOff = writeWord8OffPtr }++instance Storable (Word16) where {			+    sizeOf    _ = SIZEOF_WORD16;				+    alignment _ = ALIGNMENT_WORD16;			+    peekElemOff = readWord16OffPtr;				+    pokeElemOff = writeWord16OffPtr }++instance Storable (Word32) where {			+    sizeOf    _ = SIZEOF_WORD32;				+    alignment _ = ALIGNMENT_WORD32;			+    peekElemOff = readWord32OffPtr;				+    pokeElemOff = writeWord32OffPtr }++instance Storable (Word64) where {			+    sizeOf    _ = SIZEOF_WORD64;				+    alignment _ = ALIGNMENT_WORD64;			+    peekElemOff = readWord64OffPtr;				+    pokeElemOff = writeWord64OffPtr }++instance Storable (Int8) where {			+    sizeOf    _ = SIZEOF_INT8;				+    alignment _ = ALIGNMENT_INT8;			+    peekElemOff = readInt8OffPtr;				+    pokeElemOff = writeInt8OffPtr }++instance Storable (Int16) where {			+    sizeOf    _ = SIZEOF_INT16;				+    alignment _ = ALIGNMENT_INT16;			+    peekElemOff = readInt16OffPtr;				+    pokeElemOff = writeInt16OffPtr }++instance Storable (Int32) where {			+    sizeOf    _ = SIZEOF_INT32;				+    alignment _ = ALIGNMENT_INT32;			+    peekElemOff = readInt32OffPtr;				+    pokeElemOff = writeInt32OffPtr }++instance Storable (Int64) where {			+    sizeOf    _ = SIZEOF_INT64;				+    alignment _ = ALIGNMENT_INT64;			+    peekElemOff = readInt64OffPtr;				+    pokeElemOff = writeInt64OffPtr }++
+ tests/expect8 view
@@ -0,0 +1,37 @@+#line 1 "HsOpenGLExt.h"+/* -----------------------------------------------------------------------------+ *+ * Module      :  GL extension support for Graphics.Rendering.OpenGL+ * Copyright   :  (c) Sven Panne 2002-2004+ * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)+ * + * Maintainer  :  sven.panne@aedion.de+ * Stability   :  provisional+ * Portability :  portable+ *+ * This header should only define preprocessor macros!+ *+ * -------------------------------------------------------------------------- */+++++/* NOTE: The macro must immediately start with the foreign declaration,+   otherwise the magic mangler (hack_foreign) in the Hugs build system+   doesn't recognize it. */+++++++++++foreign import ccall unsafe "dynamic" dyn_glFogCoorddEXT :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (GLdouble -> IO ()) ; +glFogCoorddEXT :: (GLdouble -> IO ()) ; +glFogCoorddEXT = dyn_glFogCoorddEXT ptr_glFogCoorddEXT ; +ptr_glFogCoorddEXT :: FunPtr a ; +ptr_glFogCoorddEXT = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress ("GL_EXT_fog_coord or OpenGL 1.4") ("glFogCoorddEXT")) ; +{-# NOINLINE ptr_glFogCoorddEXT #-}
+ tests/expect9 view
@@ -0,0 +1,16 @@+#line 1 "multiline"+++++5 back to ordinary text.+#line 1 "./inclusion"+hello world, this is an inclusion++#line 7 "multiline"+7 hello again+8 some more+9 some line here;	+	and some more;	+	finish now+10 end
+ tests/fasta view
@@ -0,0 +1,7 @@+#define XCONCAT(a, b) a##b+#define CONCAT(a, b) XCONCAT(a, b)+#define PS(val) () <- trace (val) (return ())+#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)+#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)++V(foo)
+ tests/fasta2 view
@@ -0,0 +1,6 @@+#define XCONCAT(a, b) a##b+#define CONCAT(a, b) XCONCAT(a, b)+#define PS(val) () <- trace (val) (return ())+#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)+#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)+V(foo)
+ tests/hashjoin view
@@ -0,0 +1,5 @@+#define FOO 1+#define BAR FOO##FOO+#define FOOFOO 2++BAR
+ tests/igloo view
@@ -0,0 +1,10 @@+#define FOO 1+#define BAR FOO++BAR++#if BAR == 1+foo+#else+bar+#endif
+ tests/igloo2 view
@@ -0,0 +1,11 @@+#define FOO 1+#define BAZ(x) x++baz+BAZ(1)++#if BAZ(1) == 1+foo+#else+bar+#endif
+ tests/igloo3 view
@@ -0,0 +1,11 @@+#define FOO 1+#define QUUX FOO ## FOO++quux+QUUX++#if QUUX == 11+foo+#else+bar+#endif
+ tests/igloo3a view
@@ -0,0 +1,11 @@+#define FOO 1+#define QUUX FOO##FOO++quux+QUUX++#if QUUX == 11+foo+#else+bar+#endif
+ tests/igloo3b view
@@ -0,0 +1,12 @@+#define FOO 1+#define QUUX(a) a ## a+#define WIBBLE QUUX(FOO)++quux+WIBBLE++#if WIBBLE == 11+foo+#else+bar+#endif
+ tests/igloo4 view
@@ -0,0 +1,10 @@+#define WIBBLE 1 ## 1++wibble+WIBBLE++#if WIBBLE == 11+foo+#else+bar+#endif
+ tests/igloo4a view
@@ -0,0 +1,10 @@+#define WIBBLE 1##1++wibble+WIBBLE++#if WIBBLE == 11+foo+#else+bar+#endif
+ tests/inclusion view
@@ -0,0 +1,1 @@+hello world, this is an inclusion
+ tests/incomplete view
@@ -0,0 +1,1 @@+incomplete
+ tests/indirect view
@@ -0,0 +1,2 @@+#define F "inclusion"+#include F
+ tests/indirect-a view
@@ -0,0 +1,2 @@+#define F(f) in##f+#include F(clusion)
+ tests/linepragma view
@@ -0,0 +1,5 @@+#include "inclusion"+#line 2 "linepragma"++#line 3 "linepragma"+
+ tests/mauke view
@@ -0,0 +1,7 @@+#define X /\+* comment */ main++#define Y _\+_LINE__++X = print Y -- should print 7
+ tests/mauke2 view
@@ -0,0 +1,4 @@+#define foo _\+_LINE__++foo
+ tests/multiline view
@@ -0,0 +1,10 @@+#define aLongMacroDefinition(x,y)	\+	some line here;	\+	and some more;	\+	finish now+5 back to ordinary text.+#include "inclusion"+7 hello again+8 some more+9 aLongMacroDefinition(a,b)+10 end
+ tests/nastyhack view
@@ -0,0 +1,16 @@+#define GHC_PKG_VERSION 6.2.2+-- hackery to convice cpp to splice GHC_PKG_VERSION into a string+version :: String+version = tail "\ +    \ GHC_PKG_VERSION"++version2 = "GHC_PKG_VERSION"++#define v3 "GHC_PKG_VERSION"+version3 = v3++#define stringify(s) #s+version4 = stringify(GHC_PKG_VERSION)++#define stringify2(s) "s"+version5 = stringify2(GHC_PKG_VERSION)
+ tests/nestcomment view
@@ -0,0 +1,7 @@+{-+#if 1+foo+#else+bar+#endif+-}
+ tests/nomacro view
@@ -0,0 +1,6 @@+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.
+ tests/numbers view
@@ -0,0 +1,29 @@+#if 1+number (1) in if+#else+rejected number (1) in if+#endif++#if 0+wrongly accepted number (0) in if+#else+number (0) in if+#endif++#if eaf+false hex number in if+#else+rejected false hex number in if+#endif++#if 0x1+real hex number (0x1) in if+#else+rejected real hex number (0x1) in if+#endif++#if 0x00+wrongly accepted real hex number (0x00) in if+#else+hex number (0x00) in if+#endif
+ tests/param view
@@ -0,0 +1,5 @@+#define FOO 1+#define BAR FOO+#define JOIN(f)  f##f++JOIN(BAR)	-- gcc gives BARBAR, cpphs gives 11
+ tests/parens view
@@ -0,0 +1,5 @@+#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \+    || ( defined(__NHC__) && __NHC__ >= 117 )+#define FINALIZERPTR yes+#endif+FINALIZERPTR
+ tests/pragma view
@@ -0,0 +1,1 @@+#pragma  ident   "@(#)time.h     1.39    99/08/10 SMI"   /* SVr4.0 1.18 */
+ tests/precedence view
@@ -0,0 +1,3 @@+#if !0 && 0+boolean operator precedence is wrong+#endif
+ tests/preinclude view
@@ -0,0 +1,1 @@+something arbitrary
+ tests/recursive view
@@ -0,0 +1,4 @@+#define C D D+#define B C C+#define A B B+A
+ tests/ross view
@@ -0,0 +1,19 @@+/* 1. C comments should be deleted by the preprocessor */++/* 2. repeated expansion */+#define FOO 4+#define BAR FOO++f = BAR++/* 3. continuation lines in macros shouldn't give newlines */+#define LONG_MACRO \+{ putStr "Hello "; \+  putStrLn "World" }++g = do LONG_MACRO++/* 4. projection macros */+#define MACRO(x) x++h = MACRO(FOO)
+ tests/runtests view
@@ -0,0 +1,75 @@+#!/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
+ tests/specialinclude view
@@ -0,0 +1,5 @@+1+2+#include "specials"+4+5
+ tests/specials view
@@ -0,0 +1,5 @@+#define error(s)	Error #s at line __LINE__ of file __FILE__+line 2+line 3+line 4  error(horrible)+line 5
+ tests/stringise view
@@ -0,0 +1,2 @@+#define foo(x)	This is #x foo x+foo(abcd ef)
+ tests/symbolvalue view
@@ -0,0 +1,3 @@+#if XXX+the symbol is defined as XXX+#endif
+ tests/testfile view
@@ -0,0 +1,34 @@+1 top of file+#define X 0+3+#ifdef X+5 X is defined+#endif+7+#if X+9 X is non-zero+#endif+11+#if error+#error "error message goes here"+#endif+15+#if warning+#warning "warning message goes here"+#endif+19+#if include+#include "inclusion"+#else+23 no inclusion, this is an else clause+#endif+25+#if noelif+27 no elif+#elif elif+29 this is an elif+#else+31 third branch of elif+#endif+33+34 end of file
+ tests/text view
@@ -0,0 +1,14 @@+Here is some ordinary text with embedded Haskell-ish constructs,+that should however /not/ be interpreted as Haskell if the --text+option is given to cpphs.  For instance, here is a Haskell comment+including a cpp definition: {-+#  define FOO bar+and now we end the comment: -}   and try out the definition:  FOO+Likewise, double and single quotes no longer delimit strings or chars: "+#  define BAZ FOO+and what do we have here?: "  ' BAZ  '++#  define expand(a,b,c)	  Some text including a, the b, and c.+Also, in text-mode, macros should be expanded inside Haskell comments:+    -- expand(this,other,that)+and strings "expand(this,other,that)".
+ tests/tmp view
@@ -0,0 +1,7 @@+#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.
+ tests/undef.hs view
@@ -0,0 +1,4 @@+#define FOO 3+wibble FOO+#undef FOO+this is FOO
+ tests/wrongline view
@@ -0,0 +1,4 @@+#define whereami __LINE__+whereami+#line 20 "foo"+__LINE__