[let algorithm look inside boxes.
John Meacham <john@repetae.net>**20051211122942] hunk ./FrontEnd/KindInfer.hs 32
+import FrontEnd.Tc.Type(Sigma())
+import FrontEnd.Utils
+import GenUtil
hunk ./FrontEnd/KindInfer.hs 43
-import FrontEnd.Utils
-import GenUtil
hunk ./FrontEnd/Representation.hs 34
-    tList,
-    Sigma,
-    Rho,
-    Tau
+    tList
hunk ./FrontEnd/Representation.hs 67
-           | TForAll { typeArgs :: [Tyvar], typeBody :: (Qual Rho) }
-           | TBox { typeKind :: Kind, typeSeq :: !Int, typeBox :: IORef Type }     -- ^ used only in typechecker
+           | TForAll { typeArgs :: [Tyvar], typeBody :: (Qual Type) }
+           | TBox { typeKind :: Kind, typeSeq :: !Int, typeBox :: IORef (Maybe Type) }     -- ^ used only in typechecker
hunk ./FrontEnd/Representation.hs 72
-type Sigma = Type
-type Rho = Type
-type Tau = Type
hunk ./FrontEnd/Representation.hs 161
-            ft (TBox _ _ box) = do
-                readIORef box
+            --ft (TBox _ _ box) = do
+            --    readIORef box
+            ft TBox {} = error "odd box"
hunk ./FrontEnd/Tc/Main.hs 41
-    e' <- tiExpr e (foldr fn typ (snds bs))
-    rs <- sequence (fsts bs)
-    as' <- sequence [ tiExprPoly a r | r <- rs | a <- as ]
+    e' <- tiExpr e (foldr fn typ bs)
+    as' <- sequence [ tiExprPoly a r | r <- bs | a <- as ]
hunk ./FrontEnd/Tc/Main.hs 48
-    (br,bt) <- newBox Star
+    bt <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 50
-    t <- br
-    e2 <- tiExprPoly e2 t  -- TODO Poly
+    e2 <- tiExprPoly e2 bt  -- TODO Poly
hunk ./FrontEnd/Tc/Main.hs 145
-            (rs1,b1) <- newBox Star
-            (rs2,b2) <- newBox Star
+            b1 <- newBox Star
+            b2 <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 148
-            s1 <- rs1
-            s2 <- rs2
-            fillBox box (s1 `fn` s2)
+            fillBox box (b1 `fn` b2)
hunk ./FrontEnd/Tc/Main.hs 151
-            (br,box) <- newBox Star
+            box <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 153
-            s1 <- br
-            (p',env) <- tiPat p s1
+            (p',env) <- tiPat p box
hunk ./FrontEnd/Tc/Main.hs 182
-        v <- newTVar Star
-        --(_,box) <- newBox Star
+        v <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 188
-        v <- newTVar Star
+        --v <- newTVar Star
+        v <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 201
+{-
hunk ./FrontEnd/Tc/Main.hs 216
-
+-}
hunk ./FrontEnd/Tc/Main.hs 225
-        v <- newTVar Star
-        --(_,v) <- newBox Star
+        --v <- newTVar Star
+        (v) <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 974
-        (_,v) <- newBox Star
+        (v) <- newBox Star
hunk ./FrontEnd/Tc/Main.hs 980
-        (_,v) <- newBox Star
+        (v) <- newBox Star
hunk ./FrontEnd/Tc/Monad.hs 35
+import Maybe
hunk ./FrontEnd/Tc/Monad.hs 149
-newBox :: Kind -> Tc (Tc Type,Type)
+newBox :: Kind -> Tc Type
hunk ./FrontEnd/Tc/Monad.hs 152
-    r <- liftIO $ newIORef (error "empty box")
-    return (liftIO $ readIORef r >>= flattenMetaVars, TBox k u r)
+    r <- liftIO $ newIORef Nothing
+    return (TBox k u r)
hunk ./FrontEnd/Tc/Monad.hs 258
-        let mp = Map.fromList $ zip (map tyvarAtom as) (snds bs)
+        let mp = Map.fromList $ zip (map tyvarAtom as) bs
hunk ./FrontEnd/Tc/Monad.hs 267
-            (_,b) <- lift (newBox $ tyvarKind t)
+            b <- lift (newBox $ tyvarKind t)
hunk ./FrontEnd/Tc/Type.hs 26
-import Representation
+import Representation hiding(flattenType)
hunk ./FrontEnd/Tc/Type.hs 33
-type Box = IORef Type
+type Box = IORef (Maybe Type)
hunk ./FrontEnd/Tc/Type.hs 37
+type Sigma = Type
+type Rho = Type
+type Tau = Type
hunk ./FrontEnd/Tc/Type.hs 50
-openBox :: MonadIO m => Box -> m Sigma
+openBox :: MonadIO m => Box -> m (Maybe Sigma)
hunk ./FrontEnd/Tc/Type.hs 54
-fillBox x t | not (isBoxy t) = liftIO $ writeIORef x t
+fillBox x t  = liftIO $ do
+    t <- flattenType t
+    when (isBoxy t) $ error "filling with boxes"
+    ct <- readIORef x
+    case ct of
+        Just _ -> fail "box is already filled"
+        Nothing -> writeIORef x (Just t)
hunk ./FrontEnd/Tc/Type.hs 179
-                | openBoxes opt =  readIORef box >>= unVar' opt
+                | openBoxes opt =  readIORef box >>= \x -> case x of
+                    Just x -> unVar' opt x
+                    Nothing -> error "unVar: empty box"
hunk ./FrontEnd/Tc/Unify.hs 15
+aquireType :: Sigma' -> Tc Sigma'
+aquireType s = do
+    s <- findType s
+    case s of
+        TBox { typeBox = box } -> do
+            r <- openBox box
+            case r of
+                Just t -> aquireType t
+                Nothing -> return s
+        _ -> return s
+
+
hunk ./FrontEnd/Tc/Unify.hs 29
-    s1 <- findType s1
-    s2 <- findType s2
+    s1 <- aquireType s1
+    s2 <- aquireType s2
hunk ./FrontEnd/Tc/Unify.hs 66
-        --r1' <- boxyInstantiate s1
-        (bs,r1') <- boxySpec s1
+        r1' <- boxyInstantiate s1
+        --(bs,r1') <- boxySpec s1
hunk ./FrontEnd/Tc/Unify.hs 69
-        let f (_,bs) = do
-            bs' <- sequence [ openBox b >>= findType | ~TBox { typeBox = b } <- bs]
-            unifyList bs'
-        mapM_ f bs
+--        let f (_,bs) = do
+--            bs' <- sequence [ openBox b >>= findType | ~TBox { typeBox = b } <- bs]
+--            unifyList bs'
+--        mapM_ f bs
hunk ./FrontEnd/Tc/Unify.hs 85
-        (oa,a) <- newBox (kind s1)
-        (ob,b) <- newBox (kind s2)
+        a <- newBox (kind s1)
+        b <- newBox (kind s2)
hunk ./FrontEnd/Tc/Unify.hs 88
-        na <- oa
-        nb <- ob
-        fillBox box (na `fn` nb)
+        fillBox box (a `fn` b)
hunk ./FrontEnd/Tc/Unify.hs 102
-    s1 <- findType s1
-    s2 <- findType s2
+    s1 <- aquireType s1
+    s2 <- aquireType s2
hunk ./FrontEnd/Tc/Unify.hs 122
-        (ra,a) <- newBox Star
-        (rb,b) <- newBox Star
+        a <- newBox (kind s1)
+        b <- newBox (kind s2)
hunk ./FrontEnd/Tc/Unify.hs 125
-        x <- ra
-        y <- rb
-        fillBox box (x `fn` y)
+        fillBox box (a `fn` b)
hunk ./FrontEnd/Tc/Unify.hs 138
-        a `boxyMatch` foldl TAp (TCon ca) (snds bs)
-        bs <- sequence $ fsts bs
+        a `boxyMatch` foldl TAp (TCon ca) bs
hunk ./FrontEnd/Tc/Unify.hs 155
-        (ra,a) <- newBox k
+        a <- newBox k
hunk ./FrontEnd/Tc/Unify.hs 157
-        a <- ra >>= findType
hunk ./Interactive.hs 223
-    (rbox,box) <- newBox Star
+    box <- newBox Star
hunk ./Interactive.hs 226
-    vv <- rbox
hunk ./Interactive.hs 227
-    (ps :=> vv) <- flattenType (ps :=> vv)
+    (ps :=> vv) <- flattenType (ps :=> box)