X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=55f8cf293ba2b102ca2aed5b3b8e6e50a13ac4c0;hb=e3dd39bf230380f02d73efc287226117bb2eb47f;hp=009eddca6281abcd815386a4515deccc9c171b85;hpb=d386e0d20c6953b7cba4d53538a1782c4aa9980d;p=ghc-hetmet.git diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 009eddc..55f8cf2 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -44,7 +44,7 @@ import FastString import Maybes ( orElse ) import Outputable -import Control.Monad ( when ) +import Control.Monad ( unless ) import GHC.Exts import Data.Char import Control.Monad ( mplus ) @@ -52,6 +52,17 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +31 December 2006 + +Conflicts: 34 shift/reduce + 1 reduce/reduce + +The reduce/reduce conflict is weird. It's between tyconsym and consym, and I +would think the two should never occur in the same context. + + -=chak + +----------------------------------------------------------------------------- 6 December 2006 Conflicts: 32 shift/reduce @@ -178,9 +189,9 @@ incorrect. 'data' { L _ ITdata } 'default' { L _ ITdefault } 'deriving' { L _ ITderiving } + 'derive' { L _ ITderive } 'do' { L _ ITdo } 'else' { L _ ITelse } - 'for' { L _ ITfor } 'hiding' { L _ IThiding } 'if' { L _ ITif } 'import' { L _ ITimport } @@ -208,7 +219,6 @@ incorrect. 'threadsafe' { L _ ITthreadsafe } 'unsafe' { L _ ITunsafe } 'mdo' { L _ ITmdo } - 'iso' { L _ ITiso } 'family' { L _ ITfamily } 'stdcall' { L _ ITstdcallconv } 'ccall' { L _ ITccallconv } @@ -547,7 +557,7 @@ ty_decl :: { LTyClDecl RdrName } -- infix type constructors to be declared {% do { (tc, tvs, _) <- checkSynHdr $2 False ; return (L (comb2 $1 $4) - (TySynonym tc tvs Nothing $4)) + (TySynonym tc tvs Nothing $4)) } } -- type family declarations @@ -556,11 +566,8 @@ ty_decl :: { LTyClDecl RdrName } -- infix type constructors to be declared -- {% do { (tc, tvs, _) <- checkSynHdr $3 False - ; let kind = case unLoc $4 of - Nothing -> liftedTypeKind - Just ki -> ki ; return (L (comb3 $1 $3 $4) - (TyFunction tc tvs False kind)) + (TyFamily TypeFamily tc tvs (unLoc $4))) } } -- type instance declarations @@ -598,14 +605,14 @@ ty_decl :: { LTyClDecl RdrName } -- data/newtype family | data_or_newtype 'family' tycl_hdr opt_kind_sig {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3} - ; checkTyVars tparms -- no type pattern - ; let kind = case unLoc $4 of - Nothing -> liftedTypeKind - Just ki -> ki + ; 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) - (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) - (Just kind) [] Nothing) } } + (TyFamily (DataFamily (unLoc $1)) tc tvs + (unLoc $4)) } } -- data/newtype instance declaration | data_or_newtype 'instance' tycl_hdr constrs deriving @@ -645,11 +652,8 @@ at_decl_cls :: { LTyClDecl RdrName } -- infix type constructors to be declared -- {% do { (tc, tvs, _) <- checkSynHdr $2 False - ; let kind = case unLoc $3 of - Nothing -> liftedTypeKind - Just ki -> ki ; return (L (comb3 $1 $2 $3) - (TyFunction tc tvs False kind)) + (TyFamily TypeFamily tc tvs (unLoc $3))) } } -- default type instance @@ -665,14 +669,15 @@ at_decl_cls :: { LTyClDecl RdrName } -- data/newtype family declaration | data_or_newtype tycl_hdr opt_kind_sig {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2} - ; checkTyVars tparms -- no type pattern - ; let kind = case unLoc $3 of - Nothing -> liftedTypeKind - Just ki -> ki + ; 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) - (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing) - (Just kind) [] Nothing) } } + (TyFamily (DataFamily (unLoc $1)) tc tvs + (unLoc $3)) + } } -- Associate type instances -- @@ -709,10 +714,6 @@ at_decl_inst :: { LTyClDecl RdrName } (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms) (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } } -opt_iso :: { Bool } - : { False } - | 'iso' { True } - data_or_newtype :: { Located NewOrData } : 'data' { L1 DataType } | 'newtype' { L1 NewType } @@ -740,10 +741,7 @@ tycl_hdr :: { Located (LHsContext RdrName, -- Glasgow extension: stand-alone deriving declarations stand_alone_deriving :: { LDerivDecl RdrName } - : 'deriving' qtycon 'for' qtycon {% do { p <- checkInstType (fmap HsTyVar $2) - ; checkDerivDecl (LL (DerivDecl p $4)) } } - - | 'deriving' '(' inst_type ')' 'for' qtycon {% checkDerivDecl (LL (DerivDecl $3 $6)) } + : 'derive' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) } ----------------------------------------------------------------------------- -- Nested declarations @@ -971,8 +969,13 @@ ctype :: { LHsType RdrName } -- 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. context :: { LHsContext RdrName } - : btype {% checkContext $1 } + : btype '~' btype {% checkContext + (LL $ HsPredTy (HsEqualP $1 $3)) } + | btype {% checkContext $1 } type :: { LHsType RdrName } : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) } @@ -983,7 +986,7 @@ gentype :: { LHsType RdrName } | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 } | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 } | btype '->' ctype { LL $ HsFunTy $1 $3 } - | btype '~' gentype { LL $ HsPredTy (HsEqualP $1 $3) } + | btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) } btype :: { LHsType RdrName } : btype atype { LL $ HsAppTy $1 $2 } @@ -1704,7 +1707,6 @@ varid_no_unsafe :: { Located RdrName } : VARID { L1 $! mkUnqual varName (getVARID $1) } | special_id { L1 $! mkUnqual varName (unLoc $1) } | 'forall' { L1 $! mkUnqual varName FSLIT("forall") } - | 'iso' { L1 $! mkUnqual varName FSLIT("iso") } | 'family' { L1 $! mkUnqual varName FSLIT("family") } qvarsym :: { Located RdrName } @@ -1729,14 +1731,14 @@ varsym_no_minus :: { Located RdrName } -- varsym not including '-' -- These special_ids are treated as keywords in various places, -- but as ordinary ids elsewhere. 'special_id' collects all these --- except 'unsafe', 'forall', 'family', and 'iso' whose treatment differs +-- except 'unsafe', 'forall', and 'family' whose treatment differs -- depending on context special_id :: { Located FastString } special_id : 'as' { L1 FSLIT("as") } | 'qualified' { L1 FSLIT("qualified") } | 'hiding' { L1 FSLIT("hiding") } - | 'for' { L1 FSLIT("for") } + | 'derive' { L1 FSLIT("derive") } | 'export' { L1 FSLIT("export") } | 'label' { L1 FSLIT("label") } | 'dynamic' { L1 FSLIT("dynamic") }