[clean up foreignptr implementation some.
John Meacham <john@repetae.net>**20120206181122
 Ignore-this: 17b7146d0bab97deb69e907f67c61af1
] hunk ./lib/base/Foreign/ForeignPtr.hs 30
--- newForeignPtrEnv :: FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
hunk ./lib/base/Foreign/ForeignPtr.hs 33
--- addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
-
-mallocForeignPtr :: Storable a => IO (ForeignPtr a)
-mallocForeignPtr = liftM FP malloc
-
hunk ./lib/base/Foreign/ForeignPtr.hs 34
-mallocForeignPtrBytes = liftM FP . mallocBytes
+mallocForeignPtrBytes x = do
+    ptr <- mallocBytes x
+    newForeignPtr finalizerFree ptr
hunk ./lib/base/Foreign/ForeignPtr.hs 38
+mallocForeignPtr :: Storable a => IO (ForeignPtr a)
+mallocForeignPtr = doMalloc undefined where
+    doMalloc :: Storable b => b -> IO (ForeignPtr b)
+    doMalloc x = mallocForeignPtrBytes (sizeOf x)
+
hunk ./lib/base/Foreign/ForeignPtr.hs 44
-mallocForeignPtrArray = liftM FP . mallocArray
+mallocForeignPtrArray  = doMalloc undefined where
+    doMalloc            :: Storable a' => a' -> Int -> IO (ForeignPtr a')
+    doMalloc dummy size  = mallocForeignPtrBytes (size * sizeOf dummy)
hunk ./lib/base/Foreign/ForeignPtr.hs 49
-mallocForeignPtrArray0 = liftM FP . mallocArray0
-
--- mallocForeignPtrArray0 :: Storable a => Int -> IO (ForeignPtr a)
--- mallocForeignPtrArray0 = liftM FP . mallocArray0
+mallocForeignPtrArray0 sz = mallocForeignPtrArray (sz + 1)
hunk ./lib/base/Foreign/ForeignPtr.hs 52
-withForeignPtr (FP p) act = act p
+withForeignPtr fp act = do
+    r <- act (unsafeForeignPtrToPtr fp)
+    touchForeignPtr fp
+    return r
hunk ./lib/base/Foreign/ForeignPtr.hs 63
+--foreign import primitive "touch_" :: ForeignPtr a ->
+
hunk ./lib/base/Foreign/ForeignPtr.hs 71
---
hunk ./lib/base/Foreign/ForeignPtr.hs 75
-newForeignPtrEnv _ _ p = newForeignPtr_ p
+newForeignPtrEnv f e p = do
+    fp <- newForeignPtr_ p
+    addForeignPtrFinalizerEnv f e fp
+    return fp
hunk ./lib/jhc/Foreign/Marshal/Array.hs 50
-
hunk ./lib/jhc/Foreign/Marshal/Array.hs 105
-
hunk ./lib/jhc/Foreign/Marshal/Array.hs 127
-
hunk ./lib/jhc/Foreign/Marshal/Array.hs 142
-
hunk ./lib/jhc/Foreign/Marshal/Array.hs 206
-
hunk ./lib/jhc/Foreign/Marshal/Array.hs 227
-
hunk ./lib/jhc/Foreign/Marshal/Array.hs 239
-
hunk ./regress/tests/0_parse/config.yaml 1
-jhc_flags: --stop parse --stale Main --no-ho
+jhc_flags: --stop parse --stale Main --no-cache
hunk ./regress/tests/1_typecheck/config.yaml 1
-jhc_flags: --stop typecheck --stale Main --no-ho
+jhc_flags: --stop typecheck --stale Main --no-cache
hunk ./rts/jhc_jgc.c 201
-                        block_threshold,
+                        (unsigned)arena->block_threshold,
hunk ./rts/slub.c 120
-static unsigned block_threshold = 8;
-