diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2ece476..621cd92 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -436,6 +436,7 @@ data ExtensionFlag
    | Opt_NondecreasingIndentation
    | Opt_RelaxedLayout
    | Opt_TraditionalRecordSyntax
+   | Opt_DelayErrors
    deriving (Eq, Show)
 
 -- | Contains not only a collection of 'DynFlag's but also a plethora of
@@ -1955,7 +1956,8 @@ xFlags = [
   ( "OverlappingInstances",             Opt_OverlappingInstances, nop ),
   ( "UndecidableInstances",             Opt_UndecidableInstances, nop ),
   ( "IncoherentInstances",              Opt_IncoherentInstances, nop ),
-  ( "PackageImports",                   Opt_PackageImports, nop )
+  ( "PackageImports",                   Opt_PackageImports, nop ),
+  ( "DelayErrors",                      Opt_DelayErrors, nop)
   ]
 
 defaultFlags :: [DynFlag]
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 0cfa60f..61fd26e 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -27,6 +27,8 @@ module TcRnDriver (
 	tcRnExtCore
     ) where
 
+import Debug.Trace (trace)
+
 #ifdef GHCI
 import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
 #endif
@@ -139,7 +141,9 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 			    	   
 		Just (L mod_loc mod)  -- The normal case
                     -> (mkModule this_pkg mod, mod_loc) } ;
-		
+   let { delayP = xopt Opt_DelayErrors $ hsc_dflags hsc_env} ;
+   trace ("Delay Errors: enabled " ++ show delayP) $
+   tcRnRetryDelayErrors delayP local_decls $ \local_decls ->
    initTc hsc_env hsc_src save_rn_syntax this_mod $ 
    setSrcSpan loc $
    do {		-- Deal with imports; first add implicit prelude
@@ -211,6 +215,136 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 	return tcg_env
     }}}}
 
+-- | Replace expressions that don't typecheck with calls to error and try typechecking again
+tcRnRetryDelayErrors :: Bool -> [LHsDecl RdrName]
+                     -> ([LHsDecl RdrName] -> IO (Messages, Maybe TcGblEnv))
+                     -> IO (Messages, Maybe TcGblEnv)
+tcRnRetryDelayErrors False decls tcrn = tcrn decls
+tcRnRetryDelayErrors True decls tcrn = do
+  ret@((warnings, errors), tc_env) <- tcrn decls
+  if isEmptyBag errors
+     then return ret
+     else let ret@((warnings', errors'), decls') =
+                  foldrBag tcRnDelayError ((emptyBag, emptyBag), decls) errors
+       in if isEmptyBag errors'
+          then tcRnRetryDelayErrors True decls' tcrn
+          else return ((warnings `unionBags` warnings', errors'), Nothing)
+
+type Find a = (a -> [LHsDecl RdrName]) -> a -> SrcSpan
+            -> Maybe (HsExpr RdrName, HsExpr RdrName -> [LHsDecl RdrName])
+
+orMaybe = flip (flip maybe Just)
+
+tcRnDelayError :: ErrMsg -> (Messages, [LHsDecl RdrName])
+               -> (Messages, [LHsDecl RdrName])
+tcRnDelayError errIn ((warnOut, errOut), decls) =
+    trace ("tcRnDelayError: called for " ++ show errSpan) $
+    case uncurry delayErrorExpr =<< findExpr =<< errSpan of
+      Nothing -> ((warnOut, errOut `snocBag` errIn), decls)
+      Just decls' -> ((warnOut `snocBag` warnIn, errOut), decls')
+    where
+      errSpan = case errMsgSpans errIn of
+                 (span@RealSrcSpan{} : _) -> Just span
+                 _ -> Nothing
+
+      warnIn = errIn
+
+      delayErrorExpr :: HsExpr RdrName
+                     -> (HsExpr RdrName -> [LHsDecl RdrName])
+                     -> Maybe [LHsDecl RdrName]
+      delayErrorExpr expr build =
+          Just $ build $ HsApp (nlHsVar $ error_RDR)
+                   (nlHsLit $ mkHsString errString)
+
+      errString = showSDoc $ (case errMsgSpans errIn of
+                    span:_ -> mkLocMessage span
+                    _ -> id)
+                  (errMsgShortDoc errIn $$ errMsgExtraInfo errIn)
+
+      findExpr = findList (findSpan findExprD) id decls
+
+      findList :: Find a -> Find [a]
+      findList _ _ [] _ = Nothing
+      findList find f (x:xs) span =
+          find (f . (:xs)) x span `orMaybe` findList find (f . (x:)) xs span
+      
+      findSpan :: Find a -> Find (Located a)
+      findSpan find f (L hay hs) needle =
+          trace ("findSpan: " ++ show hay) $
+          if needle `isSubspanOf` hay
+          then find (f . L hay) hs needle
+          else Nothing 
+
+      findSpanE :: Find (LHsExpr RdrName)
+      findSpanE f (L hay hs) needle =
+          trace ("findSpanE: " ++ show hay) $
+          if needle == hay
+          then trace "DelayError: Found error location" $ Just (hs, f . L hay)
+          else if needle `isSubspanOf` hay
+          then findExprE (f . L hay) hs needle
+          else Nothing 
+
+      findBag :: Find a -> Find (Bag a)
+      findBag find f hay = findList find (f . listToBag) (bagToList hay)
+
+      findExprD :: Find (HsDecl RdrName)
+      findExprD f (InstD (InstDecl a lbs c d)) span =
+           findBag (findSpan findExprB) (\x -> f . InstD $ InstDecl a x c d) lbs span
+      findExprD f (ValD bind) span = findExprB (f . ValD) bind span
+      findExprD _ _ _ = Nothing
+
+      findExprB :: Find (HsBind RdrName)
+      findExprB f b@FunBind { fun_matches = MatchGroup ms _ptt } span =
+          findList (findSpan findExprM)
+              (\x -> f b { fun_matches = MatchGroup x _ptt }) ms span
+      findExprB f b@PatBind { pat_rhs = grhs } span = 
+          findExprGs (\x -> f b { pat_rhs = x }) grhs span
+      findExprB _ _ _ = Nothing
+
+      findExprM :: Find (Match RdrName)
+      findExprM f (Match a b grhs) span = findExprGs (\x -> f $ Match a b x) grhs span
+
+      findExprGs :: Find (GRHSs RdrName)
+      findExprGs f (GRHSs lgrh lbs) span =
+          findList (findSpan findExprG) (\x -> f $ GRHSs x lbs) lgrh span
+          `orMaybe` findExprLB (\x -> f $ GRHSs lgrh x) lbs span
+
+      findExprLB :: Find (HsLocalBinds RdrName)
+      findExprLB f (HsValBinds (ValBindsIn lbs b)) span =
+          findBag (findSpan findExprB)
+             (\x -> f . HsValBinds $ ValBindsIn x b) lbs span
+      findExprLB _ _ _ = Nothing
+
+      findExprG f (GRHS lguards lrhs) span =
+          Nothing -- TODO guards
+          `orMaybe` findSpanE (\x -> f $ GRHS lguards x) lrhs span
+
+      findExprE f (HsLam mg) span = Nothing -- TODO
+      findExprE f (HsApp a b) span = 
+          findSpanE (\x -> f $ HsApp x b) a span
+          `orMaybe` findSpanE (\x -> f $ HsApp a x) b span
+      findExprE f (OpApp a b _c d) span =
+          findSpanE (\x -> f $ OpApp x b _c d) a span
+          `orMaybe` findSpanE (\x -> f $ OpApp a x _c d) b span
+          `orMaybe` findSpanE (\x -> f $ OpApp a b _c x) d span
+      findExprE f (NegApp a b) span =
+          findSpanE (\x -> f $ NegApp x b) a span
+      findExprE f (HsPar a) span =
+          findSpanE (\x -> f $ HsPar x) a span
+      findExprE f (SectionL a b) span = 
+          findSpanE (\x -> f $ SectionL x b) a span
+          `orMaybe` findSpanE (\x -> f $ SectionL a x) b span
+      findExprE f (SectionR a b) span = 
+          findSpanE (\x -> f $ SectionR x b) a span
+          `orMaybe` findSpanE (\x -> f $ SectionR a x) b span
+      findExprE f (ExplicitTuple a b) span = Nothing -- TODO
+      findExprE f (HsCase lhe mg) span = Nothing -- TODO
+      findExprE f (HsIf _a b c d) span = Nothing -- TODO
+      findExprE f (HsLet lbs le) span = Nothing -- TODO
+      findExprE f (HsDo ctx lss _t) span = Nothing -- TODO
+      findExprE f (ExplicitList _t les) span =
+          findList findSpanE (f . ExplicitList _t) les span
+      findExprE _ _ _ = Nothing -- TODO
 
 implicitPreludeWarn :: SDoc
 implicitPreludeWarn