[replace the typechecking monad with one based on the monad transformers, clean up the code somewhat
John Meacham <john@repetae.net>**20051206082852] hunk ./FrontEnd/TIMonad.hs 27
-                getErrorContext,
hunk ./FrontEnd/TIMonad.hs 29
-                getKindEnv,
hunk ./FrontEnd/TIMonad.hs 38
+import Control.Monad.Fix
+import Control.Monad.Reader
hunk ./FrontEnd/TIMonad.hs 44
-import Text.PrettyPrint.HughesPJ(render,Doc)
+import Text.PrettyPrint.HughesPJ(render,Doc())
hunk ./FrontEnd/TIMonad.hs 46
-import Class                 (ClassHierarchy)
+import Class(ClassHierarchy())
hunk ./FrontEnd/TIMonad.hs 48
-import Doc.PPrint(pprint,PPrint)
+import Doc.PPrint(PPrint(..))
hunk ./FrontEnd/TIMonad.hs 50
-import FrontEnd.KindInfer             (KindEnv)
+import FrontEnd.KindInfer(KindEnv())
hunk ./FrontEnd/TIMonad.hs 52
-import TypeSigs              (SigEnv)
-import Type                  (Instantiate (..), mgu)
+import TypeSigs(SigEnv)
+import Type(Instantiate (..), mgu)
hunk ./FrontEnd/TIMonad.hs 68
-      -- tcSubst             :: IORef Subst,
hunk ./FrontEnd/TIMonad.hs 74
-newtype TI a = TI (TcEnv -> IO a)
hunk ./FrontEnd/TIMonad.hs 75
-instance MonadIO TI where
-    liftIO x = TI (\_ -> x)
+newtype TI a = TI (ReaderT TcEnv IO a)
+    deriving(MonadFix,MonadIO,MonadReader TcEnv,Functor)
hunk ./FrontEnd/TIMonad.hs 78
---instance MonadReader TcEnv TI  where
-{-# INLINE ask #-}
-{-# INLINE local #-}
-{-# INLINE asks #-}
+instance Monad TI where
+    return a = TI $ return a
+    TI comp >>= fun = TI $ do x <- comp; case fun x of TI m -> m
+    TI a >> TI b = TI $ a >> b
+    fail s = TI $ do
+        st <- ask
+        liftIO $ processIOErrors
+        liftIO $ typeError (Failure s) (tcDiagnostics st)
hunk ./FrontEnd/TIMonad.hs 87
-ask = TI (\t -> return t)
-local f (TI c) = TI (\t -> c (f t))
-asks f = liftM f ask
+instance MonadWarn TI where
+    addWarning w = liftIO $ processErrors [w]
hunk ./FrontEnd/TIMonad.hs 90
-instance Monad TI where
-    {-# INLINE return #-}
-    {-# INLINE (>>=) #-}
-    {-# INLINE (>>) #-}
-    return a = TI (\_ -> return a)
-    TI comp >>= fun = TI (\t -> comp t >>= \x -> case fun x of
-        TI r -> r t)
-    TI a >> TI b = TI (\t -> a t >> b t)
-    fail s = TI $ \st -> do
-        processIOErrors
-        typeError (Failure s) (tcDiagnostics st)
+instance MonadSrcLoc TI where
+    getSrcLoc = do
+        xs <- asks tcDiagnostics
+        case xs of
+            (Msg (Just sl) _:_) -> return sl
+            _ -> return bogusASrcLoc
hunk ./FrontEnd/TIMonad.hs 97
-instance Functor TI where
-    fmap = liftM
hunk ./FrontEnd/TIMonad.hs 98
-runTI     :: Map.Map HsName Scheme-> ClassHierarchy -> KindEnv -> SigEnv -> Module -> TI a -> IO a
-runTI env' ch' kt' st' mod' (TI c) = do
+runTI :: Map.Map HsName Scheme-> ClassHierarchy -> KindEnv -> SigEnv -> Module -> TI a -> IO a
+runTI env' ch' kt' st' mod' (TI tim) = do
hunk ./FrontEnd/TIMonad.hs 101
-    -- sub <- newIORef nullSubst
-    c tcenv {  tcVarnum = vn } where
+    runReaderT tim tcenv {  tcVarnum = vn } where
hunk ./FrontEnd/TIMonad.hs 108
-        -- tcSubst = undefined,
hunk ./FrontEnd/TIMonad.hs 110
-
hunk ./FrontEnd/TIMonad.hs 128
---getSubst :: TI Subst
---getSubst = TI $ \t -> readIORef (tcSubst t) -- gets subst
hunk ./FrontEnd/TIMonad.hs 130
-getDConsTypeEnv = TI $ \t -> return (tcDConsEnv t) -- gets env
+getDConsTypeEnv = asks tcDConsEnv
hunk ./FrontEnd/TIMonad.hs 170
-{-
---s <- getSubst
---let t1' = apply s t1
---    t2' = apply s t2
-
-                 case mgu t1' t2' of
-                   Just u  -> extSubst u
-                   Nothing -> do
-                              diagnosis <- getErrorContext
-                              typeError (Unification $ "attempted to unify " ++
-                                                       pretty t1' ++
-                                                       " with " ++
-                                                       pretty t2')
-                                        diagnosis
--}
hunk ./FrontEnd/TIMonad.hs 180
---extSubst s' = TI (\t -> modifyIORef (tcSubst t) (s' @@))
hunk ./FrontEnd/TIMonad.hs 183
-newTVar k   = TI $ \te -> do
-                n <- readIORef (tcVarnum te)
-                r <- newIORef Nothing
-                let ident = Qual (tcModuleName te) $ HsIdent $ "v" ++ show n
-                    v = tyvar ident k (Just r)
-                writeIORef (tcVarnum te) $! n + 1
-                return $ TVar v
-
+newTVar k   = do
+    te <- ask
+    n <- liftIO $ readIORef (tcVarnum te)
+    r <- liftIO $ newIORef Nothing
+    let ident = Qual (tcModuleName te) $ HsIdent $ "v" ++ show n
+        v = tyvar ident k (Just r)
+    liftIO $ writeIORef (tcVarnum te) $! n + 1
+    return $ TVar v
hunk ./FrontEnd/TIMonad.hs 202
+