[Git][ghc/ghc][master] Some forall-related cleanup in deriving code

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
6eedbd83 by Ryan Scott at 2019-05-24T02:43:12Z
Some forall-related cleanup in deriving code

* Tweak the parser to allow `deriving` clauses to mention explicit
  `forall`s or kind signatures without gratuitous parentheses.
  (This fixes #14332 as a consequence.)
* Allow Haddock comments on `deriving` clauses with explicit
  `forall`s. This requires corresponding changes in Haddock.

- - - - -


7 changed files:

- compiler/deSugar/ExtractDocs.hs
- compiler/parser/Parser.y
- + testsuite/tests/deriving/should_compile/T14332.hs
- testsuite/tests/deriving/should_compile/all.T
- testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs
- testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
- utils/haddock


Changes:

=====================================
compiler/deSugar/ExtractDocs.hs
=====================================
@@ -191,11 +191,22 @@ subordinates instMap decl = case decl of
                   , (dL->L _ (ConDeclField _ ns _ doc)) <- (unLoc flds)
                   , (dL->L _ n) <- ns ]
         derivs  = [ (instName, [unLoc doc], M.empty)
-                  | HsIB { hsib_body = (dL->L l (HsDocTy _ _ doc)) }
-                      <- concatMap (unLoc . deriv_clause_tys . unLoc) $
-                           unLoc $ dd_derivs dd
+                  | (l, doc) <- mapMaybe (extract_deriv_ty . hsib_body) $
+                                concatMap (unLoc . deriv_clause_tys . unLoc) $
+                                unLoc $ dd_derivs dd
                   , Just instName <- [M.lookup l instMap] ]
 
+        extract_deriv_ty :: LHsType GhcRn -> Maybe (SrcSpan, LHsDocString)
+        extract_deriv_ty ty =
+          case dL ty of
+            -- deriving (forall a. C a {- ^ Doc comment -})
+            L l (HsForAllTy{ hst_fvf = ForallInvis
+                           , hst_body = dL->L _ (HsDocTy _ _ doc) })
+                                  -> Just (l, doc)
+            -- deriving (C a {- ^ Doc comment -})
+            L l (HsDocTy _ _ doc) -> Just (l, doc)
+            _                     -> Nothing
+
 -- | Extract constructor argument docs from inside constructor decls.
 conArgDocs :: ConDecl GhcRn -> Map Int (HsDocString)
 conArgDocs con = case getConArgs con of


=====================================
compiler/parser/Parser.y
=====================================
@@ -2086,9 +2086,9 @@ inst_type :: { LHsSigType GhcPs }
         : sigtype                       { mkLHsSigType $1 }
 
 deriv_types :: { [LHsSigType GhcPs] }
-        : typedoc                       { [mkLHsSigType $1] }
+        : ktypedoc                      { [mkLHsSigType $1] }
 
-        | typedoc ',' deriv_types       {% addAnnotation (gl $1) AnnComma (gl $2)
+        | ktypedoc ',' deriv_types      {% addAnnotation (gl $1) AnnComma (gl $2)
                                            >> return (mkLHsSigType $1 : $3) }
 
 comma_types0  :: { [LHsType GhcPs] }  -- Zero or more:  ty,ty,ty


=====================================
testsuite/tests/deriving/should_compile/T14332.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+module T14332 where
+
+import Data.Kind
+
+class C a b
+
+data D a = D
+  deriving ( forall a. C a
+           , Show :: Type -> Constraint
+           )


=====================================
testsuite/tests/deriving/should_compile/all.T
=====================================
@@ -102,6 +102,7 @@ test('T14045b', normal, compile, [''])
 test('T14094', normal, compile, [''])
 test('T14339', normal, compile, [''])
 test('T14331', normal, compile, [''])
+test('T14332', normal, compile, [''])
 test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques'])
 test('T14579', normal, compile, ['-ddump-deriv -dsuppress-uniques'])
 test('T14579a', normal, compile, [''])


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T11768.hs
=====================================
@@ -1,6 +1,12 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module T11768 where
 
+class C a b
+
 data Foo = Foo
   deriving Eq -- ^ Documenting a single type
 
@@ -8,6 +14,7 @@ data Bar = Bar
   deriving ( Eq -- ^ Documenting one of multiple types
            , Ord
            )
+  deriving anyclass ( forall a. C a {- ^ Documenting forall type -} )
 
 -- | Documenting a standalone deriving instance
 deriving instance Read Bar


=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr
=====================================
@@ -1,12 +1,14 @@
 
 ==================== Parser ====================
 module T11768 where
+class C a b
 data Foo
   = Foo
   deriving Eq " Documenting a single type"
 data Bar
   = Bar
   deriving (Eq " Documenting one of multiple types", Ord)
+  deriving anyclass (forall a. C a " Documenting forall type ")
 <document comment>
 deriving instance Read Bar
 


=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 103a894471b18c9c3b0d9faffe2420e10b420686
+Subproject commit 273d5aa8d4a3208879192aeca3b9f1a8245a3c3e



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6eedbd83a19cad94414b37f984b6e9c2b0c0b2e4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/6eedbd83a19cad94414b37f984b6e9c2b0c0b2e4
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190523/fdbd2881/attachment-0001.html>