X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fparser%2FParser.y.pp;h=47b049eaee0a9182d51954ab5571cdcb8543d1df;hb=5cb496dc86fac0b6023c08d4a0d7467df8d7b540;hp=6493b06f291f796a185108c6d71c9499abdd1c97;hpb=ef70af356e3229cc5c64359bf7866e5fdf44bb09;p=ghc-hetmet.git

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 6493b06..47b049e 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -8,7 +8,7 @@
 -- ---------------------------------------------------------------------------
 
 {
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn -w #-}
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
@@ -240,7 +240,7 @@ incorrect.
  'label'	{ L _ ITlabel } 
  'dynamic'	{ L _ ITdynamic }
  'safe'		{ L _ ITsafe }
- 'threadsafe'	{ L _ ITthreadsafe }
+ 'threadsafe'	{ L _ ITthreadsafe }  -- ToDo: remove deprecated alias
  'unsafe'	{ L _ ITunsafe }
  'mdo'		{ L _ ITmdo }
  'family'	{ L _ ITfamily }
@@ -957,7 +957,7 @@ callconv :: { CallConv }
 safety :: { Safety }
 	: 'unsafe'			{ PlayRisky }
 	| 'safe'			{ PlaySafe  False }
-	| 'threadsafe'			{ PlaySafe  True }
+	| 'threadsafe'			{ PlaySafe  True } -- deprecated alias
 
 fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
        : STRING var '::' sigtypedoc     { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
@@ -1004,17 +1004,6 @@ strict_mark :: { Located HsBang }
 	: '!'				{ L1 HsStrict }
 	| '{-# UNPACK' '#-}' '!'	{ LL HsUnbox }
 
-----------------------
--- Notes for 'ctype'
--- We should probably use 'gentype' rather than 'type' in the LHS of type declarations
--- That would leave the only use of 'type' in 'ctype'; and only one of its occurrences 
--- makes sense there too! So it might make sense to inline type there:
---    ctype : 'forall' tv_bndrs '.' ctype
---          | context '=>' ctype           
---          | ipvar '::' gentype
---          | gentype
--- Which in turn would let us rename gentype to type 
-
 -- A ctype is a for-all type
 ctype	:: { LHsType RdrName }
 	: 'forall' tv_bndrs '.' ctype	{ LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
@@ -1023,10 +1012,6 @@ ctype	:: { LHsType RdrName }
 	| ipvar '::' type		{ LL (HsPredTy (HsIParam (unLoc $1) $3)) }
 	| type  			{ $1 }
 
-type :: { LHsType RdrName }
-	: ipvar '::' gentype		{ LL (HsPredTy (HsIParam (unLoc $1) $3)) }
-	| gentype			{ $1 }
-
 ----------------------
 -- Notes for 'ctypedoc'
 -- It would have been nice to simplify the grammar by unifying `ctype` and 
@@ -1045,10 +1030,6 @@ ctypedoc :: { LHsType RdrName }
 	| ipvar '::' type		{ LL (HsPredTy (HsIParam (unLoc $1) $3)) }
 	| typedoc			{ $1 }
 
-typedoc :: { LHsType RdrName }
-	: ipvar '::' gentype		{ LL (HsPredTy (HsIParam (unLoc $1) $3)) }
-	| gentypedoc			{ $1 }
-
 ----------------------
 -- Notes for 'context'
 -- We parse a context as a btype so that we don't get reduce/reduce
@@ -1097,6 +1078,10 @@ atype :: { LHsType RdrName }
 	| '[:' ctype ':]'		{ LL $ HsPArrTy  $2 }
 	| '(' ctype ')'		        { LL $ HsParTy   $2 }
 	| '(' ctype '::' kind ')'	{ LL $ HsKindSig $2 (unLoc $4) }
+	| '$(' exp ')'	      		{ LL $ HsSpliceTy (mkHsSplice $2 ) }
+	| TH_ID_SPLICE	      		{ LL $ HsSpliceTy (mkHsSplice 
+					         (L1 $ HsVar (mkUnqual varName 
+							        (getTH_ID_SPLICE $1)))) } -- $x
 -- Generics
         | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
 
@@ -1165,9 +1150,9 @@ gadt_constrlist :: { Located [LConDecl RdrName] }
 	|     vocurly    gadt_constrs close	{ $2 }
 
 gadt_constrs :: { Located [LConDecl RdrName] }
-        : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
+        : gadt_constrs ';' gadt_constr  { sL (comb2 $1 (head $3)) ($3 ++ unLoc $1) }
         | gadt_constrs ';' 		{ $1 }
-        | gadt_constr                   { L1 [$1] } 
+        | gadt_constr                   { sL (getLoc (head $1)) $1 } 
 
 -- We allow the following forms:
 --	C :: Eq a => a -> T a
@@ -1175,15 +1160,15 @@ gadt_constrs :: { Located [LConDecl RdrName] }
 --	D { x,y :: a } :: T a
 --	forall a. Eq a => D { x,y :: a } :: T a
 
-gadt_constr :: { LConDecl RdrName }
-        : con '::' sigtype
-              { LL (mkGadtDecl $1 $3) } 
+gadt_constr :: { [LConDecl RdrName] }
+        : con_list '::' sigtype
+                { map (sL (comb2 $1 $3)) (mkGadtDecl (unLoc $1) $3) } 
         -- Syntax: Maybe merge the record stuff with the single-case above?
         --         (to kill the mostly harmless reduce/reduce error)
         -- XXX revisit audreyt
 	| constr_stuff_record '::' sigtype
 		{ let (con,details) = unLoc $1 in 
-		  LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing) }
+		  [LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3) Nothing)] }
 {-
 	| forall context '=>' constr_stuff_record '::' sigtype
 		{ let (con,details) = unLoc $4 in 
@@ -1743,6 +1728,10 @@ con	:: { Located RdrName }
 	| '(' consym ')'	{ LL (unLoc $2) }
 	| sysdcon		{ L1 $ nameRdrName (dataConName (unLoc $1)) }
 
+con_list :: { Located [Located RdrName] }
+con_list : con                  { L1 [$1] }
+         | con ',' con_list     { LL ($1 : unLoc $3) }
+
 sysdcon	:: { Located DataCon }	-- Wired in data constructors
 	: '(' ')'		{ LL unitDataCon }
 	| '(' commas ')'	{ LL $ tupleCon Boxed $2 }