Add -fwarn-monomorphism-restriction (on by default) to warn when the MR is used

[ghc-hetmet.git] / compiler / typecheck / TcSimplify.lhs

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index b4b0b73..911e2ff 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -1202,9 +1202,22 @@ tcSimplifyRestricted doc top_lvl bndrs tau_tvs wanteds
        ; gbl_tvs' <- tcGetGlobalTyVars
        ; constrained_dicts' <- mappM zonkInst constrained_dicts
 
-       ; let constrained_tvs' = tyVarsOfInsts constrained_dicts'
-             qtvs = (tau_tvs' `minusVarSet` oclose (fdPredsOfInsts constrained_dicts) gbl_tvs')
-                        `minusVarSet` constrained_tvs'
+       ; let qtvs1 = tau_tvs' `minusVarSet` oclose (fdPredsOfInsts constrained_dicts) gbl_tvs'
+                               -- As in tcSimplifyInfer
+
+               -- Do not quantify over constrained type variables:
+               -- this is the monomorphism restriction
+             constrained_tvs' = tyVarsOfInsts constrained_dicts'
+             qtvs = qtvs1 `minusVarSet` constrained_tvs'
+             pp_bndrs = pprWithCommas (quotes . ppr) bndrs
+
+       -- Warn in the mono
+       ; warn_mono <- doptM Opt_WarnMonomorphism
+       ; warnTc (warn_mono && (constrained_tvs' `intersectsVarSet` qtvs1))
+                (vcat[ ptext SLIT("the Monomorphism Restriction applies to the binding")
+                               <> plural bndrs <+> ptext SLIT("for") <+> pp_bndrs,
+                       ptext SLIT("Consider giving a type signature for") <+> pp_bndrs])
+
        ; traceTc (text "tcSimplifyRestricted" <+> vcat [
                pprInsts wanteds, pprInsts constrained_dicts',
                ppr _binds,
@@ -2252,17 +2265,7 @@ disambiguate interactive dflags insts
        ;     return () }
   | otherwise
   = do         {       -- Figure out what default types to use
-         mb_defaults <- getDefaultTys
-       ; default_tys <- case mb_defaults of
-                          Just tys -> return tys
-                          Nothing  ->  -- No use-supplied default;
-                                       -- use [Integer, Double]
-                               do { integer_ty <- tcMetaTy integerTyConName
-                                  ; checkWiredInTyCon doubleTyCon
-                                  ; string_ty <- tcMetaTy stringTyConName
-                                  ; if ovl_strings     -- Add String if -foverloaded-strings
-                                       then return [integer_ty,doubleTy,string_ty] 
-                                       else return [integer_ty,doubleTy] }
+       ; default_tys <- getDefaultTys extended_defaulting ovl_strings
 
        ; traceTc (text "disambigutate" <+> vcat [ppr unaries, ppr bad_tvs, ppr defaultable_groups])
        ; mapM_ (disambigGroup default_tys) defaultable_groups  }
@@ -2325,8 +2328,43 @@ disambigGroup default_tys dicts
                -- After this we can't fail
           ; warnDefault dicts default_ty
           ; unifyType default_ty (mkTyVarTy tyvar) }
+
+
+getDefaultTys :: Bool -> Bool -> TcM [Type]
+getDefaultTys extended_deflts ovl_strings
+  = do { mb_defaults <- getDeclaredDefaultTys
+       ; case mb_defaults of {
+          Just tys -> return tys ;     -- User-supplied defaults
+          Nothing  -> do
+
+       -- No use-supplied default
+       -- Use [Integer, Double], plus modifications
+       { integer_ty <- tcMetaTy integerTyConName
+       ; checkWiredInTyCon doubleTyCon
+       ; string_ty <- tcMetaTy stringTyConName
+       ; return (opt_deflt extended_deflts unitTy
+                       -- Note [Default unitTy]
+                       ++
+                 [integer_ty,doubleTy]
+                       ++
+                 opt_deflt ovl_strings string_ty) } } }
+  where
+    opt_deflt True  ty = [ty]
+    opt_deflt False ty = []
 \end{code}
 
+Note [Default unitTy]
+~~~~~~~~~~~~~~~~~~~~~
+In interative mode (or with -fextended-default-rules) we add () as the first type we
+try when defaulting.  This has very little real impact, except in the following case.
+Consider: 
+       Text.Printf.printf "hello"
+This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
+want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
+default the 'a' to (), rather than to Integer (which is what would otherwise happen;
+and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
+() to the list of defaulting types.  See Trac #1200.
+
 Note [Avoiding spurious errors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 When doing the unification for defaulting, we check for skolem