-- ---------------------------------------------------------------------------
{
-{-# 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
'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
--
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
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) }
-- 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)) }
| 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) }
+gadt_constr :: { [LConDecl RdrName] }
+ : con_list '::' sigtype
+ { map (sL (comb2 $1 $3)) (mkGadtDecl (unLoc $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) }
+ [LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing)] }
{-
| forall context '=>' constr_stuff_record '::' sigtype
{ let (con,details) = unLoc $4 in
-- 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 "!") }