Super-monster patch implementing the new typechecker -- at last

This major patch implements the new OutsideIn constraint solving
algorithm in the typecheker, following our JFP paper "Modular type
inference with local assumptions".  

Done with major help from Dimitrios Vytiniotis and Brent Yorgey.

7 files changed, 140 insertions, 130 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 75f31cac9a..557dfb47ff 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -293,6 +293,7 @@ data ExtensionFlag
    | Opt_MonomorphismRestriction
    | Opt_MonoPatBinds
    | Opt_MonoLocalBinds
+   | Opt_RelaxedPolyRec		-- Deprecated
    | Opt_ExtendedDefaultRules           -- Use GHC's extended rules for defaulting
    | Opt_ForeignFunctionInterface
    | Opt_UnliftedFFITypes
@@ -314,8 +315,6 @@ data ExtensionFlag
    | Opt_RecordPuns
    | Opt_ViewPatterns
    | Opt_GADTs
-   | Opt_OutsideIn
-   | Opt_RelaxedPolyRec		-- Deprecated
    | Opt_NPlusKPatterns
    | Opt_DoAndIfThenElse
 
@@ -731,26 +730,9 @@ defaultDynFlags =
         filesToClean   = panic "defaultDynFlags: No filesToClean",
         dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         haddockOptions = Nothing,
-        flags = [
-            Opt_AutoLinkPackages,
-            Opt_ReadUserPackageConf,
-
-            Opt_MethodSharing,
-
-            Opt_DoAsmMangling,
-
-            Opt_SharedImplib,
-
-            Opt_GenManifest,
-            Opt_EmbedManifest,
-            Opt_PrintBindContents
-            ]
-            ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
-                    -- The default -O0 options
-            ++ standardWarnings,
-
+        flags = defaultFlags,
         language = Nothing,
-        extensionFlags = Left [],
+        extensionFlags = Left defaultExtensionFlags,
 
         log_action = \severity srcSpan style msg ->
                         case severity of
@@ -1004,95 +986,6 @@ updOptLevel n dfs
    extra_dopts  = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ]
    remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ]
 
-optLevelFlags :: [([Int], DynFlag)]
-optLevelFlags
-  = [ ([0],     Opt_IgnoreInterfacePragmas)
-    , ([0],     Opt_OmitInterfacePragmas)
-
-    , ([1,2],   Opt_IgnoreAsserts)
-    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
-                                         --              in PrelRules
-    , ([1,2],   Opt_DoEtaReduction)
-    , ([1,2],   Opt_CaseMerge)
-    , ([1,2],   Opt_Strictness)
-    , ([1,2],   Opt_CSE)
-    , ([1,2],   Opt_FullLaziness)
-    , ([1,2],   Opt_Specialise)
-    , ([1,2],   Opt_FloatIn)
-
-    , ([2],     Opt_LiberateCase)
-    , ([2],     Opt_SpecConstr)
-    , ([2],     Opt_RegsGraph)
-
---     , ([2],     Opt_StaticArgumentTransformation)
--- Max writes: I think it's probably best not to enable SAT with -O2 for the
--- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
--- several improvements to the heuristics, and I'm concerned that without
--- those changes SAT will interfere with some attempts to write "high
--- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
--- this year. In particular, the version in HEAD lacks the tail call
--- criterion, so many things that look like reasonable loops will be
--- turned into functions with extra (unneccesary) thunk creation.
-
-    , ([0,1,2], Opt_DoLambdaEtaExpansion)
-                -- This one is important for a tiresome reason:
-                -- we want to make sure that the bindings for data
-                -- constructors are eta-expanded.  This is probably
-                -- a good thing anyway, but it seems fragile.
-    ]
-
--- -----------------------------------------------------------------------------
--- Standard sets of warning options
-
-standardWarnings :: [DynFlag]
-standardWarnings
-    = [ Opt_WarnWarningsDeprecations,
-        Opt_WarnDeprecatedFlags,
-        Opt_WarnUnrecognisedPragmas,
-        Opt_WarnOverlappingPatterns,
-        Opt_WarnMissingFields,
-        Opt_WarnMissingMethods,
-        Opt_WarnDuplicateExports,
-        Opt_WarnLazyUnliftedBindings,
-        Opt_WarnDodgyForeignImports,
-        Opt_WarnWrongDoBind,
-        Opt_WarnAlternativeLayoutRuleTransitional
-      ]
-
-minusWOpts :: [DynFlag]
-minusWOpts
-    = standardWarnings ++
-      [ Opt_WarnUnusedBinds,
-        Opt_WarnUnusedMatches,
-        Opt_WarnUnusedImports,
-        Opt_WarnIncompletePatterns,
-        Opt_WarnDodgyExports,
-        Opt_WarnDodgyImports
-      ]
-
-minusWallOpts :: [DynFlag]
-minusWallOpts
-    = minusWOpts ++
-      [ Opt_WarnTypeDefaults,
-        Opt_WarnNameShadowing,
-        Opt_WarnMissingSigs,
-        Opt_WarnHiShadows,
-        Opt_WarnOrphans,
-        Opt_WarnUnusedDoBind
-      ]
-
--- minuswRemovesOpts should be every warning option
-minuswRemovesOpts :: [DynFlag]
-minuswRemovesOpts
-    = minusWallOpts ++
-      [Opt_WarnImplicitPrelude,
-       Opt_WarnIncompletePatternsRecUpd,
-       Opt_WarnSimplePatterns,
-       Opt_WarnMonomorphism,
-       Opt_WarnUnrecognisedPragmas,
-       Opt_WarnTabs
-      ]
-
 -- -----------------------------------------------------------------------------
 -- StgToDo:  abstraction of stg-to-stg passes to run.
 
@@ -1558,8 +1451,7 @@ fFlags = [
   ( "warn-orphans",                     Opt_WarnOrphans, nop ),
   ( "warn-tabs",                        Opt_WarnTabs, nop ),
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, nop ),
-  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
-    \_ -> deprecate "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+  ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings, nop),
   ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, nop ),
   ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, nop ),
   ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ),
@@ -1746,6 +1638,31 @@ xFlags = [
     \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" )
   ]
 
+defaultFlags :: [DynFlag]
+defaultFlags 
+  = [ Opt_AutoLinkPackages,
+      Opt_ReadUserPackageConf,
+
+      Opt_MethodSharing,
+
+      Opt_DoAsmMangling,
+
+      Opt_SharedImplib,
+
+      Opt_GenManifest,
+      Opt_EmbedManifest,
+      Opt_PrintBindContents
+    ]
+
+    ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
+             -- The default -O0 options
+
+    ++ standardWarnings
+
+defaultExtensionFlags :: [OnOff ExtensionFlag]
+defaultExtensionFlags 
+  = []		-- In due course I'd like Opt_MonoLocalBinds to be on by default
+
 impliedFlags :: [(ExtensionFlag, ExtensionFlag)]
 impliedFlags
   = [ (Opt_RankNTypes,                Opt_ExplicitForAll)
@@ -1755,15 +1672,13 @@ impliedFlags
     , (Opt_ExistentialQuantification, Opt_ExplicitForAll)
     , (Opt_PolymorphicComponents,     Opt_ExplicitForAll)
 
-    , (Opt_GADTs,               Opt_OutsideIn)       -- We want type-sig variables to
-                                                     --      be completely rigid for GADTs
+    , (Opt_GADTs,                  Opt_MonoLocalBinds)
+    , (Opt_TypeFamilies,           Opt_MonoLocalBinds)
+    , (Opt_FunctionalDependencies, Opt_MonoLocalBinds)
 
-    , (Opt_TypeFamilies,        Opt_OutsideIn)       -- Trac #2944 gives a nice example
     , (Opt_TypeFamilies,        Opt_KindSignatures)  -- Type families use kind signatures
       						     -- all over the place
 
-    , (Opt_ScopedTypeVariables, Opt_OutsideIn)       -- Ditto for scoped type variables; see
-                                                     --      Note [Scoped tyvars] in TcBinds
     , (Opt_ImpredicativeTypes,  Opt_RankNTypes)
 
 	-- Record wild-cards implies field disambiguation
@@ -1773,6 +1688,95 @@ impliedFlags
     , (Opt_RecordWildCards,     Opt_DisambiguateRecordFields)
   ]
 
+optLevelFlags :: [([Int], DynFlag)]
+optLevelFlags
+  = [ ([0],     Opt_IgnoreInterfacePragmas)
+    , ([0],     Opt_OmitInterfacePragmas)
+
+    , ([1,2],   Opt_IgnoreAsserts)
+    , ([1,2],   Opt_EnableRewriteRules)  -- Off for -O0; see Note [Scoping for Builtin rules]
+                                         --              in PrelRules
+    , ([1,2],   Opt_DoEtaReduction)
+    , ([1,2],   Opt_CaseMerge)
+    , ([1,2],   Opt_Strictness)
+    , ([1,2],   Opt_CSE)
+    , ([1,2],   Opt_FullLaziness)
+    , ([1,2],   Opt_Specialise)
+    , ([1,2],   Opt_FloatIn)
+
+    , ([2],     Opt_LiberateCase)
+    , ([2],     Opt_SpecConstr)
+    , ([2],     Opt_RegsGraph)
+
+--     , ([2],     Opt_StaticArgumentTransformation)
+-- Max writes: I think it's probably best not to enable SAT with -O2 for the
+-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate
+-- several improvements to the heuristics, and I'm concerned that without
+-- those changes SAT will interfere with some attempts to write "high
+-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier
+-- this year. In particular, the version in HEAD lacks the tail call
+-- criterion, so many things that look like reasonable loops will be
+-- turned into functions with extra (unneccesary) thunk creation.
+
+    , ([0,1,2], Opt_DoLambdaEtaExpansion)
+                -- This one is important for a tiresome reason:
+                -- we want to make sure that the bindings for data
+                -- constructors are eta-expanded.  This is probably
+                -- a good thing anyway, but it seems fragile.
+    ]
+
+-- -----------------------------------------------------------------------------
+-- Standard sets of warning options
+
+standardWarnings :: [DynFlag]
+standardWarnings
+    = [ Opt_WarnWarningsDeprecations,
+        Opt_WarnDeprecatedFlags,
+        Opt_WarnUnrecognisedPragmas,
+        Opt_WarnOverlappingPatterns,
+        Opt_WarnMissingFields,
+        Opt_WarnMissingMethods,
+        Opt_WarnDuplicateExports,
+        Opt_WarnLazyUnliftedBindings,
+        Opt_WarnDodgyForeignImports,
+        Opt_WarnWrongDoBind,
+        Opt_WarnAlternativeLayoutRuleTransitional
+      ]
+
+minusWOpts :: [DynFlag]
+minusWOpts
+    = standardWarnings ++
+      [ Opt_WarnUnusedBinds,
+        Opt_WarnUnusedMatches,
+        Opt_WarnUnusedImports,
+        Opt_WarnIncompletePatterns,
+        Opt_WarnDodgyExports,
+        Opt_WarnDodgyImports
+      ]
+
+minusWallOpts :: [DynFlag]
+minusWallOpts
+    = minusWOpts ++
+      [ Opt_WarnTypeDefaults,
+        Opt_WarnNameShadowing,
+        Opt_WarnMissingSigs,
+        Opt_WarnHiShadows,
+        Opt_WarnOrphans,
+        Opt_WarnUnusedDoBind
+      ]
+
+-- minuswRemovesOpts should be every warning option
+minuswRemovesOpts :: [DynFlag]
+minuswRemovesOpts
+    = minusWallOpts ++
+      [Opt_WarnImplicitPrelude,
+       Opt_WarnIncompletePatternsRecUpd,
+       Opt_WarnSimplePatterns,
+       Opt_WarnMonomorphism,
+       Opt_WarnUnrecognisedPragmas,
+       Opt_WarnTabs
+      ]
+
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
                        mapM_ setExtensionFlag glasgowExtsFlags
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 5dfa76c8d4..92345c7314 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -148,7 +148,7 @@ module GHC (
 	TyCon, 
 	tyConTyVars, tyConDataCons, tyConArity,
 	isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
-	isOpenTyCon,
+	isFamilyTyCon,
 	synTyConDefn, synTyConType, synTyConResKind,
 
 	-- ** Type variables
@@ -247,7 +247,7 @@ import InteractiveEval
 
 import TcRnDriver
 import TcIface
-import TcRnTypes        hiding (LIE)
+import TcRnTypes
 import TcRnMonad        ( initIfaceCheck )
 import Packages
 import NameSet
@@ -255,6 +255,7 @@ import RdrName
 import qualified HsSyn -- hack as we want to reexport the whole module
 import HsSyn hiding ((<.>))
 import Type
+import Coercion		( synTyConResKind )
 import TcType		hiding( typeKind )
 import Id
 import Var
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 156a04e0a6..5c41f68e85 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -129,7 +129,7 @@ import Id
 import Type		
 
 import Annotations
-import Class		( Class, classSelIds, classATs, classTyCon )
+import Class		( Class, classAllSelIds, classATs, classTyCon )
 import TyCon
 import DataCon		( DataCon, dataConImplicitIds, dataConWrapId )
 import PrelNames	( gHC_PRIM )
@@ -1333,7 +1333,7 @@ implicitTyThings (AClass cl)
     --    are only the family decls; they have no implicit things
     map ATyCon (classATs cl) ++
     -- superclass and operation selectors
-    map AnId (classSelIds cl)
+    map AnId (classAllSelIds cl)
 
 implicitTyThings (ADataCon dc) = 
     -- For data cons add the worker and (possibly) wrapper
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index b10a31defe..d859784fad 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -112,7 +112,7 @@ pprTyConHdr _ tyCon
             | otherwise            = sLit "data"
 
     opt_family
-      | GHC.isOpenTyCon tyCon = ptext (sLit "family")
+      | GHC.isFamilyTyCon tyCon = ptext (sLit "family")
       | otherwise             = empty
 
     opt_stupid 	-- The "stupid theta" part of the declaration
@@ -149,15 +149,15 @@ pprTypeForUser :: PrintExplicitForalls -> GHC.Type -> SDoc
 --	(C a, Ord b) => stuff
 pprTypeForUser print_foralls ty 
   | print_foralls = ppr tidy_ty
-  | otherwise     = ppr (mkPhiTy [p | (_tvs, ps) <- ctxt, p <- ps] ty')
+  | otherwise     = ppr (mkPhiTy ctxt ty')
   where
     tidy_ty     = tidyTopType ty
-    (ctxt, ty') = tcMultiSplitSigmaTy tidy_ty
+    (_, ctxt, ty') = tcSplitSigmaTy tidy_ty
 
 pprTyCon :: PrintExplicitForalls -> ShowMe -> TyCon -> SDoc
 pprTyCon pefas show_me tyCon
   | GHC.isSynTyCon tyCon
-  = if GHC.isOpenTyCon tyCon
+  = if GHC.isFamilyTyCon tyCon
     then pprTyConHdr pefas tyCon <+> dcolon <+> 
 	 pprTypeForUser pefas (GHC.synTyConResKind tyCon)
     else 
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 143d81e52e..6536a13c49 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -127,6 +127,7 @@ static_flags = [
   , Flag "dsuppress-module-prefixes" (PassFlag addOpt)
   , Flag "dppr-user-length"          (AnySuffix addOpt)
   , Flag "dopt-fuel"                 (AnySuffix addOpt)
+  , Flag "dtrace-level"              (AnySuffix addOpt)
   , Flag "dno-debug-output"          (PassFlag addOpt)
   , Flag "dstub-dead-values"         (PassFlag addOpt)
       -- rest of the debugging flags are dynamic
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 752c516ac4..a8e35516ad 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -24,7 +24,7 @@ module StaticFlags (
 	opt_SuppressUniques,
         opt_SuppressCoercions,
 	opt_SuppressModulePrefixes,
-	opt_PprStyle_Debug,
+	opt_PprStyle_Debug, opt_TraceLevel,
         opt_NoDebugOutput,
 
 	-- profiling opts
@@ -193,7 +193,11 @@ opt_SuppressModulePrefixes :: Bool
 opt_SuppressModulePrefixes	= lookUp  (fsLit "-dsuppress-module-prefixes")
 
 opt_PprStyle_Debug  :: Bool
-opt_PprStyle_Debug		= lookUp  (fsLit "-dppr-debug")
+opt_PprStyle_Debug              = lookUp  (fsLit "-dppr-debug")
+
+opt_TraceLevel :: Int
+opt_TraceLevel = lookup_def_int "-dtrace-level" 1  	-- Standard level is 1
+	       	 			    	        -- Less verbose is 0
 
 opt_PprUserLength   :: Int
 opt_PprUserLength	        = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 6a0a2cfcde..8ce4dcda5c 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -20,7 +20,7 @@ import CoreMonad
 import CoreUtils
 import Rules
 import CoreArity	( exprArity, exprBotStrictness_maybe )
-import Class		( classSelIds )
+import Class		( classAllSelIds )
 import VarEnv
 import VarSet
 import Var
@@ -454,7 +454,7 @@ mustExposeTyCon exports tc
   | isEnumerationTyCon tc	-- For an enumeration, exposing the constructors
   = True			-- won't lead to the need for further exposure
 				-- (This includes data types with no constructors.)
-  | isOpenTyCon tc		-- Open type family
+  | isFamilyTyCon tc		-- Open type family
   = True
 
   | otherwise			-- Newtype, datatype
@@ -560,7 +560,7 @@ getImplicitBinds type_env
   = map get_defn (concatMap implicit_ids (typeEnvElts type_env))
   where
     implicit_ids (ATyCon tc)  = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
-    implicit_ids (AClass cls) = classSelIds cls
+    implicit_ids (AClass cls) = classAllSelIds cls
     implicit_ids _            = []
     
     get_defn :: Id -> CoreBind