ghc/tests/ccall/should_run/fed001.hs

   1 import Foreign
   2 import Monad
   3
   4 newtype Ptr a = Ptr Addr
   5 unPtr (Ptr x) = x
   6
   7 type CInt  = Int32
   8 type CSize = Word32
   9
  10 foreign export dynamic
  11    mkComparator :: (Ptr Int -> Ptr Int -> IO CInt)
  12                 -> IO (Ptr (Ptr Int -> Ptr Int -> IO CInt))
  13
  14 foreign import
  15    qsort :: Addr -> CSize -> CSize -> Ptr (Ptr Int -> Ptr Int -> IO CInt)
  16          -> IO ()
  17
  18 compareInts :: Ptr Int -> Ptr Int -> IO CInt
  19 compareInts a1 a2 = do
  20    i1 <- peek (unPtr a1)
  21    i2 <- peek (unPtr 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 <- mallocElems (head values) 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 ())