summaryrefslogtreecommitdiff
path: root/testsuite/tests/ghc-regress/ffi/should_run/ffi013.hs
blob: ae38c71b109dae2fda8f4b01f9b2cd5a62062a59 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
import Foreign
import Foreign.C.Types

foreign import ccall "wrapper"
   mkComparator :: (Ptr Int -> Ptr Int -> IO CInt) 
		-> IO (FunPtr (Ptr Int -> Ptr Int -> IO CInt))

foreign import ccall
   qsort :: Ptr Int -> CSize -> CSize -> FunPtr (Ptr Int -> Ptr Int -> IO CInt) 
	 -> IO ()

compareInts :: Ptr Int -> Ptr Int -> IO CInt
compareInts a1 a2 = do
   i1 <- peek a1
   i2 <- peek a2
   return (fromIntegral (i1 - i2 :: Int))

main :: IO ()
main = do
   c <- mkComparator compareInts
   let values = [ 12, 56, 90, 34, 78 ] :: [Int]
       n      = length values
   withArray values $ \ buf -> do
      qsort buf (fromIntegral n) (fromIntegral (sizeOf (head values))) c
      values' <- peekArray n buf
      print values'