Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
b85a0293
by Simon Jakobi at 2026-03-11T15:06:41-04:00
3 changed files:
- + testsuite/tests/perf/should_run/T1216.hs
- + testsuite/tests/perf/should_run/T1216.stdout
- testsuite/tests/perf/should_run/all.T
Changes:
| 1 | +{-# LANGUAGE BangPatterns #-}
|
|
| 2 | + |
|
| 3 | +import Data.Array.Base
|
|
| 4 | +import GHC.Arr(unsafeIndex,index)
|
|
| 5 | +import Data.Array.IArray
|
|
| 6 | +import Control.Monad.ST
|
|
| 7 | +import Data.Array.ST
|
|
| 8 | +import System.Environment(getArgs)
|
|
| 9 | + |
|
| 10 | +type Elem = Double
|
|
| 11 | +type Vector = [Elem]
|
|
| 12 | +type Matrix = [Vector]
|
|
| 13 | + |
|
| 14 | +n :: Num a => a
|
|
| 15 | +n = 40
|
|
| 16 | + |
|
| 17 | +a :: Matrix
|
|
| 18 | +a = [[if i==j then 1 else 0|i<-[1..n]]|j<-[1..n]]
|
|
| 19 | + |
|
| 20 | +p :: Vector
|
|
| 21 | +p = [1..n]
|
|
| 22 | + |
|
| 23 | +------------------------ array-based, update-in-place code
|
|
| 24 | + |
|
| 25 | +type VectorA s = STUArray s Int Elem
|
|
| 26 | +type MatrixA s = STUArray s (Int,Int) Elem
|
|
| 27 | + |
|
| 28 | +{-# INLINE myreadArray #-}
|
|
| 29 | +-- | Read an element from a mutable array
|
|
| 30 | +myreadArray :: (MArray a e m, Ix i) => a i e -> i -> m e
|
|
| 31 | +myreadArray marr i = do
|
|
| 32 | + (l,u) <- getBounds marr
|
|
| 33 | + unsafeRead marr (myindex (l,u) i)
|
|
| 34 | + |
|
| 35 | +{-# INLINE mywriteArray #-}
|
|
| 36 | +-- | Write an element in a mutable array
|
|
| 37 | +mywriteArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
|
|
| 38 | +mywriteArray marr i e = do
|
|
| 39 | + (l,u) <- getBounds marr
|
|
| 40 | + unsafeWrite marr (myindex (l,u) i) e
|
|
| 41 | + |
|
| 42 | +myindex b i = index b i
|
|
| 43 | +-- the following is supposed to be the default implementation of index,
|
|
| 44 | +-- from GHC.Arr
|
|
| 45 | +-- myindex b i | inRange b i = unsafeIndex b i
|
|
| 46 | +-- | otherwise = error "Error in array index"
|
|
| 47 | + |
|
| 48 | +matA :: MatrixA s -> VectorA s -> VectorA s -> ST s (VectorA s)
|
|
| 49 | +(m `matA` v) tmp = m `seq` v `seq` tmp `seq` l 1 1 0
|
|
| 50 | + where l !i !j !s | i>n = return tmp
|
|
| 51 | + l i j s | j>n = mywriteArray tmp i s >> l (i+1) 1 0
|
|
| 52 | + l i j s = do a<-myreadArray m (i,j)
|
|
| 53 | + b<-myreadArray v j
|
|
| 54 | + l i (j+1) (s+a*b)
|
|
| 55 | + |
|
| 56 | +loopA a p q n | n==0 = return q
|
|
| 57 | +loopA a p q n = do
|
|
| 58 | + (a `matA` p) q
|
|
| 59 | + loopA a p q (n-1)
|
|
| 60 | + |
|
| 61 | +testA c = runSTUArray (do
|
|
| 62 | + aA <- newListArray ((1,1),(n,n)) (concat a)
|
|
| 63 | + pA <- newListArray (1,n) p
|
|
| 64 | + qA <- newArray (1,n) 0
|
|
| 65 | + loopA aA pA qA c
|
|
| 66 | + )
|
|
| 67 | + |
|
| 68 | +main = print $ testA 100_000 |
| 1 | +array (1,40) [(1,1.0),(2,2.0),(3,3.0),(4,4.0),(5,5.0),(6,6.0),(7,7.0),(8,8.0),(9,9.0),(10,10.0),(11,11.0),(12,12.0),(13,13.0),(14,14.0),(15,15.0),(16,16.0),(17,17.0),(18,18.0),(19,19.0),(20,20.0),(21,21.0),(22,22.0),(23,23.0),(24,24.0),(25,25.0),(26,26.0),(27,27.0),(28,28.0),(29,29.0),(30,30.0),(31,31.0),(32,32.0),(33,33.0),(34,34.0),(35,35.0),(36,36.0),(37,37.0),(38,38.0),(39,39.0),(40,40.0)] |
| ... | ... | @@ -112,6 +112,13 @@ test('T149', |
| 112 | 112 | ],
|
| 113 | 113 | makefile_test, ['T149'])
|
| 114 | 114 | |
| 115 | +test ('T1216',
|
|
| 116 | + [collect_stats('bytes allocated',5),
|
|
| 117 | + only_ways(['normal'])
|
|
| 118 | + ],
|
|
| 119 | + compile_and_run,
|
|
| 120 | + ['-O'])
|
|
| 121 | + |
|
| 115 | 122 | test('T5113',
|
| 116 | 123 | [collect_stats('bytes allocated',5),
|
| 117 | 124 | only_ways(['normal'])
|