[greatly clean up implementation of 'Ptr' and friends, get rid of Addr intermediate type, add System.Mem.StableName
John Meacham <john@repetae.net>**20090821020717
 Ignore-this: 4a1c88d7b36ce24f1099758832f69fd7
] hunk ./bugs/issue-cfaf0ff2b21f778812bfd4a15c213c1d6af66798.yaml 8
-status: :unstarted
-disposition: 
+status: :closed
+disposition: :fixed
hunk ./bugs/issue-cfaf0ff2b21f778812bfd4a15c213c1d6af66798.yaml 19
+- - 2009-08-21 02:06:49.949469 Z
+  - John Meacham <john@repetae.net>
+  - closed with disposition fixed
+  - ""
hunk ./docs/index.mkd 10
- * [The (incomplete) Manual](manual.html) The beginings of the jhc manual
+ * For information on running jhc, see [The Manual](manual.html). 
hunk ./lib/base/Foreign/Marshal/Pool.hs 108
-    poke ptr (v :: Ptr ())
-    return ((ptr :: Ptr (Ptr ())) `plusPtr` sizeOf pool)
+    poke ptr v
+    return (castPtr $ ptr `plusPtr` sizeOf pool)
hunk ./lib/jhc/Foreign/Ptr.hs 28
+import Data.Word
hunk ./lib/jhc/Foreign/Ptr.hs 32
-    showsPrec n (Ptr x) = showsPrec n (toInteger (addrToWordPtr  x))
-
-nullPtr :: Ptr a
-nullPtr = Ptr nullAddr
-
-plusPtr :: Ptr a -> Int -> Ptr b
-plusPtr (Ptr addr) off = Ptr (plusAddr addr off)
-
-minusPtr :: Ptr a -> Ptr b -> Int
-minusPtr (Ptr a1) (Ptr a2) =  minusAddr a1 a2
+    showsPrec n x = showsPrec n (toInteger (ptrToWordPtr  x))
hunk ./lib/jhc/Foreign/Ptr.hs 43
+castFunPtrToPtr :: FunPtr a -> Ptr b
+castFunPtrToPtr (FunPtr x) = Ptr x
hunk ./lib/jhc/Foreign/Ptr.hs 46
-nullFunPtr = FunPtr nullFunAddr
-castFunPtr (FunPtr addr) = FunPtr addr
-
---castFunPtrToPtr :: FunPtr a -> Ptr b
---castFunPtrToPtr = unsafeCoerce
-
---castPtrToFunPtr :: Ptr a -> FunPtr b
---castPtrToFunPtr = unsafeCoerce
-
+castPtrToFunPtr :: Ptr a -> FunPtr b
+castPtrToFunPtr (Ptr x) = FunPtr x
hunk ./lib/jhc/Foreign/Ptr.hs 49
-foreign import primitive "U2U" castFunPtrToPtr :: FunPtr a -> Ptr b
-foreign import primitive "U2U" castPtrToFunPtr :: Ptr a -> FunPtr b
hunk ./lib/jhc/Foreign/Ptr.hs 50
+foreign import primitive "U2U" ptrToWordPtr :: Ptr a -> WordPtr
+foreign import primitive "U2U" wordPtrToPtr :: WordPtr -> Ptr a
hunk ./lib/jhc/Foreign/Storable.hs 1
-{-# OPTIONS_JHC -N #-}
+{-# OPTIONS_JHC -N -fm4 -funboxed-values -funboxed-tuples -fffi #-}
hunk ./lib/jhc/Foreign/Storable.hs 4
+m4_include(Foreign/Storable.m4)
+
+import Jhc.Types
hunk ./lib/jhc/Foreign/Storable.hs 12
-plusPtr :: Ptr a -> Int -> Ptr b
-plusPtr (Ptr addr) off = Ptr (plusAddr addr off)
hunk ./lib/jhc/Foreign/Storable.hs 26
-    peekByteOff addr off = IO $ \w -> unIO (peek $! (addr `plusPtr` off)) w
-    pokeByteOff addr off x = IO $ \w -> unIO (let adr = (addr `plusPtr` off) in adr `seq` poke adr x) w
+    peekByteOff addr off = IO $ \w -> unIO (peek $! (castPtr $ addr `plusPtr` off)) w
+    pokeByteOff addr off x = IO $ \w -> unIO (let adr = castPtr (addr `plusPtr` off) in adr `seq` poke adr x) w
hunk ./lib/jhc/Foreign/Storable.hs 33
+INST_STORABLE((Ptr a),Ptr,BitsPtr_,bits<ptr>)
+INST_STORABLE((FunPtr a),FunPtr,BitsPtr_,bits<ptr>)
+
+-- foreign import "Add" plusBitsPtr_ :: BitsPtr_ -> Int -> BitsPtr_
hunk ./lib/jhc/Foreign/Storable.m4 1
+m4_divert(-1)
hunk ./lib/jhc/Foreign/Storable.m4 7
-    peek (Ptr (Addr addr)) = IO $ \w -> case peek$2 addr w of
-        (# w', r #) -> (# w', $1 r #)
-    poke (Ptr (Addr addr)) ($1 v) = IO $ \w -> case poke$2 addr v w of
+    peek (Ptr addr) = IO $ \w -> case peek$3 addr w of
+        (# w', r #) -> (# w', $2 r #)
+    poke (Ptr addr) ($2 v) = IO $ \w -> case poke$3 addr v w of
hunk ./lib/jhc/Foreign/Storable.m4 11
-    sizeOf _ = boxInt (sizeOf$2 0#)
-    alignment _ = boxInt (alignmentOf$2 0#)
+    sizeOf _ = boxInt (sizeOf$3 0#)
+    alignment _ = boxInt (alignmentOf$3 0#)
hunk ./lib/jhc/Foreign/Storable.m4 15
-foreign import primitive "peek.$3" peek$2 :: Addr__ -> UIO $2
-foreign import primitive "poke.$3" poke$2 :: Addr__ -> $2 -> UIO_
-foreign import primitive "sizeOf.$3" sizeOf$2 :: $2 -> Int__
-foreign import primitive "alignmentOf.$3" alignmentOf$2 :: $2 -> Int__
+foreign import primitive "peek.$4" peek$3 :: Addr__ -> UIO $3
+foreign import primitive "poke.$4" poke$3 :: Addr__ -> $3 -> UIO_
+foreign import primitive "sizeOf.$4" sizeOf$3 :: $3 -> Int__
+foreign import primitive "alignmentOf.$4" alignmentOf$3 :: $3 -> Int__
hunk ./lib/jhc/Foreign/Storable.m4 27
-    peek (Ptr (Addr addr)) = IO $ \w -> case peek$2 addr w of
+    peek (Ptr addr) = IO $ \w -> case peek$2 addr w of
hunk ./lib/jhc/Foreign/Storable.m4 29
-    poke (Ptr (Addr addr)) v = IO $ \w -> case poke$2 addr (unbox$1 v) w of
+    poke (Ptr addr) v = IO $ \w -> case poke$2 addr (unbox$1 v) w of
hunk ./lib/jhc/Foreign/Storable.m4 48
+m4_divert
hunk ./lib/jhc/Jhc/Addr.hs 4
-m4_include(Foreign/Storable.m4)
hunk ./lib/jhc/Jhc/Addr.hs 6
-    Addr(..),
-    FunAddr(..),
hunk ./lib/jhc/Jhc/Addr.hs 8
-    ptrFromAddr__,
-    nullAddr,
+    nullPtr,
+    nullFunPtr,
hunk ./lib/jhc/Jhc/Addr.hs 11
-    nullFunAddr,
-    plusAddr,
-    minusAddr,
-    addrToWordPtr,
-    wordPtrToAddr,
-    wordPtrToFunAddr,
-    funAddrToWordPtr
+    plusPtr,
+    minusPtr
hunk ./lib/jhc/Jhc/Addr.hs 15
+import Jhc.Basics
hunk ./lib/jhc/Jhc/Addr.hs 17
-import Data.Word
+import Jhc.Order
hunk ./lib/jhc/Jhc/Addr.hs 20
-import Jhc.Order
-import Jhc.Basics
-import Jhc.IO
-import Foreign.Storable
hunk ./lib/jhc/Jhc/Addr.hs 21
-data Addr = Addr BitsPtr_
-data FunAddr = FunAddr BitsPtr_
hunk ./lib/jhc/Jhc/Addr.hs 22
-newtype Ptr a = Ptr Addr
-newtype FunPtr a = FunPtr FunAddr
+data Ptr a = Ptr BitsPtr_
+data FunPtr a = FunPtr BitsPtr_
hunk ./lib/jhc/Jhc/Addr.hs 25
-nullAddr = Addr 0#
-nullFunAddr = FunAddr 0#
+nullPtr :: Ptr a
+nullFunPtr :: FunPtr a
+nullPtr = Ptr 0#
+nullFunPtr = FunPtr 0#
hunk ./lib/jhc/Jhc/Addr.hs 30
-INST_EQORDER(Addr,BitsPtr_)
-INST_EQORDER(FunAddr,BitsPtr_)
+INST_EQORDER((Ptr a),Ptr,BitsPtr_,U)
+INST_EQORDER((FunPtr a),FunPtr,BitsPtr_,U)
hunk ./lib/jhc/Jhc/Addr.hs 33
-INST_STORABLE(Addr,BitsPtr_,bits<ptr>)
-INST_STORABLE(FunAddr,BitsPtr_,bits<ptr>)
hunk ./lib/jhc/Jhc/Addr.hs 34
-{-# INLINE plusAddr #-}
-plusAddr :: Addr -> Int -> Addr
-plusAddr (Addr addr) off = case unboxInt off of
-    off_ -> Addr (addr `plusWordPtr` intToPtr__ off_)
+{-# INLINE plusPtr #-}
+plusPtr :: Ptr a -> Int -> Ptr a
+plusPtr (Ptr addr) off = case unboxInt off of
+    off_ -> Ptr (addr `plusWordPtr` intToPtr__ off_)
hunk ./lib/jhc/Jhc/Addr.hs 39
-{-# INLINE minusAddr #-}
-minusAddr :: Addr -> Addr -> Int
-minusAddr (Addr a1) (Addr a2) = boxInt (ptrToInt__ (a1 `minusWP` a2))
+{-# INLINE minusPtr #-}
+minusPtr :: Ptr a -> Ptr a -> Int
+minusPtr (Ptr a1) (Ptr a2) = boxInt (ptrToInt__ (a1 `minusWP` a2))
hunk ./lib/jhc/Jhc/Addr.hs 43
-foreign import primitive "U2U" addrToWordPtr :: Addr -> WordPtr
-foreign import primitive "U2U" wordPtrToAddr :: WordPtr -> Addr
-foreign import primitive "U2U" wordPtrToFunAddr :: WordPtr -> FunAddr
-foreign import primitive "U2U" funAddrToWordPtr :: FunAddr -> WordPtr
hunk ./lib/jhc/Jhc/Addr.hs 50
-ptrFromAddr__ :: Addr__ -> Ptr a
-ptrFromAddr__ addr = Ptr (Addr addr)
-
-instance Storable (Ptr a) where
-    sizeOf (Ptr a) = sizeOf a
-    alignment (Ptr a) = alignment a
-    peek p = peek (castPtr p) `thenIO` (returnIO . Ptr)
-    poke p (Ptr x) = poke (castPtr p) x
-
-instance Eq (Ptr a) where
-    Ptr a == Ptr b = a == b
-    Ptr a /= Ptr b = a /= b
-
-instance Ord (Ptr a) where
-    compare (Ptr a) (Ptr b) = compare a b
-    Ptr a <= Ptr b = a <= b
-    Ptr a < Ptr b = a < b
-    Ptr a > Ptr b = a > b
-    Ptr a >= Ptr b = a >= b
hunk ./lib/jhc/Jhc/Addr.hs 54
+castFunPtr :: FunPtr a -> FunPtr b
+castFunPtr (FunPtr addr) = FunPtr addr
hunk ./lib/jhc/Jhc/Handle.hs 80
-    ptr <- withCString fp $ \cfp -> c_fopen cfp (toStr m)
+    ptr <- withCString fp $ \cfp -> c_fopen cfp (Ptr (toStr m))
hunk ./lib/jhc/Jhc/Handle.hs 90
-toStr ReadMode = ptrFromAddr__ "r"#
-toStr WriteMode = ptrFromAddr__ "w"#
-toStr AppendMode = ptrFromAddr__ "a"#
-toStr ReadWriteMode = ptrFromAddr__ "r+"#
+toStr ReadMode = "r"#
+toStr WriteMode = "w"#
+toStr AppendMode = "a"#
+toStr ReadWriteMode = "r+"#
hunk ./lib/jhc/Jhc/IO.hs 43
-unIO :: IO a -> World__ -> (# World__, a #)
+unIO :: IO a -> UIO a
hunk ./lib/jhc/Jhc/IO.hs 49
+fromUIO :: UIO a -> IO a
+fromUIO x = IO x
+
+fromUIO_ :: UIO_ -> IO ()
+fromUIO_ f = IO $ \w -> (# f w, () #) 
+
+
hunk ./lib/jhc/Jhc/Inst/Storable.hs 20
-INST_STORABLE(Float,Float32_,fbits32)
-INST_STORABLE(Double,Float64_,fbits64)
+INST_STORABLE(Float,Float,Float32_,fbits32)
+INST_STORABLE(Double,Double,Float64_,fbits64)
hunk ./lib/jhc/Jhc/JumpPoint.hs 11
-newtype JumpPoint = JumpPoint Addr
+newtype JumpPoint = JumpPoint (Ptr ())
hunk ./lib/jhc/Jhc/JumpPoint.hs 33
-foreign import ccall "malloc.h malloc" _malloc :: Int -> IO Addr
-foreign import ccall "malloc.h free" _free :: Addr -> IO ()
+foreign import ccall "malloc.h malloc" _malloc :: Int -> IO (Ptr a)
+foreign import ccall "malloc.h free" _free :: Ptr a -> IO ()
hunk ./lib/jhc/Jhc/Monad.hs 17
-class Monad m  where
+class Monad m where
hunk ./lib/jhc/Jhc/Monad.hs 40
-mapM             :: Monad m => (a -> m b) -> [a] -> m [b]
+mapM :: Monad m => (a -> m b) -> [a] -> m [b]
hunk ./lib/jhc/Jhc/Monad.hs 48
-mapM_            :: Monad m => (a -> m b) -> [a] -> m ()
+mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
hunk ./lib/jhc/Jhc/Monad.hs 53
-sequence       :: Monad m => [m a] -> m [a]
+sequence :: Monad m => [m a] -> m [a]
hunk ./lib/jhc/Jhc/Monad.hs 58
-sequence_      :: Monad m => [m a] -> m ()
+sequence_ :: Monad m => [m a] -> m ()
hunk ./lib/jhc/Jhc/Monad.hs 63
-(=<<)            :: Monad m => (a -> m b) -> m a -> m b
-f =<< x          =  x >>= f
+(=<<) :: Monad m => (a -> m b) -> m a -> m b
+f =<< x =  x >>= f
hunk ./lib/jhc/Jhc/Order.hs 1
-{-# OPTIONS_JHC -N -fffi #-}
+{-# OPTIONS_JHC -fm4 -N -fffi #-}
+
+m4_include(Jhc/Order.m4)
hunk ./lib/jhc/Jhc/Order.hs 18
+import Jhc.Types
hunk ./lib/jhc/Jhc/Order.hs 99
-instance Eq Char where
-    Char x == Char y = boxBool (equalsChar x y)
-    Char x /= Char y = boxBool (nequalsChar x y)
+INST_EQORDER(Char,Char,Bits32_,U)
hunk ./lib/jhc/Jhc/Order.hs 101
-instance Ord Char where
-    Char x < Char y = boxBool (bits32ULt x y)
-    Char x > Char y = boxBool (bits32UGt x y)
-    Char x <= Char y = boxBool (bits32ULte x y)
-    Char x >= Char y = boxBool (bits32UGte x y)
hunk ./lib/jhc/Jhc/Order.hs 120
-foreign import primitive "Eq" equalsChar :: Char__ -> Char__ -> Bool__
-foreign import primitive "NEq" nequalsChar :: Char__ -> Char__ -> Bool__
-foreign import primitive "ULt" bits32ULt :: Char__ -> Char__ -> Bool__
-foreign import primitive "ULte" bits32ULte :: Char__ -> Char__ -> Bool__
-foreign import primitive "UGt" bits32UGt :: Char__ -> Char__ -> Bool__
-foreign import primitive "UGte" bits32UGte :: Char__ -> Char__ -> Bool__
-foreign import primitive "box" boxBool :: Bool__ -> Bool
hunk ./lib/jhc/Jhc/Order.m4 10
-    $1 x == $1 y = boxBool (equals$2 x y)
-    $1 x /= $1 y = boxBool (nequals$2 x y)
+    $2 x == $2 y = boxBool (equals$3 x y)
+    $2 x /= $2 y = boxBool (nequals$3 x y)
hunk ./lib/jhc/Jhc/Order.m4 13
-foreign import primitive "Eq" equals$2 :: $2 -> $2 -> Bool__
-foreign import primitive "NEq" nequals$2 :: $2 -> $2 -> Bool__
+foreign import primitive "Eq" equals$3 :: $3 -> $3 -> Bool__
+foreign import primitive "NEq" nequals$3 :: $3 -> $3 -> Bool__
hunk ./lib/jhc/Jhc/Order.m4 20
+
hunk ./lib/jhc/Jhc/Order.m4 23
-    $1 x < $1 y = boxBool (lt$2 x y)
-    $1 x > $1 y = boxBool (gt$2 x y)
-    $1 x <= $1 y = boxBool (lte$2 x y)
-    $1 x >= $1 y = boxBool (gte$2 x y)
+    $2 x < $2 y = boxBool (lt$4$3 x y)
+    $2 x > $2 y = boxBool (gt$4$3 x y)
+    $2 x <= $2 y = boxBool (lte$4$3 x y)
+    $2 x >= $2 y = boxBool (gte$4$3 x y)
hunk ./lib/jhc/Jhc/Order.m4 28
-foreign import primitive "$3Lt" lt$3$2   :: $2 -> $2 -> Bool__
-foreign import primitive "$3Lte" lte$3$2 :: $2 -> $2 -> Bool__
-foreign import primitive "$3Gt" gt$3$2   :: $2 -> $2 -> Bool__
-foreign import primitive "$3Gte" gte$3$2 :: $2 -> $2 -> Bool__
+foreign import primitive "$4Lt" lt$4$3   :: $3 -> $3 -> Bool__
+foreign import primitive "$4Lte" lte$4$3 :: $3 -> $3 -> Bool__
+foreign import primitive "$4Gt" gt$4$3   :: $3 -> $3 -> Bool__
+foreign import primitive "$4Gte" gte$4$3 :: $3 -> $3 -> Bool__
hunk ./lib/jhc/Jhc/Order.m4 36
-m4_define(INST_EQORDER,{{INST_EQ($1,$2)INST_ORDER($1,$2,$3)}})
+m4_define(INST_EQORDER,{{INST_EQ($1,$2,$3)INST_ORDER($1,$2,$3,$4)}})
hunk ./lib/jhc/Jhc/Order.m4 39
-
-
hunk ./lib/jhc/Jhc/Prim.hs 24
+type HeapAddr_ = BitsPtr_
hunk ./lib/jhc/Prelude/IO.hs 71
-    file <- withCString fn $ \fnc -> c_fopen fnc (ptrFromAddr__ "r"#)
+    file <- withCString fn $ \fnc -> c_fopen fnc (Ptr "r"#)
adddir ./lib/jhc/System/Mem
addfile ./lib/jhc/System/Mem/StableName.hs
hunk ./lib/jhc/System/Mem/StableName.hs 1
+
+{-# OPTIONS_JHC -N -fffi -fm4   #-}
+
+m4_include(Jhc/Order.m4)
+
+module System.Mem.StableName(StableName(),makeStableName,hashStableName) where
+
+
+import Jhc.IO
+import Jhc.Order
+import Jhc.Basics
+
+data StableName a = StableName HeapAddr_
+
+makeStableName :: a -> IO (StableName a)
+makeStableName x = returnIO $ StableName (toHeapAddr x)
+
+hashStableName :: StableName a -> Int
+hashStableName (StableName a) = heapAddrToInt a
+
+foreign import primitive toHeapAddr :: a -> HeapAddr_
+foreign import primitive "U2I" heapAddrToInt :: HeapAddr_ -> Int
+
+INST_EQORDER((StableName a),StableName,HeapAddr_,U)
hunk ./lib/jhc/jhc.cabal 54
-        System.Mem
+        System.Mem,
+        System.Mem.StableName