[fix typechecking of mutually recursive bindings. implement monomorphism restriction.
John Meacham <john@repetae.net>**20060214100912] hunk ./FrontEnd/Tc/Main.hs 23
+import Support.FreeVars
hunk ./FrontEnd/Tc/Main.hs 381
-    ss <- sequence [newMetaVar Tau Star | _ <- bs]
-    (rs,ps) <- censor (const mempty) $ listen $ localEnv (Map.fromList [  (getDeclName d,s) | d <- bs | s <- ss]) $ sequence [ tcDecl d s | d <- bs | s <- ss ]
-    ps <- flattenType ps
+    ts <- sequence [newMetaVar Tau Star | _ <- bs]
+    (res,ps) <- censor (const mempty) $ listen $ localEnv (Map.fromList [  (getDeclName d,s) | d <- bs | s <- ts]) $ sequence [ tcDecl d s | d <- bs | s <- ts ]
+    ps' <- flattenType ps
+    ts' <- flattenType ts
+    fs <- freeMetaVarsEnv
+    let vss = map (Set.fromList . freeVars) ts'
+        gs = (Set.unions vss) Set.\\ fs
+    (mvs,ds,rs) <- splitReduce (Set.toList fs) (Set.toList $ foldr1 Set.intersect vss) ps'
+    addPreds ds
+    scs' <- if restricted bs then do
+        let gs' = gs Set.\\ Set.fromList (freeVars rs)
+        addPreds rs
+        mapM (quantify (Set.toList gs') []) ts'
+     else mapM (quantify (Set.toList gs) rs) ts'
hunk ./FrontEnd/Tc/Main.hs 396
-            s <- flattenType s
-            when (dump FD.BoxySteps) $ liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
-            s <- generalize ps s
+            --s <- flattenType s
hunk ./FrontEnd/Tc/Main.hs 398
+            --s <- generalize ps s
+            --when (dump FD.BoxySteps) $ liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
hunk ./FrontEnd/Tc/Main.hs 401
-    nenv <- sequence [ f n s | (n,s) <- Map.toAscList $ mconcat $ snds rs]
+    nenv <- sequence [ f (getDeclName d) t  | (d,_) <- res | t <- scs' ]
+    --nenv <- sequence [ f n s | (n,s) <- Map.toAscList $ mconcat $ snds res]
hunk ./FrontEnd/Tc/Main.hs 404
-    return (fsts rs, Map.fromList nenv)
+    return (fsts res, Map.fromList nenv)