diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc
index 4ea8f787dc5b07ce06839cbbfad955760e0f1fc7..9fb5ac42a2b67fd1980f9596dc3cf3fd7f6a3732 100644
--- a/System/Posix/Directory/Common.hsc
+++ b/System/Posix/Directory/Common.hsc
@@ -39,8 +39,8 @@ import Foreign.C
 
 newtype DirStream = DirStream (Ptr CDir)
 
-type CDir       = ()
-type CDirent    = ()
+data {-# CTYPE "DIR" #-} CDir
+data {-# CTYPE "struct dirent" #-} CDirent
 
 -- | @rewindDirStream dp@ calls @rewinddir@ to reposition
 --   the directory stream @dp@ at the beginning of the directory.
diff --git a/System/Posix/IO/Common.hsc b/System/Posix/IO/Common.hsc
index 198b3f13b6dd99018df264fd3d2c52e6267969c9..eb4a721199c848e0c2ff7d7ee809a8329761dd78 100644
--- a/System/Posix/IO/Common.hsc
+++ b/System/Posix/IO/Common.hsc
@@ -320,9 +320,7 @@ getLock (Fd fd) lock =
     maybeResult (_, (Unlock, _, _, _)) = Nothing
     maybeResult x = Just x
 
-type CFLock     = ()
-
-allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a
+allocaLock :: FileLock -> (Ptr Base.CFLock -> IO a) -> IO a
 allocaLock (lockreq, mode, start, len) io =
   allocaBytes (#const sizeof(struct flock)) $ \p -> do
     (#poke struct flock, l_type)   p (lockReq2Int lockreq :: CShort)
@@ -336,7 +334,7 @@ lockReq2Int ReadLock  = (#const F_RDLCK)
 lockReq2Int WriteLock = (#const F_WRLCK)
 lockReq2Int Unlock    = (#const F_UNLCK)
 
-bytes2ProcessIDAndLock :: Ptr CFLock -> IO (ProcessID, FileLock)
+bytes2ProcessIDAndLock :: Ptr Base.CFLock -> IO (ProcessID, FileLock)
 bytes2ProcessIDAndLock p = do
   req   <- (#peek struct flock, l_type)   p
   mode  <- (#peek struct flock, l_whence) p
diff --git a/System/Posix/Process/Common.hsc b/System/Posix/Process/Common.hsc
index c13bf5e68ec9e7d604600ba1801abceae3ffed7f..ee7310eb8f7c3deb42eb392657fecaf6671e1864 100644
--- a/System/Posix/Process/Common.hsc
+++ b/System/Posix/Process/Common.hsc
@@ -212,7 +212,7 @@ getProcessTimes = do
                            childSystemTime = cst
                           })
 
-type CTms = ()
+data {-# CTYPE "struct tms" #-} CTms
 
 foreign import capi unsafe "HsUnix.h times"
   c_times :: Ptr CTms -> IO CClock
diff --git a/System/Posix/Resource.hsc b/System/Posix/Resource.hsc
index 4c5ca4883a5c7730db4ebd54423eaa53ad14b2be..280c25fbc54c176b04575b0c7f390df3800c3bff 100644
--- a/System/Posix/Resource.hsc
+++ b/System/Posix/Resource.hsc
@@ -55,7 +55,7 @@ data ResourceLimit
   | ResourceLimit Integer
   deriving Eq
 
-type RLimit = ()
+data {-# CTYPE "struct rlimit" #-} RLimit
 
 foreign import ccall unsafe "HsUnix.h __hscore_getrlimit"
   c_getrlimit :: CInt -> Ptr RLimit -> IO CInt
diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc
index 68ce321c0a40140a351347b608dd392406af6f88..5d81ec549026ca02a8b6f22227cf76526b3604b8 100644
--- a/System/Posix/Terminal/Common.hsc
+++ b/System/Posix/Terminal/Common.hsc
@@ -77,6 +77,7 @@ import Foreign.Ptr ( Ptr, plusPtr )
 import Foreign.Storable ( Storable(..) )
 import System.IO.Unsafe ( unsafePerformIO )
 import System.Posix.Types
+import System.Posix.Internals ( CTermios )
 
 #if !HAVE_TCDRAIN
 import System.IO.Error ( ioeSetLocation )
@@ -86,7 +87,6 @@ import GHC.IO.Exception ( unsupportedOperation )
 -- -----------------------------------------------------------------------------
 -- Terminal attributes
 
-type CTermios = ()
 newtype TerminalAttributes = TerminalAttributes (ForeignPtr CTermios)
 
 makeTerminalAttributes :: ForeignPtr CTermios -> TerminalAttributes