-- ---------------------------------------------------------------------------
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
import Module
import StaticFlags ( opt_SccProfilingOn, opt_Hpc )
import Type ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
+import Class ( FunDep )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..), RuleMatchInfo(..), defaultInlineSpec )
import DynFlags
'label' { L _ ITlabel }
'dynamic' { L _ ITdynamic }
'safe' { L _ ITsafe }
- 'threadsafe' { L _ ITthreadsafe }
+ 'threadsafe' { L _ ITthreadsafe } -- ToDo: remove deprecated alias
'unsafe' { L _ ITunsafe }
'mdo' { L _ ITmdo }
'family' { L _ ITfamily }
'stdcall' { L _ ITstdcallconv }
'ccall' { L _ ITccallconv }
+ 'prim' { L _ ITprimcallconv }
'dotnet' { L _ ITdotnet }
'proc' { L _ ITproc } -- for arrow notation extension
'rec' { L _ ITrec } -- for arrow notation extension
-- Type classes
--
cl_decl :: { LTyClDecl RdrName }
- : 'class' tycl_hdr fds where_cls
- {% do { let { (binds, sigs, ats, docs) =
- cvBindsAndSigs (unLoc $4)
- ; (ctxt, tc, tvs, tparms) = unLoc $2}
- ; checkTyVars tparms -- only type vars allowed
- ; checkKindSigs ats
- ; return $ L (comb4 $1 $2 $3 $4)
- (mkClassDecl (ctxt, tc, tvs)
- (unLoc $3) sigs binds ats docs) } }
+ : 'class' tycl_hdr fds where_cls {% mkClassDecl (comb4 $1 $2 $3 $4) $2 $3 $4 }
-- Type declarations (toplevel)
--
ty_decl :: { LTyClDecl RdrName }
-- ordinary type synonyms
- : 'type' type '=' ctype
+ : 'type' type '=' ctypedoc
-- Note ctype, not sigtype, on the right of '='
-- We allow an explicit for-all but we don't insert one
-- in type Foo a = (b,b)
--
-- Note the use of type for the head; this allows
-- infix type constructors to be declared
- {% do { (tc, tvs, _) <- checkSynHdr $2 False
- ; return (L (comb2 $1 $4)
- (TySynonym tc tvs Nothing $4))
- } }
+ {% mkTySynonym (comb2 $1 $4) False $2 $4 }
-- type family declarations
| 'type' 'family' type opt_kind_sig
-- Note the use of type for the head; this allows
-- infix type constructors to be declared
- --
- {% do { (tc, tvs, _) <- checkSynHdr $3 False
- ; return (L (comb3 $1 $3 $4)
- (TyFamily TypeFamily tc tvs (unLoc $4)))
- } }
+ {% mkTyFamily (comb3 $1 $3 $4) TypeFamily $3 (unLoc $4) }
-- type instance declarations
| 'type' 'instance' type '=' ctype
-- Note the use of type for the head; this allows
-- infix type constructors and type patterns
- --
- {% do { (tc, tvs, typats) <- checkSynHdr $3 True
- ; return (L (comb2 $1 $5)
- (TySynonym tc tvs (Just typats) $5))
- } }
+ {% mkTySynonym (comb2 $1 $5) True $3 $5 }
-- ordinary data type or newtype declaration
| data_or_newtype tycl_hdr constrs deriving
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
- ; checkTyVars tparms -- no type pattern
- ; return $!
- sL (comb4 $1 $2 $3 $4)
+ {% mkTyData (comb4 $1 $2 $3 $4) (unLoc $1) False $2
+ Nothing (reverse (unLoc $3)) (unLoc $4) }
-- We need the location on tycl_hdr in case
-- constrs and deriving are both empty
- (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
- Nothing (reverse (unLoc $3)) (unLoc $4)) } }
-- ordinary GADT declaration
| data_or_newtype tycl_hdr opt_kind_sig
'where' gadt_constrlist
deriving
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
- ; checkTyVars tparms -- can have type pats
- ; return $!
- sL (comb4 $1 $2 $4 $5)
- (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
- (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
+ {% mkTyData (comb4 $1 $2 $4 $5) (unLoc $1) False $2
+ (unLoc $3) (reverse (unLoc $5)) (unLoc $6) }
+ -- We need the location on tycl_hdr in case
+ -- constrs and deriving are both empty
-- data/newtype family
- | 'data' 'family' tycl_hdr opt_kind_sig
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
- ; checkTyVars tparms -- no type pattern
- ; unless (null (unLoc ctxt)) $ -- and no context
- parseError (getLoc ctxt)
- "A family declaration cannot have a context"
- ; return $
- L (comb3 $1 $2 $4)
- (TyFamily DataFamily tc tvs (unLoc $4)) } }
+ | 'data' 'family' type opt_kind_sig
+ {% mkTyFamily (comb3 $1 $2 $4) DataFamily $3 (unLoc $4) }
-- data/newtype instance declaration
| data_or_newtype 'instance' tycl_hdr constrs deriving
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
- -- can have type pats
- ; return $
- L (comb4 $1 $3 $4 $5)
- -- We need the location on tycl_hdr in case
- -- constrs and deriving are both empty
- (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
- Nothing (reverse (unLoc $4)) (unLoc $5)) } }
+ {% mkTyData (comb4 $1 $3 $4 $5) (unLoc $1) True $3
+ Nothing (reverse (unLoc $4)) (unLoc $5) }
-- GADT instance declaration
| data_or_newtype 'instance' tycl_hdr opt_kind_sig
'where' gadt_constrlist
deriving
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
- -- can have type pats
- ; return $
- L (comb4 $1 $3 $6 $7)
- (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
- (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
-
--- Associate type family declarations
+ {% mkTyData (comb4 $1 $3 $6 $7) (unLoc $1) True $3
+ (unLoc $4) (reverse (unLoc $6)) (unLoc $7) }
+
+-- Associated type family declarations
--
-- * They have a different syntax than on the toplevel (no family special
-- identifier).
: 'type' type opt_kind_sig
-- Note the use of type for the head; this allows
-- infix type constructors to be declared
- --
- {% do { (tc, tvs, _) <- checkSynHdr $2 False
- ; return (L (comb3 $1 $2 $3)
- (TyFamily TypeFamily tc tvs (unLoc $3)))
- } }
+ {% mkTyFamily (comb3 $1 $2 $3) TypeFamily $2 (unLoc $3) }
-- default type instance
| 'type' type '=' ctype
-- Note the use of type for the head; this allows
-- infix type constructors and type patterns
- --
- {% do { (tc, tvs, typats) <- checkSynHdr $2 True
- ; return (L (comb2 $1 $4)
- (TySynonym tc tvs (Just typats) $4))
- } }
+ {% mkTySynonym (comb2 $1 $4) True $2 $4 }
-- data/newtype family declaration
- | 'data' tycl_hdr opt_kind_sig
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
- ; checkTyVars tparms -- no type pattern
- ; unless (null (unLoc ctxt)) $ -- and no context
- parseError (getLoc ctxt)
- "A family declaration cannot have a context"
- ; return $
- L (comb3 $1 $2 $3)
- (TyFamily DataFamily tc tvs (unLoc $3))
- } }
-
--- Associate type instances
+ | 'data' type opt_kind_sig
+ {% mkTyFamily (comb3 $1 $2 $3) DataFamily $2 (unLoc $3) }
+
+-- Associated type instances
--
at_decl_inst :: { LTyClDecl RdrName }
-- type instance declarations
: 'type' type '=' ctype
-- Note the use of type for the head; this allows
-- infix type constructors and type patterns
- --
- {% do { (tc, tvs, typats) <- checkSynHdr $2 True
- ; return (L (comb2 $1 $4)
- (TySynonym tc tvs (Just typats) $4))
- } }
+ {% mkTySynonym (comb2 $1 $4) True $2 $4 }
-- data/newtype instance declaration
| data_or_newtype tycl_hdr constrs deriving
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
- -- can have type pats
- ; return $
- L (comb4 $1 $2 $3 $4)
- -- We need the location on tycl_hdr in case
- -- constrs and deriving are both empty
- (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
- Nothing (reverse (unLoc $3)) (unLoc $4)) } }
+ {% mkTyData (comb4 $1 $2 $3 $4) (unLoc $1) True $2
+ Nothing (reverse (unLoc $3)) (unLoc $4) }
-- GADT instance declaration
| data_or_newtype tycl_hdr opt_kind_sig
'where' gadt_constrlist
deriving
- {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
- -- can have type pats
- ; return $
- L (comb4 $1 $2 $5 $6)
- (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
- (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
+ {% mkTyData (comb4 $1 $2 $5 $6) (unLoc $1) True $2
+ (unLoc $3) (reverse (unLoc $5)) (unLoc $6) }
data_or_newtype :: { Located NewOrData }
: 'data' { L1 DataType }
-- (Eq a, Ord b) => T a b
-- T Int [a] -- for associated types
-- Rather a lot of inlining here, else we get reduce/reduce errors
-tycl_hdr :: { Located (LHsContext RdrName,
- Located RdrName,
- [LHsTyVarBndr RdrName],
- [LHsType RdrName]) }
- : context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
- | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
+tycl_hdr :: { Located (LHsContext RdrName, LHsType RdrName) }
+ : context '=>' type { LL ($1, $3) }
+ | type { L1 (noLoc [], $1) }
-----------------------------------------------------------------------------
-- Stand-alone deriving
callconv :: { CallConv }
: 'stdcall' { CCall StdCallConv }
| 'ccall' { CCall CCallConv }
+ | 'prim' { CCall PrimCallConv}
| 'dotnet' { DNCall }
safety :: { Safety }
: 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
- | 'threadsafe' { PlaySafe True }
+ | 'threadsafe' { PlaySafe True } -- deprecated alias
fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
: STRING var '::' sigtypedoc { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
: {- empty -} { Nothing }
| '::' atype { Just $2 }
-sigtypes1 :: { [LHsType RdrName] }
- : sigtype { [ $1 ] }
- | sigtype ',' sigtypes1 { $1 : $3 }
-
-sigtype :: { LHsType RdrName }
+sigtype :: { LHsType RdrName } -- Always a HsForAllTy,
+ -- to tell the renamer where to generalise
: ctype { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
-- Wrap an Implicit forall if there isn't one there already
-sigtypedoc :: { LHsType RdrName }
+sigtypedoc :: { LHsType RdrName } -- Always a HsForAllTy
: ctypedoc { L1 (mkImplicitHsForAllTy (noLoc []) $1) }
-- Wrap an Implicit forall if there isn't one there already
: sig_vars ',' var { LL ($3 : unLoc $1) }
| var { L1 [$1] }
+sigtypes1 :: { [LHsType RdrName] } -- Always HsForAllTys
+ : sigtype { [ $1 ] }
+ | sigtype ',' sigtypes1 { $1 : $3 }
+
-----------------------------------------------------------------------------
-- Types
infixtype :: { LHsType RdrName }
- : btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
- | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
+ : btype qtyconop type { LL $ HsOpTy $1 $2 $3 }
+ | btype tyvarop type { LL $ HsOpTy $1 $2 $3 }
-infixtypedoc :: { LHsType RdrName }
- : infixtype { $1 }
- | infixtype docprev { LL $ HsDocTy $1 $2 }
-
-gentypedoc :: { LHsType RdrName }
- : btype { $1 }
- | btypedoc { $1 }
- | infixtypedoc { $1 }
- | btype '->' ctypedoc { LL $ HsFunTy $1 $3 }
- | btypedoc '->' ctypedoc { LL $ HsFunTy $1 $3 }
-
-ctypedoc :: { LHsType RdrName }
- : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
- | context '=>' ctypedoc { LL $ mkImplicitHsForAllTy $1 $3 }
- -- A type of form (context => type) is an *implicit* HsForAllTy
- | gentypedoc { $1 }
-
strict_mark :: { Located HsBang }
: '!' { L1 HsStrict }
| '{-# UNPACK' '#-}' '!' { LL HsUnbox }
-- A ctype is a for-all type
ctype :: { LHsType RdrName }
: 'forall' tv_bndrs '.' ctype { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
- | context '=>' type { LL $ mkImplicitHsForAllTy $1 $3 }
+ | context '=>' ctype { LL $ mkImplicitHsForAllTy $1 $3 }
-- A type of form (context => type) is an *implicit* HsForAllTy
- | type { $1 }
+ | ipvar '::' type { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
+ | type { $1 }
+
+----------------------
+-- Notes for '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
+-- since it leads to ambiguity. The reason is the support for comments on record
+-- fields:
+-- data R = R { field :: Int -- ^ comment on the field }
+-- If we allow comments on types here, it's not clear if the comment applies
+-- to 'field' or to 'Int'. So we must use `ctype` to describe the type.
+
+ctypedoc :: { LHsType RdrName }
+ : 'forall' tv_bndrs '.' ctypedoc { LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
+ | context '=>' ctypedoc { LL $ mkImplicitHsForAllTy $1 $3 }
+ -- A type of form (context => type) is an *implicit* HsForAllTy
+ | ipvar '::' type { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
+ | typedoc { $1 }
+----------------------
+-- Notes for 'context'
-- We parse a context as a btype so that we don't get reduce/reduce
-- errors in ctype. The basic problem is that
-- (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 here and in gentype, to permit an individual
--- equational constraint without parenthesis.
+
+-- 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
context :: { LHsContext RdrName }
: btype '~' btype {% checkContext
(LL $ HsPredTy (HsEqualP $1 $3)) }
| btype {% checkContext $1 }
type :: { LHsType RdrName }
- : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
- | gentype { $1 }
-
-gentype :: { LHsType RdrName }
: btype { $1 }
- | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
- | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
+ | btype qtyconop type { LL $ HsOpTy $1 $2 $3 }
+ | btype tyvarop type { LL $ HsOpTy $1 $2 $3 }
| btype '->' ctype { LL $ HsFunTy $1 $3 }
| btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) }
+typedoc :: { LHsType RdrName }
+ : btype { $1 }
+ | btype docprev { LL $ HsDocTy $1 $2 }
+ | btype qtyconop type { LL $ HsOpTy $1 $2 $3 }
+ | btype qtyconop type docprev { LL $ HsDocTy (L (comb3 $1 $2 $3) (HsOpTy $1 $2 $3)) $4 }
+ | btype tyvarop type { LL $ HsOpTy $1 $2 $3 }
+ | btype tyvarop type docprev { LL $ HsDocTy (L (comb3 $1 $2 $3) (HsOpTy $1 $2 $3)) $4 }
+ | btype '->' ctypedoc { LL $ HsFunTy $1 $3 }
+ | btype docprev '->' ctypedoc { LL $ HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2)) $4 }
+ | btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) }
+
btype :: { LHsType RdrName }
: btype atype { LL $ HsAppTy $1 $2 }
| atype { $1 }
-btypedoc :: { LHsType RdrName }
- : btype atype docprev { LL $ HsDocTy (L (comb2 $1 $2) (HsAppTy $1 $2)) $3 }
- | atype docprev { LL $ HsDocTy $1 $2 }
-
atype :: { LHsType RdrName }
: gtycon { L1 (HsTyVar (unLoc $1)) }
| tyvar { L1 (HsTyVar (unLoc $1)) }
- | strict_mark atype { LL (HsBangTy (unLoc $1) $2) }
+ | strict_mark atype { LL (HsBangTy (unLoc $1) $2) } -- Constructor sigs only
+ | '{' fielddecls '}' { LL $ HsRecTy $2 } -- Constructor sigs only
| '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
| '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
| '[' ctype ']' { LL $ HsListTy $2 }
| '[:' ctype ':]' { LL $ HsPArrTy $2 }
| '(' ctype ')' { LL $ HsParTy $2 }
| '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
+ | '$(' exp ')' { LL $ HsSpliceTy (mkHsSplice $2 ) }
+ | TH_ID_SPLICE { LL $ HsSpliceTy (mkHsSplice
+ (L1 $ HsVar (mkUnqual varName
+ (getTH_ID_SPLICE $1)))) } -- $x
-- Generics
| INTEGER { L1 (HsNumTy (getINTEGER $1)) }
| '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2)
(unLoc $4)) }
-fds :: { Located [Located ([RdrName], [RdrName])] }
+fds :: { Located [Located (FunDep RdrName)] }
: {- empty -} { noLoc [] }
| '|' fds1 { LL (reverse (unLoc $2)) }
-fds1 :: { Located [Located ([RdrName], [RdrName])] }
+fds1 :: { Located [Located (FunDep RdrName)] }
: fds1 ',' fd { LL ($3 : unLoc $1) }
| fd { L1 [$1] }
-fd :: { Located ([RdrName], [RdrName]) }
+fd :: { Located (FunDep RdrName) }
: varids0 '->' varids0 { L (comb3 $1 $2 $3)
(reverse (unLoc $1), reverse (unLoc $3)) }
| vocurly gadt_constrs close { $2 }
gadt_constrs :: { Located [LConDecl RdrName] }
- : gadt_constrs ';' gadt_constr { LL ($3 : unLoc $1) }
+ : gadt_constrs ';' gadt_constr { sL (comb2 $1 (head $3)) ($3 ++ unLoc $1) }
| gadt_constrs ';' { $1 }
- | gadt_constr { L1 [$1] }
+ | gadt_constr { sL (getLoc (head $1)) $1 }
-- We allow the following forms:
-- C :: Eq a => a -> T a
-- D { x,y :: a } :: T a
-- forall a. Eq a => D { x,y :: a } :: T a
-gadt_constr :: { LConDecl RdrName }
- : con '::' sigtype
- { LL (mkGadtDecl $1 $3) }
- -- Syntax: Maybe merge the record stuff with the single-case above?
- -- (to kill the mostly harmless reduce/reduce error)
- -- XXX revisit audreyt
- | constr_stuff_record '::' sigtype
- { let (con,details) = unLoc $1 in
- LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
-{-
- | forall context '=>' constr_stuff_record '::' sigtype
- { let (con,details) = unLoc $4 in
- LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6) Nothing ) }
- | forall constr_stuff_record '::' sigtype
- { let (con,details) = unLoc $2 in
- LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4) Nothing) }
--}
+gadt_constr :: { [LConDecl RdrName] }
+ : con_list '::' sigtype
+ { map (sL (comb2 $1 $3)) (mkGadtDecl (unLoc $1) $3) }
+ -- Deprecated syntax for GADT record declarations
+ | oqtycon '{' fielddecls '}' '::' sigtype
+ {% do { cd <- mkDeprecatedGadtRecordDecl (comb2 $1 $6) $1 $3 $6
+ ; return [cd] } }
constrs :: { Located [LConDecl RdrName] }
: {- empty; a GHC extension -} { noLoc [] }
constr :: { LConDecl RdrName }
: maybe_docnext forall context '=>' constr_stuff maybe_docprev
{ let (con,details) = unLoc $5 in
- L (comb4 $2 $3 $4 $5) (ConDecl con Explicit (unLoc $2) $3 details ResTyH98 ($1 `mplus` $6)) }
+ addConDoc (L (comb4 $2 $3 $4 $5) (mkSimpleConDecl con (unLoc $2) $3 details))
+ ($1 `mplus` $6) }
| maybe_docnext forall constr_stuff maybe_docprev
{ let (con,details) = unLoc $3 in
- L (comb2 $2 $3) (ConDecl con Explicit (unLoc $2) (noLoc []) details ResTyH98 ($1 `mplus` $4)) }
+ addConDoc (L (comb2 $2 $3) (mkSimpleConDecl con (unLoc $2) (noLoc []) details))
+ ($1 `mplus` $4) }
forall :: { Located [LHsTyVarBndr RdrName] }
: 'forall' tv_bndrs '.' { LL $2 }
-- 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)
- : btype {% mkPrefixCon $1 [] >>= return.LL }
- | oqtycon '{' '}' {% mkRecCon $1 [] >>= return.LL }
- | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
- | btype conop btype { LL ($2, InfixCon $1 $3) }
+ : btype {% splitCon $1 >>= return.LL }
+ | btype conop btype { LL ($2, InfixCon $1 $3) }
-constr_stuff_record :: { Located (Located RdrName, HsConDeclDetails RdrName) }
- : oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
- | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
+fielddecls :: { [ConDeclField RdrName] }
+ : {- empty -} { [] }
+ | fielddecls1 { $1 }
-fielddecls :: { [([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] }
- : fielddecl maybe_docnext ',' maybe_docprev fielddecls { addFieldDoc (unLoc $1) $4 : addFieldDocs $5 $2 }
- | fielddecl { [unLoc $1] }
+fielddecls1 :: { [ConDeclField RdrName] }
+ : fielddecl maybe_docnext ',' maybe_docprev fielddecls1
+ { [ addFieldDoc f $4 | f <- $1 ] ++ addFieldDocs $5 $2 }
+ -- This adds the doc $4 to each field separately
+ | fielddecl { $1 }
-fielddecl :: { Located ([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName)) }
- : maybe_docnext sig_vars '::' ctype maybe_docprev { L (comb3 $2 $3 $4) (reverse (unLoc $2), $4, $1 `mplus` $5) }
+fielddecl :: { [ConDeclField RdrName] } -- A list because of f,g :: Int
+ : maybe_docnext sig_vars '::' ctype maybe_docprev { [ ConDeclField fld $4 ($1 `mplus` $5)
+ | fld <- reverse (unLoc $2) ] }
-- We allow the odd-looking 'inst_type' in a deriving clause, so that
-- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
-- so it's not enabled yet.
-- But this case *is* used for the left hand side of a generic definition,
-- which is parsed as an expression before being munged into a pattern
- | qcname '{|' gentype '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
+ | qcname '{|' type '|}' { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
(sL (getLoc $3) (HsType $3)) }
aexp2 :: { LHsExpr RdrName }
| '(' consym ')' { LL (unLoc $2) }
| sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
+con_list :: { Located [Located RdrName] }
+con_list : con { L1 [$1] }
+ | con ',' con_list { LL ($1 : unLoc $3) }
+
sysdcon :: { Located DataCon } -- Wired in data constructors
: '(' ')' { LL unitDataCon }
| '(' commas ')' { LL $ tupleCon Boxed $2 }
tyvarop :: { Located RdrName }
tyvarop : '`' tyvarid '`' { LL (unLoc $2) }
| tyvarsym { $1 }
+ | '.' {% parseErrorSDoc (getLoc $1)
+ (vcat [ptext (sLit "Illegal symbol '.' in type"),
+ ptext (sLit "Perhaps you intended -XRankNTypes or similar flag"),
+ ptext (sLit "to enable explicit-forall syntax: forall <tvs>. <type>")])
+ }
tyvarid :: { Located RdrName }
: VARID { L1 $! mkUnqual tvName (getVARID $1) }
| 'dynamic' { L1 (fsLit "dynamic") }
| 'stdcall' { L1 (fsLit "stdcall") }
| 'ccall' { L1 (fsLit "ccall") }
+ | 'prim' { L1 (fsLit "prim") }
special_sym :: { Located FastString }
special_sym : '!' { L1 (fsLit "!") }
projects / ghc-hetmet.git / blobdiff