diff --git a/Graphics/GD.hsc b/Graphics/GD.hsc
--- a/Graphics/GD.hsc
+++ b/Graphics/GD.hsc
@@ -3,6 +3,8 @@
                     Image, Size, Point, Color,
                     -- * Creating and copying images
                     newImage, copyImage,
+                    -- * Memory management
+                    withImage,
                     -- * Loading images
                     -- ** JPEG
                     loadJpegFile, loadJpegData, 
@@ -34,7 +36,7 @@
                    ) where
 
 import Control.Exception (bracket)
-import Control.Monad (liftM)
+import Control.Monad (liftM, unless)
 import Foreign
 import Foreign.C
 import Foreign.ForeignPtr
@@ -104,10 +106,13 @@
 foreign import ccall "gd.h gdImageCreateTrueColor" gdImageCreateTrueColor 
     :: CInt -> CInt -> IO (Ptr GDImage)
 
-foreign import ccall "gd.h &gdImageDestroy" ptr_gdImageDestroy 
-    :: FunPtr (Ptr GDImage -> IO ())
+foreign import ccall "gd.h gdImageDestroy" gdImageDestroy
+    :: Ptr GDImage -> IO ()
 
+foreign import ccall "gd-extras.h &gdImagePtrDestroyIfNotNull" ptr_gdImagePtrDestroyIfNotNull 
+    :: FunPtr (Ptr (Ptr GDImage) -> IO ())
 
+
 -- Copying image parts
 
 foreign import ccall "gd.h gdImageCopy" gdImageCopy
@@ -155,9 +160,10 @@
     :: Ptr GDImage -> CInt -> CInt -> CInt -> IO ()
 
 
-
-
-type Image = ForeignPtr GDImage
+-- We use a second level of indirection to allow storing a null pointer
+-- when the image has already been freed. This allows 'withImage' to 
+-- free the @gdImage@ early.
+newtype Image = Image (ForeignPtr (Ptr GDImage))
 
 type Size = (Int,Int)
 
@@ -165,15 +171,39 @@
 
 type Color = CInt
 
-
--- | Call gd_free_image when the image is garbage collected.
 mkImage :: Ptr GDImage -> IO Image
-mkImage p = newForeignPtr ptr_gdImageDestroy p
+mkImage img = do fp <- mallocForeignPtr
+                 withForeignPtr fp $ \p -> poke p img
+                 addForeignPtrFinalizer ptr_gdImagePtrDestroyIfNotNull fp
+                 return $ Image fp
 
+-- | Creates an image, performs an operation on the image, and
+-- frees it.
+-- This function allows block scoped management of 'Image' objects.
+-- If you are handling large images, the delay before the finalizer which frees
+-- the image runs may cause significant temporary extra memory use.
+-- Use this function to force the image to be freed as soons as you are done with it.
+-- Note that it is unsafe to hold on to the 'Image' after the
+-- function is done.
+withImage :: IO Image -- ^ Image creation action.
+          -> (Image -> IO b) -- ^ Some operation on the image. The result should
+                             -- not reference the 'Image'.
+          -> IO b
+withImage ini f = bracket ini freeImage f
 
-withImage :: Image -> (Ptr GDImage -> IO a) -> IO a
-withImage = withForeignPtr
+-- | Overwrites the pointer with a null pointer, and frees the @gdImage@. 
+-- Safe to call twice. Doesn't free the 'ForeignPtr', we rely on the
+-- GC to do that.
+freeImage :: Image -> IO ()
+freeImage (Image fp) = withForeignPtr fp $ 
+  \pp -> do p <- peek pp
+            poke pp nullPtr
+            unless (p == nullPtr) $ gdImageDestroy p
 
+withImagePtr :: Image -> (Ptr GDImage -> IO a) -> IO a
+withImagePtr (Image fp) f = withForeignPtr fp $
+  \pp -> peek pp >>= \p -> if p == nullPtr then fail "Image has been freed." else f p
+
 -- | Create a new empty image.
 newImage :: Size -> IO Image
 newImage (w,h) = newImage_ (int w) (int h)
@@ -185,11 +215,11 @@
 
 -- | Create a new empty image and apply a function to it.
 onNewImage :: CInt -> CInt -> (Ptr GDImage -> IO a) -> IO Image
-onNewImage w h f = newImage_ w h >>= \i -> withImage i f >> return i
+onNewImage w h f = newImage_ w h >>= \i -> withImagePtr i f >> return i
 
 -- | Make a copy of an image.
 copyImage :: Image -> IO Image
-copyImage i = withImage i f
+copyImage i = withImagePtr i f
   where f p = do (w,h) <- imageSize_ p
                  onNewImage w h (\p' -> gdImageCopy p' p 0 0 0 0 w h)
 
@@ -260,7 +290,7 @@
 saveGifFile = saveImageFile gdImageGif
 
 saveImageFile :: (Ptr GDImage -> Ptr CFILE -> IO ()) -> FilePath -> Image -> IO ()
-saveImageFile f file i = withImage i (\p -> withCFILE file "wb" (f p))
+saveImageFile f file i = withImagePtr i (\p -> withCFILE file "wb" (f p))
 
 --
 -- * Getting information about images.
@@ -268,7 +298,7 @@
 
 -- | Get the size of an image.
 imageSize :: Image -> IO (Int,Int) -- ^ (width, height)
-imageSize i = liftM f $ withImage i imageSize_
+imageSize i = liftM f $ withImagePtr i imageSize_
     where f = (\ (w,h) -> (fromIntegral w, fromIntegral h))
 
 imageSize_ :: Ptr GDImage -> IO (CInt,CInt)
@@ -285,7 +315,7 @@
             -> Int -- ^ height in pixels of output image
             -> Image 
             -> IO Image
-resizeImage w h i = withImage i f
+resizeImage w h i = withImagePtr i f
     where 
       f p = do let (outW,outH) = (fromIntegral w, fromIntegral h)
                (inW, inH) <- imageSize_ p
@@ -297,7 +327,7 @@
                    -- 2 for 180 degrees, etc.
             -> Image 
             -> IO Image
-rotateImage r i = withImage i f
+rotateImage r i = withImagePtr i f
     where f p = do (inW,inH) <- imageSize_ p
                    let q = fromIntegral (r `mod` 4)
                        (outW,outH) | r `mod` 2 == 0 = (inW,inH) 
@@ -320,21 +350,21 @@
                     -> Point -- ^ Lower right corner
                     -> Color -> Image -> IO ()
 drawFilledRectangle (x1,y1) (x2,y2) c i =
-    withImage i $ \p -> 
+    withImagePtr i $ \p -> 
         gdImageFilledRectangle p (int x1) (int y1) (int x2) (int y2) c
 
 drawFilledEllipse :: Point -- ^ Center
                   -> Size  -- ^ Width and height
                   -> Color -> Image -> IO ()
 drawFilledEllipse (cx,cy) (w,h) c i =
-    withImage i $ \p -> 
+    withImagePtr i $ \p -> 
         gdImageFilledEllipse p (int cx) (int cy) (int w) (int h) c
 
 drawLine :: Point -- ^ Start
          -> Point -- ^ End
          -> Color -> Image -> IO ()
 drawLine (x1,y1) (x2,y2) c i =
-    withImage i $ \p ->
+    withImagePtr i $ \p ->
         gdImageLine p (int x1) (int y1) (int x2) (int y2) c
 
 drawArc :: Point -- ^ Center
@@ -343,19 +373,19 @@
         -> Int   -- ^ Ending position (degrees)
         -> Color -> Image -> IO ()
 drawArc (cx,cy) (w,h) sp ep c i =
-    withImage i $ \p ->
+    withImagePtr i $ \p ->
         gdImageArc p (int cx) (int cy) (int w) (int h) (int sp) (int ep) c
 
 -- | Use anti-aliasing when performing the given drawing function.
 --   This can cause a segault with some gd versions.
 antiAliased :: (Color -> Image -> IO a) -> Color -> Image -> IO a
 antiAliased f c i = 
-    do withImage i (\p -> gdImageSetAntiAliased p c)
+    do withImagePtr i (\p -> gdImageSetAntiAliased p c)
        f (#{const gdAntiAliased}) i
 
 setPixel :: Point -> Color -> Image -> IO ()
 setPixel (x,y) c i =
-    withImage i $ \p ->
+    withImagePtr i $ \p ->
         gdImageSetPixel p (int x) (int y) c
 
 --
diff --git a/cbits/gd-extras.c b/cbits/gd-extras.c
--- a/cbits/gd-extras.c
+++ b/cbits/gd-extras.c
@@ -1,7 +1,13 @@
 #include <gd.h>
 #include "gd-extras.h"
 
-
+BGD_DECLARE(void) gdImagePtrDestroyIfNotNull (gdImagePtr *imp)
+{
+  gdImagePtr im = *imp;
+  if (im) {
+    gdImageDestroy(im);
+  }
+}
 
 BGD_DECLARE(void) gdImageCopyRotated90 (gdImagePtr dst,
 					gdImagePtr src,
diff --git a/cbits/gd-extras.h b/cbits/gd-extras.h
--- a/cbits/gd-extras.h
+++ b/cbits/gd-extras.h
@@ -7,6 +7,8 @@
 
 #include <gd.h>
 
+BGD_DECLARE(void) gdImagePtrDestroyIfNotNull (gdImagePtr *im);
+
 BGD_DECLARE(void) gdImageCopyRotated90 (gdImagePtr dst,
 					gdImagePtr src,
 					int dstX, int dstY,
diff --git a/gd.cabal b/gd.cabal
--- a/gd.cabal
+++ b/gd.cabal
@@ -1,5 +1,5 @@
 Name: gd
-Version: 3000.1.0
+Version: 3000.2.0
 Copyright: Bjorn Bringert
 Maintainer: bjorn@bringert.net
 Author: Bjorn Bringert