[Clean up TIMonad, remove old state monad based code. make instance of MonadIO.
John Meacham <john@repetae.net>**20050502045001] hunk ./FrontEnd/TIMonad.hs 5
-        Copyright:              Mark Jones and The Hatchet Team 
+        Copyright:              Mark Jones and The Hatchet Team
hunk ./FrontEnd/TIMonad.hs 10
-        Description:            A monad to support type inference, in 
+        Description:            A monad to support type inference, in
hunk ./FrontEnd/TIMonad.hs 24
-module TIMonad (TI, 
+module TIMonad (TI,
hunk ./FrontEnd/TIMonad.hs 27
-                getErrorContext, 
-                --pushErrorContext, 
+                getErrorContext,
hunk ./FrontEnd/TIMonad.hs 29
-                --popErrorContext,
-                -- DCAssumpTable,
hunk ./FrontEnd/TIMonad.hs 39
+
hunk ./FrontEnd/TIMonad.hs 41
-import Atom
-import Class                 (ClassHierarchy)
+import Control.Monad.Trans
hunk ./FrontEnd/TIMonad.hs 43
+import Monad
+import qualified Data.Map as Map
hunk ./FrontEnd/TIMonad.hs 46
-import Doc.PPrint(pprint,PPrint)
+
+import Atom
+import Class                 (ClassHierarchy)
hunk ./FrontEnd/TIMonad.hs 50
-import HsSyn    
+import Doc.PPrint(pprint,PPrint)
+import HsSyn
hunk ./FrontEnd/TIMonad.hs 53
-import Monad
-import qualified Data.Map as Map
hunk ./FrontEnd/TIMonad.hs 73
-    } 
+    }
hunk ./FrontEnd/TIMonad.hs 77
---newtype TI a = TI (TcEnv -> State -> (# a, State #))
hunk ./FrontEnd/TIMonad.hs 79
---instance MonadState State TI where 
---    {-# INLINE get #-}
---    {-# INLINE put #-}
---    get = TI (\_ s -> (# s,s #))
---    put s = TI (\_ _ -> (# (),s #))
---    get = TI (\s -> readIORef (tcState s))
---    put s = TI (\v -> writeIORef (tcState v) $! s)
+instance MonadIO TI where
+    liftIO x = TI (\_ -> x)
hunk ./FrontEnd/TIMonad.hs 89
-asks f = liftM f ask 
-
--- dcat == data constructor assump table
+asks f = liftM f ask
hunk ./FrontEnd/TIMonad.hs 100
-        processIOErrors 
+        processIOErrors
hunk ./FrontEnd/TIMonad.hs 102
-        -- fail s
-
---    return a
---        = TI (\_ state -> (# a, state #))    -- maintain state and return value
---    TI comp >>= fun
---        = TI (\e state -> case comp e state of  
---            (# result, newState #) -> case fun result of  
---                TI comp' -> comp' e newState)
-
---    TI comp >>= fun
---        = TI (\state -> let (result, newState) = comp state
---                            TI comp' = fun result
---                        in
---                        if inerror newState then (undefined, newState)
---                                            else comp' newState)
--- we only continue with the calculations if there isn't an error
hunk ./FrontEnd/TIMonad.hs 114
-        tcModuleName = mod', 
+        tcModuleName = mod',
hunk ./FrontEnd/TIMonad.hs 120
-        
+
hunk ./FrontEnd/TIMonad.hs 126
-   run the computation but during it have the diagnostic at the top of the 
+   run the computation but during it have the diagnostic at the top of the
hunk ./FrontEnd/TIMonad.hs 131
-withContext diagnostic comp = do 
+withContext diagnostic comp = do
hunk ./FrontEnd/TIMonad.hs 142
-getDConsTypeEnv :: TI (Map.Map HsName Scheme) 
-getDConsTypeEnv = TI $ \t -> return (tcDConsEnv t) -- gets env 
+getDConsTypeEnv :: TI (Map.Map HsName Scheme)
+getDConsTypeEnv = TI $ \t -> return (tcDConsEnv t) -- gets env
hunk ./FrontEnd/TIMonad.hs 158
-dConScheme :: HsName -> TI Scheme 
+dConScheme :: HsName -> TI Scheme
hunk ./FrontEnd/TIMonad.hs 161
-        env <- getDConsTypeEnv 
+        env <- getDConsTypeEnv
hunk ./FrontEnd/TIMonad.hs 163
-           Nothing 
-            --  | Just n <- fromTupname conName -> return (toTuple n) 
+           Nothing
+            --  | Just n <- fromTupname conName -> return (toTuple n)
hunk ./FrontEnd/TIMonad.hs 177
-                              typeError (Unification $ "attempted to unify " ++ 
+                              typeError (Unification $ "attempted to unify " ++
hunk ./FrontEnd/TIMonad.hs 190
-{-
-trim       :: [Tyvar] -> TI ()
-trim vs     = TI (\state ->
-                     let s' = [(v,t) | (v,t) <- toListFM (subst state), v `elem` vs]
-                         force = length (tv (map snd s'))
-                     in force `seq` ((), state {subst = listToFM s'})
-                 )
--}
hunk ./FrontEnd/TIMonad.hs 192
---extSubst s' = TI (\_ state -> (# (), state {subst = s'@@(subst state)} #))
hunk ./FrontEnd/TIMonad.hs 195
-newTVar k   = TI $ \te -> do 
+newTVar k   = TI $ \te -> do
hunk ./FrontEnd/TIMonad.hs 201
-                 
---newTVar k   = TI (\te state -> 
---                   let n = varnum state
---                       ident = Qual (tcModuleName te) $ HsIdent $ "v" ++ show n
---                       v = Tyvar (Atom.fromString $ fromHsName ident) ident k
---                   in  (# TVar v, state{varnum = n+1} #)
---                 )
-
-{-
-freshInt :: TI Int
-freshInt = TI (\state -> 
-                   let n = varnum state
-                   in  (n, state{varnum = n+1})
-                 )
--}
hunk ./FrontEnd/TIMonad.hs 203
-    
hunk ./FrontEnd/TIMonad.hs 205
-freshInst (Forall ks qt) = do 
+freshInst (Forall ks qt) = do
hunk ./FrontEnd/Unlit.hs 39
-unlit :: 
+unlit ::