ghc/tests/ccall/should_run/fed001.hs

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