diff --git a/Makefile.am b/Makefile.am
index d6b9211..2838240 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -56,7 +56,13 @@ GHCLANG= -XTypeFamilies -XViewPatterns -XUndecidableInstances -XOverlappingInsta
 	-XRecordWildCards -XRecursiveDo -XTupleSections -XParallelListComp \
 	-XGeneralizedNewtypeDeriving -XScopedTypeVariables -XFlexibleInstances \
 	-XTypeSynonymInstances -XMultiParamTypeClasses -XDeriveDataTypeable \
-	-fglasgow-exts -XNoMonoLocalBinds -XNamedFieldPuns
+	-XNoMonoLocalBinds -XNamedFieldPuns \
+	-XForeignFunctionInterface -XUnliftedFFITypes -XImplicitParams -XUnboxedTuples \
+	-XStandaloneDeriving -XDeriveFunctor -XDeriveFoldable -XDeriveTraversable -XDeriveGeneric \
+	-XFlexibleContexts -XConstrainedClassMethods -XFunctionalDependencies -XMagicHash \
+	-XPolymorphicComponents -XExistentialQuantification -XUnicodeSyntax -XPostfixOperators \
+	-XPatternGuards -XLiberalTypeSynonyms -XRankNTypes -XTypeOperators \
+	-XEmptyDataDecls -XKindSignatures
 
 GHCOPTS= $(HSOPTS) -XBangPatterns -O @GHCFLAGS@ $(GHCDEBUGOPTS) $(GHCINC) $(PACKAGES) $(GHCLANG)
 
diff --git a/compat/haskell98/IO.hs b/compat/haskell98/IO.hs
index cbe4677..c99324f 100644
--- a/compat/haskell98/IO.hs
+++ b/compat/haskell98/IO.hs
@@ -23,7 +23,8 @@ module IO (
   ) where
 
 import System.IO
-import System.IO.Error
+import Control.Exception (try)
+import System.IO.Error hiding (try)
 
 -- | The 'bracket' function captures a common allocate, compute, deallocate
 -- idiom in which the deallocation step must occur even in the case of an
diff --git a/src/C/FromGrin2.hs b/src/C/FromGrin2.hs
index d4508bd..51dc256 100644
--- a/src/C/FromGrin2.hs
+++ b/src/C/FromGrin2.hs
@@ -4,7 +4,6 @@ module C.FromGrin2(compileGrin) where
 
 import Control.Monad.Identity
 import Control.Monad.RWS(asks,tell,local,get,runRWST,RWST,MonadState(..),MonadWriter(..),MonadReader(..))
-import Control.Monad
 import Data.Char
 import Data.List
 import Data.Maybe
@@ -71,7 +70,9 @@ data Env = Env {
     rConst :: Set.Set Atom,
     rGrin :: Grin
     }
-    {-! derive: update !-}
+
+rEMap_u f r@Env{rEMap  = x} = r{rEMap = f x}
+rInscope_u f r@Env{rInscope  = x} = r{rInscope = f x}
 
 newtype C a = C (RWST Env Written HcHash Uniq a)
     deriving(Monad,UniqueProducer,MonadState HcHash,MonadWriter Written,MonadReader Env,Functor)
@@ -183,6 +184,7 @@ compileGrin grin = (LBS.fromChunks code, req)  where
                 text "static node_t _" <> tshow (varName v) <> text " = { .head = " <> ef <> text " };\n" <>
                 text "#define " <> tshow (varName v) <+>  text "(MKLAZY_C(&_" <> tshow (varName v) <> text "))\n";
         return ts
+    convertCAF _ = error "FromGrin2.compileGrin: bad."
 
 convertFunc :: Maybe FfiExport -> (Atom,Lam) -> C [Function]
 convertFunc ffie (n,as :-> body) = do
@@ -313,6 +315,7 @@ tyToC dh (Op.TyBits b h) = f b h where
         (Op.Bits 128) -> "__float128"
         _ -> error "tyToC: unknown"
     f _ _ = error "tyToC: unknown"
+tyToC _ _ = error "FromGrin2.tToC: bad."
 
 opTyToCh hint opty = basicType (tyToC hint opty)
 opTyToC opty = basicType (tyToC Op.HintUnsigned opty)
@@ -565,7 +568,7 @@ convertExp (Prim Func { primArgTypes = as, primRetType = r, primRetArgs = rs@(_:
     tell mempty { wRequires = primRequires }
     vs' <- mapM convertVal vs
     rt <- mapM convertType ty
-    let rrs = map basicType' (r:rs)
+    --let rrs = map basicType' (r:rs)
     ras <- mapM (newVar . basicType') rs
     (stmt,rv) <- basicType' r `newTmpVar` (functionCall (name $ unpackPS funcName) ([ cast (basicType' t) v | v <- vs' | t <- as ] ++ map reference ras))
     return $ (stmt, structAnon (zip (rv:ras) rt))
@@ -635,15 +638,17 @@ convertExp Alloc { expValue = v, expCount = c, expRegion = r } |
 
 convertExp e = return (err (show e),err "nothing")
 
+{-
 ccaf :: (Var,Val) -> P.Doc
 ccaf (v,val) = text "/* " <> text (show v) <> text " = " <>
     (text $ P.render (pprint val)) <> text "*/\n" <>
      text "static node_t _" <> tshow (varName v) <> text ";\n" <>
      text "#define " <> tshow (varName v) <+>  text "(MKLAZY_C(&_" <>
      tshow (varName v) <> text "))\n";
+-}
 
 buildConstants cpr grin fh = P.vcat (map cc (Grin.HashConst.toList fh)) where
-    tyenv = grinTypeEnv grin
+    --tyenv = grinTypeEnv grin
     comm nn = text "/* " <> tshow (nn) <> text " */"
     cc nn@(HcNode a zs,i) = comm nn $$ cd $$ def where
         cd = text "static const struct" <+> tshow (nodeStructName a) <+> text "_c" <> tshow i <+> text "= {" <> hsep (punctuate P.comma (ntag ++ rs)) <> text "};"
@@ -921,7 +926,7 @@ gc_roots vs   = case length vs of
 --    1 ->  functionCall (name "gc_frame1") (v_gc:vs)
 --    2 ->  functionCall (name "gc_frame2") (v_gc:vs)
     lvs -> functionCall (name "gc_frame0") (v_gc:constant (number (fromIntegral lvs)):vs)
-gc_end        = functionCall (name "gc_end") []
+--gc_end        = functionCall (name "gc_end") []
 tbsize sz = functionCall (name "TO_BLOCKS") [sz]
 
 jhc_malloc_atomic sz | fopts FO.Jgc = functionCall (name "gc_array_alloc_atomic") [v_gc,nullPtr, sz, toExpression (0::Int)]
@@ -950,11 +955,11 @@ f_promote e   = functionCall (name "promote") [e]
 f_PROMOTE e   = functionCall (name "PROMOTE") [e]
 f_FETCH_TAG e = functionCall (name "FETCH_TAG") [e]
 f_FETCH_RAW_TAG e = functionCall (name "FETCH_RAW_TAG") [e]
-f_FETCH_MEM_TAG e = functionCall (name "FETCH_MEM_TAG") [e]
+--f_FETCH_MEM_TAG e = functionCall (name "FETCH_MEM_TAG") [e]
 f_SET_RAW_TAG e   = functionCall (name "SET_RAW_TAG") [e]
 f_SET_MEM_TAG e v = functionCall (name "SET_MEM_TAG") [e,v]
 f_demote e    = functionCall (name "demote") [e]
-f_follow e    = functionCall (name "follow") [e]
+--f_follow e    = functionCall (name "follow") [e]
 f_update x y  = functionCall (name "update") [x,y]
 
 arg i = name $ 'a':show i
diff --git a/src/C/Generate.hs b/src/C/Generate.hs
index aa1ae66..bf87efe 100644
--- a/src/C/Generate.hs
+++ b/src/C/Generate.hs
@@ -73,8 +73,8 @@ module C.Generate(
 
 import Char
 import Control.Monad
-import Control.Monad.RWS(RWS(..),MonadState(..),MonadWriter(..),MonadReader(..),runRWS,asks,MonadFix(..))
-import Control.Monad.Writer(Writer(..),censor, runWriter)
+import Control.Monad.RWS(RWS,MonadState(..),MonadWriter(..),MonadReader(..),runRWS,asks,MonadFix(..))
+import Control.Monad.Writer(censor, runWriter)
 import Data.Monoid(Monoid(..))
 import Data.List(intersperse)
 import Data.Maybe(isNothing)
diff --git a/src/C/Prims.hs b/src/C/Prims.hs
index 402655b..fa09561 100644
--- a/src/C/Prims.hs
+++ b/src/C/Prims.hs
@@ -72,13 +72,13 @@ data Prim =
     | PrimTypeInfo {
         primArgTy :: Op.Ty,
         primRetTy :: Op.Ty,
-        primTypeInfo :: {-# UNPACK #-} !PrimTypeInfo
+        primTypeInfo :: !PrimTypeInfo
         }
     | PrimString !PackedString  -- address of a raw string. encoded in utf8.
     | PrimDotNet {
-        primStatic :: {-# UNPACK #-} !Bool,
+        primStatic :: !Bool,
         primDotNet :: !DotNetPrim,
-        primIOLike :: {-# UNPACK #-} !Bool,
+        primIOLike :: !Bool,
         primAssembly :: !PackedString,
         primDotNetName :: !PackedString
         }
diff --git a/src/Cmm/Op.hs b/src/Cmm/Op.hs
index 392c15b..ae1ba76 100644
--- a/src/Cmm/Op.hs
+++ b/src/Cmm/Op.hs
@@ -351,7 +351,8 @@ binopFunc (TyBits b _) _ bop = g b =<< f bop where
     f FPwr = Just "pow"
     f FAtan2 = Just "atan2"
     f _ = Nothing
-binopFunc TyBool _ bop = Nothing where
+binopFunc TyBool _ bop = Nothing
+binopFunc _ _ _ = error "Op.binopFunc: bad."
 
 binopInfix :: BinOp -> Maybe (String,Int)
 binopInfix UDiv = Just ("/",8)
diff --git a/src/Doc/DocLike.hs b/src/Doc/DocLike.hs
index ffceecf..bd7be81 100644
--- a/src/Doc/DocLike.hs
+++ b/src/Doc/DocLike.hs
@@ -5,7 +5,6 @@ module Doc.DocLike where
 
 -- arch-tag: a88f19fb-e18d-475f-b6d1-8da78676261a
 
-import Data.Monoid(Monoid(..))
 import Control.Monad.Reader()
 import qualified Text.PrettyPrint.HughesPJ as P
 
diff --git a/src/Doc/Pretty.hs b/src/Doc/Pretty.hs
index 2ef95c9..5ef52c4 100644
--- a/src/Doc/Pretty.hs
+++ b/src/Doc/Pretty.hs
@@ -124,6 +124,7 @@ softbreak       = group linebreak
 -- Combinators for prelude types
 -----------------------------------------------------------
 
+{-
 -- string is like "text" but replaces '\n' by "line"
 string ""       = empty
 string ('\n':s) = line <> string s
@@ -148,7 +149,7 @@ double d        = text (show d)
 
 rational :: Rational -> Doc
 rational r      = text (show r)
-
+-}
 
 
 
diff --git a/src/E/CPR.hs b/src/E/CPR.hs
index ae33d7b..ef150a1 100644
--- a/src/E/CPR.hs
+++ b/src/E/CPR.hs
@@ -1,6 +1,6 @@
 module E.CPR(Val(..), cprAnalyzeDs, cprAnalyzeProgram) where
 
-import Control.Monad.Writer(Writer(..),runWriter,tell,Monoid(..))
+import Control.Monad.Writer(runWriter,tell,Monoid(..))
 import Data.Binary
 import Data.Monoid()
 import Data.Typeable
diff --git a/src/E/Eta.hs b/src/E/Eta.hs
index d38d8a7..4214816 100644
--- a/src/E/Eta.hs
+++ b/src/E/Eta.hs
@@ -27,7 +27,6 @@ import E.Values
 import GenUtil hiding(replicateM_)
 import Info.Types
 import Name.Id
-import Support.CanType
 import Support.FreeVars
 import Util.NameMonad
 import Util.SetLike
@@ -46,6 +45,7 @@ instance Show ArityType where
 arity at = f at 0 where
     f (AFun _ a) n = f a $! (1 + n)
     f x n | n `seq` x `seq` True = (x,n)
+    f _ _ = error "Eta.arity: bad."
 
 getArityInfo tvr
     | Just at <- Info.lookup (tvrInfo tvr) = arity at
@@ -89,10 +89,12 @@ expandPis dataTable e = f (followAliases dataTable e) where
     f (EPi v r) = EPi v (f (followAliases dataTable r))
     f e = e
 
+{-
 fromPi' :: DataTable ->  E -> (E,[TVr])
 fromPi' dataTable e = f [] (followAliases dataTable e) where
     f as (EPi v e) = f (v:as) (followAliases dataTable e)
     f as e  =  (e,reverse as)
+-}
 
 -- this annotates, but only expands top-level definitions
 etaExpandProgram :: Stats.MonadStats m => Program -> m Program
@@ -122,6 +124,7 @@ etaReduce e = f e where
         f e = e
 
 -- | only reduce if all lambdas can be discarded. otherwise leave them in place
+{-
 etaReduce' :: E -> (E,Int)
 etaReduce' e = case f e 0 of
         (ELam {},_) -> (e,0)
@@ -129,13 +132,14 @@ etaReduce' e = case f e 0 of
     where
         f (ELam t (EAp x (EVar t'))) n | n `seq` True, t == t' && (tvrIdent t `notMember` (freeVars x :: IdSet)) = f x (n + 1)
         f e n = (e,n)
+-}
 
 etaExpandDef' dataTable n t e = etaExpandDef dataTable n t e >>= \x -> case x of
     Nothing -> return (tvrInfo_u (annotateArity e) t,e)
     Just x -> return x
 
-collectIds :: E -> IdSet
-collectIds e = execWriter $ annotate mempty (\id nfo -> tell (singleton id) >> return nfo) (\_ -> return) (\_ -> return) e
+--collectIds :: E -> IdSet
+--collectIds e = execWriter $ annotate mempty (\id nfo -> tell (singleton id) >> return nfo) (\_ -> return) (\_ -> return) e
 -- | eta expand a definition
 etaExpandDef :: (NameMonad Id m,Stats.MonadStats m)
     => DataTable
diff --git a/src/E/FromHs.hs b/src/E/FromHs.hs
index 64e5af7..9ae5906 100644
--- a/src/E/FromHs.hs
+++ b/src/E/FromHs.hs
@@ -428,10 +428,10 @@ convertDecls tiData props classHierarchy assumps dataTable hsDecls = res where
                     rv <- zipWithM marshallFromC vs rets
                     return $ eTuple' rv
                 return (id,fun)
-            _ -> invalidDecl "foreign declaration is of incorrect form."
+            -- _ -> invalidDecl "foreign declaration is of incorrect form."
 
-    isExtTypeRaw ExtTypeRaw {} = True
-    isExtTypeRaw _ = False
+    --isExtTypeRaw ExtTypeRaw {} = True
+    --isExtTypeRaw _ = False
 
     cDecl,cDecl' :: HsDecl -> C [(Name,TVr,E)]
     cDecl' d = withSrcLoc (srcLoc d) $ catchError (cDecl d) (\(_ :: IOError) -> return [])
diff --git a/src/E/LambdaLift.hs b/src/E/LambdaLift.hs
index 4de0c5f..3a5b590 100644
--- a/src/E/LambdaLift.hs
+++ b/src/E/LambdaLift.hs
@@ -86,8 +86,12 @@ data S = S {
     isStrict :: Bool,
     declEnv :: [(TVr,E)]
     }
-    {-! derive: update !-}
 
+isStrict_u f r@S{isStrict  = x} = r{isStrict = f x}
+topVars_u f r@S{topVars  = x} = r{topVars = f x}
+isStrict_s v =  isStrict_u  (const v)
+
+{-
 etaReduce :: E -> (E,Int)
 etaReduce e = case f e 0 of
         (ELam {},_) -> (e,0)
@@ -95,6 +99,7 @@ etaReduce e = case f e 0 of
     where
         f (ELam t (EAp x (EVar t'))) n | n `seq` True, t == t' && not (tvrIdent t `member` (freeVars x :: IdSet)) = f x (n + 1)
         f e n = (e,n)
+-}
 
 -- | we do not lift functions that only appear in saturated strict contexts,
 -- as these functions will never have an escaping thunk or partial app
diff --git a/src/E/PrimOpt.hs b/src/E/PrimOpt.hs
index 746e543..7b0cc8f 100644
--- a/src/E/PrimOpt.hs
+++ b/src/E/PrimOpt.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecursiveDo,ViewPatterns #-}
+{-# LANGUAGE DoRec,ViewPatterns #-}
 module E.PrimOpt(performPrimOpt) where
 
 import Control.Monad.Fix()
diff --git a/src/E/Rules.hs b/src/E/Rules.hs
index f641933..6261874 100644
--- a/src/E/Rules.hs
+++ b/src/E/Rules.hs
@@ -16,7 +16,7 @@ module E.Rules(
     rulesFromARules
     )where
 
-import Control.Monad.Writer(WriterT(..),execWriterT,liftM,tell)
+import Control.Monad.Writer(execWriterT,liftM,tell)
 import Data.Maybe
 import Data.Monoid(Monoid(..))
 import qualified Data.Traversable as T
diff --git a/src/E/SSimplify.hs b/src/E/SSimplify.hs
index ad959d5..8da5e0d 100644
--- a/src/E/SSimplify.hs
+++ b/src/E/SSimplify.hs
@@ -29,7 +29,7 @@ import E.PrimOpt
 import E.Program
 import E.Rules
 import E.Subst
-import E.Traverse(runRename)
+--import E.Traverse(runRename)
 import E.TypeCheck
 import E.Values
 import GenUtil hiding (split)
@@ -54,7 +54,7 @@ import qualified FlagDump as FD
 import qualified FlagOpts as FO
 import qualified Info.Info as Info
 
-type Bind = (TVr,E)
+--type Bind = (TVr,E)
 
 data Occurance =
     Unused        -- ^ unused means a var is not used at the term level, but might be at the type level
@@ -66,7 +66,7 @@ data Occurance =
     deriving(Show,Eq,Ord)
 
 data UseInfo = UseInfo {
-    useOccurance :: {-# UNPACK #-} !Occurance,   -- ^ occurance Info
+    useOccurance :: !Occurance,   -- ^ occurance Info
     minimumArgs  :: {-# UNPACK #-} !Int          -- ^ minimum number of args that are ever passed to this function (if used)
     }
     deriving(Show,Eq,Ord,Typeable)
@@ -218,14 +218,14 @@ collectBinding comb = do
 
 unOMap (OMap x) = x
 
-collectCombs :: [Comb] -> OMap -> OM [Comb]
-collectCombs cs _ = return cs
+--collectCombs :: [Comb] -> OMap -> OM [Comb]
+--collectCombs cs _ = return cs
 
 collectDs :: [Comb] -> OMap -> OM [Comb]
 collectDs ds (OMap fve) = do
     ds' <- mapM (grump . collectBinding) ds
     exp <- ask
-    let (reachable',graph) = newGraphReachable ds' (\ ((comb,_),_) -> combIdent comb) (\ ((_,rv),fv) -> keys (fv `mappend` rv))
+    let (reachable',_) = newGraphReachable ds' (\ ((comb,_),_) -> combIdent comb) (\ ((_,rv),fv) -> keys (fv `mappend` rv))
         rds = reachable' (keys fve ++ [ combIdent t | t <- ds,  (combIdent t `member` exp)])
         -- ignore rules when calculating loopbreakers
         -- we must not simplify the expanded body of a rule without recalculating occurance info.
@@ -245,6 +245,7 @@ collectDs ds (OMap fve) = do
             False -> case  (tvrIdent t `member` exp) of
                 True -> noUseInfo
                 False | Just r <- mlookup (tvrIdent t) fids -> r
+                _ -> error "SSimplify.collectDs: bad."
         ds''' = [ combHead_s (calcStrictInfo $ annbind ffids (combHead comb)) comb | (comb,_) <- ds'']
         froo comb = (combHead_s (combHead comb) {tvrType = t' } comb,fvs) where
             (t',fvs) = collectOccurance' (tvrType $ combHead comb)
@@ -282,9 +283,9 @@ orMany xs = f (filter ((/= Unused) . useOccurance) xs) where
         ui x = UseInfo { minimumArgs =  minimum (map minimumArgs xs), useOccurance = x }
 
 data SimplifyOpts = SimpOpts {
-    so_noInlining :: {-# UNPACK #-} !Bool, -- ^ this inhibits all inlining inside functions which will always be inlined
-    so_finalPhase :: {-# UNPACK #-} !Bool, -- ^ no rules and don't inhibit inlining
-    so_postLift   :: {-# UNPACK #-} !Bool, -- ^ don't inline anything that was lifted out
+    so_noInlining :: !Bool, -- ^ this inhibits all inlining inside functions which will always be inlined
+    so_finalPhase :: !Bool, -- ^ no rules and don't inhibit inlining
+    so_postLift   :: !Bool, -- ^ don't inline anything that was lifted out
     so_boundVars :: IdMap Comb,            -- ^ bound variables
     so_forwardVars :: IdSet,               -- ^ variables that we know will exist, but might not yet.
 
@@ -321,11 +322,11 @@ data Forced = ForceInline | ForceNoinline | NotForced
 data Binding
     = NotAmong [Name]
     | IsBoundTo {
-        bindingOccurance :: {-# UNPACK #-} !Occurance,
+        bindingOccurance :: !Occurance,
         bindingE :: OutE,
-        bindingCheap :: {-# UNPACK #-} !Bool,
-        inlineForced :: {-# UNPACK #-} !Forced,
-        bindingAtomic :: {-# UNPACK #-} !Bool
+        bindingCheap :: !Bool,
+        inlineForced :: !Forced,
+        bindingAtomic :: !Bool
         }
     | NotKnown
     deriving(Ord,Eq,Show)
@@ -351,6 +352,7 @@ instance Monoid Forced where
 
 fixInline finalPhase v bt@IsBoundTo {} = bt {
     inlineForced = inlineForced bt `mappend` calcForced finalPhase v }
+fixInline _ _ _ = error "SSimplify.fixInline: bad."
 
 calcForced finalPhase v =
     let props = getProperties v in
@@ -367,18 +369,21 @@ data Env = Env {
     envInScope :: IdMap Binding,
     envInScopeCache :: IdMap E
     }
-    {-! derive: Monoid, update !-}
+    {-! derive: Monoid !-}
+
+envSubst_u f r@Env{envSubst  = x} = r{envSubst = f x}
+envSubst_s v =  envSubst_u  (const v)
 
 susp:: E -> Subst -> Range
 susp e sub =  Susp e sub
 
-insertSuspSubst :: TVr -> InE -> Env -> Env
-insertSuspSubst t e env = insertSuspSubst' (tvrIdent t) e env
+--insertSuspSubst :: TVr -> InE -> Env -> Env
+--insertSuspSubst t e env = insertSuspSubst' (tvrIdent t) e env
 
-insertSuspSubst' :: Id -> InE -> Env -> Env
-insertSuspSubst' z _e env | isEmptyId z = env
-insertSuspSubst' t e env = cacheSubst env {
-    envSubst = minsert t (susp e (envSubst env)) (envSubst env) }
+--insertSuspSubst' :: Id -> InE -> Env -> Env
+--insertSuspSubst' z _e env | isEmptyId z = env
+--insertSuspSubst' t e env = cacheSubst env {
+--    envSubst = minsert t (susp e (envSubst env)) (envSubst env) }
 
 insertRange :: Id -> Range -> Env -> Env
 insertRange z e env | isEmptyId z = env
@@ -465,8 +470,8 @@ data Cont =
         }-}
     deriving(Show)
 
-isApplyTo ApplyTo {} = True
-isApplyTo _ = False
+--isApplyTo ApplyTo {} = True
+--isApplyTo _ = False
 
 simplifyDs :: forall m . MonadStats m => Program -> SimplifyOpts -> [Comb] -> m [Comb]
 simplifyDs prog sopts dsIn = ans where
@@ -841,11 +846,11 @@ simplifyDs prog sopts dsIn = ans where
     hFunc e xs' = do app (e,xs')
     didInline ::OutE -> [OutE] -> SM OutE
     didInline z zs = return (foldl EAp z zs)
-    didInline z zs = do
-        used <- smUsedNames
-        let (ne,nn) = runRename used (foldl EAp z zs)
-        smAddNamesIdSet nn
-        return ne
+    --didInline z zs = do
+    --    used <- smUsedNames
+    --    let (ne,nn) = runRename used (foldl EAp z zs)
+    --    smAddNamesIdSet nn
+    --    return ne
     appVar v xs | so_postLift sopts = app (EVar v,xs)
     appVar v xs = do
         me <- etaExpandAp (progDataTable prog) v xs
@@ -965,6 +970,7 @@ exprSize max e discount known = f max e >>= \n -> return (max - n) where
     f n ELetRec {eDefs = ds, eBody = e } = do
         n <- foldM f n (snds ds)
         f n e
+    f _ Unknown = error "SSimplify.exprSize: bad."
 
 noSizeIncrease e xs = f e xs where
     currentSize = 1 + length xs
@@ -1030,6 +1036,7 @@ runSM env (SM x) = (r,s) where
 
 instance MonadStats SM where
    mticks' n k = SM $ tell (Stats.singleStat n k) >> return ()
+   mtickStat = error "MonadStats.mtickStat: not impl."
 
 modifyIds fn = SM $ modify f where
     f s@SmState { idsUsed = used, idsBound = bound } = case fn (used,bound) of (used',bound') -> s { idsUsed = used', idsBound = bound' }
@@ -1064,12 +1071,12 @@ instance NameMonad Id SM where
 --        (used,bound) <- getIds
         newNameFrom $ candidateIds seed -- (size used + 10000*size bound)
 
-smUsedNames = SM $ gets idsUsed
-smBoundNames = SM $ gets idsBound
+--smUsedNames = SM $ gets idsUsed
+--smBoundNames = SM $ gets idsBound
 
 smAddNamesIdSet nset = --trace ("addNamesIdSet: "++ show (size nset)) $
    do modifyIds (\ (used,bound) -> (nset `union` used, bound) )
 smAddBoundNamesIdSet nset = --trace ("addBoundNamesIdSet: "++show (size nset)) $
    do modifyIds (\ (used,bound) -> (nset `union` used, nset `union` bound) )
 
-smAddBoundNamesIdMap = smAddNamesIdSet . idMapToIdSet
+--smAddBoundNamesIdMap = smAddNamesIdSet . idMapToIdSet
diff --git a/src/E/TypeCheck.hs b/src/E/TypeCheck.hs
index 10f55da..e54988a 100644
--- a/src/E/TypeCheck.hs
+++ b/src/E/TypeCheck.hs
@@ -340,7 +340,7 @@ inferType dataTable ds e = rfc e where
         withContext "checking pattern equality" $ eqAll (et:ps)
         return ect
     fc Unknown = return Unknown
-    fc e = failDoc $ text "what's this? " </> (prettyE e)
+    --fc e = failDoc $ text "what's this? " </> (prettyE e)
     calt (EVar v) (Alt l e) = do
         let nv =  followAliases undefined (patToLitEE l)
         rfc (subst' v nv e)
@@ -420,11 +420,12 @@ typeInfer' dataTable ds e = case runContextEither $ typeInfer'' dataTable ds e o
     Right v -> v
 
 data TcEnv = TcEnv {
-    tcDefns :: [(TVr,E)],
-    tcContext :: [String],
-    tcDataTable :: DataTable
+    --tcDefns :: [(TVr,E)],
+    tcContext :: [String]
+    --tcDataTable :: DataTable
     }
-   {-! derive: update !-}
+
+tcContext_u f r@TcEnv{tcContext  = x} = r{tcContext = f x}
 
 newtype Tc a = Tc (Reader TcEnv a)
     deriving(Monad,Functor,MonadReader TcEnv)
@@ -433,6 +434,7 @@ instance ContextMonad Tc where
     type ContextOf Tc = String
     withContext s = local (tcContext_u (s:))
 
+{-
 tcE :: E -> Tc E
 tcE e = rfc e where
     rfc e =  withContextDoc (text "tcE:" </> ePretty e) (fc e >>=  strong')
@@ -467,6 +469,7 @@ tcE e = rfc e where
         strong' ty
     fc Unknown = return Unknown
     fc e = failDoc $ text "what's this? " </> (ePretty e)
+-}
 
 typeInfer'' :: (ContextMonad m, ContextOf m ~ String) => DataTable -> [(TVr,E)] -> E -> m E
 typeInfer'' dataTable ds e = rfc e where
@@ -504,7 +507,7 @@ typeInfer'' dataTable ds e = rfc e where
     fc ECase { eCaseType = ty } = do
         strong' ty
     fc Unknown = return Unknown
-    fc e = failDoc $ text "what's this? " </> (ePretty e)
+    --fc e = failDoc $ text "what's this? " </> (ePretty e)
 
 -- | find substitution that will transform the left term into the right one,
 -- only substituting for the vars in the list
@@ -556,3 +559,4 @@ match lup vs = \e1 e2 -> liftM Seq.toList $ execWriterT (un e1 e2 etherealIds) w
     lam va ea vb eb (c:cs) = do
         un (tvrType va) (tvrType vb) (c:cs)
         un (subst va (EVar va { tvrIdent = c }) ea) (subst vb (EVar vb { tvrIdent = c }) eb) cs
+    lam _ _ _ _ _ = error "TypeCheck.match: bad."
diff --git a/src/Fixer/Fixer.hs b/src/Fixer/Fixer.hs
index 59106cc..5153fa6 100644
--- a/src/Fixer/Fixer.hs
+++ b/src/Fixer/Fixer.hs
@@ -111,7 +111,7 @@ instance Fixable a => Show (Value a) where
     showsPrec _ (IV a) = showString "<<" . shows (hashUnique $ ident a) . showString ">>"
 
 data RvValue a = RvValue {
-    ident :: {-# UNPACK #-} !Unique,
+    ident :: !Unique,
     action :: {-# UNPACK #-} !(IORef [a -> IO ()]),
     pending :: {-# UNPACK #-} !(IORef a),
     current :: {-# UNPACK #-} !(IORef a),
diff --git a/src/FrontEnd/Class.hs b/src/FrontEnd/Class.hs
index 52af14c..5320c6e 100644
--- a/src/FrontEnd/Class.hs
+++ b/src/FrontEnd/Class.hs
@@ -28,7 +28,7 @@ module FrontEnd.Class(
     ) where
 
 import Control.Monad.Identity
-import Control.Monad.Writer(Monoid(..),Writer(..))
+import Control.Monad.Writer(Monoid(..))
 import Data.Generics(mkQ,something)
 import Data.List(nub)
 import Data.Maybe
@@ -236,12 +236,15 @@ chToClassHead kt qt@HsClassHead { .. }  =
 createClassAssocs kt decls = [ Assoc (ctc n) False (map ct as) (ctype t) | HsTypeDecl { hsDeclName = n, hsDeclTArgs = as, hsDeclType = t } <- decls ] where
     ctc n = let nn = toName TypeConstructor n in Tycon nn (kindOf nn kt)
     ct (HsTyVar n) = let nn = toName TypeVal n in tyvar nn (kindOf nn kt)
+    ct _ = error "Class.createClassAssocs: bad1."
     ctype HsTyAssoc = kindStar
+    ctype _ = error "Class.createClassAssocs: bad2."
 --    ctype t = Just $ runIdentity $ hsTypeToType kt t
 
 createInstAssocs kt decls = [ (ctc n,map ct (czas ca),map ct as,ctype t) | HsTypeDecl { hsDeclName = n, hsDeclTArgs = (ca:as), hsDeclType = t } <- decls ] where
     ctc n = let nn = toName TypeConstructor n in Tycon nn (kindOf nn kt)
     ct (HsTyVar n) = let nn = toName TypeVal n in tyvar nn (kindOf nn kt)
+    ct _ = error "Class.createInstAssocs: bad."
     czas ca = let (HsTyCon {},zas) = fromHsTypeApp ca in zas
     ctype HsTyAssoc = Nothing
     ctype t = Just $ runIdentity $ hsTypeToType kt t
@@ -270,8 +273,8 @@ instanceToTopDecls _ _ _ = mempty
 
 instanceName n t = toName Val ("Instance@",'i':show n ++ "." ++ show t)
 defaultInstanceName n = toName Val ("Instance@",'i':show n ++ ".default")
-aliasDefaultInstanceName :: Name -> Class -> Name
-aliasDefaultInstanceName n ca = toName Val ("Instance@",'i':show n ++ ".default."++show ca)
+-- aliasDefaultInstanceName :: Name -> Class -> Name
+-- aliasDefaultInstanceName n ca = toName Val ("Instance@",'i':show n ++ ".default."++show ca)
 
 methodToTopDecls :: Monad m
     => KindEnv         -- ^ the kindenv
@@ -301,6 +304,7 @@ defaultMethodToTopDecls kt methodSigs HsClassHead { .. } (methodName, methodDecl
      --  = newMethodSig cntxt newMethodName sigFromClass argType
     renamedMethodDecls = renameOneDecl newMethodName methodDecls
 
+{-
 aliasDefaultMethodToTopDecls :: KindEnv -> [Assump] -> Class -> (Name, HsDecl) -> (HsDecl,Assump)
 aliasDefaultMethodToTopDecls kt methodSigs aliasName (methodName, methodDecls)
    = (renamedMethodDecls,(newMethodName,sigFromClass)) where
@@ -310,6 +314,7 @@ aliasDefaultMethodToTopDecls kt methodSigs aliasName (methodName, methodDecls)
          _ -> error $ "sigFromClass: " ++ show methodSigs ++ " " ++ show  methodName
       --  = newMethodSig cntxt newMethodName sigFromClass argType
      renamedMethodDecls = renameOneDecl newMethodName methodDecls
+-}
 
 renameOneDecl :: Name -> HsDecl -> HsDecl
 renameOneDecl newName (HsFunBind matches)
@@ -318,6 +323,7 @@ renameOneDecl newName (HsFunBind matches)
 -- (ie no compound patterns)
 renameOneDecl newName (HsPatBind sloc (HsPVar patName) rhs wheres)
    = HsPatBind sloc (HsPVar (nameName newName)) rhs wheres
+renameOneDecl _ _ = error "Class.renameOneDecl"
 
 renameOneMatch :: Name -> HsMatch -> HsMatch
 renameOneMatch newName (HsMatch sloc oldName pats rhs wheres)
@@ -355,8 +361,8 @@ newMethodSig' kt methodName newCntxt qt' instanceType  = newQualType where
 
 -- collect assumptions of all class methods
 
-classMethodAssumps :: ClassHierarchy -> [Assump]
-classMethodAssumps hierarchy = concatMap classAssumps $ classRecords hierarchy
+--classMethodAssumps :: ClassHierarchy -> [Assump]
+--classMethodAssumps hierarchy = concatMap classAssumps $ classRecords hierarchy
 
 --------------------------------------------------------------------------------
 
@@ -388,7 +394,7 @@ scatterInstancesOf cr = map extract (classClasses cr)
 -}
 --------------------------------------------------------------------------------
 
-failSl sl m = fail $ show sl ++ ": " ++ m
+--failSl sl m = fail $ show sl ++ ": " ++ m
 
 classHierarchyFromRecords rs =
     CH (Map.fromList [ (className x,x)| x <- rs ]) mempty
@@ -476,11 +482,13 @@ showListAndSepInWidth f width sep things = unlines $ groupStringsToWidth width n
 pretty  :: PPrint Doc a => a -> String
 pretty   = render . pprint
 
+{-
 nameOfTyCon :: NameType -> HsType -> Name
 nameOfTyCon t (HsTyCon n) = toName t n
 nameOfTyCon t (HsTyTuple xs) = nameTuple t (length xs)
 nameOfTyCon t (HsTyFun _ _) = tc_Arrow
 nameOfTyCon _ t = error $ "nameOfTyCon: " ++ show t
+-}
 
 groupEquations :: [HsDecl] -> [(Name, HsDecl)]
 groupEquations [] = []
@@ -518,6 +526,7 @@ noNewtypeDerivable = [
 
 -- classes that behave identically to their component when they have a single
 -- unary constructor but are not newtypes
+{-
 unaryPassDerivable :: [Name]
 unaryPassDerivable = [
     class_Ix,
@@ -525,3 +534,4 @@ unaryPassDerivable = [
     class_Ord,
     class_Bounded
     ]
+-}
diff --git a/src/FrontEnd/DependAnalysis.hs b/src/FrontEnd/DependAnalysis.hs
index 559b52c..d82684f 100644
--- a/src/FrontEnd/DependAnalysis.hs
+++ b/src/FrontEnd/DependAnalysis.hs
@@ -55,6 +55,7 @@ getBindGroups ns toName getDeps = filter (not . null) (map (concatMap f) $ Scc.s
 --
 -- Create a list of edges from a list of nodes.
 --
+{-
 buildNameEdges :: [node]           ->    -- List of nodes
                   (node -> name)   ->    -- Function to convert nodes to a unique name
                   (node -> [name]) ->    -- Function to return dependencies of this node
@@ -65,6 +66,7 @@ buildNameEdges (n:ns) getName getDeps
 	= map mapFunc (getDeps n) ++ (buildNameEdges ns getName getDeps)
 	where
 	mapFunc = ( \ s -> (getName n, s) )
+-}
 
 --
 -- Create a list of groups from a list of names.
@@ -125,15 +127,18 @@ mapOnTuple fm ((a1,a2):as)
 --
 -- Display bind group information in a human readable (or as close to) form.
 --
+{-
 showBindGroups :: [[node]]        ->     -- List of nodes
 		  (node->String)  ->     -- Function to convert a node to a string
                   String                 -- Printable string
 showBindGroups ns getAlias
 	= showBindGroups_ ns getAlias 0
+-}
 
 --
 -- Recursive function which does the work of showBindGroups.
 --
+{-
 showBindGroups_ :: [[node]]        ->     -- List of nodes
 		   (node->String)  ->     -- Function to convert a node to a string
                    Int             ->     -- Bind group number
@@ -146,6 +151,7 @@ showBindGroups_ (n:ns) getAlias groupNum
 	  ++ showBindGroups_ ns getAlias (groupNum + 1)
 	where
 	bgString = wrapString "EMPTY" (listToString n getAlias)
+-}
 
 --------------------------------------------------------------------------------
 -- debugBindGroups
diff --git a/src/FrontEnd/Exports.hs b/src/FrontEnd/Exports.hs
index eb579d1..6f6432b 100644
--- a/src/FrontEnd/Exports.hs
+++ b/src/FrontEnd/Exports.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecursiveDo,NoMonoLocalBinds #-}
+{-# LANGUAGE DoRec,NoMonoLocalBinds #-}
 -- | determine export\/imports for modules via fixpoint recursion
 
 module FrontEnd.Exports(determineExports,ModInfo(..)) where
@@ -100,6 +100,7 @@ determineExports' owns doneMods todoMods = mdo
                 g x = Name.qualifyName m x
             f z = entSpec False is z
         return $ mapDomain toUnqualified (unions $ map f es)
+    getExports _ _ = error "Exports.getExports: bad."
 
     -- | determine what is visible in a module
     getImports :: Monad m => ModInfo -> (Module -> m (Rel Name Name)) -> m (Rel Name Name)
@@ -136,9 +137,10 @@ determineExports' owns doneMods todoMods = mdo
 		Nothing -> [TypeConstructor,ClassName]
 		Just nt -> [nt]
 	    ss = concat $ concat [ maybeToList (Map.lookup x ownsMap) | x <- Set.toList $ range rdl ]
-	    cd n = [toName DataConstructor n, toName Val n, toName FieldLabel n ]
+	    --cd n = [toName DataConstructor n, toName Val n, toName FieldLabel n ]
 	    rdl = (restrictDomain (`elem` map (`toName` n) ct) rel)
 	f _ (HsEQualified t n) = f (Just t) n
+        f _ _ = error "Export.determineExports': bad."
 
 defsToRel xs = fromList $ map f xs where
     f (n,_,_) = (toUnqualified n,n)
diff --git a/src/FrontEnd/HsErrors.hs b/src/FrontEnd/HsErrors.hs
index d63cc25..662321d 100644
--- a/src/FrontEnd/HsErrors.hs
+++ b/src/FrontEnd/HsErrors.hs
@@ -22,7 +22,7 @@ hsType :: (MonadSrcLoc m, MonadWarn m) => HsType -> m ()
 --    hsQualType (hsTypeType x)
 hsType x = traverseHsType (\x -> hsType x >> return x) x >> return ()
 
-hsQualType x  = hsType (hsQualTypeType x)
+--hsQualType x  = hsType (hsQualTypeType x)
 
 data Context = InClass [HsType] | InInstance [HsType] | TopLevel | Local
     deriving(Eq)
@@ -47,7 +47,7 @@ hsDecl cntx decl = f cntx decl where
         let ds = map (toName ClassName) ds'
 --        when (null cs) $ warn sl "h98-emptydata" "data types with no constructors are a non-haskell98 feature"
         checkDeriving sl False ds
-        let isEnum = all (\x ->  null (hsConDeclArgs x)) cs
+--        let isEnum = all (\x ->  null (hsConDeclArgs x)) cs
 --        when (not isEnum && class_Enum `elem` ds) $ warn sl "derive-enum" "Cannot derive enum from non enumeration type"
 --        when (not isEnum && length cs /= 1 && class_Bounded `elem` ds) $ warn sl "derive-bounded" "Cannot derive bounded from non enumeration or unary type"
         return ()
@@ -73,15 +73,16 @@ hsDecl cntx decl = f cntx decl where
 
     f _ _ = return ()
 
-fetchQtArgs sl HsQualType { hsQualTypeType = t } | (HsTyCon {},args@(_:_)) <- fromHsTypeApp t = return args
-fetchQtArgs sl _ = warn sl InvalidDecl "invalid head in class or instance decl" >> return []
+--fetchQtArgs sl HsQualType { hsQualTypeType = t } | (HsTyCon {},args@(_:_)) <- fromHsTypeApp t = return args
+--fetchQtArgs sl _ = warn sl InvalidDecl "invalid head in class or instance decl" >> return []
 
 checkDeriving _ _ xs | all (`elem` derivableClasses) xs = return ()
 --checkDeriving sl True _ = warn sl "h98-newtypederiv" "arbitrary newtype derivations are a non-haskell98 feature"
 checkDeriving sl False xs
   = let nonDerivable = filter (`notElem` derivableClasses) xs
     in warn sl (UnknownDeriving nonDerivable) ("attempt to derive from a non-derivable class: " ++ unwords (map show nonDerivable))
+checkDeriving _ True _ = error "HsErrors.checkDeriving: bad."
 
-fromHsTypeApp t = f t [] where
-    f (HsTyApp a b) rs = f a (b:rs)
-    f t rs = (t,rs)
+--fromHsTypeApp t = f t [] where
+--    f (HsTyApp a b) rs = f a (b:rs)
+--    f t rs = (t,rs)
diff --git a/src/FrontEnd/HsPretty.hs b/src/FrontEnd/HsPretty.hs
index b5e658f..defeb24 100644
--- a/src/FrontEnd/HsPretty.hs
+++ b/src/FrontEnd/HsPretty.hs
@@ -405,6 +405,7 @@ ppHsTypePrec p HsTyExists { hsTypeVars = vs, hsTypeType = qt } = parensIf (p > 1
 ppHsTypePrec _ HsTyExpKind { hsTyLType = Located _ t, hsTyKind = k } = do
     t <- ppHsType t
     return $ DL.parens ( t DL.<+> DL.text "::" DL.<+> pprint k)
+ppHsTypePrec _ _ = error "HsPretty.ppHsTypePrec: bad."
 
 instance DL.DocLike d => P.PPrint d HsKind where
     pprint (HsKind k) = pprint k
diff --git a/src/FrontEnd/KindInfer.hs b/src/FrontEnd/KindInfer.hs
index e01f267..bd37fb4 100644
--- a/src/FrontEnd/KindInfer.hs
+++ b/src/FrontEnd/KindInfer.hs
@@ -21,7 +21,7 @@ import Control.Monad.Identity
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Data.Binary
-import Data.Generics(Typeable, everything, mkQ, Data)
+import Data.Generics(Typeable, everything, mkQ)
 import Data.IORef
 import Data.List
 import System.IO.Unsafe
@@ -43,7 +43,6 @@ import Options
 import Support.FreeVars
 import Support.MapBinaryInstance
 import Util.ContextMonad
-import Util.Gen
 import Util.HasSize
 import qualified FlagDump as FD
 import qualified Util.Seq as Seq
@@ -310,6 +309,7 @@ kiType k HsTyExists { hsTypeVars = vs, hsTypeType = HsQualType con t } = do
     mapM_ initTyVarBind vs
     mapM_ kiPred con
     kiType' k t
+kiType _ _ = error "KindInfer.kiType: bad."
 
 initTyVarBind HsTyVarBind { hsTyVarBindName = name, hsTyVarBindKind = kk } = do
     nk <- lookupKind KindSimple (toName TypeVal name)
@@ -338,6 +338,7 @@ kiApps ca args fk = f ca args fk where
         let nv = (KVar x `Kfun` KVar y)
         varBind var nv
         f nv as fk
+    f _ _ _ = error "KindInfer.kiApps: bad."
 
 kiApps' :: Kind -> [Kind] -> Kind -> Ki ()
 kiApps' ca args fk = f ca args fk where
@@ -352,6 +353,7 @@ kiApps' ca args fk = f ca args fk where
         let nv = (KVar x `Kfun` KVar y)
         varBind var nv
         f nv as fk
+    f _ _ _ = error "KindInfer.kiApps': bad."
 
 kiPred :: HsAsst -> Ki ()
 kiPred asst@(HsAsst n ns) = do
@@ -432,6 +434,7 @@ kiDecl d = withSrcLoc (srcLoc d) (f d) where
         let rn = Seq.toList $ everything (Seq.<>) (mkQ Seq.empty g) newClassBodies
             newClassBodies = map typeFromSig $ filter isHsTypeSig sigsAndDefaults
             typeFromSig (HsTypeSig _sloc _names qualType) = qualType
+            typeFromSig _ = error "KindInfer.typeFromSig: bad."
             g (HsTyVar n') | hsNameToOrig n' == hsNameToOrig classArg = Seq.single (toName TypeVal n')
             g _ = Seq.empty
         carg <- lookupKind KindSimple (toName TypeVal classArg)
@@ -569,6 +572,7 @@ hsAsstToPred kt (HsAsst className [varName])
    | isConstructorLike varName = IsIn  (toName ClassName className) (TCon (Tycon (toName TypeConstructor varName) (head $ kindOfClass (toName ClassName className) kt)))
    | otherwise = IsIn (toName ClassName className) (TVar $ tyvar (toName TypeVal varName) (head $ kindOfClass (toName ClassName className) kt))
 hsAsstToPred kt (HsAsstEq t1 t2) = IsEq (runIdentity $ hsTypeToType' kt t1) (runIdentity $ hsTypeToType' kt t2)
+hsAsstToPred _ _ = error "KindInfer.hsAsstToPred: bad."
 
 hsQualTypeToSigma kt qualType = hsQualTypeToType kt (Just []) qualType
 
diff --git a/src/FrontEnd/ParseUtils.hs b/src/FrontEnd/ParseUtils.hs
index 439293d..901ec13 100644
--- a/src/FrontEnd/ParseUtils.hs
+++ b/src/FrontEnd/ParseUtils.hs
@@ -90,7 +90,6 @@ checkAssertion t =  checkAssertion' [] t
 		checkAssertion' _ _ = fail "Illegal class assertion"
                 tast (a,[HsTyVar n]) = return (HsAsst a [n]) -- (a,n)
                 tast _ = fail "Invalid Class. multiparameter classes not yet supported"
-                tast _ = error "tast!"
 --checkAssertion = checkAssertion' []
 --	where	checkAssertion' ts (HsTyCon c) = return (c,ts)
 --		checkAssertion' ts (HsTyApp a t) = checkAssertion' (t:ts) a
@@ -110,6 +109,7 @@ checkSimple _kw (HsTyCon t)   xs = return (t,xs)
 checkSimple kw _ _ = fail ("Illegal " ++ kw ++ " declaration")
 --checkSimple kw t ts = fail ("Illegal " ++ kw ++ " declaration: " ++ show (t,ts))
 
+{-
 checkInstHeader :: HsQualType -> P (HsContext,Name,[HsType])
 checkInstHeader (HsQualType cs t) = do
 	(c,ts) <- checkInsts t []
@@ -119,6 +119,7 @@ checkInsts :: HsType -> [HsType] -> P ((Name,[HsType]))
 checkInsts (HsTyApp l t) ts = checkInsts l (t:ts)
 checkInsts (HsTyCon c)   ts = return (c,ts)
 checkInsts _ _ = fail "Illegal instance declaration"
+-}
 
 -----------------------------------------------------------------------------
 -- Checking Patterns.
@@ -232,8 +233,7 @@ checkExpr e = case e of
         HsAsPat _ _     -> fail "@ only valid in pattern"
         HsWildCard sl   -> return $ HsWildCard sl -- TODO check for strict mode
         HsIrrPat _      -> fail "~ only valid in pattern"
-
---	_                         -> fail "Parse error in expression"
+	_                         -> fail "Parse error in expression"
 
 -- type signature for polymorphic recursion!!
 check1Expr :: HsExp -> (HsExp -> a) -> P a
@@ -306,6 +306,7 @@ isFunLhs _ _ = Nothing
 -----------------------------------------------------------------------------
 -- In a class or instance body, a pattern binding must be of a variable.
 
+{-
 checkClassBody :: [HsDecl] -> P [HsDecl]
 checkClassBody decls = do
 	mapM_ checkMethodDef decls
@@ -316,6 +317,7 @@ checkMethodDef (HsPatBind _ (HsPVar _) _ _) = return ()
 checkMethodDef (HsPatBind loc _ _ _) =
 	fail "illegal method definition" `atSrcLoc` loc
 checkMethodDef _ = return ()
+-}
 
 -----------------------------------------------------------------------------
 -- Check that an identifier or symbol is unqualified.
@@ -343,6 +345,7 @@ mkRecConstrOrUpdate _         _        = fail "Empty record update"
 -- Reverse a list of declarations, merging adjacent HsFunBinds of the
 -- same name and checking that their arities match.
 
+{-
 checkRevDecls :: [HsDecl] -> P [HsDecl]
 checkRevDecls = mergeFunBinds []
     where
@@ -359,6 +362,7 @@ checkRevDecls = mergeFunBinds []
 			else mergeMatches (ms++ms') ds
 		mergeMatches ms' ds = mergeFunBinds (HsFunBind ms':revDs) ds
 	mergeFunBinds revDs (d:ds) = mergeFunBinds (d:revDs) ds
+-}
 
 -- this used to be done in post-process
 
@@ -398,6 +402,7 @@ doForeign srcLoc names ms qt = ans where
             f ("export":rs) cname = do
                 let (safe,conv) = pconv rs
                 return $ HsForeignExport srcLoc (FfiExport cname safe conv undefined undefined) vname qt
+            f _ _ = error "ParseUtils: bad."
         f (map show names') (maybe cname id mstring) where
     pconv rs = g Safe CCall rs where
         g _ cc ("safe":rs) = g Safe cc rs
diff --git a/src/FrontEnd/Rename.hs b/src/FrontEnd/Rename.hs
index 976bef0..e5bcb7a 100644
--- a/src/FrontEnd/Rename.hs
+++ b/src/FrontEnd/Rename.hs
@@ -349,6 +349,7 @@ renameKindHsCon HsConDecl { .. } = do
         f e = addWarn InvalidDecl "invalid argument in kind declaration" >> return e
     hsConDeclConArg <- mapM bt hsConDeclConArg
     return HsConDecl { .. }
+renameKindHsCon _ = error "Rename.renameKindHsCon: bad."
 
 instance Rename HsBangType where
     rename (HsBangedTy t) = HsBangedTy `fmap` rename t
diff --git a/src/FrontEnd/Representation.hs b/src/FrontEnd/Representation.hs
index 56c0fd8..7c9e161 100644
--- a/src/FrontEnd/Representation.hs
+++ b/src/FrontEnd/Representation.hs
@@ -58,7 +58,7 @@ data MetaVar = MetaVar {
     metaUniq :: {-# UNPACK #-} !Int,
     metaKind :: Kind,
     metaRef :: {-# UNPACK #-} !(IORef (Maybe Type)),
-    metaType :: {-# UNPACK #-} !MetaVarType
+    metaType :: !MetaVarType
     }
     {-! derive: Binary !-}
 
@@ -76,7 +76,9 @@ instance TypeNames Type where
     tCharzh = TCon (Tycon tc_Char_ kindHash)
 
 instance Ord (IORef a)
-instance Binary (IORef a)
+instance Binary (IORef a) where
+  put = error "Binary.put: not impl."
+  get = error "Binary.get: not impl."
 
 tList :: Type
 tList = TCon (Tycon tc_List (Kfun kindStar kindStar))
@@ -99,6 +101,7 @@ instance Eq Type where
     _ == _ = False
 
 tassocToAp TAssoc { typeCon = con, typeClassArgs = cas, typeExtraArgs = eas } = foldl tAp (TCon con) (cas ++ eas)
+tassocToAp _ = error "Representation.tassocToAp: bad."
 
 -- Unquantified type variables
 
@@ -252,7 +255,7 @@ prettyPrintTypePrec n t  = unparse $ zup (runIdentity (runVarNameT (f t))) where
         t2 <- f t2
         return $ t1 `arr` t2
     f (TMetaVar mv) = return $ atom $ pprint mv
-    f tv = return $ atom $ parens $ text ("FrontEnd.Tc.Type.pp: " ++ show tv)
+    --f tv = return $ atom $ parens $ text ("FrontEnd.Tc.Type.pp: " ++ show tv)
 
 instance DocLike d => PPrint d MetaVarType where
     pprint  t = case t of
diff --git a/src/FrontEnd/Tc/Class.hs b/src/FrontEnd/Tc/Class.hs
index cbbb8ba..8d63491 100644
--- a/src/FrontEnd/Tc/Class.hs
+++ b/src/FrontEnd/Tc/Class.hs
@@ -24,7 +24,6 @@ import Doc.PPrint
 import FrontEnd.Class
 import FrontEnd.Tc.Monad
 import FrontEnd.Tc.Type
-import FrontEnd.Warning
 import Name.Name
 import Name.Names
 import Options
diff --git a/src/FrontEnd/Tc/Kind.hs b/src/FrontEnd/Tc/Kind.hs
index 3d098e1..83f7d10 100644
--- a/src/FrontEnd/Tc/Kind.hs
+++ b/src/FrontEnd/Tc/Kind.hs
@@ -122,7 +122,7 @@ instance Monoid KindConstraint where
 data Kindvar = Kindvar {
     kvarUniq       :: {-# UNPACK #-} !Int,
     kvarRef        :: {-# UNPACK #-} !(IORef (Maybe Kind)),
-    kvarConstraint :: {-# UNPACK #-} !KindConstraint
+    kvarConstraint :: !KindConstraint
     }
 
 instance Binary Kindvar where
diff --git a/src/FrontEnd/Tc/Main.hs b/src/FrontEnd/Tc/Main.hs
index 80825ec..62bf23e 100644
--- a/src/FrontEnd/Tc/Main.hs
+++ b/src/FrontEnd/Tc/Main.hs
@@ -23,8 +23,7 @@ import FrontEnd.Tc.Kind
 import FrontEnd.Tc.Monad hiding(listenPreds)
 import FrontEnd.Tc.Type
 import FrontEnd.Tc.Unify
-import FrontEnd.Utils
-import FrontEnd.Utils(getDeclName)
+import FrontEnd.Utils(getDeclName,maybeGetDeclName)
 import FrontEnd.Warning
 import GenUtil
 import Name.Name
@@ -63,6 +62,7 @@ tcKnownApp e coerce vname as typ = do
         f lt [] = do
             fc <- lt `subsumes` typ
             return ([],fc)
+        f _ _ = error "Main.tcKnownApp: bad."
     (nas,CTId) <- f rt as
     return (e',nas)
 
@@ -655,7 +655,7 @@ tcMiscDecl d = withContext (locMsg (srcLoc d) "in the declaration" "") $ f d whe
         ch <- getClassHierarchy
         ke <- getKindEnv
         let supers = asksClassRecord ch hsClassHead classSupers
-            (ctx,(cn,[a])) = chToClassHead ke cHead
+            (ctx,(_,[a])) = chToClassHead ke cHead
         assertEntailment ctx [ IsIn s a | s <- supers]
         return []
 
@@ -728,6 +728,8 @@ tcDecl decl@(HsFunBind matches) typ = withContext (declDiagnostic decl) $ do
     matches' <- mapM (`tcMatch` typ) matches
     return (HsFunBind matches', Map.singleton (getDeclName decl) typ)
 
+tcDecl _ _ = error "Main.tcDecl: bad."
+
 tcMatch ::  HsMatch -> Sigma -> Tc HsMatch
 tcMatch (HsMatch sloc funName pats rhs wheres) typ = withContext (locMsg sloc "in" $ show funName) $ do
     let lam (p:ps) (TMetaVar mv) rs = do -- ABS2
@@ -766,6 +768,7 @@ declDiagnostic ::  (HsDecl) -> Diagnostic
 declDiagnostic decl@(HsPatBind sloc (HsPVar {}) _ _) = locMsg sloc "in the declaration" $ render $ ppHsDecl decl
 declDiagnostic decl@(HsPatBind sloc pat _ _) = locMsg sloc "in the pattern binding" $ render $ ppHsDecl decl
 declDiagnostic decl@(HsFunBind matches) = locMsg (srcLoc decl) "in the function binding" $ render $ ppHsDecl decl
+declDiagnostic _ = error "Main.declDiagnostic: bad."
 
 tiExpl ::  Expl -> Tc (HsDecl,TypeEnv)
 tiExpl (sc, decl@HsForeignDecl {}) = do return (decl,Map.empty)
@@ -794,7 +797,7 @@ restricted monomorphismRestriction bs = any isHsActionDecl bs || (monomorphismRe
    isSimpleDecl (HsPatBind _sloc _pat _rhs _wheres) = True
    isSimpleDecl _ = False
 
-getBindGroupName (expl,impls) =  map getDeclName (snds expl ++ concat (rights impls) ++ lefts impls)
+--getBindGroupName (expl,impls) =  map getDeclName (snds expl ++ concat (rights impls) ++ lefts impls)
 
 tiProgram ::  [BindGroup] -> [HsDecl] -> Tc [HsDecl]
 tiProgram bgs es = ans where
@@ -840,6 +843,7 @@ tiLit (HsFrac _) = do
 
 tiLit (HsStringPrim _)  = return (TCon (Tycon tc_BitsPtr kindHash))
 tiLit (HsString _)  = return tString
+tiLit _ = error "Main.tiLit: bad."
 
 ------------------------------------------
 -- Binding analysis and program generation
diff --git a/src/FrontEnd/Tc/Monad.hs b/src/FrontEnd/Tc/Monad.hs
index 3314108..d838d30 100644
--- a/src/FrontEnd/Tc/Monad.hs
+++ b/src/FrontEnd/Tc/Monad.hs
@@ -53,10 +53,9 @@ import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.Writer.Strict
 import Data.IORef
-import Data.Monoid
 import List
 import System
-import Text.PrettyPrint.HughesPJ(Doc)
+--import Text.PrettyPrint.HughesPJ(Doc)
 import qualified Data.Foldable as T
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
@@ -83,7 +82,7 @@ import Support.Tickle
 import qualified FlagDump as FD
 import {-# SOURCE #-} FrontEnd.Tc.Class(simplify)
 
-data BindingType = RecursiveInfered | Supplied
+-- data BindingType = RecursiveInfered | Supplied
 type TypeEnv = Map.Map Name Sigma
 
 -- read only environment, set up before type checking.
@@ -100,7 +99,11 @@ data TcEnv = TcEnv {
     tcInstanceEnv       :: InstanceEnv,
     tcOptions           :: Opt  -- module specific options
     }
-   {-! derive: update !-}
+
+tcConcreteEnv_u    f r@TcEnv{tcConcreteEnv  = x} = r{tcConcreteEnv = f x}
+tcDiagnostics_u    f r@TcEnv{tcDiagnostics  = x} = r{tcDiagnostics = f x}
+tcMutableEnv_u     f r@TcEnv{tcMutableEnv  = x}  = r{tcMutableEnv = f x}
+tcRecursiveCalls_u f r@TcEnv{tcRecursiveCalls  = x} = r{tcRecursiveCalls = f x}
 
 data Output = Output {
     collectedPreds   :: !Preds,
@@ -111,7 +114,7 @@ data Output = Output {
     tcWarnings       :: !(Seq.Seq Warning),
     outKnots         :: [(Name,Name)]
     }
-   {-! derive: update, Monoid !-}
+   {-! derive: Monoid !-}
 
 newtype Tc a = Tc (ReaderT TcEnv (WriterT Output IO) a)
     deriving(MonadFix,MonadIO,MonadReader TcEnv,MonadWriter Output,Functor)
@@ -223,6 +226,7 @@ askCurrentEnv = do
     env2 <- asks tcMutableEnv
     return (env2 `Map.union` env1)
 
+{-
 dConScheme :: Name -> Tc Sigma
 dConScheme conName = do
     env <- askCurrentEnv
@@ -230,6 +234,7 @@ dConScheme conName = do
         Just s -> return s
         Nothing -> error $ "dConScheme: constructor not found: " ++ show conName ++
                               "\nin this environment:\n" ++ show env
+-}
 
 -- | returns a new box and a function to read said box.
 
@@ -281,7 +286,7 @@ instance Instantiate Type where
     inst mm ts (TMetaVar mv) | Just t <- Map.lookup (metaUniq mv) mm  = t
     inst mm ts (TMetaVar mv) = TMetaVar mv
     inst mm ts (TAssoc tc as bs) = TAssoc tc (map (inst mm ts) as) (map (inst mm ts) bs)
-    inst mm _ t = error $ "inst: " ++ show t
+    --inst mm _ t = error $ "inst: " ++ show t
 
 instance Instantiate a => Instantiate [a] where
   inst mm ts = map (inst mm ts)
@@ -307,8 +312,8 @@ addPreds ps = do
         constraints = Seq.fromList [ Equality { constraintSrcLoc = sl,
         constraintType1 = a, constraintType2 = b } | IsEq a b <- ps ] }
 
-addConstraints :: [Constraint] -> Tc ()
-addConstraints ps = Tc $ tell mempty { constraints = Seq.fromList ps }
+--addConstraints :: [Constraint] -> Tc ()
+--addConstraints ps = Tc $ tell mempty { constraints = Seq.fromList ps }
 
 listenPreds :: Tc a -> Tc (a,Preds)
 listenPreds action = censor (\x -> x { collectedPreds = mempty }) $
@@ -380,6 +385,7 @@ boxySpec (TForAll as qt@(ps :=> t)) = do
     (t',vs) <- runWriterT (f t as)
     addPreds $ inst mempty (Map.fromList [ (tyvarName bt,s) | (bt,s) <- vs ]) ps
     return (sortGroupUnderFG fst snd vs,t')
+boxySpec _ = error "boxySpec: bad."
 
 freeMetaVarsEnv :: Tc (Set.Set MetaVar)
 freeMetaVarsEnv = do
@@ -401,6 +407,7 @@ quantify_n vs ps rs | not $ any isBoxyMetaVar vs = do
 
     ch <- getClassHierarchy
     return $ [TForAll nvs (FrontEnd.Tc.Class.simplify ch ps :=> r) | r <- rs ]
+                    | otherwise = error "quantify_n: bad."
 
 quantify :: [MetaVar] -> [Pred] -> Rho -> Tc Sigma
 quantify vs ps r = do [s] <- quantify_n vs ps [r]; return s
@@ -489,6 +496,7 @@ readFilledBox mv | isBoxyMetaVar mv = zonkBox mv >>= \v -> case v of
     t -> return t
 readFilledBox mv = error $ "readFilledBox: nonboxy" ++ show mv
 
+{-
 elimBox :: MetaVar -> Tc Type
 elimBox mv | isBoxyMetaVar mv = do
     t <- readMetaVar mv
@@ -497,13 +505,14 @@ elimBox mv | isBoxyMetaVar mv = do
         Nothing -> newMetaVar Tau (getType mv)
 
 elimBox mv = error $ "elimBox: nonboxy" ++ show mv
+-}
 
 ----------------------------------------
 -- Declaration of instances, boilerplate
 ----------------------------------------
 
-pretty :: PPrint Doc a => a -> String
-pretty x = show (pprint x :: Doc)
+--pretty :: PPrint Doc a => a -> String
+--pretty x = show (pprint x :: Doc)
 
 instance Monad Tc where
     return a = Tc $ return a
diff --git a/src/FrontEnd/Tc/Type.hs b/src/FrontEnd/Tc/Type.hs
index db68062..fb5ab9a 100644
--- a/src/FrontEnd/Tc/Type.hs
+++ b/src/FrontEnd/Tc/Type.hs
@@ -14,16 +14,13 @@ module FrontEnd.Tc.Type(
     kindUTuple,
     unfoldKind,
     fn,
-    followTaus,
     fromTAp,
     fromTArrow,
     module FrontEnd.Tc.Type,
     prettyPrintType,
-    readMetaVar,
     tForAll,
     tList,
     Constraint(..),
-    applyTyvarMap,
     Class(),
     Kindvar(..),
     tTTuple,
@@ -37,7 +34,6 @@ import Control.Monad.Identity
 import Control.Monad.Writer
 import Data.IORef
 import Data.List
-import Data.Monoid
 import qualified Data.Map as Map
 import qualified Data.Set as S
 
@@ -48,8 +44,6 @@ import FrontEnd.SrcLoc
 import FrontEnd.Tc.Kind
 import Name.Name
 import Name.Names
-import Name.VConsts
-import Support.CanType
 import Support.FreeVars
 import Support.Tickle
 
diff --git a/src/FrontEnd/Tc/Unify.hs b/src/FrontEnd/Tc/Unify.hs
index eed9056..36529ad 100644
--- a/src/FrontEnd/Tc/Unify.hs
+++ b/src/FrontEnd/Tc/Unify.hs
@@ -8,7 +8,7 @@ module FrontEnd.Tc.Unify(
 
 import Control.Monad
 import Control.Monad.Trans
-import Control.Monad.Writer(Monoid(..),Writer(..))
+import Control.Monad.Writer(Monoid(..))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 
diff --git a/src/GenUtil.hs b/src/GenUtil.hs
index d1660d5..2adf9a6 100644
--- a/src/GenUtil.hs
+++ b/src/GenUtil.hs
@@ -113,6 +113,7 @@ module GenUtil(
     on,
     mapMsnd,
     mapMfst,
+    iocatch,
 
     -- * Classes
     UniqueProducer(..)
@@ -121,7 +122,10 @@ module GenUtil(
 import Char(isAlphaNum, isSpace, toLower, ord, chr)
 import List
 import Monad
-import qualified IO
+import qualified System.IO as IO
+import System.IO.Error (isDoesNotExistError)
+import Control.Exception
+import Prelude hiding (catch)
 import qualified System
 import Random(StdGen, newStdGen, Random(randomR))
 import Time
@@ -138,6 +142,10 @@ import CPUTime
 {-# RULES "snub/[]" snub [] = [] #-}
 {-# RULES "snub/[x]" forall x . snub [x] = [x] #-}
 
+-- | catch function only for IOException
+iocatch :: IO a -> (IOException -> IO a) -> IO a
+iocatch = catch
+
 -- | sorted nub of list, much more efficient than nub, but doesnt preserve ordering.
 snub :: Ord a => [a] -> [a]
 snub = map head . group . sort
@@ -429,11 +437,11 @@ lefts xs = [x | Left x <- xs]
 
 -- | Trasform IO errors into the failing of an arbitrary monad.
 ioM :: Monad m => IO a -> IO (m a)
-ioM action = catch (fmap return action) (\e -> return (fail (show e)))
+ioM action = iocatch (fmap return action) (\e -> return (fail (show e)))
 
 -- | Trasform IO errors into the mzero of an arbitrary member of MonadPlus.
 ioMp :: MonadPlus m => IO a -> IO (m a)
-ioMp action = catch (fmap return action) (\_ -> return mzero)
+ioMp action = iocatch (fmap return action) (\_ -> return mzero)
 
 -- | reformat a string to not be wider than a given width, breaking it up
 -- between words.
@@ -542,7 +550,7 @@ shellQuote ss = unwords (map f ss) where
 -- | looks up an enviornment variable and returns it in an arbitrary Monad rather
 -- than raising an exception if the variable is not set.
 lookupEnv :: Monad m => String -> IO (m String)
-lookupEnv s = catch (fmap return $ System.getEnv s) (\e -> if IO.isDoesNotExistError e then return (fail (show e)) else ioError e)
+lookupEnv s = catch (fmap return $ System.getEnv s) (\e -> if isDoesNotExistError e then return (fail (show e)) else ioError e)
 
 {-# SPECIALIZE fmapLeft :: (a -> c) -> [(Either a b)] -> [(Either c b)] #-}
 fmapLeft :: Functor f => (a -> c) -> f (Either a b) -> f (Either c b)
diff --git a/src/Grin/FromE.hs b/src/Grin/FromE.hs
index 4e11df9..940fe23 100644
--- a/src/Grin/FromE.hs
+++ b/src/Grin/FromE.hs
@@ -36,7 +36,6 @@ import Stats(mtick')
 import StringTable.Atom
 import Support.CanType
 import Support.FreeVars
-import Util.GMap
 import Util.Graph as G
 import Util.Once
 import Util.SetLike as SL
@@ -185,9 +184,9 @@ compile prog@Program { progDataTable = dataTable } = do
 
     -- FFI
     let tvrAtom t  = liftM convertName (fromId $ tvrIdent t)
-    let ef x = do n <- tvrAtom x
-                  return (n, [] :-> discardResult (App (scTag x) [] []))
-        ep x = do when verbose $ putStrLn ("EP FOR "++show x)
+    --let ef x = do n <- tvrAtom x
+    --           return (n, [] :-> discardResult (App (scTag x) [] []))
+    let ep x = do when verbose $ putStrLn ("EP FOR "++show x)
                   n <- tvrAtom x
                   case Info.lookup (tvrInfo x) of
                     Just l -> return [(n, l)]
@@ -207,9 +206,9 @@ compile prog@Program { progDataTable = dataTable } = do
         --initCafs = sequenceG_ [ BaseOp Overwrite [(Var v TyINode),node] | (v,node) <- cafs ]
         initCafs = Return []
         ds' = ds ++ fbaps
-        a @>> b = a :>>= ([] :-> b)
-        sequenceG_ [] = Return []
-        sequenceG_ (x:xs) = foldl (@>>) x xs
+        --a @>> b = a :>>= ([] :-> b)
+        --sequenceG_ [] = Return []
+        --sequenceG_ (x:xs) = foldl (@>>) x xs
     let grin = setGrinFunctions theFuncs emptyGrin {
             grinEntryPoints = minsert funcMain (FfiExport "_amain" Safe CCall [] "void") $
                                 fromList epv,
@@ -314,6 +313,7 @@ getName' dataTable v@LitCons { litName = n, litArgs = es }
     cn = convertName n
     cons = runIdentity $ getConstructor n dataTable
     nargs = length (conSlots cons)
+getName' _ _ = error "FromE.getName': bad."
 
 isDataAlias x = case x of
     DataAlias {} -> True
@@ -398,6 +398,7 @@ compile' cenv (tvr,as,e) = ans where
                         _ -> do
                             ee <- evalVar [TyNode] tvr
                             app fty ee as
+            _ -> error "FromE.ce: bad."
     ce e | Just z <- literal e = return (Return z)
     ce e | Just (Const z) <- constant e = return (Return $ keepIts [z])
     ce e | Just z <- constant e = return (gEval z)
@@ -442,8 +443,8 @@ compile' cenv (tvr,as,e) = ans where
 
     -- other primitives
     ce (EPrim ap xs ty) = do
-        let prim = ap
-            xs' = keepIts $ args xs
+        --let prim = ap
+        let xs' = keepIts $ args xs
             ty' = toTypes TyNode ty
 
         case ap of
@@ -535,6 +536,7 @@ compile' cenv (tvr,as,e) = ans where
     cp'' (Alt (LitInt i t) e) | Just ty <- toCmmTy t = do
         x <- ce e
         return ([Lit i $ TyPrim ty] :-> x)
+    cp'' _ = error "FromE.cp'': bad."
 
     getName x = getName' (dataTable cenv) x
 
@@ -710,8 +712,8 @@ compile' cenv (tvr,as,e) = ans where
 
     con _ = fail "not constructor"
 
-    scInfo tvr | Just n <- mlookup (tvrIdent tvr) (scMap cenv) = return n
-    scInfo tvr = fail $ "not a supercombinator:" <+> show tvr
+    --scInfo tvr | Just n <- mlookup (tvrIdent tvr) (scMap cenv) = return n
+    --scInfo tvr = fail $ "not a supercombinator:" <+> show tvr
     newNodeVar =  fmap (\x -> Var x TyNode) newVar
     newPrimVar ty =  fmap (\x -> Var x ty) newVar
     newNodePtrVar =  fmap (\x -> Var x TyINode) newVar
diff --git a/src/Grin/Grin.hs b/src/Grin/Grin.hs
index fa4cf05..95a1c85 100644
--- a/src/Grin/Grin.hs
+++ b/src/Grin/Grin.hs
@@ -475,6 +475,7 @@ instance CanType Exp where
     getType Call { expType = ty } = ty
     getType MkClosure { expType = ty } = ty
     getType GcRoots { expBody = body } = getType body
+    getType _ = error "Exp.getType: bad."
 
 instance CanType Val where
     type TypeOf Val = Ty
@@ -674,6 +675,7 @@ instance Show Ty where
     show (TyRegister t) = 'r':show t
     show (TyCall c as rt) = show c <> tupled (map show as) <+> "->" <+> show rt
     show TyUnknown = "?"
+    show _ = error "Ty.show: bad."
 
 instance Show Val where
     -- showsPrec _ s | Just st <- fromVal s = text $ show (st::String)
diff --git a/src/Grin/Main.hs b/src/Grin/Main.hs
index 55cb741..3c9109b 100644
--- a/src/Grin/Main.hs
+++ b/src/Grin/Main.hs
@@ -124,7 +124,7 @@ compileGrinToC grin = do
                   "rts/jhc_rts.c", "lib/lib_cbits.c", "rts/gc_jgc.c",
                   "rts/stableptr.c"]
     tdir <- getTempDir
-    ds <- catch (getDirectoryContents (tdir FP.</> "cbits")) (\_ -> return [])
+    ds <- iocatch (getDirectoryContents (tdir FP.</> "cbits")) (\_ -> return [])
     let extraCFiles = map (tdir FP.</>) cFiles ++ ["-I" ++ tdir ++ "/cbits", "-I" ++ tdir ] ++ [ tdir FP.</> "cbits" FP.</> fn | fn@(reverse -> 'c':'.':_) <- ds ]
     let comm = shellQuote $ [cc] ++ extraCFiles ++ [cf, "-o", fn] ++ args ++ rls
         globalvar n c = LBS.fromString $ "char " ++ n ++ "[] = \"" ++ c ++ "\";"
diff --git a/src/Grin/NodeAnalyze.hs b/src/Grin/NodeAnalyze.hs
index 15290e1..393fd3b 100644
--- a/src/Grin/NodeAnalyze.hs
+++ b/src/Grin/NodeAnalyze.hs
@@ -7,7 +7,6 @@ module Grin.NodeAnalyze(nodeAnalyze) where
 
 import Control.Monad.Identity hiding(join)
 import Control.Monad.RWS hiding(join)
-import Control.Monad.Trans
 import Data.Maybe
 import Text.Printf
 import qualified Data.Map as Map
@@ -270,8 +269,8 @@ data WhatToDo
     | WhatConstant Val
     | WhatSubs Ty (Val -> Exp) (Val -> Exp)
 
-isWhatUnchanged WhatUnchanged = True
-isWhatUnchanged _ = False
+--isWhatUnchanged WhatUnchanged = True
+--isWhatUnchanged _ = False
 
 transformFuncs :: (Atom -> [Ty] -> Maybe [Ty] -> (Maybe [WhatToDo],Maybe [WhatToDo])) -> Grin -> Grin
 transformFuncs fn grin = grin'' where
@@ -287,6 +286,7 @@ transformFuncs fn grin = grin'' where
             f (_,WhatDelete) = []
             f (_,WhatConstant _) = []
             f (Var v _,WhatSubs nty _ _) = [Var v nty]
+            f _ = error "NodeAnalyze.transformFuncs: f bad."
         e' =  g (zip p ats) (j e)
         g ((_,WhatUnchanged):xs) e = g xs e
         g ((_,WhatDelete):xs) e = g xs e
@@ -294,11 +294,14 @@ transformFuncs fn grin = grin'' where
         g ((Var v vt,WhatSubs nt _ ft):xs) e = ft (Var v nt) :>>= [Var v vt] :-> g xs e
         g [] e = e :>>= rvs :-> h (zip rvs rts) (drop (length (getType e)) [v1 .. ]) [] where
             rvs = zipWith Var [v1 .. ] (getType e)
+        g _ _ = error "NodeAnalyze.transformFuncs: g bad."
         h ((r,WhatUnchanged):xs) vs rs = h xs vs (r:rs)
         h ((r,WhatDelete):xs) vs rs = h xs vs rs
         h ((r,WhatConstant _):xs) vs rs = h xs vs rs
         h ((r,WhatSubs nty tt _):xs) (v:vs) rs = tt r :>>= [Var v nty] :-> h xs vs (Var v nty:rs)
         h [] _ rs = Return (reverse rs)
+        h _ _ _ = error "NodeAnalyze.transformFuncs: h bad."
+    f _ _ = error "NodeAnalyze.transformFuncs: f bad."
 
     j app@(BaseOp (StoreNode False) [NodeC a xs]) = res where
         res = if isNothing ats' then app else e'
@@ -312,6 +315,7 @@ transformFuncs fn grin = grin'' where
         f ((_,WhatConstant _):xs) rs = f xs rs
         f ((Var v oty,WhatSubs nty tt _):xs) rs = tt (Var v oty) :>>= [Var v nty] :-> f xs (Var v nty:rs)
         f [] rs = BaseOp (StoreNode False) [NodeC a (reverse rs)]
+        f _ _ = error "NodeAnalyze.transformFuncs: f bad."
 
     j app@(App a xs ts) = res where
         res = if isNothing ats' && isNothing rts'  then app else e'
@@ -326,12 +330,14 @@ transformFuncs fn grin = grin'' where
         f ((_,WhatConstant _):xs) rs = f xs rs
         f ((Var v oty,WhatSubs nty tt _):xs) rs = tt (Var v oty) :>>= [Var v nty] :-> f xs (Var v nty:rs)
         f [] rs = App a (reverse rs) ts' :>>= rvars :-> g (zip rvars' rts) rvars []
+        f _ _ = error "NodeAnalyze.transformFuncs: f bad."
 
         g [] [] rs = Return (reverse rs)
         g ((_,WhatUnchanged):xs) (n:ns) rs = g xs ns (n:rs)
         g ((v,WhatDelete):xs) vs rs = Return [ValUnknown (getType v)] :>>= [v] :-> g xs vs (v:rs)
         g ((v,WhatConstant c):xs) vs rs = Return [c] :>>= [v] :-> g xs vs (v:rs)
         g ((v,WhatSubs _ _ ft):xs) (n:ns) rs = ft n :>>= [v] :-> g xs ns (v:rs)
+        g _ _ _ = error "NodeAnalyze.transformFuncs: g bad."
 
         rvars = zipWith Var [ v1 .. ] ts'
         rvars' = zipWith Var (drop (length rvars) [ v1 .. ]) ts
@@ -365,6 +371,7 @@ fixupfs cmap tyEnv l = tickleM f (l::Lam) where
         Just ResultBounded { resultLB = Just lb } -> return lb
         Just ResultBounded { resultLB = Nothing } -> return bottom
         _ -> fail "lupVar"
+    lupVar _ = fail "lupVar2"
     pstuff x arg n@(N w t) = liftIO $ when verbose (printf "-- %s %s %s\n" x (show arg) (show n))
     f a@(BaseOp Eval [arg]) | Just n <- lupVar arg = case n of
         N WHNF _ -> do
diff --git a/src/Grin/SSimplify.hs b/src/Grin/SSimplify.hs
index 49e83ac..acaa76d 100644
--- a/src/Grin/SSimplify.hs
+++ b/src/Grin/SSimplify.hs
@@ -37,8 +37,8 @@ import qualified Stats
 data SEnv = SEnv {
     envSubst :: IM.IntMap Val,   -- renaming substitution
     envCSE   :: Map.Map Exp (Atom,Exp),
-    envPapp  :: IM.IntMap (Atom,[Val]),
-    envPush  :: IM.IntMap Exp
+    envPapp  :: IM.IntMap (Atom,[Val])
+    --envPush  :: IM.IntMap Exp
     }
     {-! derive: Monoid !-}
 
@@ -50,11 +50,13 @@ data SCol = SCol {
     }
     {-! derive: Monoid !-}
 
+{-
 data ExpInfo = ExpInfo {
     expFreeVars :: GSet Var,
     expUnboxing :: UnboxingResult,
     expType     :: [Ty]
     }
+-}
 
 newtype S a = S (RWS SEnv SCol SState a)
     deriving(Monad,Functor,MonadWriter SCol, MonadReader SEnv,MonadState SState)
@@ -307,6 +309,7 @@ instance CanType Unbox where
     type TypeOf Unbox = Ty
     getType (UnConst v) = getType v
     getType (UnUnknown t) = t
+    getType _ = error "getType: bad."
 
 unboxRet :: UnboxingResult -> [Val] -> Exp
 unboxRet ur vs = f ur vs where
@@ -319,6 +322,7 @@ unboxRet ur vs = f ur vs where
     g [] vs = ([],vs)
     g (UnUnknown _:xs) (v:vs) = let (r,y) = g xs vs in (v:r,y)
     g (UnConst v:xs) vs = let (r,y) = g xs vs in (v:r,y)
+    g _ _ = error "SSimplify.unboxRet: bad."
 
 unboxTypes :: UnboxingResult -> Maybe [Ty]
 unboxTypes ur = f ur where
@@ -332,6 +336,7 @@ unboxTypes ur = f ur where
     f (UnDemote _) = Just [tyDNode]
     h (UnUnknown t) = [t]
     h (UnConst {}) = []
+    h _ = error "SSimplify.unboxTypes: bad."
 
 unboxModify :: UnboxingResult -> Exp -> Exp
 unboxModify ur = f ur where
@@ -342,12 +347,17 @@ unboxModify ur = f ur where
     f (UnReturn xs) = runIdentity . editTail nty (g xs)
     f (UnStore _ _ us) =runIdentity . editTail nty (z us)
     f (UnDemote _) =runIdentity . editTail nty y
+    f _ = error "SSimplify.unboxModify: bad1."
     g xs (Return ys) = return $ Return (concat $ zipWith h xs ys)
+    g _ _ = error "SSimplify.unboxModify: bad2."
     h (UnUnknown _) y = [y]
     h (UnConst {}) _ = []
+    h _ _ = error "SSimplify.unboxModify: bad3."
     z xs (BaseOp (StoreNode _) [NodeC _ ts]) = return . Return . concat $ zipWith h xs ts
+    z _ _ = error "SSimplify.unboxModify: bad4."
     y (BaseOp Demote [x]) = return $ Return [x]
     y (Return [Const v]) = return $ Return [v]
+    y _ = error "SSimplify.unboxModify: bad5."
     mApp f (App f' as tys) | f == f' = return $ Return as
     mApp f e  = error $ "mApp: " ++ show (f,e)
 
diff --git a/src/Grin/Show.hs b/src/Grin/Show.hs
index 111ca25..07be5bf 100644
--- a/src/Grin/Show.hs
+++ b/src/Grin/Show.hs
@@ -8,7 +8,7 @@ module Grin.Show(
     ) where
 
 import Char
-import Control.Monad.Writer(Writer(..),tell,when,forM_,execWriter)
+import Control.Monad.Writer(tell,when,forM_,execWriter)
 import Data.Maybe
 import IO
 import qualified Data.Map as Map
diff --git a/src/Grin/StorageAnalysis.hs b/src/Grin/StorageAnalysis.hs
index ca61053..1200144 100644
--- a/src/Grin/StorageAnalysis.hs
+++ b/src/Grin/StorageAnalysis.hs
@@ -64,6 +64,7 @@ storeAnalyze grin = do
     let cmap = Map.filterWithKey fm $ Map.map (lower . fromJust . flip Map.lookup res) rm
         lower (ResultJust _ j) = j
         lower ResultBounded { resultLB = Nothing } = S
+        lower _ = error "StorageAnalysis.storeAnalyze: bad."
         fm _ E = False
         fm (Vr _) _ = True
         fm (Va _ _) _ = True
diff --git a/src/Ho/Binary.hs b/src/Ho/Binary.hs
index 855383d..c2cfa70 100644
--- a/src/Ho/Binary.hs
+++ b/src/Ho/Binary.hs
@@ -52,7 +52,7 @@ recordHoFile ho idep fs header = do
             fs' <- mapM shortenPath fs
             putErrLn $ "Skipping Writing Ho Files: " ++ show fs'
       else do
-    let removeLink' fn = catch  (removeLink fn)  (\_ -> return ())
+    let removeLink' fn = iocatch  (removeLink fn)  (\_ -> return ())
     let g (fn:fs) = do
             f fn
             mapM_ (l fn) fs
diff --git a/src/Ho/Build.hs b/src/Ho/Build.hs
index 8a08607..1924a49 100644
--- a/src/Ho/Build.hs
+++ b/src/Ho/Build.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE DoRec #-}
 module Ho.Build (
     module Ho.Type,
     dumpHoFile,
@@ -10,15 +10,12 @@ module Ho.Build (
 
 import Control.Concurrent
 import Control.Monad.Identity
-import Data.Char
 import Data.IORef
 import Data.List hiding(union)
 import Data.Maybe
 import Data.Monoid(Monoid(..))
 import Data.Tree
 import Data.Version(Version,parseVersion,showVersion)
-import Data.Yaml.Syck
-import System.Directory (removeFile)
 import System.FilePath as FP
 import System.Mem
 import Text.Printf
@@ -40,12 +37,9 @@ import E.Traverse(emapE)
 import E.TypeCheck()
 import FrontEnd.Class
 import FrontEnd.FrontEnd
-import FrontEnd.HsParser
 import FrontEnd.HsSyn
 import FrontEnd.Infix
-import FrontEnd.ParseMonad
 import FrontEnd.SrcLoc
-import FrontEnd.Unlit
 import FrontEnd.Warning(warn,processIOErrors,WarnType(..))
 import Ho.Binary
 import Ho.Collected()
@@ -56,11 +50,10 @@ import Name.Name
 import Options
 import PackedString(PackedString,packString,unpackPS)
 import Support.TempDir
-import Util.FilterInput
 import Util.Gen
 import Util.SetLike
 import Util.YAML
-import Version.Config(revision,version)
+import Version.Config(version)
 import Version.Version(versionString)
 import qualified FlagDump as FD
 import qualified FlagOpts as FO
@@ -101,7 +94,7 @@ type LibraryName = PackedString
 
 findFirstFile :: [FilePath] -> IO (LBS.ByteString,FilePath)
 findFirstFile [] = fail "findFirstFile: file not found"
-findFirstFile (x:xs) = flip catch (\e -> findFirstFile xs) $ do
+findFirstFile (x:xs) = flip iocatch (\e -> findFirstFile xs) $ do
     bs <- LBS.readFile x
     return (bs,x)
 
@@ -118,7 +111,12 @@ data Done = Done {
     hosEncountered  :: Map.Map HoHash     (FilePath,HoHeader,HoIDeps,Ho),
     modEncountered  :: Map.Map Module     ModDone
     }
-    {-! derive: update !-}
+
+hosEncountered_u f r@Done{hosEncountered  = x} = r{hosEncountered = f x}
+knownSourceMap_u f r@Done{knownSourceMap  = x} = r{knownSourceMap = f x}
+loadedLibraries_u f r@Done{loadedLibraries  = x} = r{loadedLibraries = f x}
+modEncountered_u f r@Done{modEncountered  = x} = r{modEncountered = f x}
+validSources_u f r@Done{validSources  = x} = r{validSources = f x}
 
 replaceSuffix suffix fp = reverse (dropWhile ('.' /=) (reverse fp)) ++ suffix
 
@@ -148,7 +146,7 @@ findHoFile done_ref fp mm sh = do
                 return (True,honame)
 
 onErr :: IO a -> IO b -> (b -> IO a) -> IO a
-onErr err good cont = join $ catch (good >>= return . cont) (\_ -> return err)
+onErr err good cont = join $ iocatch (good >>= return . cont) (\_ -> return err)
 
 fetchSource :: Opt -> IORef Done -> [FilePath] -> Maybe (Module,SrcLoc) -> IO Module
 fetchSource _ _ [] _ = fail "No files to load"
@@ -277,11 +275,13 @@ instance ProvidesModules CompUnit where
     providesModules (CompSources ss) = concatMap providesModules ss
     providesModules (CompLibrary ho libr) = libProvides (hoModuleGroup ho) libr
     providesModules CompDummy = []
+    providesModules (CompTCed _) = error "providesModules: bad1."
 
 instance ProvidesModules CompLink where
     providesModules (CompLinkUnit cu) = providesModules cu
     providesModules (CompCollected _ cu) = providesModules cu
     providesModules (CompTcCollected _ cu) = providesModules cu
+    providesModules (CompLinkLib _ _) = error "providesModules: bad2c."
 
 instance ProvidesModules SourceCode where
     providesModules sp = [sourceModName (sourceInfo sp)]
@@ -342,9 +342,10 @@ toCompUnitGraph done roots = do
                 writeIORef (lmods mg) (Right myHash)
                 modifyIORef cug_ref ((myHash,(deps,CompLibrary ho lib)):)
                 return myHash
+        g _ = error "Build.toCompUnitGraph: bad."
         pm :: [HoHash] -> IO HoHash -> IO HoHash
         pm [] els = els
-        pm (h:hs) els = hvalid h `catch` (\_ -> pm hs els)
+        pm (h:hs) els = hvalid h `iocatch` (\_ -> pm hs els)
         hvalid h = do
             ll <- Map.lookup h `fmap` readIORef hom_ref
             case ll of
@@ -352,7 +353,7 @@ toCompUnitGraph done roots = do
                 Just (True,_) -> return h
                 Just (False,af@(fp,hoh,idep,ho)) -> do
                     fp <- shortenPath fp
-                    isGood <- catch ( mapM_ cdep (hoDepends idep) >> mapM_ hvalid (hoModDepends idep) >> return True) (\_ -> return False)
+                    isGood <- iocatch ( mapM_ cdep (hoDepends idep) >> mapM_ hvalid (hoModDepends idep) >> return True) (\_ -> return False)
                     let isStale = not . null $ map (show . fst) (hoDepends idep) `intersect` optStale options
                         libsGood = all (\ (p,h) -> fmap (libHash) (Map.lookup p (loadedLibraries done)) == Just h) (hohLibDeps hoh)
                         noGood forced = do
@@ -488,6 +489,7 @@ printModProgress fmtLen maxModules tickProgress ms = f "[" ms where
         case ms of
             [x] -> g curModule bl "]" x
             (x:xs) -> do g curModule bl "-" x; putErrLn ""; f "-" xs
+            _ -> error "Build.printModProgress: bad."
     g curModule bl el modName = putErr $ printf "%s%*d of %*d%s %-17s" bl fmtLen curModule fmtLen maxModules el (show $ hsModuleName modName)
 
 countNodes cn = do
@@ -503,6 +505,7 @@ countNodes cn = do
             CompLinkUnit cu      -> return $ f cu
             CompTcCollected _ cu -> return $ f cu
             CompCollected _ cu   -> return $ f cu
+            CompLinkLib _ _      -> error "Build.countNodes: bad."
         f cu = case cu of
             CompTCed (_,_,_,ss) -> Set.fromList ss
             CompSources sc      -> Set.fromList (map sourceIdent sc)
@@ -553,6 +556,8 @@ typeCheckGraph modOpt cn = do
                         let ctc' = htc `mappend` ctc
                         writeIORef ref (CompTcCollected ctc' (CompTCed ((htc,tidata,[ (x,y) | (x,y,_) <- modules],map (sourceHoName . sourceInfo) sc))))
                         return ctc'
+                    _ -> error "Build.typeCheckGraph: bad1."
+            _ -> error "Build.typeCheckGraph: bad2."
         showProgress ms = printModProgress fmtLen maxModules tickProgress ms
         fmtLen = ceiling (logBase 10 (fromIntegral maxModules+1) :: Double) :: Int
         tickProgress = modifyMVar cur $ \val -> return (val+1,val)
@@ -576,6 +581,7 @@ compileCompNode ifunc func ksm cn = do
                 CompCollected ch _ -> return ch
                 CompTcCollected _ cl -> h cl
                 CompLinkUnit cu -> h cu
+                _ -> error "Build.compileCompNode: bad."
             h cu = do
                 deps' <- randomPermuteIO deps
                 cho <- mconcat `fmap` mapM f deps'
@@ -672,6 +678,7 @@ buildLibrary ifunc func = ans where
                 case cl of
                     CompLinkLib l _ -> return l
                     CompCollected _ y -> g hs cd ref y
+                    _ -> error "Build.buildLibrary: bad1."
             g hh deps ref cn = do
                 deps <- mapM f deps
                 let (mg,mll) = case cn of
@@ -686,6 +693,7 @@ buildLibrary ifunc func = ans where
                                     )) where
                                         mg = hoModuleGroup ho
                                         ho' = mapHoBodies eraseE ho
+                        _ -> error "Build.buildLibrary: bad2."
                     res = (mg,mconcat (snds deps) `mappend` mll)
                 writeIORef ref (CompLinkLib res cn)
                 return res
diff --git a/src/Ho/Library.hs b/src/Ho/Library.hs
index 8d3692e..7804562 100644
--- a/src/Ho/Library.hs
+++ b/src/Ho/Library.hs
@@ -108,9 +108,9 @@ fetchAllLibraries = ans where
             byhashes = Map.unions byhashes'
         return (bynames,byhashes)
     f fp = do
-        fs <- flip catch (\_ -> return [] ) $ getDirectoryContents fp
+        fs <- flip iocatch (\_ -> return [] ) $ getDirectoryContents fp
         forM fs $ \e -> case reverse e of
-            ('l':'h':'.':r)  -> flip catch (\_ -> return mempty) $ do
+            ('l':'h':'.':r)  -> flip iocatch (\_ -> return mempty) $ do
                 lib <- readHlFile  (fp ++ "/" ++ e)
                 return (Map.singleton (libBaseName lib) [lib], Map.singleton (libHash lib) lib)
             _               -> return mempty
@@ -244,7 +244,7 @@ readDescFile fp = do
     let doYaml opt = do
             lbs <- LBS.readFile fp
             dt <- preprocess opt fp lbs
-            desc <- catch (parseYamlBytes $ BS.concat (LBS.toChunks dt))
+            desc <- iocatch (parseYamlBytes $ BS.concat (LBS.toChunks dt))
                 (\e -> putErrDie $ "Error parsing desc file '" ++ fp ++ "'\n" ++ show e)
             when verbose2 $ do
                 yaml <- emitYaml desc
diff --git a/src/Main.hs b/src/Main.hs
index 7d892f4..66ff090 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -65,7 +65,7 @@ processFiles :: [String] -> IO ()
 processFiles cs = f cs (optMainFunc options) where
     f [] Nothing  = do
         int <- Interactive.isInteractive
-        when (not int) $ putErrDie "jhc: no input files"
+        when (not int) $ putErrDie "ajhc: no input files"
         g [Left preludeModule]
     f [] (Just (b,m)) = do
         m <- getModule (parseName Val m)
diff --git a/src/StringTable/Atom.hsc b/src/StringTable/Atom.hsc
index 36ce6f9..c3f6f42 100644
--- a/src/StringTable/Atom.hsc
+++ b/src/StringTable/Atom.hsc
@@ -22,7 +22,9 @@ import Data.Binary.Put
 import Data.Bits
 import Data.Data
 import Data.Monoid
-import Foreign
+import System.IO.Unsafe (unsafePerformIO)
+import Foreign.Marshal
+import Foreign.Storable
 import Foreign.C
 import GHC.Exts
 import qualified Data.ByteString as BS
diff --git a/src/Support/IniParse.hs b/src/Support/IniParse.hs
index 0a0e890..0dca225 100644
--- a/src/Support/IniParse.hs
+++ b/src/Support/IniParse.hs
@@ -110,7 +110,7 @@ parseIniFiles
     -> [String]      -- ^ the m-flags
     -> IO (Map.Map String String)
 parseIniFiles verbose raw fs ss = do
-    let rf fn = catch (do c <- parseIniFile fn; pverb ("reading " ++ fn); return c) (\_ -> return Seq.empty)
+    let rf fn = iocatch (do c <- parseIniFile fn; pverb ("reading " ++ fn); return c) (\_ -> return Seq.empty)
         pverb s = if verbose then putErrLn s else return ()
     rawp <- parseIniRaw "(builtin targets.ini)" raw
     fsc <- mapM rf fs
diff --git a/src/Support/MD5.hs b/src/Support/MD5.hs
index c8245d4..f87c745 100644
--- a/src/Support/MD5.hs
+++ b/src/Support/MD5.hs
@@ -6,7 +6,11 @@ module Support.MD5(
 import Control.Monad
 import Data.Binary
 import Data.Char
-import Foreign
+import Data.Bits
+import System.IO.Unsafe (unsafePerformIO)
+import Foreign.Marshal
+import Foreign.Ptr
+import Foreign.Storable
 import Foreign.C
 import System.IO
 import qualified Data.ByteString as BS
diff --git a/src/Support/TempDir.hs b/src/Support/TempDir.hs
index 80ed5e4..a131684 100644
--- a/src/Support/TempDir.hs
+++ b/src/Support/TempDir.hs
@@ -25,6 +25,7 @@ import System.IO.Unsafe
 import System.Posix.Signals
 import Text.Printf
 import qualified Data.Set as Set
+import GenUtil (iocatch)
 
 data TempDir = TempDir {
     tempDirClean   :: Bool,  -- ^ whether to delete the directory afterwords.
@@ -147,7 +148,7 @@ wrapMain main = E.catch (main >> cleanUp) f where
 -------------------
 
 ignoreError :: IO () -> IO ()
-ignoreError action = Prelude.catch action (\_ -> return ())
+ignoreError action = iocatch action (\_ -> return ())
 
 {-# NOINLINE tdRef #-}
 tdRef :: IORef TempDir
diff --git a/src/Util/BitSet.hs b/src/Util/BitSet.hs
index 9f1d69c..f8327b0 100644
--- a/src/Util/BitSet.hs
+++ b/src/Util/BitSet.hs
@@ -47,7 +47,7 @@ instance SetLike BitSet where
         f w n r = if even w || not (fn n) then f w1 n1 r else f w1 n1 (setBit r n) where
             !n1 = n + 1
             !w1 = w `shiftR` 1
-
+    spartition = error "BitSet.spartition: not impl."
 
 instance IsEmpty BitSet where
     isEmpty (BitSet n) = n == 0
@@ -106,7 +106,8 @@ instance Enum a => SetLike (EnumBitSet a) where
     member (fromEnum -> i) (EBS v) = member i v
     insert (fromEnum -> i) (EBS v) = EBS $ insert i v
     sfilter f (EBS v) = EBS $ sfilter (f . toEnum) v
-
+    keys = error "EnumBitSet.keys: not impl."
+    spartition = error "EnumBitSet.spartition: not impl."
 
 {-
 instance Enum a => BuildSet a (EnumBitSet a) where
diff --git a/src/Util/Graph.hs b/src/Util/Graph.hs
index 05b2e8d..82d550e 100644
--- a/src/Util/Graph.hs
+++ b/src/Util/Graph.hs
@@ -1,6 +1,6 @@
 -- | Data.Graph is sorely lacking in several ways, This just tries to fill in
 -- some holes and provide a more convinient interface
-{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE DoRec #-}
 
 module Util.Graph(
     Graph(),
@@ -29,7 +29,8 @@ module Util.Graph(
 import Control.Monad
 import Control.Monad.ST
 import Data.Array.IArray
-import Data.Array.ST
+import Data.Array.ST hiding(unsafeFreeze)
+import Data.Array.Unsafe (unsafeFreeze)
 import Data.Graph hiding(Graph)
 import Data.Maybe
 import GenUtil
diff --git a/src/Util/Graphviz.hs b/src/Util/Graphviz.hs
index ea89838..36d3a95 100644
--- a/src/Util/Graphviz.hs
+++ b/src/Util/Graphviz.hs
@@ -9,13 +9,14 @@ import List(intersperse)
 
 data Orient = Portrait | Landscape deriving (Eq, Show)
 
+{-
 o2s :: Orient -> String
 o2s Portrait = "\trotate = \"0\"\n"
 o2s Landscape = "\trotate = \"90\"\n"
 
-
 i2d :: Int -> Double
 i2d = fromInteger . toInteger
+-}
 
 
 -- | Format a graph for graphviz with reasonable defaults: title of \"fgl\",
@@ -60,11 +61,11 @@ graphviz g t headers fnode fedge (w, h) p@(pw', ph') o =
 	e = labEdges g
 	ns = concatMap sn n
 	es = concatMap se e
-	sz w' h' = if o == Portrait then show w'++","++show h' else show h'++","++show w'
-	ps = show w++","++show h
-	(pw, ph) = if o == Portrait then p else (ph', pw')
+	--sz w' h' = if o == Portrait then show w'++","++show h' else show h'++","++show w'
+	--ps = show w++","++show h
+	--(pw, ph) = if o == Portrait then p else (ph', pw')
 	--gs = show ((w*(i2d pw))-m)++","++show ((h*(i2d ph))-m)
-	gs = sz (w*(i2d pw)) (h*(i2d ph))
+	--gs = sz (w*(i2d pw)) (h*(i2d ph))
     in "digraph "++sq t++" {\n"
 --	    ++"\tmargin = \"0\"\n"
 --	    ++"\tpage = \""++ps++"\"\n"
diff --git a/src/Util/Interact.hs b/src/Util/Interact.hs
index aa03f2e..46896f1 100644
--- a/src/Util/Interact.hs
+++ b/src/Util/Interact.hs
@@ -146,8 +146,8 @@ runInteraction act s = do
             [":version"] -> putStrLn (interactVersion act) >> return act
             [":echo"] -> putStrLn arg >> return act
             [":addhist"] -> addHistory arg >> return act
-            [":cd"] -> catch (setCurrentDirectory arg) (\_ -> putStrLn $ "Could not change to directory: " ++ arg) >> return act
-            [":pwd"] -> (catch getCurrentDirectory (\_ -> putStrLn "Could not get current directory." >> return "") >>= putStrLn)  >> return act
+            [":cd"] -> iocatch (setCurrentDirectory arg) (\_ -> putStrLn $ "Could not change to directory: " ++ arg) >> return act
+            [":pwd"] -> (iocatch getCurrentDirectory (\_ -> putStrLn "Could not get current directory." >> return "") >>= putStrLn)  >> return act
             [":set"] -> case simpleUnquote arg of
                 [] -> showSet >> return act
                 rs -> do
@@ -156,11 +156,11 @@ runInteraction act s = do
                     return act { interactSet = Map.fromList [ x | x@(a,_) <- ts, a `elem` interactSettables act ] `Map.union` interactSet act }
             [":unset"] -> return act { interactSet = interactSet act Map.\\ Map.fromList [ (cleanupWhitespace rs,"") | rs <- simpleUnquote arg] }
             [":execfile"] -> do
-                fc <- catch (readFile arg) (\_ -> putStrLn ("Could not read file: " ++ arg) >> return "")
+                fc <- iocatch (readFile arg) (\_ -> putStrLn ("Could not read file: " ++ arg) >> return "")
                 act <- runInteractions act { interactEcho = True } (lines fc)
                 return act { interactEcho = False }
             [":execfile!"] -> do
-                fc <- catch (readFile arg) (\_ -> return "")
+                fc <- iocatch (readFile arg) (\_ -> return "")
                 runInteractions act { interactEcho = True } (lines fc)
             [":command"] -> return act { interactCommandMode = True }
             [":normal"] -> return act {interactCommandMode = False }
@@ -178,11 +178,11 @@ beginInteraction act = do
     hist <- case interactHistFile act of
         Nothing -> return Nothing
         Just fn -> do
-            ch <- catch (readFile fn >>= return . lines) (\_ -> return [])
+            ch <- iocatch (readFile fn >>= return . lines) (\_ -> return [])
             let cl = (map head $ group ch)
             mapM_ addHistory cl
             putStrLn $ show (length cl) ++ " lines of history added from " ++ fn
-            catch (openFile fn AppendMode >>= return . Just) (\_ -> return Nothing)
+            iocatch (openFile fn AppendMode >>= return . Just) (\_ -> return Nothing)
     go hist act
     where
     go hist act = do
@@ -192,7 +192,7 @@ beginInteraction act = do
         s <- readLine (thePrompt act) (return . expand)
         case (hist,s) of
             (Just h,(_:_)) -> do
-                catch (hPutStrLn h s >> hFlush h) (const (return ()))
+                iocatch (hPutStrLn h s >> hFlush h) (const (return ()))
             _ -> return ()
         act' <- runInteraction act s
         go hist act'
diff --git a/src/Util/Progress.hs b/src/Util/Progress.hs
index e655750..b71acea 100644
--- a/src/Util/Progress.hs
+++ b/src/Util/Progress.hs
@@ -65,11 +65,12 @@ progressStep pr k = (pr { pTreap = ot, pBias = nb, pTotal = pTotal pr + pIncreme
     (ot,nb,ks) = f (pBias pr - pIncrement pr) itreap []
     f b t ks | b <= negate dec = f (b + dec) (insertWith (+) k dec t) (k:ks)
              | otherwise = (t,b,ks) where
-        Just (k,p,t') = extract t
+        Just (k,_,_) = extract t
 
 toPercent :: Double -> Double
 toPercent d = (/ 100) . fromInteger $ round (d * 10000)
 
+{-
 histogram :: Ord k => [k] -> (Int,[(k,Int)])
 histogram ks = mapSnd toListByPriority (foldr f (0,Nil) ks) where
     f k (n,t) = (n - 1,insertWith (+) k (-1) t)
@@ -89,12 +90,14 @@ toListByPriority :: Treap k p -> [(k,p)]
 toListByPriority t = f t [] where
     f Nil rs = rs
     f (Fork k p t1 t2) rs = f t1 ((k,p):f t2 rs)
+-}
 
 
 
 data Treap k p = Nil | Fork k p (Treap k p) (Treap k p)
     deriving(Show)
 
+{-
 lookup :: Ord k => k -> Treap k p -> Maybe p
 lookup k t = f t where
     f Nil = Nothing
@@ -102,6 +105,7 @@ lookup k t = f t where
         LT -> f t1
         GT -> f t2
         EQ -> Just p
+-}
 
 merge :: Ord p => Treap k p -> Treap k p -> Treap k p
 merge Nil t = t
@@ -114,8 +118,10 @@ extract :: (Ord k,Ord p) => Treap k p -> Maybe (k,p,Treap k p)
 extract Nil = Nothing
 extract (Fork kx x t1 t2) = Just (kx,x,merge t1 t2)
 
+{-
 fromList [] = Nil
 fromList ((k,p):rs) = insert k p (fromList rs)
+-}
 
 insertWith :: (Ord k,Ord p) => (p -> p -> p) -> k -> p -> Treap k p -> Treap k p
 insertWith fp k p t = f t where
@@ -130,8 +136,10 @@ insertWith fp k p t = f t where
     ins k p t1 (Fork k' p' l r) | p > p' = Fork k' p' (ins k p t1 l) r
     ins k p t1 t2 = Fork k p t1 t2
 
+{-
 insert :: (Ord k,Ord p) => k -> p -> Treap k p -> Treap k p
 insert k p t = insertWith const k p t
+-}
 
 
 
diff --git a/src/Util/RWS.hs b/src/Util/RWS.hs
index d7d846e..3c53ef6 100644
--- a/src/Util/RWS.hs
+++ b/src/Util/RWS.hs
@@ -27,7 +27,6 @@ import Control.Monad.Trans
 import Control.Monad.Reader
 import Control.Monad.Writer
 import Control.Monad.State
-import Data.Monoid
 
 
 
diff --git a/src/Util/UnionFind.hs b/src/Util/UnionFind.hs
index e6c71c7..66ff0f3 100644
--- a/src/Util/UnionFind.hs
+++ b/src/Util/UnionFind.hs
@@ -15,9 +15,9 @@ module Util.UnionFind(
 import Control.Monad.Trans
 import Data.IORef
 import Data.Unique
-import Monad(when,liftM)
+import Control.Monad (when)
 
-data Element w a = Element a {-# UNPACK #-} !Unique {-# UNPACK #-} !(IORef (Link w a))
+data Element w a = Element a !Unique {-# UNPACK #-} !(IORef (Link w a))
 data Link w a = Weight {-# UNPACK #-} !Int w | Next (Element w a)
 
 type T = Element
diff --git a/src/Util/UnionSolve.hs b/src/Util/UnionSolve.hs
index 9c85304..803c695 100644
--- a/src/Util/UnionSolve.hs
+++ b/src/Util/UnionSolve.hs
@@ -52,9 +52,11 @@ newtype C l v = C (S.Seq (CL l v))
 
 data Op = OpLte | OpEq | OpGte
 
+{-
 flipOp OpLte = OpGte
 flipOp OpGte = OpLte
 flipOp OpEq = OpEq
+-}
 
 instance Show Op where
     show OpEq  = " = "
@@ -164,6 +166,7 @@ solve putLog csp = do
                         OpEq  ->  doEq lvl xe (Ri xml xlb xmu xub) ye (Ri yml ylb ymu yub)
                         OpLte -> doLte lvl xe (Ri xml xlb xmu xub) ye (Ri yml ylb ymu yub)
                         OpGte -> doLte lvl ye (Ri yml ylb ymu yub) xe (Ri xml xlb xmu xub)
+                _ -> fail $ "UnionSolve: bad " ++  show (xw,yw)
         doEq lvl xe ~(Ri _ xlb _ xub) ye ~(Ri _ ylb _ yub) = do
             union const xe ye
             ne <- find xe
@@ -227,7 +230,7 @@ solve putLog csp = do
                     doUpdate (Ri nv lb mu ub) ve
                     unless (nv `eq` ml) $
                         mapM_ (\v -> doOp' v OpGte l') (Set.toList ub)
-                _ -> fail $ "UnionSolve: bad " ++  show (fromElement ve,vw,op,l)
+                -- _ -> fail $ "UnionSolve: bad " ++  show (fromElement ve,vw,op,l)
         testBoundLT Nothing _ = True
         testBoundLT (Just x) y = x `lte` y
         testBoundGT Nothing _ = True
diff --git a/src/cbits/lookup3.c b/src/cbits/lookup3.c
index d5215e7..c955b6c 100644
--- a/src/cbits/lookup3.c
+++ b/src/cbits/lookup3.c
@@ -288,7 +288,9 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval)
   u.ptr = key;
   if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) {
     const uint32_t *k = (const uint32_t *)key;         /* read 32-bit chunks */
+#ifdef VALGRIND
     const uint8_t  *k8;
+#endif
 
     /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
     while (length > 12)
@@ -472,7 +474,9 @@ void hashlittle2(
   u.ptr = key;
   if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) {
     const uint32_t *k = (const uint32_t *)key;         /* read 32-bit chunks */
+#ifdef VALGRIND
     const uint8_t  *k8;
+#endif
 
     /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
     while (length > 12)
@@ -647,7 +651,9 @@ uint32_t hashbig( const void *key, size_t length, uint32_t initval)
   u.ptr = key;
   if (HASH_BIG_ENDIAN && ((u.i & 0x3) == 0)) {
     const uint32_t *k = (const uint32_t *)key;         /* read 32-bit chunks */
+#ifdef VALGRIND
     const uint8_t  *k8;
+#endif
 
     /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
     while (length > 12)
