[commit: ghc] master: Removed deprecated syntax for GADT constuctors. (30c981e)
git at git.haskell.org
git at git.haskell.org
Mon Aug 3 16:20:26 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/30c981e135033840fe1b4bcab697b412369739d7/ghc
>---------------------------------------------------------------
commit 30c981e135033840fe1b4bcab697b412369739d7
Author: Ulya Trofimovich <skvadrik at gmail.com>
Date: Mon Aug 3 17:45:56 2015 +0200
Removed deprecated syntax for GADT constuctors.
Old syntax was deprecated 6 years ago in this commit
432b9c9322181a3644083e3c19b7e240d90659e7 by simonpj:"New syntax for
GADT-style record declarations, and associated refactoring" discussed
in Trac #3306.
This patch removes 2 reduce/reduce conflicts in parser. Conflicting
productions were:
```
gadt_constr -> con_list '::' sigtype
gadt_constr -> oqtycon '{' fielddecls '}' '::' sigtype
```
Recursive inlining of `con_list` and `oqtycon` helped reveal the
conflict:
```
gadt_constr -> '(' CONSYM ')' '::' sigtype
gadt_constr -> '(' CONSYM ')' '{' fielddecls '}' '::' sigtype
```
between two types of GADT constructors (second form stands for
deprecated syntax).
Test Plan: `make fasttest`, one breakage TEST="records-fail" (parse
error instead of typecheck error due to removal of deprecated syntax).
Updated test.
Reviewers: simonmar, bgamari, austin, simonpj
Reviewed By: simonpj
Subscribers: thomie, mpickering, trofi
Differential Revision: https://phabricator.haskell.org/D1118
GHC Trac Issues: #3306
>---------------------------------------------------------------
30c981e135033840fe1b4bcab697b412369739d7
compiler/parser/Parser.y | 65 +++++++++++++------------------
compiler/parser/RdrHsSyn.hs | 20 ----------
testsuite/tests/gadt/records-fail1.hs | 12 +++++-
testsuite/tests/gadt/records-fail1.stderr | 5 +--
4 files changed, 37 insertions(+), 65 deletions(-)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 1cfe491..4b8eca6 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -82,10 +82,9 @@ import Util ( looksLikePackageName )
}
-{- Last updated: 29 Jul 2015
+{- Last updated: 31 Jul 2015
Conflicts: 47 shift/reduce
- 2 reduce/reduce
If you modify this parser and add a conflict, please update this comment.
You can learn more about the conflicts by passing 'happy' the -i flag:
@@ -293,29 +292,6 @@ state 950 contains 1 shift/reduce conflicts.
Conflict: 'by'
--------------------------------------------------------------------------------
-
-state 1230 contains 1 reduce/reduce conflicts.
-
- *** tyconsym -> ':' . (rule 653)
- consym -> ':' . (rule 721)
-
- Conflict: ')'
-
--------------------------------------------------------------------------------
-
-state 1231 contains 1 reduce/reduce conflicts.
-
- *** tyconsym -> CONSYM . (rule 651)
- consym -> CONSYM . (rule 720)
-
- Conflict: ')'
-
-TODO: Why? (NB: This one has been around for a while; it's quite puzzling
- because we really shouldn't get confused between tyconsym and consym.
- Trace the state machine, maybe?)
-
-TODO: Same as State 1230
-------------------------------------------------------------------------------
-- API Annotations
@@ -1820,18 +1796,24 @@ gadt_constr_with_doc
{% return $1 }
gadt_constr :: { LConDecl RdrName }
- -- Returns a list because of: C,D :: ty
+ -- see Note [Difference in parsing GADT and data constructors]
+ -- Returns a list because of: C,D :: ty
: con_list '::' sigtype
{% do { (anns,gadtDecl) <- mkGadtDecl (unLoc $1) $3
; ams (sLL $1 $> gadtDecl)
(mj AnnDcolon $2:anns) } }
- -- Deprecated syntax for GADT record declarations
- | oqtycon '{' fielddecls '}' '::' sigtype
- {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 (noLoc $3) $6
- ; cd' <- checkRecordSyntax cd
- ; ams (L (comb2 $1 $6) (unLoc cd'))
- [moc $2,mcc $4,mj AnnDcolon $5] } }
+{- Note [Difference in parsing GADT and data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+GADT constructors have simpler syntax than usual data constructors:
+in GADTs, types cannot occur to the left of '::', so they cannot be mixed
+with constructor names (see Note [Parsing data constructors is hard]).
+
+Due to simplified syntax, GADT constructor names (left-hand side of '::')
+use simpler grammar production than usual data constructor names. As a
+consequence, GADT constructor names are resticted (names like '(*)' are
+allowed in usual data constructors, but not in GADTs).
+-}
constrs :: { Located ([AddAnn],[LConDecl RdrName]) }
: maybe_docnext '=' constrs1 { L (comb2 $2 $3) ([mj AnnEqual $2]
@@ -1862,16 +1844,21 @@ forall :: { Located ([AddAnn],[LHsTyVarBndr RdrName]) }
| {- empty -} { noLoc ([],[]) }
constr_stuff :: { Located (Located RdrName, HsConDeclDetails RdrName) }
--- We parse the constructor declaration
--- C t1 t2
--- as a btype (treating C as a type constructor) and then convert C to be
--- a data constructor. Reason: it might continue like this:
--- C t1 t2 %: D Int
--- in which case C really would be a type constructor. We can't resolve this
--- ambiguity till we come across the constructor oprerator :% (or not, more usually)
+ -- see Note [Parsing data constructors is hard]
: btype {% splitCon $1 >>= return.sLL $1 $> }
| btype conop btype { sLL $1 $> ($2, InfixCon $1 $3) }
+{- Note [Parsing data constructors is hard]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We parse the constructor declaration
+ C t1 t2
+as a btype (treating C as a type constructor) and then convert C to be
+a data constructor. Reason: it might continue like this:
+ C t1 t2 %: D Int
+in which case C really would be a type constructor. We can't resolve this
+ambiguity till we come across the constructor oprerator :% (or not, more usually)
+-}
+
fielddecls :: { [LConDeclField RdrName] }
: {- empty -} { [] }
| fielddecls1 { $1 }
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index ab3f17d..18890b5 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -35,7 +35,6 @@ module RdrHsSyn (
mkExtName, -- RdrName -> CLabelString
mkGadtDecl, -- [Located RdrName] -> LHsType RdrName -> ConDecl RdrName
mkSimpleConDecl,
- mkDeprecatedGadtRecordDecl,
mkATDefault,
-- Bunch of functions in the parser monad for
@@ -469,25 +468,6 @@ mkPatSynMatchGroup (L _ patsyn_name) (L _ decls) =
text "pattern synonym 'where' clause must bind the pattern synonym's name" <+>
quotes (ppr patsyn_name) $$ ppr decl
-mkDeprecatedGadtRecordDecl :: SrcSpan
- -> Located RdrName
- -> Located [LConDeclField RdrName]
- -> LHsType RdrName
- -> P (LConDecl RdrName)
--- This one uses the deprecated syntax
--- C { x,y ::Int } :: T a b
--- We give it a RecCon details right away
-mkDeprecatedGadtRecordDecl loc (L con_loc con) flds res_ty
- = do { data_con <- tyConToDataCon con_loc con
- ; return (L loc (ConDecl { con_old_rec = True
- , con_names = [data_con]
- , con_explicit = Implicit
- , con_qvars = mkHsQTvs []
- , con_cxt = noLoc []
- , con_details = RecCon flds
- , con_res = ResTyGADT loc res_ty
- , con_doc = Nothing })) }
-
mkSimpleConDecl :: Located RdrName -> [LHsTyVarBndr RdrName]
-> LHsContext RdrName -> HsConDeclDetails RdrName
-> ConDecl RdrName
diff --git a/testsuite/tests/gadt/records-fail1.hs b/testsuite/tests/gadt/records-fail1.hs
index 8eefee5..b26404a 100644
--- a/testsuite/tests/gadt/records-fail1.hs
+++ b/testsuite/tests/gadt/records-fail1.hs
@@ -2,10 +2,18 @@
-- Tests record syntax for GADTs
+-- Record syntax in GADTs has been deprecated since July 2009
+-- see commit 432b9c9322181a3644083e3c19b7e240d90659e7 by simonpj:
+-- "New syntax for GADT-style record declarations, and associated refactoring"
+-- and Trac #3306
+
+-- It's been removed in August 2015
+-- see Phab D1118
+
+-- test should result into parse error
+
module ShouldFail where
data T a where
T1 { x :: a, y :: b } :: T (a,b)
T4 { x :: Int } :: T [a]
-
-
\ No newline at end of file
diff --git a/testsuite/tests/gadt/records-fail1.stderr b/testsuite/tests/gadt/records-fail1.stderr
index 6fd871c..9e8c80b 100644
--- a/testsuite/tests/gadt/records-fail1.stderr
+++ b/testsuite/tests/gadt/records-fail1.stderr
@@ -1,5 +1,2 @@
-records-fail1.hs:7:1: error:
- Constructors T1 and T4 have a common field ‘x’,
- but have different result types
- In the data type declaration for ‘T’
+records-fail1.hs:18:6: error: parse error on input ‘{’
More information about the ghc-commits
mailing list