X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y.pp;h=156cedcab385b437cbea945dcdfd6caa09d709d2;hb=5d3051c66796dcf884b052f9e4afc3ed19b9f514;hp=844cc8670e995f8bb0ea3648b1875096febeea43;hpb=491c85e7478f46d92166b938b4833504a28ff9d4;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index 844cc86..156cedc 100644
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -25,7 +25,7 @@ import Type		( funTyCon )
 import ForeignCall	( Safety(..), CExportSpec(..), CLabelString,
 			  CCallConv(..), CCallTarget(..), defaultCCallConv
 			)
-import OccName		( UserFS, varName, dataName, tcClsName, tvName )
+import OccName		( varName, dataName, tcClsName, tvName )
 import DataCon		( DataCon, dataConName )
 import SrcLoc		( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
 			  SrcSpan, combineLocs, srcLocFile, 
@@ -774,7 +774,7 @@ gentype :: { LHsType RdrName }
         : btype                         { $1 }
         | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
         | btype tyvarop  gentype  	{ LL $ HsOpTy $1 $2 $3 }
-	| btype '->' gentype		{ LL $ HsFunTy $1 $3 }
+ 	| btype '->' ctype		{ LL $ HsFunTy $1 $3 }
 
 btype :: { LHsType RdrName }
 	: btype atype			{ LL $ HsAppTy $1 $2 }
@@ -784,10 +784,10 @@ atype :: { LHsType RdrName }
 	: gtycon			{ L1 (HsTyVar (unLoc $1)) }
 	| tyvar				{ L1 (HsTyVar (unLoc $1)) }
 	| strict_mark atype		{ LL (HsBangTy (unLoc $1) $2) }
-	| '(' type ',' comma_types1 ')'	{ LL $ HsTupleTy Boxed  ($2:$4) }
+	| '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
 	| '(#' comma_types1 '#)'	{ LL $ HsTupleTy Unboxed $2     }
-	| '[' type ']'			{ LL $ HsListTy  $2 }
-	| '[:' type ':]'		{ LL $ HsPArrTy  $2 }
+	| '[' ctype ']'			{ LL $ HsListTy  $2 }
+	| '[:' ctype ':]'		{ LL $ HsPArrTy  $2 }
 	| '(' ctype ')'		        { LL $ HsParTy   $2 }
 	| '(' ctype '::' kind ')'	{ LL $ HsKindSig $2 $4 }
 -- Generics
@@ -809,8 +809,8 @@ comma_types0  :: { [LHsType RdrName] }
 	| {- empty -}			{ [] }
 
 comma_types1	:: { [LHsType RdrName] }
-	: type				{ [$1] }
-	| type  ',' comma_types1	{ $1 : $3 }
+	: ctype				{ [$1] }
+	| ctype  ',' comma_types1	{ $1 : $3 }
 
 tv_bndrs :: { [LHsTyVarBndr RdrName] }
 	 : tv_bndr tv_bndrs		{ $1 : $2 }
@@ -968,6 +968,10 @@ deriving :: { Located (Maybe [LHsType RdrName]) }
 
 decl 	:: { Located (OrdList (LHsDecl RdrName)) }
 	: sigdecl			{ $1 }
+	| '!' infixexp rhs		{% do { pat <- checkPattern $2;
+					        return (LL $ unitOL $ LL $ ValD $ 
+							PatBind (LL $ BangPat pat) (unLoc $3)
+								placeHolderType placeHolderNames) } }
 	| infixexp opt_sig rhs		{% do { r <- checkValDef $1 $2 $3;
 						return (LL $ unitOL (LL $ ValD r)) } }
 
@@ -1063,6 +1067,7 @@ aexps 	:: { [LHsExpr RdrName] }
 aexp	:: { LHsExpr RdrName }
 	: qvar '@' aexp			{ LL $ EAsPat $1 $3 }
 	| '~' aexp			{ LL $ ELazyPat $2 }
+--	| '!' aexp			{ LL $ EBangPat $2 }
 	| aexp1				{ $1 }
 
 aexp1	:: { LHsExpr RdrName }
@@ -1086,7 +1091,7 @@ aexp2	:: { LHsExpr RdrName }
 	| INTEGER			{ L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
 	| RATIONAL			{ L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
 	| '(' exp ')'			{ LL (HsPar $2) }
-	| '(' exp ',' texps ')'		{ LL $ ExplicitTuple ($2 : reverse $4) Boxed }
+	| '(' texp ',' texps ')'	{ LL $ ExplicitTuple ($2 : reverse $4) Boxed }
 	| '(#' texps '#)'		{ LL $ ExplicitTuple (reverse $2)      Unboxed }
 	| '[' list ']'                  { LL (unLoc $2) }
 	| '[:' parr ':]'                { LL (unLoc $2) }
@@ -1128,9 +1133,15 @@ cvtopdecls0 :: { [LHsDecl RdrName] }
 	: {- empty -}		{ [] }
 	| cvtopdecls		{ $1 }
 
+texp :: { LHsExpr RdrName }
+	: exp				{ $1 }
+	| qopm infixexp			{ LL $ SectionR $1 $2 }
+	-- The second production is really here only for bang patterns
+	-- but 
+
 texps :: { [LHsExpr RdrName] }
-	: texps ',' exp			{ $3 : $1 }
-	| exp				{ [$1] }
+	: texps ',' texp		{ $3 : $1 }
+	| texp				{ [$1] }
 
 
 -----------------------------------------------------------------------------
@@ -1140,17 +1151,17 @@ texps :: { [LHsExpr RdrName] }
 -- avoiding another shift/reduce-conflict.
 
 list :: { LHsExpr RdrName }
-	: exp			{ L1 $ ExplicitList placeHolderType [$1] }
+	: texp			{ L1 $ ExplicitList placeHolderType [$1] }
 	| lexps 		{ L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
-	| exp '..'		{ LL $ ArithSeq noPostTcExpr (From $1) }
-	| exp ',' exp '..' 	{ LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
-	| exp '..' exp	 	{ LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
-	| exp ',' exp '..' exp	{ LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-	| exp pquals		{ sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
+	| texp '..'		{ LL $ ArithSeq noPostTcExpr (From $1) }
+	| texp ',' exp '..' 	{ LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
+	| texp '..' exp	 	{ LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
+	| texp ',' exp '..' exp	{ LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
+	| texp pquals		{ sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
 
 lexps :: { Located [LHsExpr RdrName] }
-	: lexps ',' exp 		{ LL ($3 : unLoc $1) }
-	| exp ',' exp			{ LL [$3,$1] }
+	: lexps ',' texp 		{ LL ($3 : unLoc $1) }
+	| texp ',' texp			{ LL [$3,$1] }
 
 -----------------------------------------------------------------------------
 -- List Comprehensions
@@ -1260,7 +1271,7 @@ stmt  :: { LStmt RdrName }
   	| 'rec' stmtlist		{ LL $ mkRecStmt (unLoc $2) }
 
 qual  :: { LStmt RdrName }
-	: infixexp '<-' exp		{% checkPattern $1 >>= \p ->
+	: exp '<-' exp			{% checkPattern $1 >>= \p ->
 					   return (LL $ mkBindStmt p $3) }
 	| exp				{ L1 $ mkExprStmt $1 }
   	| 'let' binds			{ LL $ LetStmt (unLoc $2) }
@@ -1469,7 +1480,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' and 'forall' whose treatment differs depending on context
-special_id :: { Located UserFS }
+special_id :: { Located FastString }
 special_id
 	: 'as'			{ L1 FSLIT("as") }
 	| 'qualified'		{ L1 FSLIT("qualified") }
@@ -1480,7 +1491,7 @@ special_id
 	| 'stdcall'             { L1 FSLIT("stdcall") }
 	| 'ccall'               { L1 FSLIT("ccall") }
 
-special_sym :: { Located UserFS }
+special_sym :: { Located FastString }
 special_sym : '!'	{ L1 FSLIT("!") }
 	    | '.' 	{ L1 FSLIT(".") }
  	    | '*' 	{ L1 FSLIT("*") }