From faee23bb69ca813296da484bc177f4480bcaee9f Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sat, 2 Jun 2018 11:56:58 -0400 Subject: vectorise: Put it out of its misery Poor DPH and its vectoriser have long been languishing; sadly it seems there is little chance that the effort will be rekindled. Every few years we discuss what to do with this mass of code and at least once we have agreed that it should be archived on a branch and removed from `master`. Here we do just that, eliminating heaps of dead code in the process. Here we drop the ParallelArrays extension, the vectoriser, and the `vector` and `primitive` submodules. Test Plan: Validate Reviewers: simonpj, simonmar, hvr, goldfire, alanz Reviewed By: simonmar Subscribers: goldfire, rwbarton, thomie, mpickering, carter Differential Revision: https://phabricator.haskell.org/D4761 --- testsuite/tests/dph/quickhull/Main.hs | 43 - testsuite/tests/dph/quickhull/Makefile | 3 - testsuite/tests/dph/quickhull/QuickHullVect.hs | 41 - testsuite/tests/dph/quickhull/SVG.hs | 34 - testsuite/tests/dph/quickhull/TestData.hs | 92 -- testsuite/tests/dph/quickhull/Types.hs | 33 - .../dph/quickhull/dph-quickhull-copy-fast.stdout | 1019 -------------------- .../dph/quickhull/dph-quickhull-copy-opt.stdout | 1019 -------------------- .../dph/quickhull/dph-quickhull-vseg-fast.stdout | 1019 -------------------- .../dph/quickhull/dph-quickhull-vseg-opt.stdout | 1019 -------------------- testsuite/tests/dph/quickhull/dph-quickhull.T | 20 - 11 files changed, 4342 deletions(-) delete mode 100644 testsuite/tests/dph/quickhull/Main.hs delete mode 100644 testsuite/tests/dph/quickhull/Makefile delete mode 100644 testsuite/tests/dph/quickhull/QuickHullVect.hs delete mode 100644 testsuite/tests/dph/quickhull/SVG.hs delete mode 100644 testsuite/tests/dph/quickhull/TestData.hs delete mode 100644 testsuite/tests/dph/quickhull/Types.hs delete mode 100644 testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout delete mode 100644 testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout delete mode 100644 testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout delete mode 100644 testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout delete mode 100644 testsuite/tests/dph/quickhull/dph-quickhull.T (limited to 'testsuite/tests/dph/quickhull') diff --git a/testsuite/tests/dph/quickhull/Main.hs b/testsuite/tests/dph/quickhull/Main.hs deleted file mode 100644 index e1dc04ba24..0000000000 --- a/testsuite/tests/dph/quickhull/Main.hs +++ /dev/null @@ -1,43 +0,0 @@ - -import qualified Types as QH -import QuickHullVect (quickhull) - -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.Prelude as P - -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) - -import System.Environment -import Data.List - -import SVG -import TestData - - ------ -runQuickhull :: PArray QH.Point -> [(Double, Double)] -runQuickhull pts - = let result = quickhull pts - resxs = P.toUArray (QH.xsOf result) - resys = P.toUArray (QH.ysOf result) - in U.index "runQuickhull" resxs 0 `seq` (zip (U.toList resxs) (U.toList resys)) - - --- Main Program --------------------------------------------------------------- -main - = do args <- getArgs - let n = case args of - [s] -> read s - _ -> 1000 - - paInput <- toPArrayPoints - $ genPointsCombo n - - let psHull = runQuickhull paInput - psInput = P.toList paInput - - putStr - $ makeSVG - (roundPoints psInput) - (roundPoints psHull) diff --git a/testsuite/tests/dph/quickhull/Makefile b/testsuite/tests/dph/quickhull/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/quickhull/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/quickhull/QuickHullVect.hs b/testsuite/tests/dph/quickhull/QuickHullVect.hs deleted file mode 100644 index e0ad75858d..0000000000 --- a/testsuite/tests/dph/quickhull/QuickHullVect.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} - -module QuickHullVect (quickhull) where - -import Types - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.Prelude.Int as Int - -import qualified Prelude as P - -distance :: Point -> Line -> Double -distance (xo, yo) ((x1, y1), (x2, y2)) - = (x1 D.- xo) D.* (y2 D.- yo) D.- (y1 D.- yo) D.* (x2 D.- xo) - -hsplit :: [:Point:] -> Line -> [:Point:] -hsplit points line@(p1, p2) - | lengthP packed Int.< 2 = singletonP p1 +:+ packed - | otherwise - = concatP [: hsplit packed ends | ends <- [:(p1, pm), (pm, p2):] :] - where - cross = [: distance p line | p <- points :] - packed = [: p | (p,c) <- zipP points cross, c D.> 0.0 :] - pm = points !: maxIndexP cross - -quickHull' :: [:Point:] -> [:Point:] -quickHull' points - | lengthP points Int.== 0 = points - | otherwise - = concatP [: hsplit points ends | ends <- [: (minx, maxx), (maxx, minx) :] :] - where - xs = [: x | (x, y) <- points :] - minx = points !: minIndexP xs - maxx = points !: maxIndexP xs - -quickhull :: PArray Point -> PArray Point -{-# NOINLINE quickhull #-} -quickhull ps = toPArrayP (quickHull' (fromPArrayP ps)) - diff --git a/testsuite/tests/dph/quickhull/SVG.hs b/testsuite/tests/dph/quickhull/SVG.hs deleted file mode 100644 index c750fb06f5..0000000000 --- a/testsuite/tests/dph/quickhull/SVG.hs +++ /dev/null @@ -1,34 +0,0 @@ - -module SVG where - --- Making a SVG diagram of the points and hull -makeSVG :: [(Int, Int)] -> [(Int, Int)] -> String -makeSVG points hull - = unlines - $ [ "" ] - ++ [svgPolygon hull] - ++ map svgPoint points - ++ map svgPointHull hull - ++ [""] - -svgPolygon :: [(Int, Int)] -> String -svgPolygon points - = "" - -svgPoint :: (Int, Int) -> String -svgPoint (x, y) - = "" - -svgPointHull :: (Int, Int) -> String -svgPointHull (x, y) - = "" - -roundPoints :: [(Double, Double)] -> [(Int, Int)] -roundPoints ps = [(round x, round y) | (x, y) <- ps] diff --git a/testsuite/tests/dph/quickhull/TestData.hs b/testsuite/tests/dph/quickhull/TestData.hs deleted file mode 100644 index 938c9fea91..0000000000 --- a/testsuite/tests/dph/quickhull/TestData.hs +++ /dev/null @@ -1,92 +0,0 @@ - -module TestData - ( genPointsUniform - , genPointsDisc - , genPointsCombo - , toPArrayPoints ) -where - -import qualified Types as QH -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.Prelude as P -import qualified Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) - -import System.Random -import Control.Exception - --- Random points generation --- IMPORTANT: We use the same seed with the same random generator in all --- quickhull codes. The asymptotic work complexity of quickhull --- is between O (N) and O (N^2) depending on the input. --- To compare benchmark results, they always need to use the same --- input. -seed = 42742 - --- | Some uniformly distributed points -genPointsUniform - :: Int -- ^ number of points - -> Double -- ^ minimum coordinate - -> Double -- ^ maximum coordinate - -> [(Double, Double)] - -genPointsUniform n minXY maxXY - = let - pointMin = 10 - pointMax = 510 - gen = mkStdGen seed - in toPairs $ take (2*n) $ randomRs (pointMin, pointMax) gen - -toPairs [] = [] -toPairs (x:y:pts) = (x, y) : toPairs pts - - --- | Some points distributed as a disc -genPointsDisc - :: Int -- ^ number of points - -> (Double, Double) -- ^ center of disc - -> Double -- ^ radius of disc - -> [(Double, Double)] - -genPointsDisc n (originX, originY) radiusMax - = let (genRadius, genAngle) - = split $ mkStdGen seed - - radius = take n $ randomRs (0, radiusMax) genRadius - angle = take n $ randomRs (- pi, pi) genAngle - - makeXY (r, a) - = ( originX + r * cos a - , originY + r * sin a) - - in map makeXY $ zip radius angle - - --- | A point cloud with areas of high and low density -genPointsCombo - :: Int -- ^ number of points - -> [(Double, Double)] - -genPointsCombo n - = genPointsDisc (n `div` 5) (250, 250) 200 - ++ genPointsDisc (n `div` 5) (100, 100) 80 - ++ genPointsDisc (n `div` 5) (150, 300) 30 - ++ genPointsDisc (n `div` 5) (500, 120) 30 - ++ genPointsDisc (n `div` 5) (300, 200) 150 - - --- | Convert a list of points to a PArray -toPArrayPoints :: [(Double, Double)] -> IO (PArray QH.Point) -toPArrayPoints ps - = do let pts = QH.points (P.fromList (map fst ps)) - (P.fromList (map snd ps)) - evaluate $ force pts - return pts - --- | Force points to be evaluated -force pts - = U.index "TestData" (P.toUArray (QH.xsOf pts)) 0 D.+ - U.index "TestData" (P.toUArray (QH.ysOf pts)) 0 - - diff --git a/testsuite/tests/dph/quickhull/Types.hs b/testsuite/tests/dph/quickhull/Types.hs deleted file mode 100644 index 6b19ef1ab3..0000000000 --- a/testsuite/tests/dph/quickhull/Types.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} - -module Types ( Point, Line, points, xsOf, ysOf) where - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double - -type Point = (Double, Double) -type Line = (Point, Point) - -points' :: [:Double:] -> [:Double:] -> [:Point:] -points' = zipP - -points :: PArray Double -> PArray Double -> PArray Point -{-# NOINLINE points #-} -points xs ys = toPArrayP (points' (fromPArrayP xs) (fromPArrayP ys)) - -xsOf' :: [:Point:] -> [:Double:] -xsOf' ps = [: x | (x, _) <- ps :] - -xsOf :: PArray Point -> PArray Double -{-# NOINLINE xsOf #-} -xsOf ps = toPArrayP (xsOf' (fromPArrayP ps)) - -ysOf' :: [:Point:] -> [:Double:] -ysOf' ps = [: y | (_, y) <- ps :] - -ysOf :: PArray Point -> PArray Double -{-# NOINLINE ysOf #-} -ysOf ps = toPArrayP (ysOf' (fromPArrayP ps)) - - diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout +++ /dev/null @@ -1,1019 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout +++ /dev/null @@ -1,1019 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout +++ /dev/null @@ -1,1019 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout +++ /dev/null @@ -1,1019 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/testsuite/tests/dph/quickhull/dph-quickhull.T b/testsuite/tests/dph/quickhull/dph-quickhull.T deleted file mode 100644 index 7d8cf322ab..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull.T +++ /dev/null @@ -1,20 +0,0 @@ - -test ('dph-quickhull-copy-fast' - , [ outputdir('copy-fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -fno-vectorisation-avoidance -package dph-lifted-copy -package dph-prim-par']) - - -test ('dph-quickhull-vseg-fast' - , [ outputdir('vseg-fast') - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg -package dph-prim-par']) - -- cgit v1.2.1