Implement -X=GADTs and -X=RelaxedPolyRec

Two new -X flags, one for GADTs and one for relaxed polymorphic recursion

This also fixes a rather confusing error message that the Darcs folk
tripped over.

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 96b2ed8..351b6d8 100644 (file)
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -162,9 +162,9 @@ tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
 
                -- Extend the envt right away with all 
                -- the Ids declared with type signatures
-       ; gla_exts     <- doptM Opt_GlasgowExts
+       ; poly_rec <- doptM Opt_RelaxedPolyRec
        ; (binds', thing) <- tcExtendIdEnv poly_ids $
-                            tc_val_binds gla_exts top_lvl sig_fn prag_fn 
+                            tc_val_binds poly_rec top_lvl sig_fn prag_fn 
                                          binds thing_inside
 
        ; return (ValBindsOut binds' sigs, thing) }
@@ -176,14 +176,14 @@ tc_val_binds :: Bool -> TopLevelFlag -> TcSigFun -> TcPragFun
 -- Typecheck a whole lot of value bindings,
 -- one strongly-connected component at a time
 
-tc_val_binds gla_exts top_lvl sig_fn prag_fn [] thing_inside
+tc_val_binds poly_rec top_lvl sig_fn prag_fn [] thing_inside
   = do { thing <- thing_inside
        ; return ([], thing) }
 
-tc_val_binds gla_exts top_lvl sig_fn prag_fn (group : groups) thing_inside
+tc_val_binds poly_rec top_lvl sig_fn prag_fn (group : groups) thing_inside
   = do { (group', (groups', thing))
-               <- tc_group gla_exts top_lvl sig_fn prag_fn group $ 
-                  tc_val_binds gla_exts top_lvl sig_fn prag_fn groups thing_inside
+               <- tc_group poly_rec top_lvl sig_fn prag_fn group $ 
+                  tc_val_binds poly_rec top_lvl sig_fn prag_fn groups thing_inside
        ; return (group' ++ groups', thing) }
 
 ------------------------
@@ -195,15 +195,15 @@ tc_group :: Bool -> TopLevelFlag -> TcSigFun -> TcPragFun
 -- We get a list of groups back, because there may 
 -- be specialisations etc as well
 
-tc_group gla_exts top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
+tc_group poly_rec top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
        -- A single non-recursive binding
        -- We want to keep non-recursive things non-recursive
         -- so that we desugar unlifted bindings correctly
  =  do { (binds, thing) <- tc_haskell98 top_lvl sig_fn prag_fn NonRecursive binds thing_inside
        ; return ([(NonRecursive, b) | b <- binds], thing) }
 
-tc_group gla_exts top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
-  | not gla_exts       -- Recursive group, normal Haskell 98 route
+tc_group poly_rec top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
+  | not poly_rec       -- Recursive group, normal Haskell 98 route
   = do { (binds1, thing) <- tc_haskell98 top_lvl sig_fn prag_fn Recursive binds thing_inside
        ; return ([(Recursive, unionManyBags binds1)], thing) }
 

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 5384e4a..ff08a28 100644 (file)
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -34,6 +34,7 @@ import Type
 import StaticFlags
 import TyCon
 import DataCon
+import DynFlags
 import PrelNames
 import BasicTypes hiding (SuccessFlag(..))
 import SrcLoc
@@ -729,8 +730,11 @@ refineAlt con pstate ex_tvs [] pat_ty
   = return pstate      -- Common case: no equational constraints
 
 refineAlt con pstate ex_tvs co_vars pat_ty
-  | not (isRigidTy pat_ty)
-  = failWithTc (nonRigidMatch con)
+  = do { opt_gadt <- doptM Opt_GADTs   -- No type-refinement unless GADTs are on
+       ; if (not opt_gadt) then return pstate
+         else do 
+
+       { checkTc (isRigidTy pat_ty) (nonRigidMatch con)
        -- We are matching against a GADT constructor with non-trivial
        -- constraints, but pattern type is wobbly.  For now we fail.
        -- We can make sense of this, however:
@@ -745,8 +749,8 @@ refineAlt con pstate ex_tvs co_vars pat_ty
        -- then unify these constraints to make pat_ty the right shape;
        -- then proceed exactly as in the rigid case
 
-  | otherwise  -- In the rigid case, we perform type refinement
-  = case gadtRefine (pat_reft pstate) ex_tvs co_vars of {
+               -- In the rigid case, we perform type refinement
+       ; case gadtRefine (pat_reft pstate) ex_tvs co_vars of {
            Failed msg     -> failWithTc (inaccessibleAlt msg) ;
            Succeeded reft -> do { traceTc trace_msg
                                 ; return (pstate { pat_reft = reft }) }
@@ -758,7 +762,7 @@ refineAlt con pstate ex_tvs co_vars pat_ty
                                vcat [ ppr con <+> ppr ex_tvs,
                                       ppr [(v, tyVarKind v) | v <- co_vars],
                                       ppr reft]
-       }
+       } } }
 \end{code}
 
 

diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index ee847f5..3217a95 100644 (file)
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -657,10 +657,11 @@ tcTyClDecl1 calc_isrec
   ; want_generic <- doptM Opt_Generics
   ; unbox_strict <- doptM Opt_UnboxStrictFields
   ; gla_exts     <- doptM Opt_GlasgowExts
+  ; gadt_ok      <- doptM Opt_GADTs
   ; is_boot     <- tcIsHsBoot  -- Are we compiling an hs-boot file?
 
        -- Check that we don't use GADT syntax in H98 world
-  ; checkTc (gla_exts || h98_syntax) (badGadtDecl tc_name)
+  ; checkTc (gadt_ok || h98_syntax) (badGadtDecl tc_name)
 
        -- Check that we don't use kind signatures without Glasgow extensions
   ; checkTc (gla_exts || isNothing mb_ksig) (badSigTyDecl tc_name)
@@ -1142,7 +1143,7 @@ badDataConTyCon data_con
 
 badGadtDecl tc_name
   = vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+> quotes (ppr tc_name)
-        , nest 2 (parens $ ptext SLIT("Use -fglasgow-exts to allow GADTs")) ]
+        , nest 2 (parens $ ptext SLIT("Use -X=GADT to allow GADTs")) ]
 
 badStupidTheta tc_name
   = ptext SLIT("A data type declared in GADT style cannot have a context:") <+> quotes (ppr tc_name)
@@ -1175,7 +1176,7 @@ badSigTyDecl tc_name
 badFamInstDecl tc_name
   = vcat [ ptext SLIT("Illegal family instance for") <+>
           quotes (ppr tc_name)
-        , nest 2 (parens $ ptext SLIT("Use -ftype-families to allow indexed type families")) ]
+        , nest 2 (parens $ ptext SLIT("Use -X=TypeFamilies to allow indexed type families")) ]
 
 badGadtIdxTyDecl tc_name
   = vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+>

diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 9fb9341..4035dc8 100644 (file)
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -678,6 +678,12 @@
              <entry><option>-X=MonoPatBinds</option></entry>
            </row>
            <row>
+             <entry><option>-X=RelaxedPolyRed</option></entry>
+             <entry>Relaxed checking for <link linkend="typing-binds">mutually-recursive polymorphic functions</link></entry>
+             <entry>dynamic</entry>
+             <entry><option>-X=NoRelaxedPolyRec</option></entry>
+           </row>
+           <row>
              <entry><option>-X=ExtendedDefaultRules</option></entry>
              <entry>Use GHCi's <link linkend="extended-default-rules">extended default rules</link> in a normal module</entry>
              <entry>dynamic</entry>
@@ -688,7 +694,20 @@
              <entry>Enable <link linkend="overloaded-strings">overloaded string literals</link>.
              </entry>
              <entry>dynamic</entry>
-             <entry><option>-X=OverloadedStrings</option></entry>
+             <entry><option>-X=NoOverloadedStrings</option></entry>
+           </row>
+           <row>
+             <entry><option>-X=GADTs</option></entry>
+             <entry>Enable <link linkend="gadts">generalised algebraic data types</link>.
+             </entry>
+             <entry>dynamic</entry>
+             <entry><option>-X=NoGADTs</option></entry>
+           </row>
+           <row>
+             <entry><option>-X=TypeFamilies</option></entry>
+             <entry>Enable <link linkend="type-families">type families</link>.</entry>
+             <entry>dynamic</entry>
+             <entry><option>-X=NoTypeFamilies</option></entry>
            </row>
            <row>
              <entry><option>-X=ScopedTypeVariables</option></entry>
@@ -705,12 +724,6 @@
              <entry><option>-X=NoTH</option></entry>
            </row>
            <row>
-             <entry><option>-X=TypeFamilies</option></entry>
-             <entry>Enable <link linkend="type-families">type families</link>.</entry>
-             <entry>dynamic</entry>
-             <entry><option>-X=NoTypeFamilies</option></entry>
-           </row>
-           <row>
              <entry><option>-X=BangPtterns</option></entry>
              <entry>Enable <link linkend="bang-patterns">bang patterns</link>.</entry>
              <entry>dynamic</entry>

diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml
index e7858ce..1881ff0 100644 (file)
--- a/docs/users_guide/glasgow_exts.xml
+++ b/docs/users_guide/glasgow_exts.xml
@@ -4039,7 +4039,7 @@ and all others are monomorphic until the group is generalised
 <para>Following a suggestion of Mark Jones, in his paper
 <ulink url="http://www.cse.ogi.edu/~mpj/thih/">Typing Haskell in
 Haskell</ulink>,
-GHC implements a more general scheme.  If <option>-fglasgow-exts</option> is
+GHC implements a more general scheme.  If <option>-X=RelaxedPolyRec</option> is
 specified:
 <emphasis>the dependency analysis ignores references to variables that have an explicit
 type signature</emphasis>.
@@ -4068,7 +4068,7 @@ Now, the defintion for <literal>f</literal> is typechecked, with this type for
 The same refined dependency analysis also allows the type signatures of 
 mutually-recursive functions to have different contexts, something that is illegal in
 Haskell 98 (Section 4.5.2, last sentence).  With
-<option>-fglasgow-exts</option>
+<option>-X=RelaxedPolyRec</option>
 GHC only insists that the type signatures of a <emphasis>refined</emphasis> group have identical
 type signatures; in practice this means that only variables bound by the same
 pattern binding must have the same context.  For example, this is fine: