-- ---------------------------------------------------------------------------
{
-{-# 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
--
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)
[LHsTyVarBndr RdrName],
[LHsType RdrName]) }
: context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
- | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
+ | type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
-----------------------------------------------------------------------------
-- Stand-alone deriving
-- Types
infixtype :: { LHsType RdrName }
- : btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
- | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
-
-infixtypedoc :: { LHsType RdrName }
- : infixtype { $1 }
- | infixtype docprev { LL $ HsDocTy $1 $2 }
+ : btype qtyconop type { LL $ HsOpTy $1 $2 $3 }
+ | btype tyvarop type { LL $ HsOpTy $1 $2 $3 }
-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
+ | 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
- | type { $1 }
+ | 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)) }
| '[:' 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)) }
-- 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 }
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) }