[add unify and runTc to TcMonad
John Meacham <john@repetae.net>**20051207041730] hunk ./FrontEnd/Tc/Monad.hs 7
+    runTc,
hunk ./FrontEnd/Tc/Monad.hs 16
+import Text.PrettyPrint.HughesPJ(Doc)
hunk ./FrontEnd/Tc/Monad.hs 23
-import Doc.Pretty
hunk ./FrontEnd/Tc/Monad.hs 26
+import Type
hunk ./FrontEnd/Tc/Monad.hs 71
+runTc :: TcInfo -> Tc a -> IO a
+runTc tcInfo  (Tc tim) = do
+    vn <- newIORef 0
+    ce <- newIORef mempty
+    runReaderT tim TcEnv {
+        tcCollectedEnv = ce,
+        tcCurrentEnv = tcInfoEnv tcInfo,
+        tcVarnum = vn,
+        tcDiagnostics = [Msg Nothing $ "Compilation of module: " ++ tcInfoModName tcInfo],
+        tcInfo = tcInfo
+        }
hunk ./FrontEnd/Tc/Monad.hs 128
-        env <- asks ( tcInfoEnv . tcInfo)
-        case Map.lookup conName env of
-           Nothing -> error $ "dConScheme: constructor not found: " ++ show conName ++
+    env <- asks ( tcInfoEnv . tcInfo)
+    case Map.lookup conName env of
+        Just s -> return s
+        Nothing -> error $ "dConScheme: constructor not found: " ++ show conName ++
hunk ./FrontEnd/Tc/Monad.hs 133
-           Just s -> return s
+
+
+unify      :: Tau -> Tau -> Tc ()
+unify t1 t2 = do
+    t1' <- findType t1
+    t2' <- findType t2
+    b <- mgu t1' t2'
+    case b of
+        Just u -> return () -- extSubst u
+        Nothing -> do
+                  diagnosis <- getErrorContext
+                  typeError (Unification $ "attempted to unify " ++
+                                           pretty t1' ++
+                                           " with " ++
+                                           pretty t2')
+                            diagnosis
+
+unifyList :: [Type] -> Tc ()
+unifyList (t1:t2:ts) = unify t1 t2 >> unifyList (t2:ts)
+unifyList _ = return ()
hunk ./FrontEnd/Tc/Monad.hs 200
-                                          
+
hunk ./FrontEnd/Type.hs 162
-mgu     :: MonadIO m => Type -> Type -> m (Maybe Subst)
+mgu     :: (MonadIO m,Monad m2) => Type -> Type -> m (m2 Subst)
hunk ./FrontEnd/Type.hs 168
-        Right x -> return (Just x)
-        Left (_::String) -> return Nothing
+        Right x -> return (return x)
+        Left (err::String) -> return (fail err)
hunk ./FrontEnd/Type.hs 196
+mgu' TForAll {} _ = error "attempt to unify TForall"
+mgu' _ TForAll {} = error "attempt to unify TForall"
hunk ./FrontEnd/Type.hs 206
-            | otherwise        = fail "varBind: kinds do not match"
+            | otherwise        = error "varBind: kinds do not match"