From: simonpj <unknown>
Date: Fri, 8 Dec 2000 09:45:42 +0000 (+0000)
Subject: [project @ 2000-12-08 09:45:41 by simonpj]
X-Git-Tag: Approximately_9120_patches~3167
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=dead48b49a68659a3bd7f5327a7001336ca0cc1e;p=ghc-hetmet.git

[project @ 2000-12-08 09:45:41 by simonpj]
Add -fno-monomorphism-restriction
---

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 335e8a9..cf5fdeb 100644
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -51,6 +51,7 @@ module CmdLineOpts (
 	opt_NumbersStrict,
 	opt_Parallel,
 	opt_SMP,
+	opt_NoMonomorphismRestriction,
 
 	-- optimisation opts
 	opt_DoSemiTagging,
@@ -405,6 +406,7 @@ 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/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
index 9c2401e..3613f57 100644
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ b/ghc/compiler/typecheck/TcBinds.lhs
@@ -12,6 +12,7 @@ module TcBinds ( tcBindsAndThen, tcTopBinds,
 import {-# SOURCE #-} TcMatches ( tcGRHSs, tcMatchesFun )
 import {-# SOURCE #-} TcExpr  ( tcExpr )
 
+import CmdLineOpts	( opt_NoMonomorphismRestriction )
 import HsSyn		( HsExpr(..), HsBinds(..), MonoBinds(..), Sig(..), StmtCtxt(..),
 			  Match(..), collectMonoBinders, andMonoBinds
 			)
@@ -428,7 +429,8 @@ tcBindWithSigs top_lvl mbind tc_ty_sigs inline_sigs is_rec
     )
   where
     tysig_names     = [name | (TySigInfo name _ _ _ _ _ _ _) <- tc_ty_sigs]
-    is_unrestricted = isUnRestrictedGroup tysig_names mbind
+    is_unrestricted | opt_NoMonomorphismRestriction = True
+		    | otherwise			    = isUnRestrictedGroup tysig_names mbind
 
 justPatBindings bind@(PatMonoBind _ _ _) binds = bind `andMonoBinds` binds
 justPatBindings (AndMonoBinds b1 b2) binds =