X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=7465adb673879c9f58417852648d340e7beafbf6;hb=1a660e030bd3aaaa34adfea77d72856cdb48479e;hp=f0fc523feee824bed3e55414da88ff937b43ad21;hpb=6c06fdc7ad20682f0f52b5a78e5e3487a2ed047b;p=ghc-hetmet.git diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index f0fc523..7465adb 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,34 +997,20 @@ 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 } | '{-# UNPACK' '#-}' '!' { LL HsUnbox } ----------------------- --- Notes for 'ctype' --- We should probably use 'gentype' rather than 'type' in the LHS of type declarations --- That would leave the only use of 'type' in 'ctype'; and only one of its occurrences --- makes sense there too! So it might make sense to inline type there: --- ctype : 'forall' tv_bndrs '.' ctype --- | context '=>' ctype --- | ipvar '::' gentype --- | gentype --- Which in turn would let us rename gentype to type - -- 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 } - -type :: { LHsType RdrName } - : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) } - | gentype { $1 } + | ipvar '::' type { LL (HsPredTy (HsIParam (unLoc $1) $3)) } + | type { $1 } ---------------------- -- Notes for 'ctypedoc' @@ -1041,11 +1027,8 @@ 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 } - -typedoc :: { LHsType RdrName } - : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) } - | gentypedoc { $1 } + | ipvar '::' type { LL (HsPredTy (HsIParam (unLoc $1) $3)) } + | typedoc { $1 } ---------------------- -- Notes for 'context' @@ -1054,7 +1037,7 @@ typedoc :: { LHsType RdrName } -- (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 gentype, +-- 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 @@ -1063,20 +1046,20 @@ context :: { LHsContext RdrName } (LL $ HsPredTy (HsEqualP $1 $3)) } | btype {% checkContext $1 } -gentype :: { LHsType RdrName } +type :: { 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) } @@ -1095,6 +1078,10 @@ atype :: { LHsType RdrName } | '[:' 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)) } @@ -1163,9 +1150,9 @@ gadt_constrlist :: { Located [LConDecl RdrName] } | 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 @@ -1173,15 +1160,15 @@ gadt_constrs :: { Located [LConDecl RdrName] } -- 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 @@ -1410,7 +1397,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 } @@ -1741,6 +1728,10 @@ con :: { Located 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 }