diff options
| -rw-r--r-- | compiler/hsSyn/HsDecls.hs | 9 | ||||
| -rw-r--r-- | compiler/parser/Parser.y | 13 | ||||
| -rw-r--r-- | docs/users_guide/7.12.1-notes.xml | 10 | ||||
| -rw-r--r-- | testsuite/tests/haddock/should_compile_flag_haddock/all.T | 1 | ||||
| -rw-r--r-- | testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr | 5 |
6 files changed, 39 insertions, 7 deletions
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 9233f4fde1..79b0deeb16 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -981,16 +981,17 @@ pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = PrefixCon arg_tys - , con_res = ResTyGADT _ res_ty }) - = ppr_con_names cons <+> dcolon <+> + , con_res = ResTyGADT _ res_ty, con_doc = doc }) + = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+> sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)] where mk_fun_ty a b = noLoc (HsFunTy a b) pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = RecCon fields - , con_res = ResTyGADT _ res_ty }) - = sep [ppr_con_names cons <+> dcolon <+> pprHsForAll expl tvs cxt, + , con_res = ResTyGADT _ res_ty, con_doc = doc }) + = sep [ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon + <+> pprHsForAll expl tvs cxt, pprConDeclFields (unLoc fields) <+> arrow <+> ppr res_ty] pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT {} }) diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index d6972532d7..99abf162d1 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1870,10 +1870,10 @@ gadt_constrlist :: { Located ([AddAnn] | {- empty -} { noLoc ([],[]) } gadt_constrs :: { Located [LConDecl RdrName] } - : gadt_constr ';' gadt_constrs + : gadt_constr_with_doc ';' gadt_constrs {% addAnnotation (gl $1) AnnSemi (gl $2) >> return (L (comb2 $1 $3) ($1 : unLoc $3)) } - | gadt_constr { L (gl $1) [$1] } + | gadt_constr_with_doc { L (gl $1) [$1] } | {- empty -} { noLoc [] } -- We allow the following forms: @@ -1882,11 +1882,18 @@ gadt_constrs :: { Located [LConDecl RdrName] } -- D { x,y :: a } :: T a -- forall a. Eq a => D { x,y :: a } :: T a +gadt_constr_with_doc :: { LConDecl RdrName } +gadt_constr_with_doc + : maybe_docnext ';' gadt_constr + {% return $ addConDoc $3 $1 } + | gadt_constr + {% return $1 } + gadt_constr :: { LConDecl RdrName } -- Returns a list because of: C,D :: ty : con_list '::' sigtype {% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3 - ; ams (sLL $1 $> $ gadtDecl) + ; ams (sLL $1 $> gadtDecl) (mj AnnDcolon $2:anns) } } -- Deprecated syntax for GADT record declarations diff --git a/docs/users_guide/7.12.1-notes.xml b/docs/users_guide/7.12.1-notes.xml index cfe98b530b..27ad849b16 100644 --- a/docs/users_guide/7.12.1-notes.xml +++ b/docs/users_guide/7.12.1-notes.xml @@ -36,6 +36,16 @@ </listitem> <listitem> <para> + The parser now supports Haddock comments on GADT data constructors. For example, + <programlisting> + data Expr a where + -- | Just a normal sum + Sum :: Int -> Int -> Expr Int + </programlisting> + </para> + </listitem> + <listitem> + <para> Implicit parameters of the new base type <literal>GHC.Stack.CallStack</literal> are treated specially, and automatically solved for the current source diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/all.T b/testsuite/tests/haddock/should_compile_flag_haddock/all.T index d803e9dd61..a0d1d7c07d 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_flag_haddock/all.T @@ -31,4 +31,5 @@ test('haddockA030', normal, compile, ['-haddock -ddump-parsed']) test('haddockA031', normal, compile, ['-haddock -ddump-parsed -XExistentialQuantification']) test('haddockA032', normal, compile, ['-haddock -ddump-parsed']) test('haddockA033', normal, compile, ['-haddock -ddump-parsed']) +test('haddockA034', normal, compile, ['-haddock -ddump-parsed']) test('T10398', normal, compile, ['-haddock -ddump-parsed']) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs new file mode 100644 index 0000000000..195d76c34a --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} + +module Hi where + +-- | This is a GADT. +data Hi where + -- | This is a GADT constructor. + Hi :: () -> Hi diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr new file mode 100644 index 0000000000..f743393349 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr @@ -0,0 +1,5 @@ + +==================== Parser ==================== +module Hi where +<document comment> +data Hi where This is a GADT constructor. Hi :: () -> Hi |