Refactor ConDeclwip/T11028-2

Summary:
The ConDecl type in HsDecls is an uneasy compromise. For the most part,
HsSyn directly reflects the syntax written by the programmer; and that
gives just the right "pegs" on which to hang Alan's API annotations. But
ConDecl doesn't properly reflect the syntax of Haskell-98 and GADT-style
data type declarations.

To be concrete, here's a draft new data type

data ConDecl name
  | ConDeclGADT
      { con_names   :: [Located name]
      , con_type    :: LHsSigType name  -- The type after the ‘::’
      , con_doc     :: Maybe LHsDocString }

  | ConDeclH98
      { con_name    :: Located name

      , con_qvars     :: Maybe (LHsQTyVars name)
        -- User-written forall (if any), and its implicit
        -- kind variables
        -- Non-Nothing needs -XExistentialQuantification

      , con_cxt       :: Maybe (LHsContext name)
        -- ^ User-written context (if any)

      , con_details   :: HsConDeclDetails name
          -- ^ Arguments

      , con_doc       :: Maybe LHsDocString
          -- ^ A possible Haddock comment.
      } deriving (Typeable)

Note that

    For GADTs, just keep a type. That's what the user writes.
    NB:HsType can represent records on the LHS of an arrow:

      { x:Int,y:Bool} -> T

    con_qvars and con_cxt are both Maybe because they are both
    optional (the forall and the context of an existential data type

    For ConDeclGADT the type variables of the data type do not scope
    over the con_type; whereas for ConDeclH98 they do scope over con_cxt
    and con_details.

Test Plan: ./validate

Reviewers: simonpj, austin, goldfire, bgamari

Subscribers: goldfire, thomie, mpickering

Differential Revision: https://phabricator.haskell.org/D1558

GHC Trac Issues: #11028

1 files changed, 15 insertions, 7 deletions

diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 1fc4f09ad9..4decbe12bb 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -45,7 +45,7 @@ import Control.Applicative (Applicative(..))
 
 import Data.Char ( chr )
 import Data.Word ( Word8 )
-import Data.Maybe( catMaybes )
+import Data.Maybe( catMaybes, fromMaybe )
 import Language.Haskell.TH as TH hiding (sigP)
 import Language.Haskell.TH.Syntax as TH
 
@@ -423,13 +423,13 @@ cvtConstr (NormalC c strtys)
   = do  { c'   <- cNameL c
         ; cxt' <- returnL []
         ; tys' <- mapM cvt_arg strtys
-        ; returnL $ mkSimpleConDecl c' Nothing cxt' (PrefixCon tys') }
+        ; returnL $ mkConDeclH98 c' Nothing cxt' (PrefixCon tys') }
 
 cvtConstr (RecC c varstrtys)
   = do  { c'    <- cNameL c
         ; cxt'  <- returnL []
         ; args' <- mapM cvt_id_arg varstrtys
-        ; returnL $ mkSimpleConDecl c' Nothing cxt'
+        ; returnL $ mkConDeclH98 c' Nothing cxt'
                                    (RecCon (noLoc args')) }
 
 cvtConstr (InfixC st1 c st2)
@@ -437,15 +437,23 @@ cvtConstr (InfixC st1 c st2)
         ; cxt' <- returnL []
         ; st1' <- cvt_arg st1
         ; st2' <- cvt_arg st2
-        ; returnL $ mkSimpleConDecl c' Nothing cxt' (InfixCon st1' st2') }
+        ; returnL $ mkConDeclH98 c' Nothing cxt' (InfixCon st1' st2') }
 
 cvtConstr (ForallC tvs ctxt con)
   = do  { tvs'  <- cvtTvs tvs
         ; L loc ctxt' <- cvtContext ctxt
         ; L _ con' <- cvtConstr con
-        ; returnL $ con' { con_qvars = mkHsQTvs (hsQTvBndrs tvs' ++ hsQTvBndrs (con_qvars con'))
-                         , con_explicit = True
-                         , con_cxt = L loc (ctxt' ++ (unLoc $ con_cxt con')) } }
+        ; let qvars = case (tvs,con_qvars con') of
+                ([],Nothing) -> Nothing
+                _  ->
+                  Just $ mkHsQTvs (hsQTvBndrs tvs' ++
+                                   hsQTvBndrs (fromMaybe (HsQTvs PlaceHolder [])
+                                              (con_qvars con')))
+        ; returnL $ con' { con_qvars = qvars
+                         , con_cxt = Just $
+                                     L loc (ctxt' ++
+                                            unLoc (fromMaybe (noLoc [])
+                                                   (con_cxt con'))) } }
 
 cvt_arg :: (TH.Strict, TH.Type) -> CvtM (LHsType RdrName)
 cvt_arg (NotStrict, ty) = cvtType ty