X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y.pp;h=83b299a7b86243d55515b2b60aa01e93396a30a1;hb=252abd9e355fe12e8f6f1e0192542a0df6ddccac;hp=49eefb3cf42c50ef1844912f69bf653f5042b5c4;hpb=40888e1d6141c919254f93545ae0d795e20ae4bf;p=ghc-hetmet.git diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp index 49eefb3..83b299a 100644 --- a/ghc/compiler/parser/Parser.y.pp +++ b/ghc/compiler/parser/Parser.y.pp @@ -8,7 +8,7 @@ -- --------------------------------------------------------------------------- { -module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where +module Parser ( parseModule, parseStmt, parseIdentifier, parseIface, parseType ) where #define INCLUDE #include INCLUDE "HsVersions.h" @@ -21,13 +21,14 @@ import RdrName import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon, listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR ) import Type ( funTyCon ) -import ForeignCall ( Safety(..), CExportSpec(..), +import ForeignCall ( Safety(..), CExportSpec(..), CLabelString, CCallConv(..), CCallTarget(..), defaultCCallConv ) import OccName ( UserFS, varName, dataName, tcClsName, tvName ) import DataCon ( DataCon, dataConName ) import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans, - SrcSpan, combineLocs, mkGeneralSrcSpan, srcLocFile ) + SrcSpan, combineLocs, srcLocFile, + mkSrcLoc, mkSrcSpan ) import Module import CmdLineOpts ( opt_SccProfilingOn ) import Type ( Kind, mkArrowKind, liftedTypeKind ) @@ -37,7 +38,6 @@ import OrdList import Bag ( emptyBag ) import Panic -import CStrings ( CLabelString ) import FastString import Maybes ( orElse ) import Outputable @@ -58,6 +58,9 @@ Conflicts: 29 shift/reduce, [SDM 19/9/2002] 1 for ambiguity in 'if x then y else z :: T' [State 136] (shift parses as 'if x then y else (z :: T)', as per longest-parse rule) +4 for ambiguity in 'if x then y else z -< e' + (shift parses as 'if x then y else (z -< T)', as per longest-parse rule) + 8 for ambiguity in 'e :: a `b` c'. Does this mean [States 160,246] (e::a) `b` c, or (e :: (a `b` c)) @@ -263,6 +266,7 @@ TH_TY_QUOTE { L _ ITtyQuote } -- ''T %name parseStmt maybe_stmt %name parseIdentifier identifier %name parseIface iface +%name parseType ctype %tokentype { Located Token } %% @@ -753,7 +757,7 @@ context :: { LHsContext RdrName } : btype {% checkContext $1 } type :: { LHsType RdrName } - : ipvar '::' gentype { LL (HsPredTy (LL $ HsIParam (unLoc $1) $3)) } + : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) } | gentype { $1 } gentype :: { LHsType RdrName } @@ -898,8 +902,15 @@ strict_mark :: { Located HsBang } : '!' { L1 HsStrict } | '{-# UNPACK' '#-}' '!' { LL HsUnbox } +-- We allow the odd-looking 'inst_type' in a deriving clause, so that +-- we can do deriving( forall a. C [a] ) in a newtype (GHC extension). +-- The 'C [a]' part is converted to an HsPredTy by checkInstType +-- We don't allow a context, but that's sorted out by the type checker. deriving :: { Located (Maybe [LHsType RdrName]) } : {- empty -} { noLoc Nothing } + | 'deriving' qtycon {% do { let { L loc tv = $2 } + ; p <- checkInstType (L loc (HsTyVar tv)) + ; return (LL (Just [p])) } } | 'deriving' '(' ')' { LL (Just []) } | 'deriving' '(' inst_types1 ')' { LL (Just $3) } -- Glasgow extension: allow partial @@ -930,7 +941,7 @@ deriving :: { Located (Maybe [LHsType RdrName]) } decl :: { Located (OrdList (LHsDecl RdrName)) } : sigdecl { $1 } - | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 (unLoc $3); + | infixexp opt_sig rhs {% do { r <- checkValDef $1 $2 $3; return (LL $ unitOL (LL $ ValD r)) } } rhs :: { Located (GRHSs RdrName) } @@ -969,10 +980,10 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) } exp :: { LHsExpr RdrName } : infixexp '::' sigtype { LL $ ExprWithTySig $1 $3 } - | fexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True } - | fexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False } - | fexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True } - | fexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False} + | infixexp '-<' exp { LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True } + | infixexp '>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False } + | infixexp '-<<' exp { LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True } + | infixexp '>>-' exp { LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False} | infixexp { $1 } infixexp :: { LHsExpr RdrName } @@ -1064,7 +1075,7 @@ aexp2 :: { LHsExpr RdrName } | '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp ) | TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) } - | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) } + | TH_VAR_QUOTE gcon { LL $ HsBracket (VarBr (unLoc $2)) } | TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) } | TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) } | '[|' exp '|]' { LL $ HsBracket (ExpBr $2) } @@ -1546,8 +1557,12 @@ comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $ sL :: SrcSpan -> a -> Located a sL span a = span `seq` L span a --- Make a source location that is just the filename. This seems slightly --- neater than trying to construct the span of the text within the file. +-- Make a source location for the file. We're a bit lazy here and just +-- make a point SrcSpan at line 1, column 0. Strictly speaking we should +-- try to find the span of the whole file (ToDo). fileSrcSpan :: P SrcSpan -fileSrcSpan = do l <- getSrcLoc; return (mkGeneralSrcSpan (srcLocFile l)) +fileSrcSpan = do + l <- getSrcLoc; + let loc = mkSrcLoc (srcLocFile l) 1 0; + return (mkSrcSpan loc loc) }