[project @ 2001-08-04 06:11:24 by ken]
[ghc-hetmet.git] / ghc / lib / std / PrelPtr.lhs
1 -----------------------------------------------------------------------------
2 -- $Id: PrelPtr.lhs,v 1.2 2001/04/13 21:37:43 panne Exp $
3 -- 
4 -- (c) 2000
5 -- 
6 -- Module PrelPtr
7
8 \begin{code}
9 {-# OPTIONS -fno-implicit-prelude #-}
10 module PrelPtr{-everything-} where
11         
12 import PrelBase
13
14 ------------------------------------------------------------------------
15 -- Data pointers.
16
17 data Ptr a = Ptr Addr# deriving (Eq, Ord)
18
19 nullPtr :: Ptr a
20 nullPtr = Ptr (int2Addr# 0#)
21
22 castPtr :: Ptr a -> Ptr b
23 castPtr (Ptr addr) = Ptr addr
24
25 plusPtr :: Ptr a -> Int -> Ptr b
26 plusPtr (Ptr addr) (I# d) = Ptr (int2Addr# (addr2Int# addr +# d))
27
28 alignPtr :: Ptr a -> Int -> Ptr a
29 alignPtr addr@(Ptr a) (I# i)
30   = case addr2Int# a    of { ai ->
31     case remInt# ai i   of {
32       0# -> addr;
33       n  -> Ptr (int2Addr# (ai +# (i -# n))) }}
34
35 minusPtr :: Ptr a -> Ptr b -> Int
36 minusPtr (Ptr a1) (Ptr a2) = I# (addr2Int# a1 -# addr2Int# a2)
37
38 instance CCallable   (Ptr a)
39 instance CReturnable (Ptr a)
40
41 ------------------------------------------------------------------------
42 -- Function pointers for the default calling convention.
43
44 data FunPtr a = FunPtr Addr# deriving (Eq, Ord)
45
46 nullFunPtr :: FunPtr a
47 nullFunPtr = FunPtr (int2Addr# 0#)
48
49 castFunPtr :: FunPtr a -> FunPtr b
50 castFunPtr (FunPtr addr) = FunPtr addr
51
52 castFunPtrToPtr :: FunPtr a -> Ptr b
53 castFunPtrToPtr (FunPtr addr) = Ptr addr
54
55 castPtrToFunPtr :: Ptr a -> FunPtr b
56 castPtrToFunPtr (Ptr addr) = FunPtr addr
57
58 instance CCallable   (FunPtr a)
59 instance CReturnable (FunPtr a)
60 \end{code}