Commit 903831d5 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Implement -XMonoLocalBinds: a radical new flag

The new flag -XMonoLocalBinds tells GHC not to generalise nested
bindings in let or where clauses, unless there is a type signature,
in which case we use it.  

I'm thinking about whether this might actually be a good direction for
Haskell go to in, although it seems pretty radical.  Anyway, the flag
is easy to implement (look at how few lines change), and having it
will allow us to experiement with and without.

Just for the record, below are the changes required in the boot 
libraries -- ie the places where.  Not quite as minimal as I'd hoped,
but the changes fall into a few standard patterns, and most represent
(in my opinion) sytlistic improvements.  I will not push these patches,
however.

== running darcs what -s --repodir libraries/base
M ./Control/Arrow.hs -2 +4
M ./Data/Data.hs -7 +22
M ./System/IO/Error.hs +1
M ./Text/ParserCombinators/ReadP.hs +1
== running darcs what -s --repodir libraries/bytestring
M ./Data/ByteString/Char8.hs -1 +2
M ./Data/ByteString/Unsafe.hs +1
== running darcs what -s --repodir libraries/Cabal
M ./Distribution/PackageDescription.hs -2 +6
M ./Distribution/PackageDescription/Check.hs +3
M ./Distribution/PackageDescription/Configuration.hs -1 +3
M ./Distribution/ParseUtils.hs -2 +4
M ./Distribution/Simple/Command.hs -1 +4
M ./Distribution/Simple/Setup.hs -12 +24
M ./Distribution/Simple/UserHooks.hs -1 +5
== running darcs what -s --repodir libraries/containers
M ./Data/IntMap.hs -2 +2
== running darcs what -s --repodir libraries/dph
M ./dph-base/Data/Array/Parallel/Arr/BBArr.hs -1 +3
M ./dph-base/Data/Array/Parallel/Arr/BUArr.hs -2 +4
M ./dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Arrays.hs -6 +10
M ./dph-prim-par/Data/Array/Parallel/Unlifted/Distributed/Combinators.hs -3 +6
M ./dph-prim-seq/Data/Array/Parallel/Unlifted/Sequential/Flat/Permute.hs -2 +4
== running darcs what -s --repodir libraries/syb
M ./Data/Generics/Twins.hs -5 +18
parent b3ff8a4e
...@@ -198,6 +198,7 @@ data DynFlag ...@@ -198,6 +198,7 @@ data DynFlag
| Opt_IncoherentInstances | Opt_IncoherentInstances
| Opt_MonomorphismRestriction | Opt_MonomorphismRestriction
| Opt_MonoPatBinds | Opt_MonoPatBinds
| Opt_MonoLocalBinds
| Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting
| Opt_ForeignFunctionInterface | Opt_ForeignFunctionInterface
| Opt_UnliftedFFITypes | Opt_UnliftedFFITypes
...@@ -1781,6 +1782,7 @@ xFlags = [ ...@@ -1781,6 +1782,7 @@ xFlags = [
( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ),
-- On by default (which is not strictly H98): -- On by default (which is not strictly H98):
( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ),
( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ),
( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ),
( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ),
( "ImplicitParams", Opt_ImplicitParams, const Supported ), ( "ImplicitParams", Opt_ImplicitParams, const Supported ),
......
...@@ -734,7 +734,7 @@ generalise :: DynFlags -> TopLevelFlag ...@@ -734,7 +734,7 @@ generalise :: DynFlags -> TopLevelFlag
-- The returned [TyVar] are all ready to quantify -- The returned [TyVar] are all ready to quantify
generalise dflags top_lvl bind_list sig_fn mono_infos lie_req generalise dflags top_lvl bind_list sig_fn mono_infos lie_req
| isMonoGroup dflags bind_list | isMonoGroup dflags top_lvl bind_list sigs
= do { extendLIEs lie_req = do { extendLIEs lie_req
; return ([], [], emptyBag) } ; return ([], [], emptyBag) }
...@@ -1157,10 +1157,12 @@ tcInstSig use_skols name ...@@ -1157,10 +1157,12 @@ tcInstSig use_skols name
sig_loc = loc }) } sig_loc = loc }) }
------------------- -------------------
isMonoGroup :: DynFlags -> [LHsBind Name] -> Bool isMonoGroup :: DynFlags -> TopLevelFlag -> [LHsBind Name]
-> [TcSigInfo] -> Bool
-- No generalisation at all -- No generalisation at all
isMonoGroup dflags binds isMonoGroup dflags top_lvl binds sigs
= dopt Opt_MonoPatBinds dflags && any is_pat_bind binds = (dopt Opt_MonoPatBinds dflags && any is_pat_bind binds)
|| (dopt Opt_MonoLocalBinds dflags && null sigs && not (isTopLevel top_lvl))
where where
is_pat_bind (L _ (PatBind {})) = True is_pat_bind (L _ (PatBind {})) = True
is_pat_bind _ = False is_pat_bind _ = False
......
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