Nothing since last release.
@@ -228,6 +226,246 @@
Older versions:
+cpphs-1.20.8, release date 2017-06-22
+By HTTP:
+Hackage.
+
+- (1.20.8) another bugfix for windows drive letters in #includes.
+
- (1.20.7) bugfix for windows drive letters in #includes.
+
- (1.20.6) minor bugfix to avoid a crash in an obscure corner case
+
+
+
+cpphs-1.20.5, release date 2017-04-11
+By HTTP:
+Hackage.
+
+- (1.20.5) reverts the changes in 1.20.4
+
+
+
+cpphs-1.20.4, release date 2017-02-27
+By HTTP:
+Hackage.
+
+- (1.20.4) more windows path handling
+
+
+
+cpphs-1.20.3, release date 2017-02-06
+By HTTP:
+Hackage.
+
+- (1.20.3) detect an absolute windows path with a drive letter in a #include
+
+
+
+cpphs-1.20.2, release date 2016-09-05
+By HTTP:
+Hackage.
+
+- (1.20.2) ensure all input/output is UTF8, regardless of locale
+
+
+
+cpphs-1.20, release date 2016-03-04
+By HTTP:
+Hackage.
+
+- bugfix for #if defined(FOO) && FOO(a,b)
+
- (1.20.1) fix version number
+
+
+
+cpphs-1.19.3, release date 2015-08-23
+By HTTP:
+Hackage.
+
+- bugfix for hlint ticket #161, for
+ the interaction of --unlit and --linepragma options
+
+
+
+cpphs-1.19.2, release date 2015-07-31
+By HTTP:
+Hackage.
+
+
+
+cpphs-1.19.1, release date 2015-07-30
+By HTTP:
+Hackage.
+
+- don't warn about trailing comments in #ifdefs
+
+
+
+cpphs-1.19, release date 2015-03-30
+By HTTP:
+Hackage.
+
+- expose more of the API
+
+
+
+cpphs-1.18.9, release date 2015-02-19
+By HTTP:
+Hackage.
+
+- accept "#if defined foo" as well as "#if defined(foo)"
+
+
+
+cpphs-1.18.8, release date 2015-01-20
+By HTTP:
+Hackage.
+
+
+
+cpphs-1.18.7, release date 2015.01.17
+By HTTP:
+Hackage.
+
+- bugfix to accept a #include with absolute filepath
+
+
+
+cpphs-1.18.6, release date 2014.10.17
+By HTTP:
+Hackage.
+
+- bugfix to reject a macro usage with different arity than its definition
+
+
+
+cpphs-1.18.5, release date 2014.06.26
+By HTTP:
+Hackage.
+
+- fix a bug related to windows filepath directory separators in #includes
+
+
+
+cpphs-1.18.4, release date 2014.03.22
+By HTTP:
+Hackage.
+
+- fix the accidental flipping of comment-stripping behaviour
+ with --cpp -traditional flags.
+
+
+
+cpphs-1.18.3, release date 2014.03.03
+By HTTP:
+Hackage.
+
+- further rewrites of the #if expression parser, for better error messages,
+ support for integer operations, and fewer precedence bugs
+
+
+
+cpphs-1.18.2, release date 2014.02.24
+By HTTP:
+Hackage.
+
+- bugfix for erroneous boolean interpretation of some macro
+ expansions in #if clauses
+
+
+
+cpphs-1.18.1, release date 2014.02.18
+By HTTP:
+Hackage.
+
+- fix for incomplete pattern-match
+
+
+
+cpphs-1.18, release date 2014.02.04
+By HTTP:
+Hackage.
+
+- Better lexing of Template Haskell single quotes. (Thanks to Stephan Wehr)
+
+
+
+cpphs-1.17.1, release date 2013.08.18
+By HTTP:
+Hackage.
+
+- (minor) Report the correct version number with cpphs --version
+
+
+
+cpphs-1.17, release date 2013.08.16
+By HTTP:
+.tar.gz,
+Hackage.
+
+- Recursively evaluate #if expressions after macro expansion (bugfix).
+
+
+
+cpphs-1.16, release date 2013.01.22
+By HTTP:
+.tar.gz,
+Hackage.
+
+- Fix the interaction of runCpphsReturningSymTab with --nomacro.
+
+
+
+cpphs-1.15, release date 2012.11.30
+By HTTP:
+.tar.gz,
+Hackage.
+
+- Fix the interaction of --nomacro with --strip.
+
- Fix the error message received when # appears without a command.
+
+
+
+cpphs-1.14, release date 2012.07.11
+By HTTP:
+.tar.gz,
+Hackage.
+
+- New API to return symbol table after processing.
+
+
+
+cpphs-1.13, release date 2011.09.26
+By HTTP:
+.tar.gz,
+Hackage.
+
+- Accept the -U commandline option for compatibility with cpp.
+
+
+
+cpphs-1.12, release date 2011.06.26
+By HTTP:
+.tar.gz,
+Hackage.
+
+- Compatibility fixes for ghc-7.2.
+
+
+
+cpphs-1.11, release date 2010.01.31
+By HTTP:
+.tar.gz,
+.zip,
+Hackage.
+
+- Major API change: runCpphs, cppIfdef and macroPass are now in the IO monad.
+
+
+
cpphs-1.10, release date 2010.01.30
By HTTP:
.tar.gz,
@@ -570,18 +808,20 @@
guarantee to implement them if they depart much from the ordinary
cpp's behaviour. Please mail
-Copyright: © 2004-2010 Malcolm Wallace,
-except for ParseLib (Copyright © 1995 Graham Hutton and Erik Meijer)
+
Copyright: © 2004-2016 Malcolm Wallace
License: The library modules in cpphs are distributed under
the terms of the LGPL (see file LICENCE-LGPL
-for more details). If that's a problem for you, contact me to make
+for more details), with a special exception for static linking (see file COPYRIGHT. If that's a problem for you, contact me to make
other arrangements. The application module 'cpphs.hs' itself is GPL
-(see file LICENCE-GPL).
+(see file LICENCE-GPL). If you have a
+commercial use for cpphs and find the terms of the (L)GPL too onerous,
+you can instead choose to distribute unmodified binaries (not source),
+under the terms of LICENCE-commercial
This software comes with no warranty. Use at your own risk.
diff --git a/new/TimeCompat.hs b/new/TimeCompat.hs
new file mode 100644
--- /dev/null
+++ b/new/TimeCompat.hs
@@ -0,0 +1,2 @@
+module TimeCompat (defaultTimeLocale) where
+import Data.Time.Format (defaultTimeLocale)
diff --git a/tests/Arr.lhs b/tests/Arr.lhs
deleted file mode 100644
--- a/tests/Arr.lhs
+++ /dev/null
@@ -1,683 +0,0 @@
-\begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}
------------------------------------------------------------------------------
--- |
--- Module : GHC.Arr
--- Copyright : (c) The University of Glasgow, 1994-2000
--- License : see libraries/base/LICENSE
---
--- Maintainer : cvs-ghc@haskell.org
--- Stability : internal
--- Portability : non-portable (GHC extensions)
---
--- GHC\'s array implementation.
---
------------------------------------------------------------------------------
-
--- #hide
-module GHC.Arr where
-
-import {-# SOURCE #-} GHC.Err ( error )
-import GHC.Enum
-import GHC.Num
-import GHC.ST
-import GHC.Base
-import GHC.List
-import GHC.Show
-
-infixl 9 !, //
-
-default ()
-\end{code}
-
-
-%*********************************************************
-%* *
-\subsection{The @Ix@ class}
-%* *
-%*********************************************************
-
-\begin{code}
--- | The 'Ix' class is used to map a contiguous subrange of values in
--- a type onto integers. It is used primarily for array indexing
--- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").
---
--- The first argument @(l,u)@ of each of these operations is a pair
--- specifying the lower and upper bounds of a contiguous subrange of values.
---
--- An implementation is entitled to assume the following laws about these
--- operations:
---
--- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@
---
--- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@
---
--- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@
---
--- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@
---
--- Minimal complete instance: 'range', 'index' and 'inRange'.
---
-class (Ord a) => Ix a where
- -- | The list of values in the subrange defined by a bounding pair.
- range :: (a,a) -> [a]
- -- | The position of a subscript in the subrange.
- index :: (a,a) -> a -> Int
- -- | Like 'index', but without checking that the value is in range.
- unsafeIndex :: (a,a) -> a -> Int
- -- | Returns 'True' the given subscript lies in the range defined
- -- the bounding pair.
- inRange :: (a,a) -> a -> Bool
- -- | The size of the subrange defined by a bounding pair.
- rangeSize :: (a,a) -> Int
- -- | like 'rangeSize', but without checking that the upper bound is
- -- in range.
- unsafeRangeSize :: (a,a) -> Int
-
- -- Must specify one of index, unsafeIndex
- index b i | inRange b i = unsafeIndex b i
- | otherwise = error "Error in array index"
- unsafeIndex b i = index b i
-
- rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
- | otherwise = 0 -- This case is only here to
- -- check for an empty range
- -- NB: replacing (inRange b h) by (l <= h) fails for
- -- tuples. E.g. (1,2) <= (2,1) but the range is empty
-
- unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
-\end{code}
-
-Note that the following is NOT right
- rangeSize (l,h) | l <= h = index b h + 1
- | otherwise = 0
-
-Because it might be the case that l (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}
diff --git a/tests/HsOpenGLExt.h b/tests/HsOpenGLExt.h
deleted file mode 100644
--- a/tests/HsOpenGLExt.h
+++ /dev/null
@@ -1,31 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * Module : GL extension support for Graphics.Rendering.OpenGL
- * Copyright : (c) Sven Panne 2002-2004
- * License : BSD-style (see the file libraries/OpenGL/LICENSE)
- *
- * Maintainer : sven.panne@aedion.de
- * Stability : provisional
- * Portability : portable
- *
- * This header should only define preprocessor macros!
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef HSOPENGLEXT_H
-#define HSOPENGLEXT_H
-
-/* NOTE: The macro must immediately start with the foreign declaration,
- otherwise the magic mangler (hack_foreign) in the Hugs build system
- doesn't recognize it. */
-#define EXTENSION_ENTRY(_msg,_entry,_ty) \
-foreign import CALLCONV unsafe "dynamic" dyn_/**/_entry :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (_ty) ; \
-_entry :: (_ty) ; \
-_entry = dyn_##_entry ptr_##_entry ; \
-ptr_/**/_entry :: FunPtr a ; \
-ptr_/**/_entry = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress (_msg) ("_entry")) ; \
-{-# NOINLINE ptr_/**/_entry #-}
-
-#endif
-
-EXTENSION_ENTRY("GL_EXT_fog_coord or OpenGL 1.4",glFogCoorddEXT,GLdouble -> IO ())
diff --git a/tests/MachDeps.h b/tests/MachDeps.h
deleted file mode 100644
--- a/tests/MachDeps.h
+++ /dev/null
diff --git a/tests/Storable.hs b/tests/Storable.hs
deleted file mode 100644
--- a/tests/Storable.hs
+++ /dev/null
@@ -1,246 +0,0 @@
-{-# OPTIONS -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module : Foreign.Storable
--- Copyright : (c) The FFI task force 2001
--- License : see libraries/base/LICENSE
---
--- Maintainer : ffi@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- The module "Foreign.Storable" provides most elementary support for
--- marshalling and is part of the language-independent portion of the
--- Foreign Function Interface (FFI), and will normally be imported via
--- the "Foreign" module.
---
------------------------------------------------------------------------------
-
-module Foreign.Storable
- ( Storable(
- sizeOf, -- :: a -> Int
- alignment, -- :: a -> Int
- peekElemOff, -- :: Ptr a -> Int -> IO a
- pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
- peekByteOff, -- :: Ptr b -> Int -> IO a
- pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
- peek, -- :: Ptr a -> IO a
- poke) -- :: Ptr a -> a -> IO ()
- ) where
-
-
-#ifdef __NHC__
-import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr
- ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)
-#else
-
-import Control.Monad ( liftM )
-
-#include "MachDeps.h"
-#include "config.h"
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Storable
-import GHC.Stable ( StablePtr )
-import GHC.Num
-import GHC.Int
-import GHC.Word
-import GHC.Stable
-import GHC.Ptr
-import GHC.Float
-import GHC.Err
-import GHC.IOBase
-import GHC.Base
-#else
-import Data.Int
-import Data.Word
-import Foreign.Ptr
-import Foreign.StablePtr
-#endif
-
-#ifdef __HUGS__
-import Hugs.Prelude
-import Hugs.Storable
-#endif
-
-{- |
-The member functions of this class facilitate writing values of
-primitive types to raw memory (which may have been allocated with the
-above mentioned routines) and reading values from blocks of raw
-memory. The class, furthermore, includes support for computing the
-storage requirements and alignment restrictions of storable types.
-
-Memory addresses are represented as values of type @'Ptr' a@, for some
-@a@ which is an instance of class 'Storable'. The type argument to
-'Ptr' helps provide some valuable type safety in FFI code (you can\'t
-mix pointers of different types without an explicit cast), while
-helping the Haskell type system figure out which marshalling method is
-needed for a given pointer.
-
-All marshalling between Haskell and a foreign language ultimately
-boils down to translating Haskell data structures into the binary
-representation of a corresponding data structure of the foreign
-language and vice versa. To code this marshalling in Haskell, it is
-necessary to manipulate primtive data types stored in unstructured
-memory blocks. The class 'Storable' facilitates this manipulation on
-all types for which it is instantiated, which are the standard basic
-types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
-'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
-'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
-as well as 'Ptr'.
-
-Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
-'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
-'pokeByteOff'.
--}
-
-class Storable a where
-
- sizeOf :: a -> Int
- -- ^ Computes the storage requirements (in bytes) of the argument.
- -- The value of the argument is not used.
-
- alignment :: a -> Int
- -- ^ Computes the alignment constraint of the argument. An
- -- alignment constraint @x@ is fulfilled by any address divisible
- -- by @x@. The value of the argument is not used.
-
- peekElemOff :: Ptr a -> Int -> IO a
- -- ^ Read a value from a memory area regarded as an array
- -- of values of the same kind. The first argument specifies
- -- the start address of the array and the second the index into
- -- the array (the first element of the array has index
- -- @0@). The following equality holds,
- --
- -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
- -- > peek (addr `plusPtr` (idx * sizeOf result))
- --
- -- Note that this is only a specification, not
- -- necessarily the concrete implementation of the
- -- function.
-
- pokeElemOff :: Ptr a -> Int -> a -> IO ()
- -- ^ Write a value to a memory area regarded as an array of
- -- values of the same kind. The following equality holds:
- --
- -- > pokeElemOff addr idx x =
- -- > poke (addr `plusPtr` (idx * sizeOf x)) x
-
- peekByteOff :: Ptr b -> Int -> IO a
- -- ^ Read a value from a memory location given by a base
- -- address and offset. The following equality holds:
- --
- -- > peekByteOff addr off = peek (addr `plusPtr` off)
-
- pokeByteOff :: Ptr b -> Int -> a -> IO ()
- -- ^ Write a value to a memory location given by a base
- -- address and offset. The following equality holds:
- --
- -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
-
- peek :: Ptr a -> IO a
- -- ^ Read a value from the given memory location.
- --
- -- Note that the peek and poke functions might require properly
- -- aligned addresses to function correctly. This is architecture
- -- dependent; thus, portable code should ensure that when peeking or
- -- poking values of some type @a@, the alignment
- -- constraint for @a@, as given by the function
- -- 'alignment' is fulfilled.
-
- poke :: Ptr a -> a -> IO ()
- -- ^ Write the given value to the given memory location. Alignment
- -- restrictions might apply; see 'peek'.
-
- -- circular default instances
-#ifdef __GLASGOW_HASKELL__
- peekElemOff = peekElemOff_ undefined
- where peekElemOff_ :: a -> Ptr a -> Int -> IO a
- peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
-#else
- peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)
-#endif
- pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
-
- peekByteOff ptr off = peek (ptr `plusPtr` off)
- pokeByteOff ptr off = poke (ptr `plusPtr` off)
-
- peek ptr = peekElemOff ptr 0
- poke ptr = pokeElemOff ptr 0
-
-#ifndef __GLASGOW_HASKELL__
-sizeOfPtr :: Storable a => Ptr a -> a -> Int
-sizeOfPtr px x = sizeOf x
-#endif
-
--- System-dependent, but rather obvious instances
-
-instance Storable Bool where
- sizeOf _ = sizeOf (undefined::HTYPE_INT)
- alignment _ = alignment (undefined::HTYPE_INT)
- peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
- pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
-
-#define STORABLE(T,size,align,read,write) \
-instance Storable (T) where { \
- sizeOf _ = size; \
- alignment _ = align; \
- peekElemOff = read; \
- pokeElemOff = write }
-
-#ifdef __GLASGOW_HASKELL__
-STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
- readWideCharOffPtr,writeWideCharOffPtr)
-#elif defined(__HUGS__)
-STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,
- readCharOffPtr,writeCharOffPtr)
-#endif
-
-STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
- readIntOffPtr,writeIntOffPtr)
-
-#ifdef __GLASGOW_HASKELL__
-STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
- readWordOffPtr,writeWordOffPtr)
-#endif
-
-STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
- readPtrOffPtr,writePtrOffPtr)
-
-STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
- readFunPtrOffPtr,writeFunPtrOffPtr)
-
-STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
- readStablePtrOffPtr,writeStablePtrOffPtr)
-
-STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
- readFloatOffPtr,writeFloatOffPtr)
-
-STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
- readDoubleOffPtr,writeDoubleOffPtr)
-
-STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
- readWord8OffPtr,writeWord8OffPtr)
-
-STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
- readWord16OffPtr,writeWord16OffPtr)
-
-STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
- readWord32OffPtr,writeWord32OffPtr)
-
-STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
- readWord64OffPtr,writeWord64OffPtr)
-
-STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
- readInt8OffPtr,writeInt8OffPtr)
-
-STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
- readInt16OffPtr,writeInt16OffPtr)
-
-STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
- readInt32OffPtr,writeInt32OffPtr)
-
-STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
- readInt64OffPtr,writeInt64OffPtr)
-
-#endif
diff --git a/tests/Test.hsc b/tests/Test.hsc
deleted file mode 100644
--- a/tests/Test.hsc
+++ /dev/null
@@ -1,11 +0,0 @@
-module Test where
-
-main :: IO ()
-main = putStrLn "shows a cpphs+hsc2hs bug with comments"
-
-#def inline int that_one_will_work(void) {return 42;}
-
-{-
-#def inline int cpphs_will_stumble(void) {return 42;}
--}
-
diff --git a/tests/chains b/tests/chains
deleted file mode 100644
--- a/tests/chains
+++ /dev/null
@@ -1,16 +0,0 @@
-For this test, assume that all of e,f,g,h are defined.
-Also that c,d are defined, a,b are not.
-If cpphs does operator precedence wrongly in infix chains, the final
-conditional will be interpreted wrongly.
-
-#if defined(a) || defined(b) || defined(c) || defined(d)
-chained || OK
-#endif
-#if defined(e) && defined(f) && defined(g) && defined(h)
-chained && OK
-#endif
-#if defined(a) && defined(b) || defined(c) && defined(d)
-mixed chain of || and && OK
-#else
-mixed chain of || and && BROKEN
-#endif
diff --git a/tests/comments b/tests/comments
deleted file mode 100644
--- a/tests/comments
+++ /dev/null
@@ -1,3 +0,0 @@
-here is an ordinary C comment: /* comment here */
-and here is a C++-style end-of-line comment: // comment here
-this line has no comments
diff --git a/tests/config.h b/tests/config.h
deleted file mode 100644
--- a/tests/config.h
+++ /dev/null
diff --git a/tests/cpp b/tests/cpp
deleted file mode 100644
--- a/tests/cpp
+++ /dev/null
@@ -1,9 +0,0 @@
-#define /**/ ++ `mplus` // not expected to work
-#define 0 mzero // not expected to work
-#define x0 X' // should work
-#define x' Xprime // should work
-#define `foo` .(foo)/**/, // bizarreness
-
-x ++ y = x0 * 0 * y `foo` x'
-
-// /*
diff --git a/tests/elif b/tests/elif
deleted file mode 100644
--- a/tests/elif
+++ /dev/null
@@ -1,10 +0,0 @@
-#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \
- ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)
-import System.IO.Unsafe (unsafePerformIO)
-#elif defined(__GLASGOW_HASKELL__)
-import IOExts (unsafePerformIO)
-#elif defined(__NHC__)
-import IOExtras (unsafePerformIO)
-#elif defined(__HBC__)
-import UnsafePerformIO
-#endif
diff --git a/tests/endcode-a b/tests/endcode-a
deleted file mode 100644
--- a/tests/endcode-a
+++ /dev/null
@@ -1,3 +0,0 @@
-\hidden{
-\begin{code}
-\end{code}}
diff --git a/tests/endcode-b b/tests/endcode-b
deleted file mode 100644
--- a/tests/endcode-b
+++ /dev/null
@@ -1,4 +0,0 @@
-\hidden{
-\begin{code}
-\end{code}
-}
diff --git a/tests/expect1 b/tests/expect1
deleted file mode 100644
--- a/tests/expect1
+++ /dev/null
@@ -1,36 +0,0 @@
-#line 1 "testfile"
-1 top of file
-
-3
-
-5 X is defined
-
-7
-
-
-
-11
-
-
-
-15
-
-
-
-19
-
-
-
-23 no inclusion, this is an else clause
-
-25
-
-
-
-
-
-31 third branch of elif
-
-33
-34 end of file
-
diff --git a/tests/expect10 b/tests/expect10
deleted file mode 100644
--- a/tests/expect10
+++ /dev/null
@@ -1,15 +0,0 @@
-#line 1 "multiline"
-
-
-
-
-5 back to ordinary text.
-#line 1 "./inclusion"
-hello world, this is an inclusion
-
-#line 7 "multiline"
-7 hello again
-8 some more
-9 aLongMacroDefinition(a,b)
-10 end
-
diff --git a/tests/expect11 b/tests/expect11
deleted file mode 100644
--- a/tests/expect11
+++ /dev/null
@@ -1,3 +0,0 @@
-#line 1 "stringise"
-
-This is "abcd ef" foo abcd ef
diff --git a/tests/expect12 b/tests/expect12
deleted file mode 100644
--- a/tests/expect12
+++ /dev/null
@@ -1,5 +0,0 @@
-#line 1 "recursive"
-
-
-
-D D D D D D D D
diff --git a/tests/expect13 b/tests/expect13
deleted file mode 100644
--- a/tests/expect13
+++ /dev/null
@@ -1,20 +0,0 @@
-#line 1 "ross"
-
-
-
-
-
-
-f = 4
-
-
-
-
-
-
-g = do { putStr "Hello "; putStrLn "World" }
-
-
-
-
-h = 4
diff --git a/tests/expect14 b/tests/expect14
deleted file mode 100644
--- a/tests/expect14
+++ /dev/null
@@ -1,4 +0,0 @@
-#line 1 "precedence"
-
-
-
diff --git a/tests/expect15 b/tests/expect15
deleted file mode 100644
--- a/tests/expect15
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "indirect"
-
-#line 1 "./inclusion"
-hello world, this is an inclusion
-
-#line 3 "indirect"
diff --git a/tests/expect15a b/tests/expect15a
deleted file mode 100644
--- a/tests/expect15a
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "indirect-a"
-
-#line 1 "./inclusion"
-hello world, this is an inclusion
-
-#line 3 "indirect-a"
diff --git a/tests/expect16 b/tests/expect16
deleted file mode 100644
--- a/tests/expect16
+++ /dev/null
@@ -1,30 +0,0 @@
-#line 1 "numbers"
-
-number (1) in if
-
-
-
-
-
-
-
-number (0) in if
-
-
-
-
-
-rejected false hex number in if
-
-
-
-real hex number (0x1) in if
-
-
-
-
-
-
-
-hex number (0x00) in if
-
diff --git a/tests/expect17 b/tests/expect17
deleted file mode 100644
--- a/tests/expect17
+++ /dev/null
@@ -1,2 +0,0 @@
-#line 1 "pragma"
-
diff --git a/tests/expect18 b/tests/expect18
deleted file mode 100644
--- a/tests/expect18
+++ /dev/null
@@ -1,1 +0,0 @@
-
diff --git a/tests/expect19 b/tests/expect19
deleted file mode 100644
--- a/tests/expect19
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "parens"
-
-
-
-
-yes
diff --git a/tests/expect2 b/tests/expect2
deleted file mode 100644
--- a/tests/expect2
+++ /dev/null
@@ -1,36 +0,0 @@
-#line 1 "testfile"
-1 top of file
-
-3
-
-5 X is defined
-
-7
-
-
-
-11
-
-
-
-15
-
-
-
-19
-
-
-
-23 no inclusion, this is an else clause
-
-25
-
-27 no elif
-
-
-
-
-
-33
-34 end of file
-
diff --git a/tests/expect20 b/tests/expect20
deleted file mode 100644
--- a/tests/expect20
+++ /dev/null
@@ -1,17 +0,0 @@
-#line 1 "chains"
-For this test, assume that all of 1,1,1,1 are defined.
-Also that 1,1 are defined, a,b are not.
-If cpphs does operator precedence wrongly in infix chains, the final
-conditional will be interpreted wrongly.
-
-
-chained || OK
-
-
-chained && OK
-
-
-mixed chain of || and && OK
-
-
-
diff --git a/tests/expect21 b/tests/expect21
deleted file mode 100644
--- a/tests/expect21
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "specials"
-
-line 2
-line 3
-line 4 Error "horrible" at line 4 of file "specials"
-line 5
diff --git a/tests/expect22 b/tests/expect22
deleted file mode 100644
--- a/tests/expect22
+++ /dev/null
@@ -1,13 +0,0 @@
-#line 1 "specialinclude"
-1
-2
-#line 1 "./specials"
-
-line 2
-line 3
-line 4 Error "horrible" at line 4 of file "./specials"
-line 5
-
-#line 4 "specialinclude"
-4
-5
diff --git a/tests/expect23 b/tests/expect23
deleted file mode 100644
--- a/tests/expect23
+++ /dev/null
@@ -1,2 +0,0 @@
-#line 1 "incomplete"
-incomplete
diff --git a/tests/expect24 b/tests/expect24
deleted file mode 100644
--- a/tests/expect24
+++ /dev/null
@@ -1,15 +0,0 @@
-#line 1 "text"
-Here is some ordinary text with embedded Haskell-ish constructs,
-that should however /not/ be interpreted as Haskell if the --text
-option is given to cpphs. For instance, here is a Haskell comment
-including a cpp definition: {-
-# define FOO bar
-and now we end the comment: -} and try out the definition: FOO
-Likewise, double and single quotes no longer delimit strings or chars: "
-# define BAZ FOO
-and what do we have here?: " ' BAZ '
-
-
-Also, in text-mode, macros should be expanded inside Haskell comments:
- -- expand(this,other,that)
-and strings "expand(this,other,that)".
diff --git a/tests/expect25 b/tests/expect25
deleted file mode 100644
--- a/tests/expect25
+++ /dev/null
@@ -1,15 +0,0 @@
-#line 1 "text"
-Here is some ordinary text with embedded Haskell-ish constructs,
-that should however /not/ be interpreted as Haskell if the --text
-option is given to cpphs. For instance, here is a Haskell comment
-including a cpp definition: {-
-
-and now we end the comment: -} and try out the definition: bar
-Likewise, double and single quotes no longer delimit strings or chars: "
-
-and what do we have here?: " ' bar '
-
-
-Also, in text-mode, macros should be expanded inside Haskell comments:
- -- Some text including this, the other, and that.
-and strings "Some text including this, the other, and that.".
diff --git a/tests/expect26 b/tests/expect26
deleted file mode 100644
--- a/tests/expect26
+++ /dev/null
@@ -1,17 +0,0 @@
-#line 1 "nastyhack"
-
--- hackery to convice cpp to splice 6.2.2 into a string
-version :: String
-version = tail "\
- \ 6.2.2"
-
-version2 = "6.2.2"
-
-
-version3 = "6.2.2"
-
-
-version4 = #6.2.2
-
-
-version5 = "6.2.2"
diff --git a/tests/expect27 b/tests/expect27
deleted file mode 100644
--- a/tests/expect27
+++ /dev/null
@@ -1,17 +0,0 @@
-#line 1 "nastyhack"
-
--- hackery to convice cpp to splice GHC_PKG_VERSION into a string
-version :: String
-version = tail "\
- \ GHC_PKG_VERSION"
-
-version2 = "GHC_PKG_VERSION"
-
-
-version3 = "GHC_PKG_VERSION"
-
-
-version4 = #6.2.2
-
-
-version5 = "6.2.2"
diff --git a/tests/expect28 b/tests/expect28
deleted file mode 100644
--- a/tests/expect28
+++ /dev/null
@@ -1,4 +0,0 @@
-#line 1 "symbolvalue"
-
-the symbol is defined as 1
-
diff --git a/tests/expect29 b/tests/expect29
deleted file mode 100644
--- a/tests/expect29
+++ /dev/null
@@ -1,12 +0,0 @@
-#line 1 "Test.hsc"
-module Test where
-
-main :: IO ()
-main = putStrLn "shows a cpphs+hsc2hs bug with comments"
-
-
-
-{-
-#def inline int cpphs_will_stumble(void) {return 42;}
--}
-
diff --git a/tests/expect3 b/tests/expect3
deleted file mode 100644
--- a/tests/expect3
+++ /dev/null
@@ -1,36 +0,0 @@
-#line 1 "testfile"
-1 top of file
-
-3
-
-5 X is defined
-
-7
-
-
-
-11
-
-
-
-15
-
-
-
-19
-
-
-
-23 no inclusion, this is an else clause
-
-25
-
-
-
-29 this is an elif
-
-
-
-33
-34 end of file
-
diff --git a/tests/expect30 b/tests/expect30
deleted file mode 100644
--- a/tests/expect30
+++ /dev/null
@@ -1,685 +0,0 @@
-#line 1 "Arr.lhs"
-
-{-# OPTIONS_GHC -fno-implicit-prelude -fno-bang-patterns #-}
------------------------------------------------------------------------------
--- |
--- Module : GHC.Arr
--- Copyright : (c) The University of Glasgow, 1994-2000
--- License : see libraries/base/LICENSE
---
--- Maintainer : cvs-ghc@haskell.org
--- Stability : internal
--- Portability : non-portable (GHC extensions)
---
--- GHC\'s array implementation.
---
------------------------------------------------------------------------------
-
--- #hide
-module GHC.Arr where
-
-import {-# SOURCE #-} GHC.Err ( error )
-import GHC.Enum
-import GHC.Num
-import GHC.ST
-import GHC.Base
-import GHC.List
-import GHC.Show
-
-infixl 9 !, //
-
-default ()
-
-
-
-
-
-
-
-
-
-
--- | The 'Ix' class is used to map a contiguous subrange of values in
--- a type onto integers. It is used primarily for array indexing
--- (see "Data.Array", "Data.Array.IArray" and "Data.Array.MArray").
---
--- The first argument @(l,u)@ of each of these operations is a pair
--- specifying the lower and upper bounds of a contiguous subrange of values.
---
--- An implementation is entitled to assume the following laws about these
--- operations:
---
--- * @'inRange' (l,u) i == 'elem' i ('range' (l,u))@
---
--- * @'range' (l,u) '!!' 'index' (l,u) i == i@, when @'inRange' (l,u) i@
---
--- * @'map' ('index' (l,u)) ('range' (l,u))) == [0..'rangeSize' (l,u)-1]@
---
--- * @'rangeSize' (l,u) == 'length' ('range' (l,u))@
---
--- Minimal complete instance: 'range', 'index' and 'inRange'.
---
-class (Ord a) => Ix a where
- -- | The list of values in the subrange defined by a bounding pair.
- range :: (a,a) -> [a]
- -- | The position of a subscript in the subrange.
- index :: (a,a) -> a -> Int
- -- | Like 'index', but without checking that the value is in range.
- unsafeIndex :: (a,a) -> a -> Int
- -- | Returns 'True' the given subscript lies in the range defined
- -- the bounding pair.
- inRange :: (a,a) -> a -> Bool
- -- | The size of the subrange defined by a bounding pair.
- rangeSize :: (a,a) -> Int
- -- | like 'rangeSize', but without checking that the upper bound is
- -- in range.
- unsafeRangeSize :: (a,a) -> Int
-
- -- Must specify one of index, unsafeIndex
- index b i | inRange b i = unsafeIndex b i
- | otherwise = error "Error in array index"
- unsafeIndex b i = index b i
-
- rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1
- | otherwise = 0 -- This case is only here to
- -- check for an empty range
- -- NB: replacing (inRange b h) by (l <= h) fails for
- -- tuples. E.g. (1,2) <= (2,1) but the range is empty
-
- unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
--- abstract these errors from the relevant index functions so that
--- the guts of the function will be small enough to inline.
-
-{-# NOINLINE indexError #-}
-indexError :: Show a => (a,a) -> a -> String -> b
-indexError rng i tp
- = error (showString "Ix{" . showString tp . showString "}.index: Index " .
- showParen True (showsPrec 0 i) .
- showString " out of range " $
- showParen True (showsPrec 0 rng) "")
-
-----------------------------------------------------------------------
-instance Ix Char where
- {-# INLINE range #-}
- range (m,n) = [m..n]
-
- {-# INLINE unsafeIndex #-}
- unsafeIndex (m,_n) i = fromEnum i - fromEnum m
-
- index b i | inRange b i = unsafeIndex b i
- | otherwise = indexError b i "Char"
-
- inRange (m,n) i = m <= i && i <= n
-
-----------------------------------------------------------------------
-instance Ix Int where
- {-# INLINE range #-}
- -- The INLINE stops the build in the RHS from getting inlined,
- -- so that callers can fuse with the result of range
- range (m,n) = [m..n]
-
- {-# INLINE unsafeIndex #-}
- unsafeIndex (m,_n) i = i - m
-
- index b i | inRange b i = unsafeIndex b i
- | otherwise = indexError b i "Int"
-
- {-# INLINE inRange #-}
- inRange (I# m,I# n) (I# i) = m <=# i && i <=# n
-
-----------------------------------------------------------------------
-instance Ix Integer where
- {-# INLINE range #-}
- range (m,n) = [m..n]
-
- {-# INLINE unsafeIndex #-}
- unsafeIndex (m,_n) i = fromInteger (i - m)
-
- index b i | inRange b i = unsafeIndex b i
- | otherwise = indexError b i "Integer"
-
- inRange (m,n) i = m <= i && i <= n
-
-----------------------------------------------------------------------
-instance Ix Bool where -- as derived
- {-# INLINE range #-}
- range (m,n) = [m..n]
-
- {-# INLINE unsafeIndex #-}
- unsafeIndex (l,_) i = fromEnum i - fromEnum l
-
- index b i | inRange b i = unsafeIndex b i
- | otherwise = indexError b i "Bool"
-
- inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
-
-----------------------------------------------------------------------
-instance Ix Ordering where -- as derived
- {-# INLINE range #-}
- range (m,n) = [m..n]
-
- {-# INLINE unsafeIndex #-}
- unsafeIndex (l,_) i = fromEnum i - fromEnum l
-
- index b i | inRange b i = unsafeIndex b i
- | otherwise = indexError b i "Ordering"
-
- inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u
-
-----------------------------------------------------------------------
-instance Ix () where
- {-# INLINE range #-}
- range ((), ()) = [()]
- {-# INLINE unsafeIndex #-}
- unsafeIndex ((), ()) () = 0
- {-# INLINE inRange #-}
- inRange ((), ()) () = True
- {-# INLINE index #-}
- index b i = unsafeIndex b i
-
-----------------------------------------------------------------------
-instance (Ix a, Ix b) => Ix (a, b) where -- as derived
- {-# SPECIALISE instance Ix (Int,Int) #-}
-
- {- INLINE range #-}
- range ((l1,l2),(u1,u2)) =
- [ (i1,i2) | i1 <- range (l1,u1), i2 <- range (l2,u2) ]
-
- {- INLINE unsafeIndex #-}
- unsafeIndex ((l1,l2),(u1,u2)) (i1,i2) =
- unsafeIndex (l1,u1) i1 * unsafeRangeSize (l2,u2) + unsafeIndex (l2,u2) i2
-
- {- INLINE inRange #-}
- inRange ((l1,l2),(u1,u2)) (i1,i2) =
- inRange (l1,u1) i1 && inRange (l2,u2) i2
-
- -- Default method for index
-
-----------------------------------------------------------------------
-instance (Ix a1, Ix a2, Ix a3) => Ix (a1,a2,a3) where
- {-# SPECIALISE instance Ix (Int,Int,Int) #-}
-
- range ((l1,l2,l3),(u1,u2,u3)) =
- [(i1,i2,i3) | i1 <- range (l1,u1),
- i2 <- range (l2,u2),
- i3 <- range (l3,u3)]
-
- unsafeIndex ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
- unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
- unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
- unsafeIndex (l1,u1) i1))
-
- inRange ((l1,l2,l3),(u1,u2,u3)) (i1,i2,i3) =
- inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
- inRange (l3,u3) i3
-
- -- Default method for index
-
-----------------------------------------------------------------------
-instance (Ix a1, Ix a2, Ix a3, Ix a4) => Ix (a1,a2,a3,a4) where
- range ((l1,l2,l3,l4),(u1,u2,u3,u4)) =
- [(i1,i2,i3,i4) | i1 <- range (l1,u1),
- i2 <- range (l2,u2),
- i3 <- range (l3,u3),
- i4 <- range (l4,u4)]
-
- unsafeIndex ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
- unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
- unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
- unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
- unsafeIndex (l1,u1) i1)))
-
- inRange ((l1,l2,l3,l4),(u1,u2,u3,u4)) (i1,i2,i3,i4) =
- inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
- inRange (l3,u3) i3 && inRange (l4,u4) i4
-
- -- Default method for index
-
-instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where
- range ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) =
- [(i1,i2,i3,i4,i5) | i1 <- range (l1,u1),
- i2 <- range (l2,u2),
- i3 <- range (l3,u3),
- i4 <- range (l4,u4),
- i5 <- range (l5,u5)]
-
- unsafeIndex ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
- unsafeIndex (l5,u5) i5 + unsafeRangeSize (l5,u5) * (
- unsafeIndex (l4,u4) i4 + unsafeRangeSize (l4,u4) * (
- unsafeIndex (l3,u3) i3 + unsafeRangeSize (l3,u3) * (
- unsafeIndex (l2,u2) i2 + unsafeRangeSize (l2,u2) * (
- unsafeIndex (l1,u1) i1))))
-
- inRange ((l1,l2,l3,l4,l5),(u1,u2,u3,u4,u5)) (i1,i2,i3,i4,i5) =
- inRange (l1,u1) i1 && inRange (l2,u2) i2 &&
- inRange (l3,u3) i3 && inRange (l4,u4) i4 &&
- inRange (l5,u5) i5
-
- -- Default method for index
-
-
-
-
-
-
-
-
-
-type IPr = (Int, Int)
-
--- | The type of immutable non-strict (boxed) arrays
--- with indices in @i@ and elements in @e@.
-data Ix i => Array i e = Array !i !i (Array# e)
-
--- | Mutable, boxed, non-strict arrays in the 'ST' monad. The type
--- arguments are as follows:
---
--- * @s@: the state variable argument for the 'ST' type
---
--- * @i@: the index type of the array (should be an instance of 'Ix')
---
--- * @e@: the element type of the array.
---
-data STArray s i e = STArray !i !i (MutableArray# s e)
- -- No Ix context for STArray. They are stupid,
- -- and force an Ix context on the equality instance.
-
--- Just pointer equality on mutable arrays:
-instance Eq (STArray s i e) where
- STArray _ _ arr1# == STArray _ _ arr2# =
- sameMutableArray# arr1# arr2#
-
-
-
-
-
-
-
-
-
-
-{-# NOINLINE arrEleBottom #-}
-arrEleBottom :: a
-arrEleBottom = error "(Array.!): undefined array element"
-
--- | Construct an array with the specified bounds and containing values
--- for given indices within these bounds.
---
--- The array is undefined (i.e. bottom) if any index in the list is
--- out of bounds. The Haskell 98 Report further specifies that if any
--- two associations in the list have the same index, the value at that
--- index is undefined (i.e. bottom). However in GHC's implementation,
--- the value at such an index is the value part of the last association
--- with that index in the list.
---
--- Because the indices must be checked for these errors, 'array' is
--- strict in the bounds argument and in the indices of the association
--- list, but nonstrict in the values. Thus, recurrences such as the
--- following are possible:
---
--- > a = array (1,100) ((1,1) : [(i, i * a!(i-1)) | i <- [2..100]])
---
--- Not every index within the bounds of the array need appear in the
--- association list, but the values associated with indices that do not
--- appear will be undefined (i.e. bottom).
---
--- If, in any dimension, the lower bound is greater than the upper bound,
--- then the array is legal, but empty. Indexing an empty array always
--- gives an array-bounds error, but 'bounds' still yields the bounds
--- with which the array was constructed.
-{-# INLINE array #-}
-array :: Ix i
- => (i,i) -- ^ a pair of /bounds/, each of the index type
- -- of the array. These bounds are the lowest and
- -- highest indices in the array, in that order.
- -- For example, a one-origin vector of length
- -- '10' has bounds '(1,10)', and a one-origin '10'
- -- by '10' matrix has bounds '((1,1),(10,10))'.
- -> [(i, e)] -- ^ a list of /associations/ of the form
- -- (/index/, /value/). Typically, this list will
- -- be expressed as a comprehension. An
- -- association '(i, x)' defines the value of
- -- the array at index 'i' to be 'x'.
- -> Array i e
-array (l,u) ies = unsafeArray (l,u) [(index (l,u) i, e) | (i, e) <- ies]
-
-{-# INLINE unsafeArray #-}
-unsafeArray :: Ix i => (i,i) -> [(Int, e)] -> Array i e
-unsafeArray (l,u) ies = runST (ST $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
- foldr (fill marr#) (done l u marr#) ies s2# }})
-
-{-# INLINE fill #-}
-fill :: MutableArray# s e -> (Int, e) -> STRep s a -> STRep s a
-fill marr# (I# i#, e) next s1# =
- case writeArray# marr# i# e s1# of { s2# ->
- next s2# }
-
-{-# INLINE done #-}
-done :: Ix i => i -> i -> MutableArray# s e -> STRep s (Array i e)
-done l u marr# s1# =
- case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
- (# s2#, Array l u arr# #) }
-
--- This is inefficient and I'm not sure why:
--- listArray (l,u) es = unsafeArray (l,u) (zip [0 .. rangeSize (l,u) - 1] es)
--- The code below is better. It still doesn't enable foldr/build
--- transformation on the list of elements; I guess it's impossible
--- using mechanisms currently available.
-
--- | Construct an array from a pair of bounds and a list of values in
--- index order.
-{-# INLINE listArray #-}
-listArray :: Ix i => (i,i) -> [e] -> Array i e
-listArray (l,u) es = runST (ST $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
- let fillFromList i# xs s3# | i# ==# n# = s3#
- | otherwise = case xs of
- [] -> s3#
- y:ys -> case writeArray# marr# i# y s3# of { s4# ->
- fillFromList (i# +# 1#) ys s4# } in
- case fillFromList 0# es s2# of { s3# ->
- done l u marr# s3# }}})
-
--- | The value at the given index in an array.
-{-# INLINE (!) #-}
-(!) :: Ix i => Array i e -> i -> e
-arr@(Array l u _) ! i = unsafeAt arr (index (l,u) i)
-
-{-# INLINE unsafeAt #-}
-unsafeAt :: Ix i => Array i e -> Int -> e
-unsafeAt (Array _ _ arr#) (I# i#) =
- case indexArray# arr# i# of (# e #) -> e
-
--- | The bounds with which an array was constructed.
-{-# INLINE bounds #-}
-bounds :: Ix i => Array i e -> (i,i)
-bounds (Array l u _) = (l,u)
-
--- | The list of indices of an array in ascending order.
-{-# INLINE indices #-}
-indices :: Ix i => Array i e -> [i]
-indices (Array l u _) = range (l,u)
-
--- | The list of elements of an array in index order.
-{-# INLINE elems #-}
-elems :: Ix i => Array i e -> [e]
-elems arr@(Array l u _) =
- [unsafeAt arr i | i <- [0 .. rangeSize (l,u) - 1]]
-
--- | The list of associations of an array in index order.
-{-# INLINE assocs #-}
-assocs :: Ix i => Array i e -> [(i, e)]
-assocs arr@(Array l u _) =
- [(i, unsafeAt arr (unsafeIndex (l,u) i)) | i <- range (l,u)]
-
--- | The 'accumArray' deals with repeated indices in the association
--- list using an /accumulating function/ which combines the values of
--- associations with the same index.
--- For example, given a list of values of some index type, @hist@
--- produces a histogram of the number of occurrences of each index within
--- a specified range:
---
--- > hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
--- > hist bnds is = accumArray (+) 0 bnds [(i, 1) | i<-is, inRange bnds i]
---
--- If the accumulating function is strict, then 'accumArray' is strict in
--- the values, as well as the indices, in the association list. Thus,
--- unlike ordinary arrays built with 'array', accumulated arrays should
--- not in general be recursive.
-{-# INLINE accumArray #-}
-accumArray :: Ix i
- => (e -> a -> e) -- ^ accumulating function
- -> e -- ^ initial value
- -> (i,i) -- ^ bounds of the array
- -> [(i, a)] -- ^ association list
- -> Array i e
-accumArray f init (l,u) ies =
- unsafeAccumArray f init (l,u) [(index (l,u) i, e) | (i, e) <- ies]
-
-{-# INLINE unsafeAccumArray #-}
-unsafeAccumArray :: Ix i => (e -> a -> e) -> e -> (i,i) -> [(Int, a)] -> Array i e
-unsafeAccumArray f init (l,u) ies = runST (ST $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- case newArray# n# init s1# of { (# s2#, marr# #) ->
- foldr (adjust f marr#) (done l u marr#) ies s2# }})
-
-{-# INLINE adjust #-}
-adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s b
-adjust f marr# (I# i#, new) next s1# =
- case readArray# marr# i# s1# of { (# s2#, old #) ->
- case writeArray# marr# i# (f old new) s2# of { s3# ->
- next s3# }}
-
--- | Constructs an array identical to the first argument except that it has
--- been updated by the associations in the right argument.
--- For example, if @m@ is a 1-origin, @n@ by @n@ matrix, then
---
--- > m//[((i,i), 0) | i <- [1..n]]
---
--- is the same matrix, except with the diagonal zeroed.
---
--- Repeated indices in the association list are handled as for 'array':
--- Haskell 98 specifies that the resulting array is undefined (i.e. bottom),
--- but GHC's implementation uses the last association for each index.
-{-# INLINE (//) #-}
-(//) :: Ix i => Array i e -> [(i, e)] -> Array i e
-arr@(Array l u _) // ies =
- unsafeReplace arr [(index (l,u) i, e) | (i, e) <- ies]
-
-{-# INLINE unsafeReplace #-}
-unsafeReplace :: Ix i => Array i e -> [(Int, e)] -> Array i e
-unsafeReplace arr@(Array l u _) ies = runST (do
- STArray _ _ marr# <- thawSTArray arr
- ST (foldr (fill marr#) (done l u marr#) ies))
-
--- | @'accum' f@ takes an array and an association list and accumulates
--- pairs from the list into the array with the accumulating function @f@.
--- Thus 'accumArray' can be defined using 'accum':
---
--- > accumArray f z b = accum f (array b [(i, z) | i <- range b])
---
-{-# INLINE accum #-}
-accum :: Ix i => (e -> a -> e) -> Array i e -> [(i, a)] -> Array i e
-accum f arr@(Array l u _) ies =
- unsafeAccum f arr [(index (l,u) i, e) | (i, e) <- ies]
-
-{-# INLINE unsafeAccum #-}
-unsafeAccum :: Ix i => (e -> a -> e) -> Array i e -> [(Int, a)] -> Array i e
-unsafeAccum f arr@(Array l u _) ies = runST (do
- STArray _ _ marr# <- thawSTArray arr
- ST (foldr (adjust f marr#) (done l u marr#) ies))
-
-{-# INLINE amap #-}
-amap :: Ix i => (a -> b) -> Array i a -> Array i b
-amap f arr@(Array l u _) =
- unsafeArray (l,u) [(i, f (unsafeAt arr i)) | i <- [0 .. rangeSize (l,u) - 1]]
-
--- | 'ixmap' allows for transformations on array indices.
--- It may be thought of as providing function composition on the right
--- with the mapping that the original array embodies.
---
--- A similar transformation of array values may be achieved using 'fmap'
--- from the 'Array' instance of the 'Functor' class.
-{-# INLINE ixmap #-}
-ixmap :: (Ix i, Ix j) => (i,i) -> (i -> j) -> Array j e -> Array i e
-ixmap (l,u) f arr =
- unsafeArray (l,u) [(unsafeIndex (l,u) i, arr ! f i) | i <- range (l,u)]
-
-{-# INLINE eqArray #-}
-eqArray :: (Ix i, Eq e) => Array i e -> Array i e -> Bool
-eqArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
- if rangeSize (l1,u1) == 0 then rangeSize (l2,u2) == 0 else
- l1 == l2 && u1 == u2 &&
- and [unsafeAt arr1 i == unsafeAt arr2 i | i <- [0 .. rangeSize (l1,u1) - 1]]
-
-{-# INLINE cmpArray #-}
-cmpArray :: (Ix i, Ord e) => Array i e -> Array i e -> Ordering
-cmpArray arr1 arr2 = compare (assocs arr1) (assocs arr2)
-
-{-# INLINE cmpIntArray #-}
-cmpIntArray :: Ord e => Array Int e -> Array Int e -> Ordering
-cmpIntArray arr1@(Array l1 u1 _) arr2@(Array l2 u2 _) =
- if rangeSize (l1,u1) == 0 then if rangeSize (l2,u2) == 0 then EQ else LT else
- if rangeSize (l2,u2) == 0 then GT else
- case compare l1 l2 of
- EQ -> foldr cmp (compare u1 u2) [0 .. rangeSize (l1, min u1 u2) - 1]
- other -> other
- where
- cmp i rest = case compare (unsafeAt arr1 i) (unsafeAt arr2 i) of
- EQ -> rest
- other -> other
-
-{-# RULES "cmpArray/Int" cmpArray = cmpIntArray #-}
-
-
-
-
-
-
-
-
-
-
-instance Ix i => Functor (Array i) where
- fmap = amap
-
-instance (Ix i, Eq e) => Eq (Array i e) where
- (==) = eqArray
-
-instance (Ix i, Ord e) => Ord (Array i e) where
- compare = cmpArray
-
-instance (Ix a, Show a, Show b) => Show (Array a b) where
- showsPrec p a =
- showParen (p > appPrec) $
- showString "array " .
- showsPrec appPrec1 (bounds a) .
- showChar ' ' .
- showsPrec appPrec1 (assocs a)
- -- Precedence of 'array' is the precedence of application
-
--- The Read instance is in GHC.Read
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-{-# INLINE newSTArray #-}
-newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
-newSTArray (l,u) init = ST $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- case newArray# n# init s1# of { (# s2#, marr# #) ->
- (# s2#, STArray l u marr# #) }}
-
-{-# INLINE boundsSTArray #-}
-boundsSTArray :: STArray s i e -> (i,i)
-boundsSTArray (STArray l u _) = (l,u)
-
-{-# INLINE readSTArray #-}
-readSTArray :: Ix i => STArray s i e -> i -> ST s e
-readSTArray marr@(STArray l u _) i =
- unsafeReadSTArray marr (index (l,u) i)
-
-{-# INLINE unsafeReadSTArray #-}
-unsafeReadSTArray :: Ix i => STArray s i e -> Int -> ST s e
-unsafeReadSTArray (STArray _ _ marr#) (I# i#) = ST $ \s1# ->
- readArray# marr# i# s1#
-
-{-# INLINE writeSTArray #-}
-writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
-writeSTArray marr@(STArray l u _) i e =
- unsafeWriteSTArray marr (index (l,u) i) e
-
-{-# INLINE unsafeWriteSTArray #-}
-unsafeWriteSTArray :: Ix i => STArray s i e -> Int -> e -> ST s ()
-unsafeWriteSTArray (STArray _ _ marr#) (I# i#) e = ST $ \s1# ->
- case writeArray# marr# i# e s1# of { s2# ->
- (# s2#, () #) }
-
-
-
-
-
-
-
-
-
-
-freezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
-freezeSTArray (STArray l u marr#) = ST $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- case newArray# n# arrEleBottom s1# of { (# s2#, marr'# #) ->
- let copy i# s3# | i# ==# n# = s3#
- | otherwise =
- case readArray# marr# i# s3# of { (# s4#, e #) ->
- case writeArray# marr'# i# e s4# of { s5# ->
- copy (i# +# 1#) s5# }} in
- case copy 0# s2# of { s3# ->
- case unsafeFreezeArray# marr'# s3# of { (# s4#, arr# #) ->
- (# s4#, Array l u arr# #) }}}}
-
-{-# INLINE unsafeFreezeSTArray #-}
-unsafeFreezeSTArray :: Ix i => STArray s i e -> ST s (Array i e)
-unsafeFreezeSTArray (STArray l u marr#) = ST $ \s1# ->
- case unsafeFreezeArray# marr# s1# of { (# s2#, arr# #) ->
- (# s2#, Array l u arr# #) }
-
-thawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
-thawSTArray (Array l u arr#) = ST $ \s1# ->
- case rangeSize (l,u) of { I# n# ->
- case newArray# n# arrEleBottom s1# of { (# s2#, marr# #) ->
- let copy i# s3# | i# ==# n# = s3#
- | otherwise =
- case indexArray# arr# i# of { (# e #) ->
- case writeArray# marr# i# e s3# of { s4# ->
- copy (i# +# 1#) s4# }} in
- case copy 0# s2# of { s3# ->
- (# s3#, STArray l u marr# #) }}}
-
-{-# INLINE unsafeThawSTArray #-}
-unsafeThawSTArray :: Ix i => Array i e -> ST s (STArray s i e)
-unsafeThawSTArray (Array l u arr#) = ST $ \s1# ->
- case unsafeThawArray# arr# s1# of { (# s2#, marr# #) ->
- (# s2#, STArray l u marr# #) }
-
-
diff --git a/tests/expect31 b/tests/expect31
deleted file mode 100644
--- a/tests/expect31
+++ /dev/null
@@ -1,11 +0,0 @@
-#line 1 "elif"
-
-
-import System.IO.Unsafe (unsafePerformIO)
-
-
-
-
-
-
-
diff --git a/tests/expect32 b/tests/expect32
deleted file mode 100644
--- a/tests/expect32
+++ /dev/null
@@ -1,2 +0,0 @@
-#line 1 "pragma"
-#pragma ident "@(#)time.h 1.39 99/08/10 SMI"
diff --git a/tests/expect33 b/tests/expect33
deleted file mode 100644
--- a/tests/expect33
+++ /dev/null
@@ -1,1 +0,0 @@
-#pragma ident "@(#)time.h 1.39 99/08/10 SMI"
diff --git a/tests/expect34 b/tests/expect34
deleted file mode 100644
--- a/tests/expect34
+++ /dev/null
@@ -1,11 +0,0 @@
-#line 1 "igloo"
-
-
-
-1
-
-
-foo
-
-
-
diff --git a/tests/expect35 b/tests/expect35
deleted file mode 100644
--- a/tests/expect35
+++ /dev/null
@@ -1,12 +0,0 @@
-#line 1 "igloo2"
-
-
-
-baz
-1
-
-
-foo
-
-
-
diff --git a/tests/expect36 b/tests/expect36
deleted file mode 100644
--- a/tests/expect36
+++ /dev/null
@@ -1,12 +0,0 @@
-#line 1 "igloo3"
-
-
-
-quux
-FOOFOO
-
-
-
-
-bar
-
diff --git a/tests/expect36a b/tests/expect36a
deleted file mode 100644
--- a/tests/expect36a
+++ /dev/null
@@ -1,12 +0,0 @@
-#line 1 "igloo3a"
-
-
-
-quux
-FOOFOO
-
-
-
-
-bar
-
diff --git a/tests/expect36b b/tests/expect36b
deleted file mode 100644
--- a/tests/expect36b
+++ /dev/null
@@ -1,13 +0,0 @@
-#line 1 "igloo3b"
-
-
-
-
-quux
-11
-
-
-foo
-
-
-
diff --git a/tests/expect37 b/tests/expect37
deleted file mode 100644
--- a/tests/expect37
+++ /dev/null
@@ -1,11 +0,0 @@
-#line 1 "igloo4"
-
-
-wibble
-11
-
-
-foo
-
-
-
diff --git a/tests/expect37a b/tests/expect37a
deleted file mode 100644
--- a/tests/expect37a
+++ /dev/null
@@ -1,11 +0,0 @@
-#line 1 "igloo4a"
-
-
-wibble
-11
-
-
-foo
-
-
-
diff --git a/tests/expect38 b/tests/expect38
deleted file mode 100644
--- a/tests/expect38
+++ /dev/null
@@ -1,8 +0,0 @@
-#line 1 "mauke"
-
-
-
-
-
-
-main = print 7 -- should print 7
diff --git a/tests/expect39 b/tests/expect39
deleted file mode 100644
--- a/tests/expect39
+++ /dev/null
@@ -1,5 +0,0 @@
-#line 1 "mauke2"
-
-
-
-4
diff --git a/tests/expect4 b/tests/expect4
deleted file mode 100644
--- a/tests/expect4
+++ /dev/null
@@ -1,39 +0,0 @@
-#line 1 "testfile"
-1 top of file
-
-3
-
-5 X is defined
-
-7
-
-
-
-11
-
-
-
-15
-
-
-
-19
-
-#line 1 "./inclusion"
-hello world, this is an inclusion
-
-#line 22 "testfile"
-
-
-
-25
-
-
-
-
-
-31 third branch of elif
-
-33
-34 end of file
-
diff --git a/tests/expect40 b/tests/expect40
deleted file mode 100644
--- a/tests/expect40
+++ /dev/null
@@ -1,8 +0,0 @@
-#line 1 "fasta"
-
-
-
-
-
-
-b7 = unsafeVisualize(foo)
diff --git a/tests/expect40a b/tests/expect40a
deleted file mode 100644
--- a/tests/expect40a
+++ /dev/null
@@ -1,7 +0,0 @@
-#line 1 "fasta2"
-
-
-
-
-
-b6 = unsafeVisualize(foo)
diff --git a/tests/expect41 b/tests/expect41
deleted file mode 100644
--- a/tests/expect41
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "hashjoin"
-
-
-
-
-2
diff --git a/tests/expect42 b/tests/expect42
deleted file mode 100644
--- a/tests/expect42
+++ /dev/null
@@ -1,5 +0,0 @@
-#line 1 "wrongline"
-
-2
-#line 20 "foo"
-20
diff --git a/tests/expect43 b/tests/expect43
deleted file mode 100644
--- a/tests/expect43
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "param"
-
-
-
-
-11 -- gcc gives BARBAR, cpphs gives 11
diff --git a/tests/expect44 b/tests/expect44
deleted file mode 100644
--- a/tests/expect44
+++ /dev/null
@@ -1,4 +0,0 @@
-#line 1 "comments"
-here is an ordinary C comment:
-and here is a C++-style end-of-line comment: // comment here
-this line has no comments
diff --git a/tests/expect44a b/tests/expect44a
deleted file mode 100644
--- a/tests/expect44a
+++ /dev/null
@@ -1,4 +0,0 @@
-#line 1 "comments"
-here is an ordinary C comment:
-and here is a C++-style end-of-line comment:
-this line has no comments
diff --git a/tests/expect45 b/tests/expect45
deleted file mode 100644
--- a/tests/expect45
+++ /dev/null
@@ -1,8 +0,0 @@
-#line 1 "nestcomment"
-{-
-
-foo
-
-
-
--}
diff --git a/tests/expect46 b/tests/expect46
deleted file mode 100644
--- a/tests/expect46
+++ /dev/null
@@ -1,7 +0,0 @@
-#line 1 "preinclude"
-#line 1 "./inclusion"
-hello world, this is an inclusion
-
-#line 2 "preinclude"
-#line 1 "preinclude"
-something arbitrary
diff --git a/tests/expect47 b/tests/expect47
deleted file mode 100644
--- a/tests/expect47
+++ /dev/null
@@ -1,5 +0,0 @@
-#line 1 "endcode-a"
-
-
-
-
diff --git a/tests/expect48 b/tests/expect48
deleted file mode 100644
--- a/tests/expect48
+++ /dev/null
@@ -1,6 +0,0 @@
-#line 1 "endcode-b"
-
-
-
-
-
diff --git a/tests/expect49 b/tests/expect49
deleted file mode 100644
--- a/tests/expect49
+++ /dev/null
@@ -1,5 +0,0 @@
-#line 1 "undef.hs"
-
-wibble 3
-
-this is FOO
diff --git a/tests/expect5 b/tests/expect5
deleted file mode 100644
--- a/tests/expect5
+++ /dev/null
@@ -1,35 +0,0 @@
-1 top of file
-
-3
-
-5 0 is defined
-
-7
-
-
-
-11
-
-
-
-15
-
-
-
-19
-
-hello world, this is an inclusion
-
-
-
-
-25
-
-
-
-
-
-31 third branch of elif
-
-33
-34 end of file
diff --git a/tests/expect50 b/tests/expect50
deleted file mode 100644
--- a/tests/expect50
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# LINE 1 "linepragma" #-}
-{-# LINE 1 "./inclusion" #-}
-hello world, this is an inclusion
-
-{-# LINE 2 "linepragma" #-}
-{-# LINE 2 "linepragma" #-}
-
-{-# LINE 3 "linepragma" #-}
-
diff --git a/tests/expect6 b/tests/expect6
deleted file mode 100644
--- a/tests/expect6
+++ /dev/null
@@ -1,10 +0,0 @@
-#line 1 "cpp"
-
-
-
-
-
-
-x ++ y = X' * 0 * y .(foo), Xprime
-
-// /*
diff --git a/tests/expect7 b/tests/expect7
deleted file mode 100644
--- a/tests/expect7
+++ /dev/null
@@ -1,297 +0,0 @@
-#line 1 "Storable.hs"
-{-# OPTIONS -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module : Foreign.Storable
--- Copyright : (c) The FFI task force 2001
--- License : see libraries/base/LICENSE
---
--- Maintainer : ffi@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- The module "Foreign.Storable" provides most elementary support for
--- marshalling and is part of the language-independent portion of the
--- Foreign Function Interface (FFI), and will normally be imported via
--- the "Foreign" module.
---
------------------------------------------------------------------------------
-
-module Foreign.Storable
- ( Storable(
- sizeOf, -- :: a -> Int
- alignment, -- :: a -> Int
- peekElemOff, -- :: Ptr a -> Int -> IO a
- pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
- peekByteOff, -- :: Ptr b -> Int -> IO a
- pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
- peek, -- :: Ptr a -> IO a
- poke) -- :: Ptr a -> a -> IO ()
- ) where
-
-
-
-
-
-
-
-import Control.Monad ( liftM )
-
-#line 1 "./MachDeps.h"
-#line 40 "Storable.hs"
-#line 1 "./config.h"
-#line 41 "Storable.hs"
-
-
-import GHC.Storable
-import GHC.Stable ( StablePtr )
-import GHC.Num
-import GHC.Int
-import GHC.Word
-import GHC.Stable
-import GHC.Ptr
-import GHC.Float
-import GHC.Err
-import GHC.IOBase
-import GHC.Base
-
-
-
-
-
-
-
-
-
-
-
-
-{- |
-The member functions of this class facilitate writing values of
-primitive types to raw memory (which may have been allocated with the
-above mentioned routines) and reading values from blocks of raw
-memory. The class, furthermore, includes support for computing the
-storage requirements and alignment restrictions of storable types.
-
-Memory addresses are represented as values of type @'Ptr' a@, for some
-@a@ which is an instance of class 'Storable'. The type argument to
-'Ptr' helps provide some valuable type safety in FFI code (you can\'t
-mix pointers of different types without an explicit cast), while
-helping the Haskell type system figure out which marshalling method is
-needed for a given pointer.
-
-All marshalling between Haskell and a foreign language ultimately
-boils down to translating Haskell data structures into the binary
-representation of a corresponding data structure of the foreign
-language and vice versa. To code this marshalling in Haskell, it is
-necessary to manipulate primtive data types stored in unstructured
-memory blocks. The class 'Storable' facilitates this manipulation on
-all types for which it is instantiated, which are the standard basic
-types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
-'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
-'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
-as well as 'Ptr'.
-
-Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
-'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
-'pokeByteOff'.
--}
-
-class Storable a where
-
- sizeOf :: a -> Int
- -- ^ Computes the storage requirements (in bytes) of the argument.
- -- The value of the argument is not used.
-
- alignment :: a -> Int
- -- ^ Computes the alignment constraint of the argument. An
- -- alignment constraint @x@ is fulfilled by any address divisible
- -- by @x@. The value of the argument is not used.
-
- peekElemOff :: Ptr a -> Int -> IO a
- -- ^ Read a value from a memory area regarded as an array
- -- of values of the same kind. The first argument specifies
- -- the start address of the array and the second the index into
- -- the array (the first element of the array has index
- -- @0@). The following equality holds,
- --
- -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
- -- > peek (addr `plusPtr` (idx * sizeOf result))
- --
- -- Note that this is only a specification, not
- -- necessarily the concrete implementation of the
- -- function.
-
- pokeElemOff :: Ptr a -> Int -> a -> IO ()
- -- ^ Write a value to a memory area regarded as an array of
- -- values of the same kind. The following equality holds:
- --
- -- > pokeElemOff addr idx x =
- -- > poke (addr `plusPtr` (idx * sizeOf x)) x
-
- peekByteOff :: Ptr b -> Int -> IO a
- -- ^ Read a value from a memory location given by a base
- -- address and offset. The following equality holds:
- --
- -- > peekByteOff addr off = peek (addr `plusPtr` off)
-
- pokeByteOff :: Ptr b -> Int -> a -> IO ()
- -- ^ Write a value to a memory location given by a base
- -- address and offset. The following equality holds:
- --
- -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
-
- peek :: Ptr a -> IO a
- -- ^ Read a value from the given memory location.
- --
- -- Note that the peek and poke functions might require properly
- -- aligned addresses to function correctly. This is architecture
- -- dependent; thus, portable code should ensure that when peeking or
- -- poking values of some type @a@, the alignment
- -- constraint for @a@, as given by the function
- -- 'alignment' is fulfilled.
-
- poke :: Ptr a -> a -> IO ()
- -- ^ Write the given value to the given memory location. Alignment
- -- restrictions might apply; see 'peek'.
-
- -- circular default instances
-
- peekElemOff = peekElemOff_ undefined
- where peekElemOff_ :: a -> Ptr a -> Int -> IO a
- peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
-
-
-
- pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
-
- peekByteOff ptr off = peek (ptr `plusPtr` off)
- pokeByteOff ptr off = poke (ptr `plusPtr` off)
-
- peek ptr = peekElemOff ptr 0
- poke ptr = pokeElemOff ptr 0
-
-
-
-
-
-
--- System-dependent, but rather obvious instances
-
-instance Storable Bool where
- sizeOf _ = sizeOf (undefined::HTYPE_INT)
- alignment _ = alignment (undefined::HTYPE_INT)
- peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
- pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
-
-
-
-
-
-
-
-
-
-instance Storable (Char) where {
- sizeOf _ = SIZEOF_INT32;
- alignment _ = ALIGNMENT_INT32;
- peekElemOff = readWideCharOffPtr;
- pokeElemOff = writeWideCharOffPtr }
-
-
-
-
-
-instance Storable (Int) where {
- sizeOf _ = SIZEOF_HSINT;
- alignment _ = ALIGNMENT_HSINT;
- peekElemOff = readIntOffPtr;
- pokeElemOff = writeIntOffPtr }
-
-
-instance Storable (Word) where {
- sizeOf _ = SIZEOF_HSWORD;
- alignment _ = ALIGNMENT_HSWORD;
- peekElemOff = readWordOffPtr;
- pokeElemOff = writeWordOffPtr }
-
-
-instance Storable ((Ptr a)) where {
- sizeOf _ = SIZEOF_HSPTR;
- alignment _ = ALIGNMENT_HSPTR;
- peekElemOff = readPtrOffPtr;
- pokeElemOff = writePtrOffPtr }
-
-instance Storable ((FunPtr a)) where {
- sizeOf _ = SIZEOF_HSFUNPTR;
- alignment _ = ALIGNMENT_HSFUNPTR;
- peekElemOff = readFunPtrOffPtr;
- pokeElemOff = writeFunPtrOffPtr }
-
-instance Storable ((StablePtr a)) where {
- sizeOf _ = SIZEOF_HSSTABLEPTR;
- alignment _ = ALIGNMENT_HSSTABLEPTR;
- peekElemOff = readStablePtrOffPtr;
- pokeElemOff = writeStablePtrOffPtr }
-
-instance Storable (Float) where {
- sizeOf _ = SIZEOF_HSFLOAT;
- alignment _ = ALIGNMENT_HSFLOAT;
- peekElemOff = readFloatOffPtr;
- pokeElemOff = writeFloatOffPtr }
-
-instance Storable (Double) where {
- sizeOf _ = SIZEOF_HSDOUBLE;
- alignment _ = ALIGNMENT_HSDOUBLE;
- peekElemOff = readDoubleOffPtr;
- pokeElemOff = writeDoubleOffPtr }
-
-instance Storable (Word8) where {
- sizeOf _ = SIZEOF_WORD8;
- alignment _ = ALIGNMENT_WORD8;
- peekElemOff = readWord8OffPtr;
- pokeElemOff = writeWord8OffPtr }
-
-instance Storable (Word16) where {
- sizeOf _ = SIZEOF_WORD16;
- alignment _ = ALIGNMENT_WORD16;
- peekElemOff = readWord16OffPtr;
- pokeElemOff = writeWord16OffPtr }
-
-instance Storable (Word32) where {
- sizeOf _ = SIZEOF_WORD32;
- alignment _ = ALIGNMENT_WORD32;
- peekElemOff = readWord32OffPtr;
- pokeElemOff = writeWord32OffPtr }
-
-instance Storable (Word64) where {
- sizeOf _ = SIZEOF_WORD64;
- alignment _ = ALIGNMENT_WORD64;
- peekElemOff = readWord64OffPtr;
- pokeElemOff = writeWord64OffPtr }
-
-instance Storable (Int8) where {
- sizeOf _ = SIZEOF_INT8;
- alignment _ = ALIGNMENT_INT8;
- peekElemOff = readInt8OffPtr;
- pokeElemOff = writeInt8OffPtr }
-
-instance Storable (Int16) where {
- sizeOf _ = SIZEOF_INT16;
- alignment _ = ALIGNMENT_INT16;
- peekElemOff = readInt16OffPtr;
- pokeElemOff = writeInt16OffPtr }
-
-instance Storable (Int32) where {
- sizeOf _ = SIZEOF_INT32;
- alignment _ = ALIGNMENT_INT32;
- peekElemOff = readInt32OffPtr;
- pokeElemOff = writeInt32OffPtr }
-
-instance Storable (Int64) where {
- sizeOf _ = SIZEOF_INT64;
- alignment _ = ALIGNMENT_INT64;
- peekElemOff = readInt64OffPtr;
- pokeElemOff = writeInt64OffPtr }
-
-
diff --git a/tests/expect8 b/tests/expect8
deleted file mode 100644
--- a/tests/expect8
+++ /dev/null
@@ -1,37 +0,0 @@
-#line 1 "HsOpenGLExt.h"
-/* -----------------------------------------------------------------------------
- *
- * Module : GL extension support for Graphics.Rendering.OpenGL
- * Copyright : (c) Sven Panne 2002-2004
- * License : BSD-style (see the file libraries/OpenGL/LICENSE)
- *
- * Maintainer : sven.panne@aedion.de
- * Stability : provisional
- * Portability : portable
- *
- * This header should only define preprocessor macros!
- *
- * -------------------------------------------------------------------------- */
-
-
-
-
-/* NOTE: The macro must immediately start with the foreign declaration,
- otherwise the magic mangler (hack_foreign) in the Hugs build system
- doesn't recognize it. */
-
-
-
-
-
-
-
-
-
-
-foreign import ccall unsafe "dynamic" dyn_glFogCoorddEXT :: Graphics.Rendering.OpenGL.GL.Extensions.Invoker (GLdouble -> IO ()) ;
-glFogCoorddEXT :: (GLdouble -> IO ()) ;
-glFogCoorddEXT = dyn_glFogCoorddEXT ptr_glFogCoorddEXT ;
-ptr_glFogCoorddEXT :: FunPtr a ;
-ptr_glFogCoorddEXT = unsafePerformIO (Graphics.Rendering.OpenGL.GL.Extensions.getProcAddress ("GL_EXT_fog_coord or OpenGL 1.4") ("glFogCoorddEXT")) ;
-{-# NOINLINE ptr_glFogCoorddEXT #-}
diff --git a/tests/expect9 b/tests/expect9
deleted file mode 100644
--- a/tests/expect9
+++ /dev/null
@@ -1,16 +0,0 @@
-#line 1 "multiline"
-
-
-
-
-5 back to ordinary text.
-#line 1 "./inclusion"
-hello world, this is an inclusion
-
-#line 7 "multiline"
-7 hello again
-8 some more
-9 some line here;
- and some more;
- finish now
-10 end
diff --git a/tests/fasta b/tests/fasta
deleted file mode 100644
--- a/tests/fasta
+++ /dev/null
@@ -1,7 +0,0 @@
-#define XCONCAT(a, b) a##b
-#define CONCAT(a, b) XCONCAT(a, b)
-#define PS(val) () <- trace (val) (return ())
-#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
-#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
-
-V(foo)
diff --git a/tests/fasta2 b/tests/fasta2
deleted file mode 100644
--- a/tests/fasta2
+++ /dev/null
@@ -1,6 +0,0 @@
-#define XCONCAT(a, b) a##b
-#define CONCAT(a, b) XCONCAT(a, b)
-#define PS(val) () <- trace (val) (return ())
-#define VIS(ioaction) let CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
-#define V(ioaction) CONCAT(b, __LINE__) = unsafeVisualize(ioaction)
-V(foo)
diff --git a/tests/hashjoin b/tests/hashjoin
deleted file mode 100644
--- a/tests/hashjoin
+++ /dev/null
@@ -1,5 +0,0 @@
-#define FOO 1
-#define BAR FOO##FOO
-#define FOOFOO 2
-
-BAR
diff --git a/tests/igloo b/tests/igloo
deleted file mode 100644
--- a/tests/igloo
+++ /dev/null
@@ -1,10 +0,0 @@
-#define FOO 1
-#define BAR FOO
-
-BAR
-
-#if BAR == 1
-foo
-#else
-bar
-#endif
diff --git a/tests/igloo2 b/tests/igloo2
deleted file mode 100644
--- a/tests/igloo2
+++ /dev/null
@@ -1,11 +0,0 @@
-#define FOO 1
-#define BAZ(x) x
-
-baz
-BAZ(1)
-
-#if BAZ(1) == 1
-foo
-#else
-bar
-#endif
diff --git a/tests/igloo3 b/tests/igloo3
deleted file mode 100644
--- a/tests/igloo3
+++ /dev/null
@@ -1,11 +0,0 @@
-#define FOO 1
-#define QUUX FOO ## FOO
-
-quux
-QUUX
-
-#if QUUX == 11
-foo
-#else
-bar
-#endif
diff --git a/tests/igloo3a b/tests/igloo3a
deleted file mode 100644
--- a/tests/igloo3a
+++ /dev/null
@@ -1,11 +0,0 @@
-#define FOO 1
-#define QUUX FOO##FOO
-
-quux
-QUUX
-
-#if QUUX == 11
-foo
-#else
-bar
-#endif
diff --git a/tests/igloo3b b/tests/igloo3b
deleted file mode 100644
--- a/tests/igloo3b
+++ /dev/null
@@ -1,12 +0,0 @@
-#define FOO 1
-#define QUUX(a) a ## a
-#define WIBBLE QUUX(FOO)
-
-quux
-WIBBLE
-
-#if WIBBLE == 11
-foo
-#else
-bar
-#endif
diff --git a/tests/igloo4 b/tests/igloo4
deleted file mode 100644
--- a/tests/igloo4
+++ /dev/null
@@ -1,10 +0,0 @@
-#define WIBBLE 1 ## 1
-
-wibble
-WIBBLE
-
-#if WIBBLE == 11
-foo
-#else
-bar
-#endif
diff --git a/tests/igloo4a b/tests/igloo4a
deleted file mode 100644
--- a/tests/igloo4a
+++ /dev/null
@@ -1,10 +0,0 @@
-#define WIBBLE 1##1
-
-wibble
-WIBBLE
-
-#if WIBBLE == 11
-foo
-#else
-bar
-#endif
diff --git a/tests/inclusion b/tests/inclusion
deleted file mode 100644
--- a/tests/inclusion
+++ /dev/null
@@ -1,1 +0,0 @@
-hello world, this is an inclusion
diff --git a/tests/incomplete b/tests/incomplete
deleted file mode 100644
--- a/tests/incomplete
+++ /dev/null
@@ -1,1 +0,0 @@
-incomplete
diff --git a/tests/indirect b/tests/indirect
deleted file mode 100644
--- a/tests/indirect
+++ /dev/null
@@ -1,2 +0,0 @@
-#define F "inclusion"
-#include F
diff --git a/tests/indirect-a b/tests/indirect-a
deleted file mode 100644
--- a/tests/indirect-a
+++ /dev/null
@@ -1,2 +0,0 @@
-#define F(f) in##f
-#include F(clusion)
diff --git a/tests/linepragma b/tests/linepragma
deleted file mode 100644
--- a/tests/linepragma
+++ /dev/null
@@ -1,5 +0,0 @@
-#include "inclusion"
-#line 2 "linepragma"
-
-#line 3 "linepragma"
-
diff --git a/tests/mauke b/tests/mauke
deleted file mode 100644
--- a/tests/mauke
+++ /dev/null
@@ -1,7 +0,0 @@
-#define X /\
-* comment */ main
-
-#define Y _\
-_LINE__
-
-X = print Y -- should print 7
diff --git a/tests/mauke2 b/tests/mauke2
deleted file mode 100644
--- a/tests/mauke2
+++ /dev/null
@@ -1,4 +0,0 @@
-#define foo _\
-_LINE__
-
-foo
diff --git a/tests/multiline b/tests/multiline
deleted file mode 100644
--- a/tests/multiline
+++ /dev/null
@@ -1,10 +0,0 @@
-#define aLongMacroDefinition(x,y) \
- some line here; \
- and some more; \
- finish now
-5 back to ordinary text.
-#include "inclusion"
-7 hello again
-8 some more
-9 aLongMacroDefinition(a,b)
-10 end
diff --git a/tests/nastyhack b/tests/nastyhack
deleted file mode 100644
--- a/tests/nastyhack
+++ /dev/null
@@ -1,16 +0,0 @@
-#define GHC_PKG_VERSION 6.2.2
--- hackery to convice cpp to splice GHC_PKG_VERSION into a string
-version :: String
-version = tail "\
- \ GHC_PKG_VERSION"
-
-version2 = "GHC_PKG_VERSION"
-
-#define v3 "GHC_PKG_VERSION"
-version3 = v3
-
-#define stringify(s) #s
-version4 = stringify(GHC_PKG_VERSION)
-
-#define stringify2(s) "s"
-version5 = stringify2(GHC_PKG_VERSION)
diff --git a/tests/nestcomment b/tests/nestcomment
deleted file mode 100644
--- a/tests/nestcomment
+++ /dev/null
@@ -1,7 +0,0 @@
-{-
-#if 1
-foo
-#else
-bar
-#endif
--}
diff --git a/tests/numbers b/tests/numbers
deleted file mode 100644
--- a/tests/numbers
+++ /dev/null
@@ -1,29 +0,0 @@
-#if 1
-number (1) in if
-#else
-rejected number (1) in if
-#endif
-
-#if 0
-wrongly accepted number (0) in if
-#else
-number (0) in if
-#endif
-
-#if eaf
-false hex number in if
-#else
-rejected false hex number in if
-#endif
-
-#if 0x1
-real hex number (0x1) in if
-#else
-rejected real hex number (0x1) in if
-#endif
-
-#if 0x00
-wrongly accepted real hex number (0x00) in if
-#else
-hex number (0x00) in if
-#endif
diff --git a/tests/param b/tests/param
deleted file mode 100644
--- a/tests/param
+++ /dev/null
@@ -1,5 +0,0 @@
-#define FOO 1
-#define BAR FOO
-#define JOIN(f) f##f
-
-JOIN(BAR) -- gcc gives BARBAR, cpphs gives 11
diff --git a/tests/parens b/tests/parens
deleted file mode 100644
--- a/tests/parens
+++ /dev/null
@@ -1,5 +0,0 @@
-#if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 600 ) \
- || ( defined(__NHC__) && __NHC__ >= 117 )
-#define FINALIZERPTR yes
-#endif
-FINALIZERPTR
diff --git a/tests/pragma b/tests/pragma
deleted file mode 100644
--- a/tests/pragma
+++ /dev/null
@@ -1,1 +0,0 @@
-#pragma ident "@(#)time.h 1.39 99/08/10 SMI" /* SVr4.0 1.18 */
diff --git a/tests/precedence b/tests/precedence
deleted file mode 100644
--- a/tests/precedence
+++ /dev/null
@@ -1,3 +0,0 @@
-#if !0 && 0
-boolean operator precedence is wrong
-#endif
diff --git a/tests/preinclude b/tests/preinclude
deleted file mode 100644
--- a/tests/preinclude
+++ /dev/null
@@ -1,1 +0,0 @@
-something arbitrary
diff --git a/tests/recursive b/tests/recursive
deleted file mode 100644
--- a/tests/recursive
+++ /dev/null
@@ -1,4 +0,0 @@
-#define C D D
-#define B C C
-#define A B B
-A
diff --git a/tests/ross b/tests/ross
deleted file mode 100644
--- a/tests/ross
+++ /dev/null
@@ -1,19 +0,0 @@
-/* 1. C comments should be deleted by the preprocessor */
-
-/* 2. repeated expansion */
-#define FOO 4
-#define BAR FOO
-
-f = BAR
-
-/* 3. continuation lines in macros shouldn't give newlines */
-#define LONG_MACRO \
-{ putStr "Hello "; \
- putStrLn "World" }
-
-g = do LONG_MACRO
-
-/* 4. projection macros */
-#define MACRO(x) x
-
-h = MACRO(FOO)
diff --git a/tests/runtests b/tests/runtests
deleted file mode 100644
--- a/tests/runtests
+++ /dev/null
@@ -1,71 +0,0 @@
-#!/bin/sh
-CPPHS=${1:-"../cpphs"}
-FAIL=0
-
-runtest() {
- if $1 >out 2>/dev/null && diff $2 out >/dev/null
- then echo "passed: " $1
- else FAIL=$?
- echo "FAILED: ($2) " $1
- fi
-}
-
-if $CPPHS