Commit 893a774d authored by simonmar's avatar simonmar
Browse files

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

Convert -fno-monomorphism-restriction into a dynamic flag.  Fixes bug
#508177.
parent f26fd000
......@@ -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
......
{-# 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)) )
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment