X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=a8eb1f75151aa12e4e2c84c20cd74077519a0089;hb=24d49415d2833a1338dfb5fd8c5c1c84df6c282b;hp=8806a3d4ef9c8ab3dc05b884283abae0217dad71;hpb=c0778bd3da61e80948e5813255ee82cdfebe0fdf;p=ghc-hetmet.git diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 8806a3d..a8eb1f7 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -8,7 +8,7 @@ -- --------------------------------------------------------------------------- { -{-# 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 @@ -774,7 +774,7 @@ tycl_hdr :: { Located (LHsContext RdrName, [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 @@ -997,8 +997,8 @@ sig_vars :: { Located [Located RdrName] } -- 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 } strict_mark :: { Located HsBang } : '!' { L1 HsStrict } @@ -1007,50 +1007,59 @@ strict_mark :: { Located HsBang } -- 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 - | typedoc { $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 } - -typedoc :: { LHsType RdrName } - : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) } - | gentypedoc { $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) } -gentypedoc :: { LHsType RdrName } +typedoc :: { LHsType RdrName } : btype { $1 } | btype docprev { LL $ HsDocTy $1 $2 } - | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 } - | btype qtyconop gentype docprev { LL $ HsDocTy (L (comb3 $1 $2 $3) (HsOpTy $1 $2 $3)) $4 } - | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 } - | btype tyvarop gentype docprev { LL $ HsDocTy (L (comb3 $1 $2 $3) (HsOpTy $1 $2 $3)) $4 } + | 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) } @@ -1384,7 +1393,7 @@ aexp1 :: { LHsExpr RdrName } -- 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 } @@ -1803,6 +1812,11 @@ tyvar : tyvarid { $1 } 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 . ")]) + } tyvarid :: { Located RdrName } : VARID { L1 $! mkUnqual tvName (getVARID $1) }