[project @ 2001-02-27 14:37:17 by rrt]
[ghc-hetmet.git] / ghc / tests / ccall / should_run / fed001.hs
index 22a4352..57a5281 100644 (file)
@@ -1,23 +1,32 @@
 import Foreign
 import Monad
+import Addr
+
+newtype XPtr a = XPtr Addr
+unXPtr (XPtr (A# x)) = x
 
 type CInt  = Int32
 type CSize = Word32
 
-foreign export dynamic mkComparator :: (Addr -> Addr -> IO CInt) -> IO Addr
-foreign import qsort :: Addr -> CSize -> CSize -> Addr -> IO ()
+foreign export dynamic 
+   mkComparator :: (XPtr Int -> XPtr Int -> IO CInt) 
+               -> IO (XPtr (XPtr Int -> XPtr Int -> IO CInt))
+
+foreign import 
+   qsort :: Ptr Int -> CSize -> CSize -> XPtr (XPtr Int -> XPtr Int -> IO CInt) 
+        -> IO ()
 
-compareInts :: Addr -> Addr -> IO CInt
+compareInts :: XPtr Int -> XPtr Int -> IO CInt
 compareInts a1 a2 = do
-   i1 <- peek a1
-   i2 <- peek a2
+   i1 <- peek (Ptr (unXPtr a1))
+   i2 <- peek (Ptr (unXPtr a2))
    return (fromIntegral (i1 - i2 :: Int))
 
 main :: IO ()
 main = do
    let values = [ 12, 56, 90, 34, 78 ] :: [Int]
        n      = length values
-   buf <- mallocElems (head values) n
+   buf <- mallocArray n
    zipWithM_ (pokeElemOff buf) [ 0 .. ] values
    c <- mkComparator compareInts
    qsort buf (fromIntegral n) (fromIntegral (sizeOf (head values))) c