ghc/tests/ccall/should_run/fed001.hs

   1 import Foreign
   2 import Monad
   3 import Addr
   4
   5 newtype XPtr a = XPtr Addr
   6 unXPtr (XPtr (A# x)) = x
   7
   8 type CInt  = Int32
   9 type CSize = Word32
  10
  11 foreign export dynamic
  12    mkComparator :: (XPtr Int -> XPtr Int -> IO CInt)
  13                 -> IO (XPtr (XPtr Int -> XPtr Int -> IO CInt))
  14
  15 foreign import
  16    qsort :: Ptr Int -> CSize -> CSize -> XPtr (XPtr Int -> XPtr Int -> IO CInt)
  17          -> IO ()
  18
  19 compareInts :: XPtr Int -> XPtr Int -> IO CInt
  20 compareInts a1 a2 = do
  21    i1 <- peek (Ptr (unXPtr a1))
  22    i2 <- peek (Ptr (unXPtr a2))
  23    return (fromIntegral (i1 - i2 :: Int))
  24
  25 main :: IO ()
  26 main = do
  27    let values = [ 12, 56, 90, 34, 78 ] :: [Int]
  28        n      = length values
  29    buf <- mallocArray n
  30    zipWithM_ (pokeElemOff buf) [ 0 .. ] values
  31    c <- mkComparator compareInts
  32    qsort buf (fromIntegral n) (fromIntegral (sizeOf (head values))) c
  33    mapM (peekElemOff buf) [ 0 .. n-1 ] >>= (print :: [Int] -> IO ())