Commit bd789853 authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Ryan Scott

Parse the (!) type operator and allow type operators in existential context

Summary:
Improve the way `(!)`, `(~)`, and other type operators are handled in the parser,
fixing two issues at once:

1. `(!)` can now be used as a type operator
   that respects fixity and precedence (#15457)
2. Existential context of a data constructor
   no longer needs parentheses (#15675)

In addition to that, with this patch it is now trivial to adjust precedence of
the `{-# UNPACK #-}` pragma, as suggested in
https://ghc.haskell.org/trac/ghc/ticket/14761#comment:7

There was a small change to API Annotations. Before this patch, `(~)` was a
strange special case that produced an annotation unlike any other type
operator. After this patch, when `(~)` or `(!)` are used to specify strictness they
produce AnnTilde and AnnBang annotations respectively, and when they are used
as type operators, they produce no annotations.

Test Plan: Validate

Reviewers: simonpj, bgamari, alanz, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, mpickering, carter

GHC Trac Issues: #15457, #15675

Differential Revision: https://phabricator.haskell.org/D5180
parent fc2ff6dd
......@@ -72,8 +72,7 @@ module Lexer (
addWarning,
lexTokenStream,
addAnnotation,AddAnn,addAnnsAt,mkParensApiAnn,
commentToAnnotation,
moveAnnotations
commentToAnnotation
) where
import GhcPrelude
......@@ -3069,23 +3068,6 @@ mkParensApiAnn s@(RealSrcSpan ss) = [mj AnnOpenP lo,mj AnnCloseP lc]
lo = mkSrcSpan (srcSpanStart s) (mkSrcLoc f sl (sc+1))
lc = mkSrcSpan (mkSrcLoc f el (ec - 1)) (srcSpanEnd s)
-- | Move the annotations and comments belonging to the @old@ span to the @new@
-- one.
moveAnnotations :: SrcSpan -> SrcSpan -> P ()
moveAnnotations old new = P $ \s ->
let
updateAnn ((l,a),v)
| l == old = ((new,a),v)
| otherwise = ((l,a),v)
updateComment (l,c)
| l == old = (new,c)
| otherwise = (l,c)
in
POk s {
annotations = map updateAnn (annotations s)
, annotations_comments = map updateComment (annotations_comments s)
} ()
queueComment :: Located Token -> P()
queueComment c = P $ \s -> POk s {
comment_q = commentToAnnotation c : comment_q s
......
......@@ -1772,19 +1772,6 @@ sigtypes1 :: { (OrdList (LHsSigType GhcPs)) }
-----------------------------------------------------------------------------
-- Types
strict_mark :: { Located ([AddAnn],HsSrcBang) }
: strictness { sL1 $1 (let (a, str) = unLoc $1 in (a, HsSrcBang NoSourceText NoSrcUnpack str)) }
| unpackedness { sL1 $1 (let (a, prag, unpk) = unLoc $1 in (a, HsSrcBang prag unpk NoSrcStrict)) }
| unpackedness strictness { sLL $1 $> (let { (a, prag, unpk) = unLoc $1
; (a', str) = unLoc $2 }
in (a ++ a', HsSrcBang prag unpk str)) }
-- Although UNPACK with no '!' without StrictData and UNPACK with '~' are illegal,
-- we get a better error message if we parse them here
strictness :: { Located ([AddAnn], SrcStrictness) }
: '!' { sL1 $1 ([mj AnnBang $1], SrcStrict) }
| '~' { sL1 $1 ([mj AnnTilde $1], SrcLazy) }
unpackedness :: { Located ([AddAnn], SourceText, SrcUnpackedness) }
: '{-# UNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getUNPACK_PRAGs $1, SrcUnpack) }
| '{-# NOUNPACK' '#-}' { sLL $1 $> ([mo $1, mc $2], getNOUNPACK_PRAGs $1, SrcNoUnpack) }
......@@ -1806,8 +1793,8 @@ ctype :: { LHsType GhcPs }
[mu AnnDcolon $2] }
| type { $1 }
----------------------
-- Notes for 'ctypedoc'
-- Note [ctype and ctypedoc]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- It would have been nice to simplify the grammar by unifying `ctype` and
-- ctypedoc` into one production, allowing comments on types everywhere (and
-- rejecting them after parsing, where necessary). This is however not possible
......@@ -1840,11 +1827,6 @@ ctypedoc :: { LHsType GhcPs }
-- (Eq a, Ord a)
-- looks so much like a tuple type. We can't tell until we find the =>
-- We have the t1 ~ t2 form both in 'context' and in type,
-- to permit an individual equational constraint without parenthesis.
-- Thus for some reason we allow f :: a~b => blah
-- but not f :: ?x::Int => blah
-- See Note [Parsing ~]
context :: { LHsContext GhcPs }
: btype {% do { (anns,ctx) <- checkContext $1
; if null (unLoc ctx)
......@@ -1853,11 +1835,11 @@ context :: { LHsContext GhcPs }
; ams ctx anns
} }
context_no_ops :: { LHsContext GhcPs }
: btype_no_ops {% do { ty <- splitTilde (reverse (unLoc $1))
; (anns,ctx) <- checkContext ty
-- See Note [Constr variatons of non-terminals]
constr_context :: { LHsContext GhcPs }
: constr_btype {% do { (anns,ctx) <- checkContext $1
; if null (unLoc ctx)
then addAnnotation (gl ty) AnnUnit (gl ty)
then addAnnotation (gl $1) AnnUnit (gl $1)
else return ()
; ams ctx anns
} }
......@@ -1906,23 +1888,26 @@ typedoc :: { LHsType GhcPs }
$4)
[mu AnnRarrow $3] }
-- See Note [Constr variatons of non-terminals]
constr_btype :: { LHsType GhcPs }
: constr_tyapps {% mergeOps (unLoc $1) }
-- See Note [Constr variatons of non-terminals]
constr_tyapps :: { Located [Located TyEl] } -- NB: This list is reversed
: constr_tyapp { sL1 $1 [$1] }
| constr_tyapps constr_tyapp { sLL $1 $> $ $2 : (unLoc $1) }
-- See Note [Parsing ~]
btype :: { LHsType GhcPs }
: tyapps {% mergeOps (unLoc $1) }
-- See Note [Constr variatons of non-terminals]
constr_tyapp :: { Located TyEl }
: tyapp { $1 }
| docprev { sL1 $1 $ TyElDocPrev (unLoc $1) }
-- Used for parsing Haskell98-style data constructors,
-- in order to forbid the blasphemous
-- > data Foo = Int :+ Char :* Bool
-- See also Note [Parsing data constructors is hard] in RdrHsSyn
btype_no_ops :: { Located [LHsType GhcPs] } -- NB: This list is reversed
: atype_docs { sL1 $1 [$1] }
| btype_no_ops atype_docs { sLL $1 $> $ $2 : (unLoc $1) }
btype :: { LHsType GhcPs }
: tyapps {% mergeOps $1 }
tyapps :: { Located [Located TyEl] } -- NB: This list is reversed
: tyapp { sL1 $1 [$1] }
| tyapps tyapp { sLL $1 $> $ $2 : (unLoc $1) }
tyapps :: { [Located TyEl] } -- NB: This list is reversed
: tyapp { [$1] }
| tyapps tyapp { $2 : $1 }
tyapp :: { Located TyEl }
: atype { sL1 $1 $ TyElOpd (unLoc $1) }
......@@ -1932,18 +1917,15 @@ tyapp :: { Located TyEl }
[mj AnnSimpleQuote $1,mj AnnVal $2] }
| SIMPLEQUOTE varop {% ams (sLL $1 $> $ TyElOpr (unLoc $2))
[mj AnnSimpleQuote $1,mj AnnVal $2] }
atype_docs :: { LHsType GhcPs }
: atype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 }
| atype { $1 }
| '~' { sL1 $1 TyElTilde }
| '!' { sL1 $1 TyElBang }
| unpackedness { sL1 $1 $ TyElUnpackedness (unLoc $1) }
atype :: { LHsType GhcPs }
: ntgtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- Not including unit tuples
| tyvar { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- (See Note [Unit tuples])
| '*' {% do { warnStarIsType (getLoc $1)
; return $ sL1 $1 (HsStarTy noExt (isUnicode $1)) } }
| strict_mark atype {% ams (sLL $1 $> (HsBangTy noExt (snd $ unLoc $1) $2))
(fst $ unLoc $1) } -- Constructor sigs only
| '{' fielddecls '}' {% amms (checkRecordSyntax
(sLL $1 $> $ HsRecTy noExt $2))
-- Constructor sigs only
......@@ -2054,23 +2036,6 @@ varids0 :: { Located [Located RdrName] }
: {- empty -} { noLoc [] }
| varids0 tyvar { sLL $1 $> ($2 : unLoc $1) }
{-
Note [Parsing ~]
~~~~~~~~~~~~~~~~
Due to parsing conflicts between laziness annotations in data type
declarations (see strict_mark) and equality types ~'s are always
parsed as laziness annotations, and turned into HsOpTy's in the
correct places using RdrHsSyn.splitTilde.
Since strict_mark is parsed as part of atype which is part of type,
typedoc and context (where HsEqTy previously appeared) it made most
sense and was simplest to parse ~ as part of strict_mark and later
turn them into HsOpTy's.
-}
-----------------------------------------------------------------------------
-- Kinds
......@@ -2167,8 +2132,60 @@ constrs1 :: { Located [LConDecl GhcPs] }
>> return (sLL $1 $> (addConDoc $5 $2 : addConDocFirst (unLoc $1) $4)) }
| constr { sL1 $1 [$1] }
{- Note [Constr variatons of non-terminals]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In record declarations we assume that 'ctype' used to parse the type will not
consume the trailing docprev:
data R = R { field :: Int -- ^ comment on the field }
In 'R' we expect the comment to apply to the entire field, not to 'Int'. The
same issue is detailed in Note [ctype and ctypedoc].
So, we do not want 'ctype' to consume 'docprev', therefore
we do not want 'btype' to consume 'docprev', therefore
we do not want 'tyapps' to consume 'docprev'.
At the same time, when parsing a 'constr', we do want to consume 'docprev':
data T = C Int -- ^ comment on Int
Bool -- ^ comment on Bool
So, we do want 'constr_stuff' to consume 'docprev'.
The problem arises because the clauses in 'constr' have the following
structure:
(a) context '=>' constr_stuff (e.g. data T a = Ord a => C a)
(b) constr_stuff (e.g. data T a = C a)
and to avoid a reduce/reduce conflict, 'context' and 'constr_stuff' must be
compatible. And for 'context' to be compatible with 'constr_stuff', it must
consume 'docprev'.
So, we want 'context' to consume 'docprev', therefore
we want 'btype' to consume 'docprev', therefore
we want 'tyapps' to consume 'docprev'.
Our requirements end up conflicting: for parsing record types, we want 'tyapps'
to leave 'docprev' alone, but for parsing constructors, we want it to consume
'docprev'.
As the result, we maintain two parallel hierarchies of non-terminals that
either consume 'docprev' or not:
tyapps constr_tyapps
btype constr_btype
context constr_context
...
They must be kept identical except for their treatment of 'docprev'.
-}
constr :: { LConDecl GhcPs }
: maybe_docnext forall context_no_ops '=>' constr_stuff
: maybe_docnext forall constr_context '=>' constr_stuff
{% ams (let (con,details,doc_prev) = unLoc $5 in
addConDoc (L (comb4 $2 $3 $4 $5) (mkConDeclH98 con
(snd $ unLoc $2)
......@@ -2190,17 +2207,8 @@ forall :: { Located ([AddAnn], Maybe [LHsTyVarBndr GhcPs]) }
| {- empty -} { noLoc ([], Nothing) }
constr_stuff :: { Located (Located RdrName, HsConDeclDetails GhcPs, Maybe LHsDocString) }
-- See Note [Parsing data constructors is hard] in RdrHsSyn
: btype_no_ops {% do { c <- splitCon (unLoc $1)
: constr_tyapps {% do { c <- mergeDataCon (unLoc $1)
; return $ sL1 $1 c } }
| btype_no_ops conop maybe_docprev btype_no_ops
{% do { lhs <- splitTilde (reverse (unLoc $1))
; (_, ds_l) <- checkInfixConstr lhs
; let rhs1 = foldl1 mkHsAppTy (reverse (unLoc $4))
; (rhs, ds_r) <- checkInfixConstr rhs1
; return $ if isJust (ds_l `mplus` $3)
then sLL $1 $> ($2, InfixCon lhs rhs1, $3)
else sLL $1 $> ($2, InfixCon lhs rhs, ds_r) } }
fielddecls :: { [LConDeclField GhcPs] }
: {- empty -} { [] }
......
This diff is collapsed.
......@@ -40,6 +40,16 @@ Language
terminating value of type ``Void``. Accordingly, GHC will not warn about
``K2`` (whereas previous versions of GHC would).
- ``(!)`` is now a valid type operator: ::
type family a ! b
- An existential context no longer requires parenthesization: ::
class a + b
data D1 = forall a b. (a + b) => D1 a b
data D2 = forall a b. a + b => D2 a b -- now allowed
Compiler
~~~~~~~~
......
......@@ -15,7 +15,6 @@
((Test11321.hs:12:20-29,AnnOpenP), [Test11321.hs:12:20]),
((Test11321.hs:12:26-28,AnnCloseS), [Test11321.hs:12:28]),
((Test11321.hs:12:26-28,AnnOpenS), [Test11321.hs:12:26]),
((Test11321.hs:13:5-11,AnnTilde), [Test11321.hs:13:7]),
((Test11321.hs:(13,5)-(14,8),AnnDarrow), [Test11321.hs:13:13-14]),
((Test11321.hs:(13,5)-(14,8),AnnVbar), [Test11321.hs:15:3]),
((Test11321.hs:13:9-11,AnnCloseS), [Test11321.hs:13:11]),
......@@ -32,7 +31,6 @@
((Test11321.hs:16:12-21,AnnOpenP), [Test11321.hs:16:12]),
((Test11321.hs:16:18-20,AnnCloseS), [Test11321.hs:16:20]),
((Test11321.hs:16:18-20,AnnOpenS), [Test11321.hs:16:18]),
((Test11321.hs:16:24-34,AnnTilde), [Test11321.hs:16:26]),
((Test11321.hs:16:28-30,AnnCloseP), [Test11321.hs:16:30]),
((Test11321.hs:16:28-30,AnnOpenP), [Test11321.hs:16:28]),
((Test11321.hs:16:28-30,AnnVal), [Test11321.hs:16:29]),
......
Boot.hs:5:13:
Not a data constructor: ‘forall’
Perhaps you intended to use ExistentialQuantification
Boot.hs:5:21: error:
Illegal symbol '.' in type
Perhaps you intended to use RankNTypes or a similar language
extension to enable explicit-forall syntax: forall <tvs>. <type>
{-# LANGUAGE TypeOperators #-}
module T15457 where
import Data.Type.Equality
data a ! b; infix 0 !
data a + b; infix 9 +
fixityProof :: (Int ! Int + Int) :~: (Int ! (Int + Int))
fixityProof = Refl
data Foo a b = MkFoo (a ! b) !Int !(Bool ! Bool)
{-# LANGUAGE TypeOperators, MultiParamTypeClasses, ExistentialQuantification #-}
module T15675 where
class a + b
data D1 = forall a b. (a + b) => D1 a b
data D2 = forall a b. a + b => D2 a b
class a ! b
data D3 = forall a b. (a ! b) => D3 !a !b
data D4 = forall a b. a ! b => D4 !a !b
......@@ -130,3 +130,5 @@ def only_MG_loc(x):
if mg.strip().startswith("(MG"))
return '\n'.join(mgLocs)
test('T15279', normalise_errmsg_fun(only_MG_loc), compile, [''])
test('T15457', normal, compile, [''])
test('T15675', normal, compile, [''])
T3811b.hs:4:14:
Cannot parse data constructor in a data/newtype declaration: !B
T3811b.hs:4:14: error:
Cannot parse data constructor in a data/newtype declaration:
! B
T3811c.hs:6:10: error:
• Unexpected strictness annotation: !Show
strictness annotation cannot appear nested inside a type
• In the instance declaration for ‘!Show D’
T3811c.hs:6:11: error:
Strictness annotation applied to a compound type.
Did you mean to add parentheses?
!(Show D)
T3811f.hs:4:7: Malformed head of type or class declaration: !Foo a
T3811f.hs:4:8: error:
Strictness annotation applied to a compound type.
Did you mean to add parentheses?
!(Foo a)
......@@ -129,3 +129,7 @@ test('typeops_B', normal, compile_fail, [''])
test('typeops_C', normal, compile_fail, [''])
test('typeops_D', normal, compile_fail, [''])
test('T15053', normal, compile_fail, [''])
test('typeopsDataCon_A', normal, compile_fail, [''])
test('typeopsDataCon_B', normal, compile_fail, [''])
test('strictnessDataCon_A', normal, compile_fail, [''])
test('strictnessDataCon_B', normal, compile_fail, [''])
strictnessDataCon_A.hs:1:21: error:
Strictness annotation cannot appear in this position.
type T = MkT { a :: {-# UNPACK #-} + Int }
strictnessDataCon_B.hs:1:21: error:
{-# UNPACK #-} cannot appear in this position.
typeopsDataCon_A.hs:1:10: error:
Cannot parse an infix data constructor in a data/newtype declaration:
Int :+ Int :+ Int
typeopsDataCon_B.hs:1:14: error: Not a data constructor: ‘+’
rnfail053.hs:5:10:
Not a data constructor: ‘forall’
Perhaps you intended to use ExistentialQuantification
rnfail053.hs:5:18: error:
Illegal symbol '.' in type
Perhaps you intended to use RankNTypes or a similar language
extension to enable explicit-forall syntax: forall <tvs>. <type>
T14761a.hs:3:19:
Unexpected UNPACK annotation: {-# UNPACK #-}Maybe
UNPACK annotation cannot appear nested inside a type
In the type ‘{-# UNPACK #-}Maybe Int’
In the definition of data constructor ‘A’
In the data declaration for ‘A’
T14761a.hs:3:34: error:
{-# UNPACK #-} applied to a compound type.
Did you mean to add parentheses?
{-# UNPACK #-} (Maybe Int)
T14761b.hs:5:19:
Unexpected strictness annotation: !Maybe
strictness annotation cannot appear nested inside a type
In the type ‘!Maybe Int’
In the definition of data constructor ‘A’
In the data declaration for ‘A’
T14761b.hs:5:21: error:
Strictness annotation applied to a compound type.
Did you mean to add parentheses?
!(Maybe Int)
T7210.hs:5:19:
Unexpected strictness annotation: !IntMap
strictness annotation cannot appear nested inside a type
In the type ‘!IntMap Int’
In the definition of data constructor ‘C’
In the data declaration for ‘T’
T7210.hs:5:20: error:
Strictness annotation applied to a compound type.
Did you mean to add parentheses?
!(IntMap Int)
T9634.hs:3:10:
Cannot parse data constructor in a data/newtype declaration: 1
T9634.hs:3:10: error:
Cannot parse data constructor in a data/newtype declaration:
1
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment