[don't print so much debugging info when boxy type infering, make E.FromHs handle a few new cases
John Meacham <john@repetae.net>**20060212152431] hunk ./E/FromHs.hs 125
-    Identity (Forall _ (_ :=> t)) = Map.lookup n assumps -- getAssump n
+    (Forall _ (_ :=> t)) = case Map.lookup n assumps of
+        Just z -> z
+        Nothing -> error $ "convertVal.Lookup failed: " ++ (show n)
hunk ./FlagDump.flags 28
+boxy-steps show step by step what the type inferencer is doing
hunk ./FrontEnd/Tc/Main.hs 5
+import IO(hFlush,stdout)
hunk ./FrontEnd/Tc/Main.hs 386
-    liftIO $ putStrLn $ "tiimpls " ++ show (map getDeclName bs)
+    --liftIO $ putStrLn $ "tiimpls " ++ show (map getDeclName bs)
hunk ./FrontEnd/Tc/Main.hs 390
-            liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
+            --liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
hunk ./FrontEnd/Tc/Main.hs 392
-            liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
+            --liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
hunk ./FrontEnd/Tc/Main.hs 394
-            liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
+            --liftIO $ putStrLn $ "*** " ++ show n ++ " :: " ++ prettyPrintType s
hunk ./FrontEnd/Tc/Main.hs 426
+tcPragmaDecl fd@(HsForeignDecl _ _ _ n qt) = do
+    kt <- getKindEnv
+    s <- hsQualTypeToSigma kt qt
+    addToCollectedEnv (Map.singleton (toName Val n) s)
+    return [fd]
+
+tcPragmaDecl _ = return []
+
hunk ./FrontEnd/Tc/Main.hs 500
-    liftIO $ putStrLn $ "** typing expl: " ++ show (getDeclName decl) ++ " " ++ prettyPrintType sc
+    --liftIO $ putStrLn $ "** typing expl: " ++ show (getDeclName decl) ++ " " ++ prettyPrintType sc
hunk ./FrontEnd/Tc/Main.hs 744
+        liftIO $ do
+            putChar '.'
+            hFlush stdout
hunk ./FrontEnd/Tc/Main.hs 749
-        mapM_ tcPragmaDecl (filter isHsPragmaRules es)
+        mapM_ tcPragmaDecl es
+        liftIO $ putStrLn "!"
hunk ./FrontEnd/Tc/Monad.hs 296
-    liftIO $ mapM_ (putStrLn . pprint) (Set.toList fmvenv)
+    -- liftIO $ mapM_ (putStrLn . pprint) (Set.toList fmvenv)
hunk ./FrontEnd/Tc/Monad.hs 357
-                putStrLn $ "varBind: " ++ pprint u <+> prettyPrintType t
+                --putStrLn $ "varBind: " ++ pprint u <+> prettyPrintType t
hunk ./FrontEnd/Tc/Type.hs 162
+    f tv = return $ atom $ parens $ text ("FrontEnd.Tc.Type.pp: " ++ show tv)
hunk ./FrontEnd/Tc/Unify.hs 11
+import Options
+import qualified FlagDump as FD
hunk ./FrontEnd/Tc/Unify.hs 24
-    --s1 <- findType s1
-    --s2 <- findType s2
-    (s1,_,_) <- unbox s1
-    (s2,_,_) <- unbox s2
-    liftIO $ putStrLn $ "subsumes: " <> ppretty s1 <+> ppretty s2
+    (s1,s2) <- if dump FD.BoxySteps then do
+        (s1,_,_) <- unbox s1
+        (s2,_,_) <- unbox s2
+        return (s1,s2)
+      else do
+        s1 <- findType s1
+        s2 <- findType s2
+        return (s1,s2)
+    printRule $ "subsumes: " <> ppretty s1 <+> ppretty s2
hunk ./FrontEnd/Tc/Unify.hs 77
-printRule s = liftIO $ putStrLn s
+printRule s
+    | dump FD.BoxySteps = liftIO $ putStrLn s
+    | otherwise = return ()
+
hunk ./FrontEnd/Tc/Unify.hs 85
-    --s1 <- findType s1
-    --s2 <- findType s2
-    (s1,_,_) <- unbox s1
-    (s2,_,_) <- unbox s2
-    liftIO $ putStrLn $ "boxyMatch: " <> ppretty s1 <+> ppretty s2
+    (s1,s2) <- if dump FD.BoxySteps then do
+        (s1,_,_) <- unbox s1
+        (s2,_,_) <- unbox s2
+        return (s1,s2)
+      else do
+        s1 <- findType s1
+        s2 <- findType s2
+        return (s1,s2)
+    printRule $ "boxyMatch: " <> ppretty s1 <+> ppretty s2
hunk ./FrontEnd/Tc/Unify.hs 98
-        liftIO $ putStrLn $ "boxyMatch: " <> ppretty s2 <+> ppretty s1
+        printRule $ "boxyMatch: " <> ppretty s2 <+> ppretty s1
hunk ./FrontEnd/Tc/Unify.hs 211
-    liftIO $ putStrLn $ "unify: " <> ppretty t1 <+> ppretty t2
+    printRule $ "unify: " <> ppretty t1 <+> ppretty t2