[fix SPEC rule in subsumes
John Meacham <john@repetae.net>**20051209113453] hunk ./FrontEnd/Tc/Main.hs 67
-    sc <- freshInstance sc
+    sc <- freshSigma sc
+--    sc <- freshInstance sc
hunk ./FrontEnd/Tc/Main.hs 74
-    sc <- freshInstance sc
+    sc <- freshSigma sc
+ --   sc <- freshInstance sc
hunk ./FrontEnd/Tc/Monad.hs 19
+    boxySpec,
hunk ./FrontEnd/Tc/Monad.hs 31
+import List
hunk ./FrontEnd/Tc/Monad.hs 276
-addPreds = tell
+addPreds ps = Tc $ tell ps
hunk ./FrontEnd/Tc/Monad.hs 310
+boxySpec :: Sigma -> Tc ([(BoundTV,[Sigma'])],Rho')
+boxySpec (TForAll as qt@(ps :=> t)) = do
+    let f (TVar t) vs | t `elem` vs = do
+            (_,b) <- lift (newBox $ tyvarKind t)
+            tell [(t,b)]
+            return b
+        f e@TCon {} _ = return e
+        f (TAp a b) vs = liftM2 TAp (f a vs) (f b vs)
+        f (TArrow a b) vs = liftM2 TArrow (f a vs) (f b vs)
+        f (TForAll as (ps :=> t)) vs = do
+            t' <- f t (vs List.\\ as)
+            return (TForAll as (ps :=> t'))
+        f t _ = error $ "boxySpec: " ++ show t
+    (t',vs) <- runWriterT (f t as)
+    addPreds $ inst (Map.fromList [ (tyvarAtom bt,s) | (bt,s) <- vs ]) ps
+    return (sortGroupUnderFG fst snd vs,t')
hunk ./FrontEnd/Tc/Type.hs 29
+isMetaTV :: Tyvar -> Bool
+isMetaTV Tyvar { tyvarRef = Just _ } = True
+isMetaTV _ = False
+
+
hunk ./FrontEnd/Tc/Unify.hs 28
-        r1 <- freshInstance fa
-        s1 `subsumes` r1
+        (_,r2) <- skolomize fa
+        --r1 <- freshInstance fa
+        s1 `subsumes` r2
hunk ./FrontEnd/Tc/Unify.hs 33
-    sub (TForAll as (_ :=> r1))  r2 | isRho' r2 = do
-        bs <- mapM (const $ newBox Star) as
-        inst (Map.fromList $ zip (map tyvarAtom as) (snds bs)) r1 `subsumes` r2
+    sub s1@(TForAll as (_ :=> _))  r2 | isRho' r2 = do
+        --r1' <- boxyInstantiate s1
+        (bs,r1') <- boxySpec s1
+        r1' `subsumes` r2
+        let f (_,bs) = do
+            bs' <- sequence [ openBox b >>= findType | ~TBox { typeBox = b } <- bs]
+            unifyList bs'
+        mapM_ f bs
+        --bs <- mapM (const $ newBox Star) as
+        --inst (Map.fromList $ zip (map tyvarAtom as) (snds bs)) r1 `subsumes` r2
hunk ./FrontEnd/Tc/Unify.hs 45
-    sub s1@TAp {} s2 = s1 `boxyMatch` s2
+    sub s1 s2 | (TCon _,_) <- fromTAp s1 = s1 `boxyMatch` s2
hunk ./FrontEnd/Tc/Unify.hs 64
-        _ -> fail $ "subsumes: " ++ show (a,b)
+        _ -> fail $ "subsumes failure: " ++ show (a,b)
hunk ./FrontEnd/Tc/Unify.hs 66
-    sub a b = fail $ "subsumes: " ++ show (a,b)
+    sub a b = fail $ "subsumes failure: " ++ show (a,b)
hunk ./FrontEnd/Tc/Unify.hs 107
-    bm a (TBox _ box) | (TCon ca,as) <- fromTAp a = do
-        bs <- mapM (const $ newBox Star) as
-        sequence_ [boxyMatch x y | x <- as | y <- snds bs]
+    bm a (TBox { typeBox = box }) | (TCon ca,as) <- fromTAp a = do
+        bs <- mapM (newBox . kind) as
+        a `boxyMatch` foldl TAp (TCon ca) (snds bs)
hunk ./FrontEnd/Tc/Unify.hs 148
+
+