[make recursive bindings get coerced correctly to the right type
John Meacham <john@repetae.net>**20060302225442] hunk ./FrontEnd/Tc/Main.hs 74
--- TODO should subsume for rank-n
hunk ./FrontEnd/Tc/Main.hs 77
-    addCoerce (toName Val n) f
+    rc <- asks tcRecursiveCalls
+    if (toName Val v `Set.member` rc) then
+        tell mempty { outKnots = [(toName Val n,toName Val v)] }
+      else do addCoerce (toName Val n) f
hunk ./FrontEnd/Tc/Main.hs 84
--- TODO should subsume for rank-n
hunk ./FrontEnd/Tc/Main.hs 440
-    when (dump FD.BoxySteps) $ liftIO $ putStrLn $ "*** tiimpls " ++ show (map getDeclName bs)
+    let names = map getDeclName bs
+    when (dump FD.BoxySteps) $ liftIO $ putStrLn $ "*** tiimpls " ++ show names
hunk ./FrontEnd/Tc/Main.hs 443
-    (res,ps) <- listenPreds $ localEnv (Map.fromList [  (getDeclName d,s) | d <- bs | s <- ts]) $ sequence [ tcDecl d s | d <- bs | s <- ts ]
+    (res,ps) <- listenPreds $
+        local (tcRecursiveCalls_u (Set.union $ Set.fromList names)) $
+            localEnv (Map.fromList [  (d,s) | d <- names | s <- ts]) $
+                sequence [ tcDecl d s | d <- bs | s <- ts ]
hunk ./FrontEnd/Tc/Module.hs 222
-        (ds,cr) <- listenCheckedRules (tiProgram program ds)
+        (ds,out) <- listen (tiProgram program ds)
hunk ./FrontEnd/Tc/Module.hs 225
-        return (env,cr,cc)
+        let cc' = Map.union cc $ Map.fromList [ (as,lup v) | (as,v) <- outKnots out ]
+            lup v = case Map.lookup v cc of
+                Just (CTAbs xs) -> ctAp (map TVar xs)
+                _ -> ctId
+        return (env,checkedRules out,cc')
hunk ./FrontEnd/Tc/Monad.hs 6
+    TcEnv(..),
+    tcRecursiveCalls_u,
+    Output(..),
hunk ./FrontEnd/Tc/Monad.hs 78
+
+data BindingType = RecursiveInfered | Supplied
hunk ./FrontEnd/Tc/Monad.hs 91
+    tcRecursiveCalls    :: Set.Set Name,
hunk ./FrontEnd/Tc/Monad.hs 100
-    existentialVars  :: [Tyvar]
+    existentialVars  :: [Tyvar],
+    outKnots         :: [(Name,Name)]
hunk ./FrontEnd/Tc/Monad.hs 117
---data Coerce e = CoerceJust e | CoerceLam [Tyvar] (Coerce e) | CoerceApp (Coerce e) [Type] | CoerceFn (Coerce e -> Coerce e) (Coerce e)
-
---newtype CoerceTerm = CoerceTerm (forall e . Coerce e -> Coerce e)
-
hunk ./FrontEnd/Tc/Monad.hs 169
+        tcRecursiveCalls = mempty,
hunk ./FrontEnd/Tc/Monad.hs 317
-skolomize :: Sigma' -> Tc ([SkolemTV],Preds,Rho')
-skolomize (TForAll vs (ps :=> rho)) = return (vs,ps,rho)
+--skolomize :: Sigma' -> Tc ([SkolemTV],Preds,Rho')
+--skolomize (TForAll vs (ps :=> rho)) = return (vs,ps,rho)
hunk ./FrontEnd/Tc/Monad.hs 322
-skolomize s = return ([],[],s)
+--skolomize s = return ([],[],s)
+skolomize s = freshSigma s >>= \x -> case x of
+--skolomize s = return s >>= \x -> case x of
+    TForAll as (ps :=> r) -> return (as,ps,r)
+    r -> return ([],[],r)
hunk ./FrontEnd/Tc/Type.hs 333
+
+
+instance Monoid CoerceTerm where
+    mempty = CTId
+    mappend = composeCoerce
hunk ./Main.hs 190
-    -- mapM_ (\(_,v,lc) -> printCheckName'' fullDataTable v lc) ds
+    mapM_ (\(_,v,lc) -> printCheckName'' fullDataTable v lc) ds