diff --git a/LIO/Concurrent.hs b/LIO/Concurrent.hs
--- a/LIO/Concurrent.hs
+++ b/LIO/Concurrent.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 -- |This module exposes the concurrent interface to LIO. Specifically,
@@ -20,7 +20,7 @@
 forkLIO :: (LabelState l p s) => LIO l p s () -> LIO l p s ThreadId
 forkLIO m = do
   s <- getTCB
-  ioTCB . forkIO $ evalLIO m s >> return ()
+  ioTCB . forkIO $ runLIO m s >> return ()
 
 
 -- | Same as 'lFork', but the supplied set of priviliges are accounted
@@ -29,15 +29,21 @@
        => p -> l -> LIO l p s a -> LIO l p s (LRes l a)
 lForkP p' l m = withCombinedPrivs p' $ \p -> do
   mv <- newEmptyLMVarP p l
-  _ <- forkLIO $ do res <- (Right <$> m) `catchTCB` (return . Left .  lubErr)
-                    lastL <- getLabel
-                    putLMVarTCB mv (if leqp p lastL l
-                                      then res
-                                      else (mkErr lastL LerrLow))
+  _ <- forkLIO $ do
+         res <- (Right <$> m) `catchTCB` (return . Left . (lubErr l))
+         lastL <- getLabel
+         putLMVarTCB mv (if leqp p lastL l
+                           then res
+                           else let l' = lub lastL l
+                                in Left . mkErr . (lub l') $
+                                      either getELabel (const l') res
+                        )
 
   return $ LRes mv
-    where mkErr cl e = Left . (LabeledExceptionTCB cl) . toException $ e
-          lubErr (LabeledExceptionTCB le e) = LabeledExceptionTCB (l `lub` le) e
+    where mkErr le = LabeledExceptionTCB le $ toException LerrLow
+          lubErr lnew (LabeledExceptionTCB le e) =
+                  LabeledExceptionTCB (le `lub` lnew) e
+          getELabel (LabeledExceptionTCB le _) = le
 
 -- | Labeled fork. @lFork@ allows one to invoke computations taht
 -- would otherwise raise the current label, but without actually
@@ -52,8 +58,12 @@
 -- result. It is require that this label is above the current label,
 -- and below the current clearance. Moreover, the supplied computation
 -- must not read anything more sensitive, i.e., with a label above the
--- supplied label --- doing so will result in an exception being
--- thrown. 
+-- supplied label --- doing so will result in an exception (whose
+-- label will reflect this observation) being thrown. 
+--
+-- If an exception is thrown in the inner computation, the exception
+-- label will be raised to the join of the result label and original
+-- exception label.
 -- 
 -- Not that, compared to 'toLabeled', @lFork@ immediately returns a
 -- labeled result of type 'LRes', which is essentially a \"future\",
@@ -64,7 +74,7 @@
       => l                    -- ^ Label of result
       -> LIO l p s a          -- ^ Computation to execute in separate thread
       -> LIO l p s (LRes l a) -- ^ Labeled result
-lFork l m = getPrivileges >>= \p -> lForkP p l m
+lFork = lForkP noPrivs
 
 -- | A labeled thread result is simply a wrapper for a labeled MVar. A
 -- thread can observe the result of another thread, only after raising
@@ -89,4 +99,4 @@
 -- the thread reads values above the result label, an exception is
 -- thrown in place of the result.
 lWait :: (LabelState l p s) => LRes l a -> LIO l p s a
-lWait v = getPrivileges >>= \p -> lWaitP p v
+lWait = lWaitP noPrivs
diff --git a/LIO/Concurrent/LMVar/TCB.hs b/LIO/Concurrent/LMVar/TCB.hs
--- a/LIO/Concurrent/LMVar/TCB.hs
+++ b/LIO/Concurrent/LMVar/TCB.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702) && (__GLASGOW_HASKELL__ < 704)
 {-# LANGUAGE SafeImports #-}
+#endif
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 704)
+{-# LANGUAGE Unsafe #-}
 #endif
 {-|
 This module provides an implementation for labeled MVars.  A labeled
diff --git a/LIO/DCLabel.hs b/LIO/DCLabel.hs
--- a/LIO/DCLabel.hs
+++ b/LIO/DCLabel.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 
@@ -26,7 +26,7 @@
 
 import LIO.Handle (evalWithRoot)
 
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 import safe Data.Typeable
 #else
 import Data.Typeable
diff --git a/LIO/FS.hs b/LIO/FS.hs
--- a/LIO/FS.hs
+++ b/LIO/FS.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 704
 {-# LANGUAGE SafeImports #-}
 #endif
 {-# LANGUAGE DeriveDataTypeable #-}
@@ -494,7 +494,7 @@
 -- open the file.
 unlabelFilePath :: LabelState l p s
                  => LFilePath l -> LIO l p s FilePath
-unlabelFilePath f = getPrivileges >>= \p -> unlabelFilePathP p f
+unlabelFilePath = unlabelFilePathP noPrivs
 
 -- | Given a pathname (forced to be relative to the root of the
 -- labeled filesystem), find the path to the corresponding object.
@@ -511,7 +511,7 @@
 lookupObjPath :: (LabelState l p s, Serialize l)
               => FilePath  -- ^ Path to object
               -> LIO l p s (LFilePath l)
-lookupObjPath f = getPrivileges >>= \p -> lookupObjPathP p f
+lookupObjPath = lookupObjPathP noPrivs
 
 -- | Same as 'lookupObjPath' but takes an additional privilege object
 -- that is exercised when raising the current label.
diff --git a/LIO/Handle.hs b/LIO/Handle.hs
--- a/LIO/Handle.hs
+++ b/LIO/Handle.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -60,7 +60,7 @@
                   ) where
 
 
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 import safe Prelude hiding (catch, readFile, writeFile)
 import safe System.IO (IOMode(..))
 import safe qualified System.IO as IO
@@ -139,13 +139,11 @@
 
 instance (Serialize l, LabelState l p s)
           => DirectoryOps (LHandle l) (LIO l p s) where
-  getDirectoryContents f = getPrivileges >>= \p -> getDirectoryContentsP p f
+  getDirectoryContents = getDirectoryContentsP noPrivs
   createDirectory  f   = do l <- getLabel 
-                            p <- getPrivileges
-                            createDirectoryP p l f
+                            createDirectoryP noPrivs l f
   openFile f m         = do l <- getLabel 
-                            p <- getPrivileges
-                            openFileP p (Just l) f m
+                            openFileP noPrivs (Just l) f m
 
 -- | Get the contents of a directory. The current label is raised to
 -- the join of the current label and that of all the directories
@@ -233,17 +231,17 @@
             
 
 instance (LabelState l p s) => CloseOps (LHandle l) (LIO l p s) where
-  hClose h = getPrivileges >>= \p -> hCloseP p h
-  hFlush h = getPrivileges >>= \p -> hFlushP p h
+  hClose = hCloseP noPrivs
+  hFlush = hFlushP noPrivs
 
 instance (LabelState l p s, CloseOps (LHandle l) (LIO l p s)
          , HandleOps IO.Handle b IO) =>
            HandleOps (LHandle l) b (LIO l p s) where
-  hGet h i            = getPrivileges >>= \p -> hGetP p h i
-  hGetNonBlocking h i = getPrivileges >>= \p -> hGetNonBlockingP p h i
-  hGetContents h      = getPrivileges >>= \p -> hGetContentsP p h
-  hPut h b            = getPrivileges >>= \p -> hPutP p h b
-  hPutStrLn h b       = getPrivileges >>= \p -> hPutStrLnP p h b
+  hGet            = hGetP noPrivs
+  hGetNonBlocking = hGetNonBlockingP noPrivs
+  hGetContents    = hGetContentsP noPrivs
+  hPut            = hPutP noPrivs
+  hPutStrLn       = hPutStrLnP noPrivs
 
 -- | Close a labeled file handle.
 hCloseP :: (LabelState l p s) => p -> LHandle l -> LIO l p s ()
@@ -334,8 +332,7 @@
 -- | Same as 'writeFile' but also takes the label of the file.
 writeFileL  :: (HandleOps IO.Handle b IO, LabelState l p s, Serialize l) =>
                l -> FilePath -> b -> LIO l p s ()
-writeFileL l path contents = getPrivileges >>= \p ->
-                             writeFileLP p l path contents
+writeFileL = writeFileLP noPrivs
 
 -- | Same as 'writeFileL' but uses privilege in opening the file.
 writeFileLP  :: (HandleOps IO.Handle b IO, LabelState l p s, Serialize l) =>
diff --git a/LIO/LIORef.hs b/LIO/LIORef.hs
--- a/LIO/LIORef.hs
+++ b/LIO/LIORef.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Safe #-}
 #endif
 -- |This module implements labeled IORefs.  The interface is analogous
diff --git a/LIO/LIORef/TCB.hs b/LIO/LIORef/TCB.hs
--- a/LIO/LIORef/TCB.hs
+++ b/LIO/LIORef/TCB.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702) && (__GLASGOW_HASKELL__ < 704)
 {-# LANGUAGE SafeImports #-}
+#endif
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 704)
+{-# LANGUAGE Unsafe #-}
 #endif
 -- |This module implements labeled IORefs.  The interface is analogous
 -- to "Data.IORef", but the operations take place in the LIO monad.
diff --git a/LIO/MonadCatch.hs b/LIO/MonadCatch.hs
--- a/LIO/MonadCatch.hs
+++ b/LIO/MonadCatch.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Safe #-}
 #endif
 {-# LANGUAGE FlexibleInstances #-}
diff --git a/LIO/MonadLIO.hs b/LIO/MonadLIO.hs
--- a/LIO/MonadLIO.hs
+++ b/LIO/MonadLIO.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 {-# LANGUAGE MultiParamTypeClasses #-}
diff --git a/LIO/Safe.hs b/LIO/Safe.hs
--- a/LIO/Safe.hs
+++ b/LIO/Safe.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 
@@ -8,7 +8,9 @@
 -- module for documentation.
 
 module LIO.Safe ( Label(..)
-                 , Priv(..), NoPrivs(..)
+                 , Priv(..), noPrivs
+                 , getPrivileges, withPrivileges
+                 , withCombinedPrivs 
                  , LIO, LabelState
                  , evalLIO
                  , getLabel, setLabelP
@@ -27,7 +29,9 @@
                  ) where
 
 import LIO.TCB ( Label(..)
-               , Priv(..), NoPrivs(..)
+               , Priv(..), noPrivs
+               , getPrivileges, withPrivileges
+               , withCombinedPrivs 
                , LIO, LabelState
                , evalLIO
                , getLabel, setLabelP
diff --git a/LIO/TCB.hs b/LIO/TCB.hs
--- a/LIO/TCB.hs
+++ b/LIO/TCB.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if __GLASGOW_HASKELL__ >= 702
+#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 704
 {-# LANGUAGE SafeImports #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 704
@@ -55,12 +55,12 @@
                 Label(..)
                 -- * Basic Privilige Functions
                 -- $privs
-               , Priv(..), NoPrivs(..)
+               , Priv(..), noPrivs
                , getPrivileges, withPrivileges
                , withCombinedPrivs 
                -- * Labeled IO Monad (LIO)
                -- $LIO
-               , LIO, LabelState
+               , LIO(..), LabelState
                , evalLIO, runLIO
                , newState
                , getLabel, setLabelP
@@ -95,6 +95,7 @@
                -- ** Labeled IO Monad (LIO)
                , LIOstate(..)
                , getTCB, putTCB
+               , getLabelStateTCB, putLabelStateTCB
                , setLabelTCB, lowerClrTCB
                -- ** Labeled Values
                , ShowTCB(..), ReadTCB(..)
@@ -265,7 +266,7 @@
 
     -- | Roughly speaking, @L_r = lostar p L L_g@ computes how close
     -- one can come to downgrading data labeled @L@ to the goal label
-    -- @L_g@, given privileges @p@.  When @p == 'NoPrivs'@, the resulting
+    -- @L_g@, given privileges @p@.  When @p == 'noPrivs'@, the resulting
     -- label @L_r == L ``lub``L_g@.  If @p@ contains all possible privileges,
     -- then @L_r == L_g@.
     --
@@ -301,16 +302,9 @@
     -- can define instances of mintTCB.
     mintTCB :: i -> t
 
--- |A generic 'Priv' instance that works for all 'Label's and confers
--- no downgrading privileges.
-data NoPrivs = NoPrivs
-instance PrivTCB NoPrivs
-instance Monoid NoPrivs where
-    mempty      = NoPrivs
-    mappend _ _ = NoPrivs
-instance (Label l) => Priv l NoPrivs where
-    leqp _ a b      = leq a b
-    lostar _ l goal = lub l goal
+-- | Alias for 'mempty'.
+noPrivs :: Monoid p => p
+noPrivs = mempty
 
 ---------------------------------------------------------------------
 -- Labeled IO -------------------------------------------------------
@@ -348,21 +342,24 @@
 newtype LIO l p s a = LIO (StateT (LIOstate l p s) IO a)
     deriving (Functor, Applicative, Monad)
 
-get :: (LabelState l p s) => LIO l p s (LIOstate l p s)
-get = mkLIO $ \s -> return (s, s)
 
-put :: (LabelState l p s) => LIOstate l p s -> LIO l p s ()
-put s = mkLIO $ \_ -> return (() , s)
+-- | Get internal state.
+getTCB :: (LabelState l p s) => LIO l p s (LIOstate l p s)
+getTCB = mkLIO $ \s -> return (s, s)
 
+-- | Put internal state.
+putTCB :: (LabelState l p s) => LIOstate l p s -> LIO l p s ()
+putTCB s = mkLIO $ \_ -> return (() , s)
+
 -- | Returns label-specific state of the 'LIO' monad.  This is the
 -- data specified as the second argument of 'evalLIO', whose type is
 -- @s@ in the monad @LIO l s@.
-getTCB :: (LabelState l p s) => LIO l p s s
-getTCB = labelState <$> get
+getLabelStateTCB :: (LabelState l p s) => LIO l p s s
+getLabelStateTCB = labelState <$> getTCB
 
 -- | Sets the label-specific state of the 'LIO' monad.  See 'getTCB'.
-putTCB :: (LabelState l p s) => s -> LIO l p s ()
-putTCB ls = get >>= put . update
+putLabelStateTCB :: (LabelState l p s) => s -> LIO l p s ()
+putLabelStateTCB ls = getTCB >>= putTCB . update
     where update s = s { labelState = ls }
 
 -- | Generate a fresh state to pass 'runLIO' when invoking it for the
@@ -373,7 +370,7 @@
 newState s = LIOstate { labelState = s
                       , lioL = lbot
                       , lioC = ltop
-                      , lioP = mempty }
+                      , lioP = noPrivs }
 
 -- | Lift an IO computation into @LIO@.
 mkLIO :: (LabelState l p s)
@@ -409,16 +406,16 @@
 
 -- | Returns the current value of the thread's label.
 getLabel :: (LabelState l p s) => LIO l p s l
-getLabel = lioL <$> get
+getLabel = lioL <$> getTCB
 
 -- | Returns the current value of the thread's clearance.
 getClearance :: (LabelState l p s) => LIO l p s l
-getClearance = lioC <$> get
+getClearance = lioC <$> getTCB
 
 
 -- | Returns the current privileges.
 getPrivileges :: (LabelState l p s) => LIO l p s p
-getPrivileges = lioP <$> get
+getPrivileges = lioP <$> getTCB
 
 -- | Execute an LIO action with a set of underlying privileges. Within
 -- a @withPrivileges@ block, the supplied privileges are used in every 
@@ -440,11 +437,11 @@
 -- @withPrivileges@ block.
 withPrivileges :: (LabelState l p s) => p -> LIO l p s a -> LIO l p s a
 withPrivileges p m = do
-  s <- get
+  s <- getTCB
   p0 <- getPrivileges
-  put s { lioP = p `mappend` p0 }
+  putTCB s { lioP = p `mappend` p0 }
   a <- m
-  put s { lioP = p0 }
+  putTCB s { lioP = p0 }
   return a
 
 -- | If the current label is @oldLabel@ and the current clearance is
@@ -456,41 +453,41 @@
 -- functionality that @setLabel@ would.
 setLabelP :: (LabelState l p s) => p -> l -> LIO l p s ()
 setLabelP p' l = withCombinedPrivs p' $ \p -> do
-  s <- get
+  s <- getTCB
   if leqp p (lioL s) l
-    then put s { lioL = l }
+    then putTCB s { lioL = l }
     else throwIO LerrPriv
 
 -- | Set the current label to anything, with no security check.
 setLabelTCB :: (LabelState l p s) => l -> LIO l p s ()
-setLabelTCB l = do s <- get
+setLabelTCB l = do s <- getTCB
                    if l `leq` lioC s
-                      then put s { lioL = l }
+                      then putTCB s { lioL = l }
                       else throwIO LerrClearance
 
 -- | Reduce the current clearance. One cannot raise the current label
 -- or create object with labels higher than the current clearance.
 lowerClr :: (LabelState l p s) => l -> LIO l p s ()
-lowerClr l = get >>= doit
+lowerClr l = getTCB >>= doit
     where doit s | not $ l `leq` lioC s = throwIO LerrClearance
                  | not $ lioL s `leq` l = throwIO LerrLow
-                 | otherwise            = put s { lioC = l }
+                 | otherwise            = putTCB s { lioC = l }
 
 -- | Raise the current clearance (undoing the effects of 'lowerClr').
 -- This requires privileges.
 lowerClrP :: (LabelState l p s) => p -> l -> LIO l p s ()
-lowerClrP p' l = withCombinedPrivs p' $ \p -> get >>= doit p
+lowerClrP p' l = withCombinedPrivs p' $ \p -> getTCB >>= doit p
     where doit p s | not $ leqp p l $ lioC s = throwIO LerrPriv
                    | not $ lioL s `leq` l = throwIO LerrLow
-                   | otherwise            = put s { lioC = l }
+                   | otherwise            = putTCB s { lioC = l }
 
 -- | Set the current clearance to anything, with no security check.
 lowerClrTCB :: (LabelState l p s) => l -> LIO l p s ()
-lowerClrTCB l = get >>= doit
+lowerClrTCB l = getTCB >>= doit
     where doit s | not $ lioL s `leq` l =
             throwIO $ LerrInval ("Cannot lower the current clearance"
                                  ++ " below current label.")
-                 | otherwise            = put s { lioC = l }
+                 | otherwise            = putTCB s { lioC = l }
 
 -- | Lowers the clearance of a computation, then restores the
 -- clearance to its previous value.  Useful to wrap around a
@@ -506,10 +503,10 @@
 -- supplied argument using 'lowerClrP'.
 withClearance :: (LabelState l p s) => l -> LIO l p s a -> LIO l p s a
 withClearance l m = do
-  s <- get
-  put s { lioC = l `glb` lioC s }
+  s <- getTCB
+  putTCB s { lioC = l `glb` lioC s }
   a <- m
-  put s { lioC = lioC s }
+  putTCB s { lioC = lioC s }
   return a
 
 -- | Lifts an 'IO' computation into the 'LIO' monad.  Note that
@@ -547,7 +544,7 @@
 -- @ccurrent@, then the label @l@ specified must satisfy
 -- @lcurrent ``leq`` l && l ``leq`` ccurrent@.
 label :: (LabelState l p s) => l -> a -> LIO l p s (Labeled l a)
-label l a = getPrivileges >>= \p -> labelP p l a
+label = labelP noPrivs
 
 -- | Constructs a 'Labeled' using privilege to allow the `Labeled`'s label
 -- to be below the current label.  If the current label is @lcurrent@
@@ -558,7 +555,7 @@
 -- use 'lowerClrP' to raise the clearance first if you wish to
 -- create an 'Labeled' at a higher label than the current clearance.
 labelP :: (LabelState l p s) => p -> l -> a -> LIO l p s (Labeled l a)
-labelP p' l a = withCombinedPrivs p' $ \p -> get >>= doit p
+labelP p' l a = withCombinedPrivs p' $ \p -> getTCB >>= doit p
     where doit p s | not $ l `leq` lioC s    = throwIO LerrClearance
                    | not $ leqp p (lioL s) l = throwIO LerrLow
                    | otherwise               = return $ LabeledTCB l a
@@ -579,7 +576,7 @@
 -- However, you can use 'labelOf' to check if 'unlabel' will succeed
 -- without throwing an exception.
 unlabel :: (LabelState l p s) => Labeled l a -> LIO l p s a
-unlabel x = getPrivileges >>= \p -> unlabelP p x
+unlabel = unlabelP noPrivs
 
 -- | Extracts the value of an 'Labeled' just like 'unlabel', but takes a
 -- privilege argument to minimize the amount the current label must be
@@ -605,26 +602,39 @@
   return $ LabeledTCB (lub l la) a
 
 
--- | @toLabeled@ is the dual of @unlabel@.  It allows one to invoke
+-- | @toLabeled@ is the dual of 'unlabel'.  It allows one to invoke
 -- computations that would raise the current label, but without
--- actually raising the label.  Instead, the result of the computation
--- is packaged into a 'Labeled' with a supplied label.
--- Thus, to get at the result of the
--- computation one will have to call 'unlabel' and raise the label, but
--- this can be postponed, or done inside some other call to 'toLabeled'.
--- This suggests that the provided label must be above the current
--- label and below the current clearance.
+-- actually raising the label.  Instead, the result of the
+-- computation is packaged into a 'Labeled' with a supplied
+-- label. (Of couse, the computation executed by @toLabeled@ must
+-- most observe any data whose label exceeds the supplied label.)
 --
--- Note that @toLabeled@ always restores the clearance to whatever it was
--- when it was invoked, regardless of what occurred in the computation
--- producing the value of the 'Labeled'. 
--- This highlights one main use of clearance: to ensure that a @Labeled@
--- computed does not exceed a particular label.
+-- To get at the result of the computation one will have to call
+-- 'unlabel' and raise the label, but this can be postponed, or
+-- done inside some other call to 'toLabeled'.  This suggests that
+-- the provided label must be above the current label and below
+-- the current clearance.
 --
+-- Note that @toLabeled@ always restores the clearance to whatever
+-- it was when it was invoked, regardless of what occurred in the
+-- computation producing the value of the 'Labeled'.  This highlights
+-- one main use of clearance: to ensure that a @Labeled@ computed
+-- does not exceed a particular label.
+--
+-- If an exception is thrown a a @toLabeled@ block, the join of
+-- the exception label and supplied label will be used as the new
+-- label.  If the current label of the inner computation is above
+-- the supplied label, an exception (whose label will reflect this
+-- observatoin) is throw by @toLabeled@.
+--
 -- WARNING: @toLabeled@ is susceptible to termination attacks.
 --
-toLabeled :: (LabelState l p s) => l -> LIO l p s a -> LIO l p s (Labeled l a)
-toLabeled l x = getPrivileges >>= \p -> toLabeledP p l x
+toLabeled :: (LabelState l p s)
+          => l -- ^ Label of result and upper bound on
+               --  inner-computations' observation
+          -> LIO l p s a -- ^ Inner computation
+          -> LIO l p s (Labeled l a)
+toLabeled = toLabeledP noPrivs
 {-# WARNING toLabeled "toLabeled is susceptible to termination attacks" #-}
 
 -- | Same as 'toLabeled' but allows one to supply a privilege object
@@ -636,13 +646,20 @@
            => p -> l -> LIO l p s a -> LIO l p s (Labeled l a)
 toLabeledP p' l m = withCombinedPrivs p' $ \p -> do
   aguardP p l
-  save_s <- get
-  a <- m `catchTCB` (\(LabeledExceptionTCB le se) -> ioTCB $ throwIO
-                       (LabeledExceptionTCB (l `lub` le) se))
-  s <- get
-  put s { lioL = lioL save_s, lioC = lioC save_s}
-  unless (leqp p (lioL s) l) $ throwIO LerrLow -- l is too low
-  return $ LabeledTCB l a
+  save_s <- getTCB
+  --
+  res <- (Right <$> m) `catchTCB` (return . Left .  (lubErr l))
+  s <- getTCB
+  let lastL = lioL s
+  putTCB s { lioL = lioL save_s, lioC = lioC save_s, lioP = lioP save_s }
+  if leqp p lastL l
+    then either (ioTCB . throwIO) (return . LabeledTCB l) res
+    else let l' = lub lastL l
+         in ioTCB . throwIO . mkErr . (lub l') $ either getELabel (const l') res
+    where mkErr le = LabeledExceptionTCB le $ toException LerrLow
+          lubErr lnew (LabeledExceptionTCB le e) =
+                  LabeledExceptionTCB (le `lub` lnew) e
+          getELabel (LabeledExceptionTCB le _) = le
 {-# WARNING toLabeledP "toLabeledP is susceptible to termination attacks" #-}
 
 -- | Executes a computation that would raise the current label, but
@@ -663,7 +680,7 @@
 -- WARNING: discard is susceptible to termination attacks.
 --
 discard :: (LabelState l p s) =>  l -> LIO l p s a -> LIO l p s ()
-discard l x = getPrivileges >>= \p -> discardP p l x
+discard = discardP noPrivs
 {-# WARNING discard "discard is susceptible to termination attacks" #-}
 
 -- | Same as 'discard', but uses privileges when comparing initial and
@@ -756,10 +773,10 @@
        -> l                     -- ^ @l@ - Label to taint with
        -> LIO l p s ()
 gtaint mylub l = do
-  s <- get
+  s <- getTCB
   let lnew = l `mylub` (lioL s)
   if lnew `leq` lioC s
-     then put s { lioL = lnew }
+     then putTCB s { lioL = lnew }
      else ioTCB $ E.throwIO $ LabeledExceptionTCB (lioL s)
           (toException LerrClearance)
 
@@ -785,7 +802,7 @@
 -- @l' ``leq`` l@ before doing the same thing as @'taint' l@.  Throws
 -- @'LerrHigh'@ if the current label @l'@ is too high.
 wguard :: (LabelState l p s) => l -> LIO l p s ()
-wguard l = getPrivileges >>= \p -> wguardP p l
+wguard = wguardP noPrivs
 
 -- |Like 'wguard', but takes privilege argument to be more permissive.
 wguardP :: (LabelState l p s) => p -> l -> LIO l p s ()
@@ -800,14 +817,14 @@
 -- objects--untrusted code shouldn't be able to create an object
 -- labeled @l@ unless @aguard l@ does not throw an exception.
 aguard :: (LabelState l p s) => l -> LIO l p s ()
-aguard l = getPrivileges >>= \p -> aguardP p l
+aguard = aguardP noPrivs
 
 -- | Like 'aguardP', but takes privilege argument to be more permissive.
 aguardP :: (LabelState l p s) => p -> l -> LIO l p s ()
 aguardP p' newl = withCombinedPrivs p' $ \p -> do
   c <- getClearance
   l <- getLabel
-  unless (leqp p newl c) $ throwIO LerrClearance
+  unless (newl `leq` c)  $ throwIO LerrClearance
   unless (leqp p l newl) $ throwIO LerrLow
 
 
@@ -914,9 +931,9 @@
     -- | Basic function for catching labeled exceptions. (The fact that
     -- they are labeled is hidden from the handler.)
     --
-    -- > catch = catchP NoPrivs
+    -- > catch = catchP noPrivs
     --
-    catch x h = getPrivileges >>= \p -> catchP p x h
+    catch = catchP noPrivs
 
 
 -- | Catches an exception, so long as the label at the point where the
@@ -930,16 +947,16 @@
        -> (e -> LIO l p s a) -- ^ Exception handler
        -> LIO l p s a        -- ^ Result of computation or handler
 catchP p' io handler = withCombinedPrivs p' $ \p -> do
-  s <- get
+  s <- getTCB
   clr <- getClearance
   (a, s') <- ioTCB $ do
     (unLIO io s) `catch` (\e@(LabeledExceptionTCB le se) ->
       case fromException se of
         Nothing -> throwIO e
-        Just e' -> if leqp p le clr
+        Just e' -> if le `leq` clr
                      then unLIO (taintP p le >> handler e') s
                      else throwIO e)
-  put s'
+  putTCB s'
   return a
 
 -- | Trusted catch functin.
@@ -948,10 +965,10 @@
          -> (LabeledException l -> LIO l p s a) -- ^ Exception handler
          -> LIO l p s a        -- ^ Result of computation or handler
 catchTCB io handler = do
-  s <- get
+  s <- getTCB
   (a, s') <- ioTCB $ do
     (unLIO io s) `E.catch` (\e -> unLIO (handler e) s)
-  put s'
+  putTCB s'
   return a
 
 -- | Version of 'catchP' with arguments swapped.
diff --git a/System/Posix/Tmp.hsc b/System/Posix/Tmp.hsc
--- a/System/Posix/Tmp.hsc
+++ b/System/Posix/Tmp.hsc
@@ -42,7 +42,7 @@
 #endif
 
 #if HAVE_MKSTEMP
-foreign import ccall unsafe "HsUnix.h __hscore_mkstemp"
+foreign import ccall unsafe "HsUnix.h __hstmp_mkstemp"
   c_mkstemp :: CString -> IO CInt
 #endif
 
@@ -64,7 +64,7 @@
 #endif
 
 #if HAVE_MKSTEMPS
-foreign import ccall unsafe "HsUnix.h __hscore_mkstemps"
+foreign import ccall unsafe "HsUnix.h __hstmp_mkstemps"
   c_mkstemps :: CString -> CInt -> IO CInt
 #endif
 
@@ -92,7 +92,7 @@
 #endif
 
 #if HAVE_MKDTEMP
-foreign import ccall unsafe "HsUnix.h __hscore_mkdtemp"
+foreign import ccall unsafe "HsUnix.h __hstmp_mkdtemp"
   c_mkdtemp :: CString -> IO CString
 #endif
 
diff --git a/examples/LambdaChair/AliceCode.hs b/examples/LambdaChair/AliceCode.hs
--- a/examples/LambdaChair/AliceCode.hs
+++ b/examples/LambdaChair/AliceCode.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Safe #-}
 #endif
 module AliceCode ( mainReview ) where
diff --git a/examples/LambdaChair/BobCode.hs b/examples/LambdaChair/BobCode.hs
--- a/examples/LambdaChair/BobCode.hs
+++ b/examples/LambdaChair/BobCode.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Safe #-}
 #endif
 module BobCode ( mainReview ) where
diff --git a/examples/LambdaChair/LambdaChair.hs b/examples/LambdaChair/LambdaChair.hs
--- a/examples/LambdaChair/LambdaChair.hs
+++ b/examples/LambdaChair/LambdaChair.hs
@@ -26,7 +26,6 @@
 import Control.Monad.State
 import Data.Maybe
 import Data.List
-import Data.Monoid
 
 import LIO.TCB
 import LIO.LIORef
@@ -146,7 +145,7 @@
 getPrivs :: ReviewDC DCPrivTCB
 getPrivs = do 
   u <- getCurUser
-  return $ maybe mempty (genPrivTCB . name) u
+  return $ maybe noPrivs (genPrivTCB . name) u
 
 -- ^ Write new users
 putUsers :: [User] -> ReviewDC ()
diff --git a/examples/LambdaChair/Main.hs b/examples/LambdaChair/Main.hs
--- a/examples/LambdaChair/Main.hs
+++ b/examples/LambdaChair/Main.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 704
 {-# LANGUAGE SafeImports #-}
 #endif
+#if __GLASGOW_HASKELL__ >= 704
+{-# LANGUAGE Unsafe #-}
+#endif
 import LambdaChair
 import DCLabel.PrettyShow
 
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 import safe AliceCode as Alice
 import safe BobCode as Bob
 #else
diff --git a/examples/LambdaChair/Safe.hs b/examples/LambdaChair/Safe.hs
--- a/examples/LambdaChair/Safe.hs
+++ b/examples/LambdaChair/Safe.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE CPP #-}
-#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 702)
+#if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Trustworthy #-}
 #endif
 module Safe ( module LambdaChair ) where
diff --git a/lio.cabal b/lio.cabal
--- a/lio.cabal
+++ b/lio.cabal
@@ -1,5 +1,5 @@
 Name:           lio
-Version:        0.1.1
+Version:        0.1.2
 build-type:     Simple
 License:        GPL
 License-File:   LICENSE