diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2016-04-25 17:22:55 +0200 |
---|---|---|
committer | Thomas Miedema <thomasmiedema@gmail.com> | 2016-04-28 23:10:18 +0200 |
commit | e20b3ed0d0a3eda9b52544f06694667ddc2dd3a1 (patch) | |
tree | a830d5060e693e270839a5bf0ebb0a81a1d0910f /testsuite/tests/llvm | |
parent | 32c0aba19d2b482e6ac2dffdb54d50a1472f7d07 (diff) | |
download | haskell-e20b3ed0d0a3eda9b52544f06694667ddc2dd3a1.tar.gz |
Testsuite: delete T5054 and T5054_2 (#5054)
These tests no longer compile, because the hmatrix api has completely
changed. Even if we managed to fix the tests, I don't think they would
provided much value, since the ghc/llvm bug from #5054 was not
reproducible in the first place.
Reviewed by: bgamari
Differential Revision: https://phabricator.haskell.org/D2139
Diffstat (limited to 'testsuite/tests/llvm')
-rw-r--r-- | testsuite/tests/llvm/should_compile/T5054.hs | 55 | ||||
-rw-r--r-- | testsuite/tests/llvm/should_compile/T5054_2.hs | 157 | ||||
-rw-r--r-- | testsuite/tests/llvm/should_compile/all.T | 2 |
3 files changed, 0 insertions, 214 deletions
diff --git a/testsuite/tests/llvm/should_compile/T5054.hs b/testsuite/tests/llvm/should_compile/T5054.hs deleted file mode 100644 index 79b01f624a..0000000000 --- a/testsuite/tests/llvm/should_compile/T5054.hs +++ /dev/null @@ -1,55 +0,0 @@ -{-# OPTIONS_GHC -W #-} - -import Data.Int -import Data.Packed -import Data.Packed.ST -import Control.Monad.ST -import Foreign.Storable -import Foreign.Ptr -import Foreign.Marshal.Utils - -main :: IO () -main = print $ arst (zeroMatrix 10 10) (Constant 9) - -data ComputeElement - = Constant !Double - | Value !Double - deriving (Eq) - -isConstant (Constant _) = True -isConstant _ = False - -instance Element ComputeElement - -fromComputeElement (Constant v) = v -fromComputeElement (Value v) = v - -sizeofDouble = sizeOf (undefined :: Double) -sizeofInt64 = sizeOf (undefined :: Int64) - -instance Storable ComputeElement where - sizeOf _ = sizeofDouble + sizeofInt64 - alignment _ = 16 - - peek p = do - v <- peek (castPtr p) - c <- peek (castPtr (p `plusPtr` sizeofDouble)) - return $ if toBool (c :: Int64) - then Constant v - else Value v - - poke p v = do - let c :: Int64 - c = fromBool (isConstant v) - poke (castPtr p) (fromComputeElement v) - poke (castPtr p `plusPtr` sizeofDouble) c - - -arst mat v = runST $ do - mat' <- thawMatrix mat - writeMatrix mat' 1 2 v - x <- fromComputeElement `fmap` readMatrix mat' 1 9 - return (x > 0) - -zeroMatrix m n = buildMatrix m n (const (Value 0)) - diff --git a/testsuite/tests/llvm/should_compile/T5054_2.hs b/testsuite/tests/llvm/should_compile/T5054_2.hs deleted file mode 100644 index 29a7ed829f..0000000000 --- a/testsuite/tests/llvm/should_compile/T5054_2.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# OPTIONS_GHC -W #-} - -import Data.Int -import Data.Packed -import Data.Packed.ST -import Control.Applicative -import Control.Monad -import Control.Monad.ST -import Foreign.Storable -import Foreign.Ptr -import Foreign.Marshal.Utils - -import Control.Parallel.Strategies - -import Graphics.Plot - - -main :: IO () -main = let whee = jacobiST zeroRho (0, 1) (constLeftBorder 100 128) - in writeFile "Something.pgm" $ matrixToPGM (computeElementMatrixToDouble whee) - -inParallel = parMap rwhnf id - -zeroMatrix m n = buildMatrix m n (const 0) - -twoMatrix m n = buildMatrix m n (const (Value 2)) - -data ComputeElement = Constant !Double - | Value !Double - deriving (Eq) - --- We don't care about showing if it's constant or not -instance Show ComputeElement where - show (Constant v) = show v - show (Value v) = show v - -instance Element ComputeElement - -isConstant (Constant _) = True -isConstant _ = False - -fromComputeElement (Constant v) = v -fromComputeElement (Value v) = v - -sizeofDouble = sizeOf (undefined :: Double) -sizeofInt64 = sizeOf (undefined :: Int64) - -instance Storable ComputeElement where - sizeOf _ = sizeofDouble + sizeofInt64 - alignment _ = 16 - - peek p = do v <- peek (castPtr p) - c <- peek (castPtr (p `plusPtr` sizeofDouble)) - return $ if toBool (c :: Int64) - then Constant v - else Value v - - poke p v = do let c :: Int64 - c = fromBool (isConstant v) - poke (castPtr p) (fromComputeElement v) - poke (castPtr p `plusPtr` sizeofDouble) c - -jacobi :: Element a => Int -> Matrix a -> Matrix a -jacobi n mat = undefined - where - core = subMatrix (1, 1) (rows mat - 1, cols mat - 1) mat - -applyComputeElement _ v@(Constant _) = v -applyComputeElement f (Value v) = Value (f v) - - -writeMatrix' = uncurry . writeMatrix -readMatrix' = uncurry . readMatrix - -zeroRho _ _ = 0 - -type STComputeMatrix s = STMatrix s ComputeElement - -type RelaxationFunction s = STComputeMatrix s -- initial matrix - -> STComputeMatrix s -- new matrix - -> Int -- i - -> Int -- j - -> ST s Double -- new element - -applyMethod :: RelaxationFunction s -> STComputeMatrix s -> STComputeMatrix s -> Int -> Int -> ST s () -applyMethod f mat mat' i j = do - c <- readMatrix mat i j - u <- f mat mat' i j - writeMatrix mat' i j $ if isConstant c - then c - else Value u - -{-# INLINE readElement #-} -readElement mat x y = fromComputeElement <$> readMatrix mat x y - -jacobiST :: (Double -> Double -> Double) -> (Double, Double) -> Matrix ComputeElement -> Matrix ComputeElement -jacobiST rho (rangeX, rangeY) origMat = runST $ do - let m = rows origMat - n = cols origMat - - dx = rangeX / fromIntegral (m - 1) - dy = rangeY / fromIntegral (n - 1) - dd = dx * dy - - rs = [1 .. (m - 2)] -- without borders - cs = [1 .. (n - 2)] - - evalRho i j = rho (fromIntegral i * dx) (fromIntegral j * dy) - - gaussSeidel f mat mat' i j = do - -- Read from old matrix - a1 <- readElement mat (i + 1) j - a2 <- readElement mat i (j + 1) - - -- Read from new matrix - b1 <- readElement mat' (i - 1) j - b2 <- readElement mat' i (j - 1) - let f = evalRho i j - u = 0.25 * (a1 + a2 + b1 + b2) + (pi * f * dd) - return u - - - jacobi mat mat' i j = do - a <- readElement mat (i + 1) j - b <- readElement mat (i - 1) j - c <- readElement mat i (j + 1) - d <- readElement mat i (j - 1) - - let f = evalRho i j - u = 0.25 * (a + b + c + d) + (pi * f * dd) - return u - - jacobiThings = applyMethod jacobi - - --iterateJacobi mat mat' = sequence_ [jacobiThings mat mat' r c | r <- rs, c <- cs] - - -- faster - iterateJacobi mat mat' = sequence_ $ map (uncurry (jacobiThings mat mat')) [(r, c) | r <- rs, c <- cs] - - -- Swap the matrices. Iterations will be an event number, 2 * n - iterateNJacobi n mat mat' = replicateM n (iterateJacobi mat mat' >> iterateJacobi mat' mat) - - mat <- thawMatrix origMat - mat' <- thawMatrix origMat - - iterateNJacobi 4000 mat mat' - - freezeMatrix mat' - -constLeftBorder v n = fromColumns (border:replicate (n - 1) rest) - where border = buildVector n (const (Constant v)) - rest = buildVector n (const (Value 0)) - -computeElementMatrixToDouble :: Matrix ComputeElement -> Matrix Double -computeElementMatrixToDouble = liftMatrix (mapVector fromComputeElement) - diff --git a/testsuite/tests/llvm/should_compile/all.T b/testsuite/tests/llvm/should_compile/all.T index 6806c25d1f..070861565b 100644 --- a/testsuite/tests/llvm/should_compile/all.T +++ b/testsuite/tests/llvm/should_compile/all.T @@ -5,8 +5,6 @@ def f( name, opts ): setTestOpts(f) -test('T5054', reqlib('hmatrix'), compile, ['-package hmatrix']) -test('T5054_2', reqlib('hmatrix'), compile, ['-package hmatrix']) # test('T5486', reqlib('integer-gmp'), compile, ['']) test('T5681', normal, compile, ['']) test('T6158', [reqlib('vector'), reqlib('primitive')], compile, ['-package vector -package primitive']) |