[project @ 2002-01-25 10:28:12 by simonmar]

Convert -fno-monomorphism-restriction into a dynamic flag.  Fixes bug
#508177.

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 529bbae..e6fadc0 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -66,7 +66,6 @@ module CmdLineOpts (
        opt_NumbersStrict,
        opt_Parallel,
        opt_SMP,
-       opt_NoMonomorphismRestriction,
        opt_RuntimeTypes,
 
        -- optimisation opts
@@ -286,6 +285,7 @@ data DynFlag
    | Opt_AllowOverlappingInstances
    | Opt_AllowUndecidableInstances
    | Opt_AllowIncoherentInstances
+   | Opt_NoMonomorphismRestriction
    | Opt_GlasgowExts
    | Opt_Generics
    | Opt_NoImplicitPrelude 
@@ -559,7 +559,6 @@ opt_DoTickyProfiling                = lookUp  SLIT("-fticky-ticky")
 
 -- language opts
 opt_AllStrict                  = lookUp  SLIT("-fall-strict")
-opt_NoMonomorphismRestriction  = lookUp  SLIT("-fno-monomorphism-restriction")
 opt_DictsStrict                        = lookUp  SLIT("-fdicts-strict")
 opt_IrrefutableTuples          = lookUp  SLIT("-firrefutable-tuples")
 opt_MaxContextReductionDepth   = lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH

diff --git a/ghc/compiler/main/DriverFlags.hs b/ghc/compiler/main/DriverFlags.hs
index 8927080..a507e8f 100644 (file)
--- a/ghc/compiler/main/DriverFlags.hs
+++ b/ghc/compiler/main/DriverFlags.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -#include "hschooks.h" #-}
 
 -----------------------------------------------------------------------------
--- $Id: DriverFlags.hs,v 1.84 2002/01/04 16:02:04 simonmar Exp $
+-- $Id: DriverFlags.hs,v 1.85 2002/01/25 10:28:14 simonmar Exp $
 --
 -- Driver flags
 --
@@ -418,6 +418,8 @@ dynamic_flags = [
 
        -- "active negatives"
   ,  ( "fno-implicit-prelude",  NoArg (setDynFlag Opt_NoImplicitPrelude) )
+  ,  ( "fno-monomorphism-restriction", 
+                       NoArg (setDynFlag Opt_NoMonomorphismRestriction) )
 
        -- the rest of the -f* and -fno-* flags
   ,  ( "fno-",                 PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )

diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 35f3923..8dad853 100644 (file)
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -12,7 +12,7 @@ module TcBinds ( tcBindsAndThen, tcTopBinds,
 import {-# SOURCE #-} TcMatches ( tcGRHSs, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcExpr )
 
-import CmdLineOpts     ( opt_NoMonomorphismRestriction )
+import CmdLineOpts     ( DynFlag(Opt_NoMonomorphismRestriction) )
 import HsSyn           ( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), 
                          Match(..), HsMatchContext(..), 
                          collectMonoBinders, andMonoBinds,
@@ -412,9 +412,16 @@ is doing.
 %************************************************************************
 
 \begin{code}
-generalise binder_names mbind tau_tvs lie_req sigs
-  | not is_unrestricted        -- RESTRICTED CASE
-  =    -- Check signature contexts are empty 
+generalise binder_names mbind tau_tvs lie_req sigs =
+
+  -- check for -fno-monomorphism-restriction
+  doptsTc Opt_NoMonomorphismRestriction                `thenTc` \ no_MR ->
+  let is_unrestricted | no_MR    = True
+                     | otherwise = isUnRestrictedGroup tysig_names mbind
+  in
+
+  if not is_unrestricted then  -- RESTRICTED CASE
+       -- Check signature contexts are empty 
     checkTc (all is_mono_sig sigs)
            (restrictedBindCtxtErr binder_names)        `thenTc_`
 
@@ -427,13 +434,13 @@ generalise binder_names mbind tau_tvs lie_req sigs
 
     returnTc (qtvs, lie_free, binds, [])
 
-  | null sigs                  -- UNRESTRICTED CASE, NO TYPE SIGS
-  = tcSimplifyInfer doc tau_tvs lie_req
+  else if null sigs then       -- UNRESTRICTED CASE, NO TYPE SIGS
+    tcSimplifyInfer doc tau_tvs lie_req
 
-  | otherwise                  -- UNRESTRICTED CASE, WITH TYPE SIGS
-  =    -- CHECKING CASE: Unrestricted group, there are type signatures
+  else                                 -- UNRESTRICTED CASE, WITH TYPE SIGS
+       -- CHECKING CASE: Unrestricted group, there are type signatures
        -- Check signature contexts are empty 
-    checkSigsCtxts sigs                                `thenTc` \ (sig_avails, sig_dicts) ->
+    checkSigsCtxts sigs                        `thenTc` \ (sig_avails, sig_dicts) ->
     
        -- Check that the needed dicts can be
        -- expressed in terms of the signature ones
@@ -445,9 +452,6 @@ generalise binder_names mbind tau_tvs lie_req sigs
     returnTc (forall_tvs, lie_free, dict_binds, sig_dicts)
 
   where
-    is_unrestricted | opt_NoMonomorphismRestriction = True
-                   | otherwise                     = isUnRestrictedGroup tysig_names mbind
-
     tysig_names = [name | (TySigInfo name _ _ _ _ _ _ _) <- sigs]
     is_mono_sig (TySigInfo _ _ _ theta _ _ _ _) = null theta