X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=abfc2582d36893b2d7b92a0a0f04b6d05e31bda2;hb=fcb8fd3a5590cf9b5eddce5cb38ecfc39a41e788;hp=060eeac87b1aff4cdb0365f06519c60efd54cca9;hpb=1ed54200532d9a9b1b58ac914dae28c1ecb48699;p=ghc-hetmet.git diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 060eeac..abfc258 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,28 @@ import Control.Monad ( mplus ) {- ----------------------------------------------------------------------------- +24 Februar 2006 + +Conflicts: 33 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 + +----------------------------------------------------------------------------- +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 @@ -208,7 +230,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 +568,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 +577,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 +616,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 +663,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 +680,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 +725,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 } @@ -1308,7 +1320,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 +1336,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) } @@ -1348,8 +1363,9 @@ aexp2 :: { LHsExpr RdrName } | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) } | '[t|' ctype '|]' { LL $ HsBracket (TypBr $2) } | '[p|' infixexp '|]' {% checkPattern $2 >>= \p -> - return (LL $ HsBracket (PatBr p)) } - | '[d|' cvtopbody '|]' { LL $ HsBracket (DecBr (mkGroup $2)) } + return (LL $ HsBracket (PatBr p)) } + | '[d|' cvtopbody '|]' {% checkDecBrGroup $2 >>= \g -> + return (LL $ HsBracket (DecBr g)) } -- arrow notation extension | '(|' aexp2 cmdargs '|)' { LL $ HsArrForm $2 Nothing (reverse $3) } @@ -1430,12 +1446,12 @@ quals :: { Located [LStmt RdrName] } parr :: { LHsExpr RdrName } : { noLoc (ExplicitPArr placeHolderType []) } - | exp { L1 $ ExplicitPArr placeHolderType [$1] } + | texp { L1 $ ExplicitPArr placeHolderType [$1] } | lexps { L1 $ ExplicitPArr placeHolderType (reverse (unLoc $1)) } - | exp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) } - | exp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) } - | exp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 } + | texp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) } + | texp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) } + | texp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 } -- We are reusing `lexps' and `pquals' from the list case. @@ -1531,10 +1547,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 +1722,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,7 +1746,7 @@ 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 @@ -1776,7 +1791,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 }