X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=5ff8ca815dc3c578cfdf7710154383046c0688ae;hp=889e4cef727258f9bd46de80c1b087d9f8a071c0;hb=102b73a3f2a2f63d3835726be625dca8053dd88c;hpb=84923cc7de2a93c22a2f72daf9ac863959efae13 diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 889e4ce..5ff8ca8 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,7 +189,7 @@ incorrect. 'data' { L _ ITdata } 'default' { L _ ITdefault } 'deriving' { L _ ITderiving } - 'derived' { L _ ITderived } + 'derive' { L _ ITderive } 'do' { L _ ITdo } 'else' { L _ ITelse } 'hiding' { L _ IThiding } @@ -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,7 +741,7 @@ tycl_hdr :: { Located (LHsContext RdrName, -- Glasgow extension: stand-alone deriving declarations stand_alone_deriving :: { LDerivDecl RdrName } - : 'derived' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) } + : 'derive' 'instance' inst_type {% checkDerivDecl (LL (DerivDecl $3)) } ----------------------------------------------------------------------------- -- Nested declarations @@ -1308,7 +1309,7 @@ aexp :: { LHsExpr RdrName } aexp1 :: { LHsExpr RdrName } : aexp1 '{' fbinds '}' {% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) - (reverse $3); + $3; return (LL r) }} | aexp2 { $1 } @@ -1324,6 +1325,9 @@ aexp2 :: { LHsExpr RdrName } : ipvar { L1 (HsIPVar $! unLoc $1) } | qcname { L1 (HsVar $! unLoc $1) } | literal { L1 (HsLit $! unLoc $1) } +-- This will enable overloaded strings permanently. Normally the renamer turns HsString +-- into HsOverLit when -foverloaded-strings is on. +-- | STRING { L1 (HsOverLit $! mkHsIsString (getSTRING $1)) } | INTEGER { L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) } | RATIONAL { L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) } | '(' exp ')' { LL (HsPar $2) } @@ -1531,10 +1535,10 @@ qual :: { LStmt RdrName } -- Record Field Update/Construction fbinds :: { HsRecordBinds RdrName } - : fbinds1 { $1 } - | {- empty -} { [] } + : fbinds1 { HsRecordBinds (reverse $1) } + | {- empty -} { HsRecordBinds [] } -fbinds1 :: { HsRecordBinds RdrName } +fbinds1 :: { [(Located id, LHsExpr id)] } : fbinds1 ',' fbind { $3 : $1 } | fbind { [$1] } @@ -1706,7 +1710,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 } @@ -1731,14 +1734,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") } - | 'derived' { L1 FSLIT("derived") } + | 'derive' { L1 FSLIT("derive") } | 'export' { L1 FSLIT("export") } | 'label' { L1 FSLIT("label") } | 'dynamic' { L1 FSLIT("dynamic") } @@ -1776,7 +1779,7 @@ consym :: { Located RdrName } literal :: { Located HsLit } : CHAR { L1 $ HsChar $ getCHAR $1 } - | STRING { L1 $ HsString $ getSTRING $1 } + | STRING { L1 $ HsString $ getSTRING $1 } | PRIMINTEGER { L1 $ HsIntPrim $ getPRIMINTEGER $1 } | PRIMCHAR { L1 $ HsCharPrim $ getPRIMCHAR $1 } | PRIMSTRING { L1 $ HsStringPrim $ getPRIMSTRING $1 }