Implement -XPolymorphicComponents

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ecf2ef2..a61994b 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -188,6 +188,7 @@ data DynFlag
    | Opt_MultiParamTypeClasses
    | Opt_FunctionalDependencies
    | Opt_UnicodeSyntax
+   | Opt_PolymorphicComponents
    | Opt_MagicHash
    | Opt_EmptyDataDecls
    | Opt_KindSignatures
@@ -1110,6 +1111,7 @@ xFlags = [
   ( "PatternGuards",                    Opt_PatternGuards ),
   ( "UnicodeSyntax",                    Opt_UnicodeSyntax ),
   ( "MagicHash",                        Opt_MagicHash ),
+  ( "PolymorphicComponents",            Opt_PolymorphicComponents ),
   ( "KindSignatures",                   Opt_KindSignatures ),
   ( "EmptyDataDecls",                   Opt_EmptyDataDecls ),
   ( "ParallelListComp",                 Opt_ParallelListComp ),
@@ -1169,6 +1171,7 @@ glasgowExtsFlags = [ Opt_GlasgowExts
            , Opt_MultiParamTypeClasses
            , Opt_FunctionalDependencies
                   , Opt_MagicHash
+           , Opt_PolymorphicComponents
            , Opt_UnicodeSyntax
            , Opt_PatternGuards
            , Opt_RankNTypes

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index d9c5fc8..753a972 100644 (file)
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -1590,6 +1590,7 @@ mkPState buf loc flags  =
               .|. thBit        `setBitIf` dopt Opt_TH           flags
               .|. ipBit        `setBitIf` dopt Opt_ImplicitParams flags
               .|. explicitForallBit `setBitIf` dopt Opt_ScopedTypeVariables flags
+              .|. explicitForallBit `setBitIf` dopt Opt_PolymorphicComponents flags
               .|. bangPatBit   `setBitIf` dopt Opt_BangPatterns flags
               .|. tyFamBit     `setBitIf` dopt Opt_TypeFamilies flags
               .|. haddockBit   `setBitIf` dopt Opt_Haddock      flags

diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs
index 18e58fc..c34387b 100644 (file)
--- a/compiler/typecheck/TcMType.lhs
+++ b/compiler/typecheck/TcMType.lhs
@@ -697,6 +697,7 @@ checkValidType ctxt ty
     doptM Opt_GlasgowExts      `thenM` \ gla_exts ->
     doptM Opt_Rank2Types       `thenM` \ rank2 ->
     doptM Opt_RankNTypes       `thenM` \ rankn ->
+    doptM Opt_PolymorphicComponents    `thenM` \ polycomp ->
     let 
        rank | rankn = Arbitrary
             | rank2 = Rank 2
@@ -710,8 +711,11 @@ checkValidType ctxt ty
                 TySynCtxt _    -> Rank 0
                 ExprSigCtxt    -> Rank 1
                 FunSigCtxt _   -> Rank 1
-                ConArgCtxt _   -> Rank 1       -- We are given the type of the entire
-                                               -- constructor, hence rank 1
+                ConArgCtxt _   -> if polycomp
+                           then Rank 2
+                                -- We are given the type of the entire
+                                -- constructor, hence rank 1
+                           else Rank 1
                 ForSigCtxt _   -> Rank 1
                 SpecInstCtxt   -> Rank 1