X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FParseIface.y;h=5d58b407a6e141b6cd48020fb9f6140692286cc8;hb=a61995821fca70c4d62769757d6808ebbc970e12;hp=e548c1ee3a03ca2de821b5337f2cf77429d6986c;hpb=0fffbea841d9647388a7b845808a9757782da663;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index e548c1e..5d58b40 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -5,27 +5,30 @@ module ParseIface ( parseIface, IfaceStuff(..) ) where
 
 import HsSyn		-- quite a bit of stuff
 import RdrHsSyn		-- oodles of synonyms
-import HsDecls		( HsIdInfo(..), HsStrictnessInfo(..) )
 import HsTypes		( mkHsForAllTy )
 import HsCore
 import Const		( Literal(..), mkMachInt_safe )
-import BasicTypes	( IfaceFlavour(..), Fixity(..), FixityDirection(..), 
+import BasicTypes	( Fixity(..), FixityDirection(..), 
 			  NewOrData(..), Version
 			)
+import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
 import HsPragmas	( noDataPragmas, noClassPragmas )
-import Type		( Kind, mkArrowKind, boxedTypeKind, openTypeKind )
-import IdInfo           ( ArityInfo, exactArity )
+import Type		( Kind, mkArrowKind, boxedTypeKind, openTypeKind, UsageAnn(..) )
+import IdInfo           ( ArityInfo, exactArity, CprInfo(..) )
 import Lex		
 
-import RnEnv            ( ifaceUnqualTC, ifaceUnqualVar, ifaceUnqualTv, ifaceQualVar, ifaceQualTC )
 import RnMonad		( ImportVersion, LocalVersion, ParsedIface(..), WhatsImported(..),
-			  RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..)
+			  RdrNamePragma, ExportItem, RdrAvailInfo, GenAvailInfo(..), WhetherHasOrphans
 			) 
 import Bag		( emptyBag, unitBag, snocBag )
 import FiniteMap	( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
-import Name		( OccName, isTCOcc, Provenance, Module,
-			  varOcc, tcOcc, mkModuleFS
+import RdrName          ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual )
+import Name		( OccName, Provenance )
+import OccName          ( mkSysOccFS,
+			  tcName, varName, dataName, clsName, tvName,
+			  EncodedFS 
 			)
+import Module           ( ModuleName, mkSysModuleFS )			
 import PrelMods         ( mkTupNameStr, mkUbxTupNameStr )
 import PrelInfo         ( mkTupConRdrName, mkUbxTupConRdrName )
 import SrcLoc		( SrcLoc )
@@ -33,12 +36,16 @@ import Maybes
 import Outputable
 
 import GlaExts
+
+#if __HASKELL1__ > 4
+import Ratio ( (%) )
+#endif
 }
 
 %name	    parseIface
-%tokentype  { IfaceToken }
-%monad	    { IfM }{ thenIf }{ returnIf }
-%lexer      { lexIface } { ITeof }
+%tokentype  { Token }
+%monad	    { P }{ thenP }{ returnP }
+%lexer      { lexer } { ITeof }
 
 %token
  'case' 	{ ITcase }  			-- Haskell keywords
@@ -66,13 +73,21 @@ import GlaExts
  'qualified' 	{ ITqualified }
  'hiding' 	{ IThiding }
 
- '__interface'	{ ITinterface }			-- GHC-extension keywords
- '__export'	{ ITexport }
- '__instimport'	{ ITinstimport }
- '__forall'	{ ITforall }
+ 'forall'	{ ITforall }			-- GHC extension keywords
+ 'foreign'	{ ITforeign }
+ 'export'	{ ITexport }
+ 'label'	{ ITlabel } 
+ 'dynamic'	{ ITdynamic }
+ 'unsafe'	{ ITunsafe }
+
+ '__interface'	{ ITinterface }			-- interface keywords
+ '__export'	{ IT__export }
+ '__forall'	{ IT__forall }
+ '__depends'	{ ITdepends }
  '__letrec'	{ ITletrec }
  '__coerce'	{ ITcoerce }
- '__inline'	{ ITinline }
+ '__inline_call'{ ITinlineCall }
+ '__inline_me'  { ITinlineMe }
  '__DEFAULT'	{ ITdefaultbranch }
  '__bot'	{ ITbottom }
  '__integer'	{ ITinteger_lit }
@@ -82,14 +97,19 @@ import GlaExts
  '__litlit'	{ ITlit_lit }
  '__string'	{ ITstring_lit }
  '__ccall'	{ ITccall $$ }
- '__scc' 	{ ITscc $$ }
- '__a'		{ ITtypeapp }
+ '__scc' 	{ ITscc }
+ '__sccC'       { ITsccAllCafs }
+
+ '__o'		{ ITonce }
+ '__m'		{ ITmany }
 
  '__A'		{ ITarity }
  '__P'		{ ITspecialise }
  '__C'		{ ITnocaf }
  '__U'		{ ITunfold $$ }
  '__S'		{ ITstrict $$ }
+ '__R'		{ ITrules }
+ '__M'		{ ITcprinfo $$ }
 
  '..'		{ ITdotdot }  			-- reserved symbols
  '::'		{ ITdcolon }
@@ -132,6 +152,7 @@ import GlaExts
  STRING		{ ITstring   $$ }
  INTEGER	{ ITinteger  $$ }
  RATIONAL	{ ITrational $$ }
+ CLITLIT	{ ITlitlit   $$ }
 
  UNKNOWN	{ ITunknown  $$ }
 %%
@@ -142,27 +163,29 @@ import GlaExts
 --		 (c) the IdInfo part of a signature (same reason)
 
 iface_stuff :: { IfaceStuff }
-iface_stuff : iface		{ PIface  $1 }
+iface_stuff : iface		{ let (nm, iff) = $1 in PIface nm iff }
       	    | type		{ PType   $1 }
       	    | id_info		{ PIdInfo $1 }
+	    | '__R' rules	{ PRules  $2 }
 
 
-iface		:: { ParsedIface }
-iface		: '__interface' mod_name INTEGER checkVersion 'where'
-                  import_part
-		  instance_import_part
+iface		:: { (ModuleName, ParsedIface) }
+iface		: '__interface' mod_fs INTEGER orphans checkVersion 'where'
 		  exports_part
+                  import_part
 		  instance_decl_part
 		  decls_part
-		  { ParsedIface 
-		        $2  		        -- Module name
-			(fromInteger $3) 	-- Module version
-			(reverse $6)	        -- Usages
-			(reverse $8)	        -- Exports
-			(reverse $7)	        -- Instance import modules
-			(reverse $10)		-- Decls
-			(reverse $9)		-- Local instances
-		  }
+		  rules_part
+		  { ( $2                        -- Module name
+		    , ParsedIface {
+			pi_mod = fromInteger $3, 	-- Module version
+			pi_orphan  = $4,
+			pi_exports = $7,        -- Exports
+			pi_usages  = $8,	-- Usages
+			pi_insts   = $9,	-- Local instances
+			pi_decls   = $10,	-- Decls
+		 	pi_rules   = $11	-- Rules 
+		      } ) }
 
 --------------------------------------------------------------------------
 
@@ -171,50 +194,58 @@ import_part :				    		  { [] }
 	    |  import_part import_decl			  { $2 : $1 }
 	    
 import_decl :: { ImportVersion OccName }
-import_decl : 'import' mod_name opt_bang INTEGER '::' whats_imported ';'
-			{ ($2, $3, fromInteger $4, $6) }
+import_decl : 'import' mod_fs INTEGER orphans whats_imported ';'
+			{ (mkSysModuleFS $2, fromInteger $3, $4, $5) }
+	-- import Foo 3 :: a 1 b 3 c 7 ;	means import a,b,c from Foo
+	-- import Foo 3	;			means import all of Foo
+	-- import Foo 3 ! :: ...stuff... ;	the ! means that Foo contains orphans
+
+orphans		    :: { WhetherHasOrphans }
+orphans		    : 						{ False }
+		    | '!'					{ True }
 
 whats_imported      :: { WhatsImported OccName }
 whats_imported      :                                           { Everything }
-                    | name_version_pair name_version_pairs      { Specifically ($1:$2) }
+                    | '::' name_version_pairs      		{ Specifically $2 }
 
 name_version_pairs  ::	{ [LocalVersion OccName] }
 name_version_pairs  :  						{ [] }
 		    |  name_version_pair name_version_pairs	{ $1 : $2 }
 
 name_version_pair   ::	{ LocalVersion OccName }
-name_version_pair   :  entity_occ INTEGER			{ ($1, fromInteger $2) }
+name_version_pair   :  var_occ INTEGER			        { ($1, fromInteger $2) }
+                    |  tc_occ  INTEGER                          { ($1, fromInteger $2) }
 
-instance_import_part :: { [Module] }
-instance_import_part : 						{   []    }
-                     | instance_import_part '__instimport' mod_name ';'
-						 		{ $3 : $1 }
 
 --------------------------------------------------------------------------
 
 exports_part	:: { [ExportItem] }
 exports_part	:  					{ [] }
-		| exports_part '__export' opt_bang mod_name entities ';'
-						{ ($4,$3,$5) : $1 }
-
-opt_bang	:: { IfaceFlavour }
-opt_bang	:						{ HiFile }
-		| '!'						{ HiBootFile }
+		| exports_part '__export' 
+		  mod_fs entities ';'			{ (mkSysModuleFS $3, $4) : $1 }
 
 entities	:: { [RdrAvailInfo] }
-entities	: 						{ [] }
-		|  entity entities				{ $1 : $2 }
+entities	: 					{ [] }
+		|  entity entities			{ $1 : $2 }
 
 entity		:: { RdrAvailInfo }
-entity		:  entity_occ 				{ if isTCOcc $1 
-							  then AvailTC $1 [$1]
-							  else Avail $1 }
-		|  entity_occ stuff_inside		{ AvailTC $1 ($1:$2) }
-		|  entity_occ '|' stuff_inside		{ AvailTC $1 $3 }
+entity		:  tc_occ 				{ AvailTC $1 [$1] }
+		|  var_occ				{ Avail $1 }
+		|  tc_occ stuff_inside		        { AvailTC $1 ($1:$2) }
+		|  tc_occ '|' stuff_inside		{ AvailTC $1 $3 }
 
 stuff_inside	:: { [OccName] }
 stuff_inside	:  '{' val_occs '}'			{ $2 }
 
+val_occ		:: { OccName }
+		:  var_occ 		{ $1 }
+                |  data_occ             { $1 }
+
+val_occs	:: { [OccName] }
+		:  val_occ    		{ [$1] }
+		|  val_occ val_occs	{ $1 : $2 }
+
+
 --------------------------------------------------------------------------
 
 fixity      :: { FixityDirection }
@@ -237,11 +268,8 @@ csigs1		: csig				{ [$1] }
 		| csig ';' csigs1		{ $1 : $3 }
 
 csig		:: { RdrNameSig }
-csig		:  src_loc var_name '::' type { ClassOpSig $2 Nothing $4 $1 }
-	        |  src_loc var_name '=' '::' type	
-			{ ClassOpSig $2 
-			    (Just (error "Un-filled-in default method"))
-			    $5 $1 }
+csig		:  src_loc var_name '::' type		{ mkClassOpSig False $2 $4 $1 }
+	        |  src_loc var_name '=' '::' type	{ mkClassOpSig True  $2 $5 $1 }
 
 --------------------------------------------------------------------------
 
@@ -254,7 +282,7 @@ inst_decl	:  src_loc 'instance' type '=' var_name ';'
 			{ InstDecl $3
 				   EmptyMonoBinds	{- No bindings -}
 				   []    		{- No user pragmas -}
-				   (Just $5)		{- Dfun id -}
+				   $5			{- Dfun id -}
 				   $1
 			}
 
@@ -270,27 +298,57 @@ decl    : src_loc var_name '::' type maybe_idinfo
   		 	 { SigD (IfaceSig $2 $4 ($5 $2) $1) }
 	| src_loc 'type' tc_name tv_bndrs '=' type 		       
 			{ TyClD (TySynonym $3 $4 $6 $1) }
-	| src_loc 'data' decl_context data_fs tv_bndrs constrs 	       
-	       		{ TyClD (TyData DataType $3 (ifaceUnqualTC $4) $5 $6 Nothing noDataPragmas $1) }
+	| src_loc 'data' decl_context tc_name tv_bndrs constrs 	       
+	       		{ TyClD (TyData DataType $3 $4 $5 $6 Nothing noDataPragmas $1) }
 	| src_loc 'newtype' decl_context tc_name tv_bndrs newtype_constr
 			{ TyClD (TyData NewType $3 $4 $5 $6 Nothing noDataPragmas $1) }
 	| src_loc 'class' decl_context tc_name tv_bndrs csigs
 			{ TyClD (mkClassDecl $3 $4 $5 $6 EmptyMonoBinds 
 					noClassPragmas $1) }
-        | src_loc fixity mb_fix val_occ
-                        { FixD (FixitySig (Unqual $4) (Fixity $3 $2) $1) }
+        | src_loc fixity mb_fix var_or_data_name
+                        { FixD (FixitySig $4 (Fixity $3 $2) $1) }
 
 maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 maybe_idinfo  : {- empty -} 	{ \_ -> [] }
 	      | src_loc PRAGMA	{ \x -> 
-				   case parseIface $2 $1 of
-				     Succeeded (PIdInfo id_info) -> id_info
-				     Failed err -> pprPanic "IdInfo parse failed" 
-				                            (vcat [ppr x, err])
+				   case parseIface $2
+				           PState{bol = 0#, atbol = 1#,
+						  context = [],
+						  glasgow_exts = 1#,
+						  loc = $1 } of
+				     POk _ (PIdInfo id_info) -> id_info
+				     PFailed err -> 
+				        pprPanic "IdInfo parse failed" 
+				            (vcat [ppr x, err])
 				}
 
 -----------------------------------------------------------------------------
 
+rules_part :: { [RdrNameRuleDecl] }
+rules_part : {- empty -}	{ [] }
+	   | src_loc PRAGMA	{ case parseIface $2 
+				           PState{bol = 0#, atbol = 1#,
+						  context = [],
+						  glasgow_exts = 1#,
+						  loc = $1 }  of
+				     POk _ (PRules rules) -> rules
+				     PFailed err -> 
+					  pprPanic "Rules parse failed" err
+				}
+
+rules	   :: { [RdrNameRuleDecl] }
+	   : {- empty -}	{ [] }
+	   | rule ';' rules	{ $1:$3 }
+
+rule	   :: { RdrNameRuleDecl }
+rule	   : src_loc STRING rule_forall qvar_name 
+	     core_args '=' core_expr	{ IfaceRuleDecl $4 (UfRuleBody $2 $3 $5 $7) $1 } 
+
+rule_forall	:: { [UfBinder RdrName] }
+rule_forall	: '__forall' '{' core_bndrs '}'	{ $3 }
+		  
+-----------------------------------------------------------------------------
+
 version		:: { Version }
 version		:  INTEGER				{ fromInteger $1 }
 
@@ -298,7 +356,7 @@ decl_context	:: { RdrNameContext }
 decl_context	:  					{ [] }
 		| '{' context_list1 '}' '=>'	{ $2 }
 
-----------------------------------------------------------------
+----------------------------------------------------------------------------
 
 constrs		:: { [RdrNameConDecl] {- empty for handwritten abstract -} }
 		: 			{ [] }
@@ -309,8 +367,8 @@ constrs1	:  constr		{ [$1] }
 		|  constr '|' constrs1	{ $1 : $3 }
 
 constr		:: { RdrNameConDecl }
-constr		:  src_loc ex_stuff data_fs batypes		{ mkConDecl (ifaceUnqualVar $3) $2 (VanillaCon $4) $1 }
-		|  src_loc ex_stuff data_fs '{' fields1 '}'	{ mkConDecl (ifaceUnqualVar $3) $2 (RecCon $5)     $1 }
+constr		:  src_loc ex_stuff data_name batypes		{ mkConDecl $3 $2 (VanillaCon $4) $1 }
+		|  src_loc ex_stuff data_name '{' fields1 '}'	{ mkConDecl $3 $2 (RecCon $5)     $1 }
                 -- We use "data_fs" so as to include ()
 
 newtype_constr	:: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
@@ -330,6 +388,7 @@ batypes		:  					{ [] }
 batype		:: { RdrNameBangType }
 batype		:  atype				{ Unbanged $1 }
 		|  '!' atype				{ Banged   $2 }
+		|  '!' '!' atype			{ Unpacked $3 }
 
 fields1		:: { [([RdrName], RdrNameBangType)] }
 fields1		: field					{ [$1] }
@@ -338,6 +397,7 @@ fields1		: field					{ [$1] }
 field		:: { ([RdrName], RdrNameBangType) }
 field		:  var_names1 '::' type		{ ($1, Unbanged $3) }
 		|  var_names1 '::' '!' type    	{ ($1, Banged   $4) }
+		|  var_names1 '::' '!' '!' type	{ ($1, Unpacked $5) }
 --------------------------------------------------------------------------
 
 type		:: { RdrNameHsType }
@@ -358,7 +418,7 @@ context_list1	: class					{ [$1] }
 		| class ',' context_list1 		{ $1 : $3 }
 
 class		:: { (RdrName, [RdrNameHsType]) }
-class		:  qtc_name atypes			{ ($1, $2) }
+class		:  qcls_name atypes			{ ($1, $2) }
 
 types2		:: { [RdrNameHsType] 			{- Two or more -}  }	
 types2		:  type ',' type			{ [$1,$3] }
@@ -367,63 +427,61 @@ types2		:  type ',' type			{ [$1,$3] }
 btype		:: { RdrNameHsType }
 btype		:  atype				{ $1 }
 		|  btype atype				{ MonoTyApp $1 $2 }
+                |  '__o' atype				{ MonoUsgTy UsOnce $2 }
+                |  '__m' atype				{ MonoUsgTy UsMany $2 }
 
 atype		:: { RdrNameHsType }
 atype		:  qtc_name 			  	{ MonoTyVar $1 }
 		|  tv_name			  	{ MonoTyVar $1 }
-	  	|  '(' ')' 				{ MonoTupleTy [] True }
 		|  '(' types2 ')'	  		{ MonoTupleTy $2 True{-boxed-} }
 		|  '(#' type '#)'  			{ MonoTupleTy [$2] False{-unboxed-} }
 		|  '(#' types2 '#)'			{ MonoTupleTy $2 False{-unboxed-} }
 		|  '[' type ']'		  		{ MonoListTy  $2 }
-		|  '{' qtc_name atypes '}'		{ MonoDictTy $2 $3 }
+		|  '{' qcls_name atypes '}'		{ MonoDictTy $2 $3 }
 		|  '(' type ')'		  		{ $2 }
 
+-- This one is dealt with via qtc_name
+--	  	|  '(' ')' 				{ MonoTupleTy [] True }
+
 atypes		:: { [RdrNameHsType] 	{-  Zero or more -} }
 atypes		:  					{ [] }
 		|  atype atypes				{ $1 : $2 }
 ---------------------------------------------------------------------
+mod_fs	        :: { EncodedFS }
+		:  CONID		{ $1 }
+
+mod_name	:: { ModuleName }
+		:  mod_fs		{ mkSysModuleFS $1 }
 
-mod_name	:: { Module }
-		:  CONID		{ mkModuleFS $1 }
 
-var_fs		:: { FAST_STRING }
+---------------------------------------------------
+var_fs		:: { EncodedFS }
 		: VARID			{ $1 }
 		| VARSYM		{ $1 }
-		| '-' 			{ SLIT("-") }
 		| '!'	  		{ SLIT("!") }
-
-data_fs         :: { FAST_STRING }
-		:  CONID		{ $1 }
-		|  CONSYM		{ $1 }
-		|  '->'			{ SLIT("->") }
-                |  '(' ')'        	{ SLIT("()") }
-		|  '(' commas ')'	{ snd (mkTupNameStr $2) }
-		|  '[' ']'              { SLIT("[]") }
-
-commas		:: { Int }
-		: ','			{ 2 }
-		| commas ','		{ $1 + 1 }
-
-val_occ		:: { OccName }
-		:  var_fs 		{ varOcc $1 }
-                |  data_fs              { varOcc $1 }
-
-val_occs	:: { [OccName] }
-		:  val_occ    		{ [$1] }
-		|  val_occ val_occs	{ $1 : $2 }
-
-entity_occ	:: { OccName }
-		:  var_fs		{ varOcc $1 }
-		|  data_fs 		{ tcOcc $1 }
+		| 'as'			{ SLIT("as") }
+		| 'qualified'		{ SLIT("qualified") }
+		| 'hiding'		{ SLIT("hiding") }
+		| 'forall'		{ SLIT("forall") }
+		| 'foreign'		{ SLIT("foreign") }
+		| 'export'		{ SLIT("export") }
+		| 'label'		{ SLIT("label") }
+		| 'dynamic'		{ SLIT("dynamic") }
+		| 'unsafe'		{ SLIT("unsafe") }
+
+qvar_fs		:: { (EncodedFS, EncodedFS) }
+		:  QVARID		{ $1 }
+		|  QVARSYM		{ $1 }
+
+var_occ	        :: { OccName }
+		:  var_fs		{ mkSysOccFS varName $1 }
 
 var_name	:: { RdrName }
-var_name	:  var_fs		{ ifaceUnqualVar $1 }
+var_name	:  var_occ		{ mkRdrUnqual $1 }
 
 qvar_name	:: { RdrName }
 qvar_name	:  var_name		{ $1 }
-		|  QVARID		{ ifaceQualVar $1 }
-		|  QVARSYM		{ ifaceQualVar $1 }
+		|  qvar_fs      	{ mkSysQual varName $1 }
 
 var_names	:: { [RdrName] }
 var_names	: 			{ [] }
@@ -432,45 +490,74 @@ var_names	: 			{ [] }
 var_names1	:: { [RdrName] }
 var_names1	: var_name var_names	{ $1 : $2 }
 
+---------------------------------------------------
+-- For some bizarre reason, 
+--      (,,,)      is dealt with by the parser
+--      Foo.(,,,)  is dealt with by the lexer
+-- Sigh
+
+data_fs	        :: { EncodedFS }
+		:  CONID		{ $1 }
+		|  CONSYM		{ $1 }
+
+qdata_fs	:: { (EncodedFS, EncodedFS) }
+                :  QCONID		{ $1 }
+                |  QCONSYM		{ $1 }
+
+data_occ	:: { OccName }
+		:  data_fs		{ mkSysOccFS dataName $1 }
+
 data_name	:: { RdrName }
-		:  CONID		{ ifaceUnqualVar $1 }
-		|  CONSYM		{ ifaceUnqualVar $1 }
-		|  '(' commas ')'	{ ifaceUnqualVar (snd (mkTupNameStr $2)) }
-		|  '[' ']'              { ifaceUnqualVar SLIT("[]") }
+                :  data_occ             { mkRdrUnqual $1 }
 
 qdata_name	:: { RdrName }
 qdata_name	:  data_name		{ $1 }
-		|  QCONID		{ ifaceQualVar $1 }
-		|  QCONSYM		{ ifaceQualVar $1 }
+		|  qdata_fs 	        { mkSysQual dataName $1 }
 				
 qdata_names	:: { [RdrName] }
 qdata_names	:				{ [] }
 		| qdata_name qdata_names	{ $1 : $2 }
 
+var_or_data_name :: { RdrName }
+                  : var_name                    { $1 }
+                  | data_name                   { $1 }
+
+---------------------------------------------------
+tc_fs           :: { EncodedFS }
+                :  data_fs              { $1 }
+
+tc_occ	        :: { OccName }
+		:  tc_fs 		{ mkSysOccFS tcName $1 }
+
 tc_name		:: { RdrName }
-tc_name		:  CONID		{ ifaceUnqualTC $1 }
-		|  CONSYM		{ ifaceUnqualTC $1 }
-		|  '(' '->' ')'		{ ifaceUnqualTC SLIT("->") }
-		|  '(' commas ')'	{ ifaceUnqualTC (snd (mkTupNameStr $2)) }
-		|  '[' ']'		{ ifaceUnqualTC SLIT("[]") }
+                :  tc_occ		{ mkRdrUnqual $1 }
 
 qtc_name	:: { RdrName }
-qtc_name	: tc_name		{ $1 }
-		| QCONID		{ ifaceQualTC $1 }
-		| QCONSYM		{ ifaceQualTC $1 }
+                : tc_name		{ $1 }
+		| qdata_fs		{ mkSysQual tcName $1 }
+
+---------------------------------------------------
+cls_name	:: { RdrName }
+        	:  data_fs		{ mkSysUnqual clsName $1 }
 
+qcls_name	:: { RdrName }
+         	: cls_name		{ $1 }
+		| qdata_fs		{ mkSysQual clsName $1 }
+
+---------------------------------------------------
 tv_name		:: { RdrName }
-tv_name		:  VARID 		{ ifaceUnqualTv $1 }
-		|  VARSYM		{ ifaceUnqualTv $1 {- Allow t2 as a tyvar -} }
+		:  VARID 		{ mkSysUnqual tvName $1 }
+		|  VARSYM		{ mkSysUnqual tvName $1 {- Allow t2 as a tyvar -} }
 
 tv_bndr		:: { HsTyVar RdrName }
-tv_bndr		:  tv_name '::' akind	{ IfaceTyVar $1 $3 }
+		:  tv_name '::' akind	{ IfaceTyVar $1 $3 }
 		|  tv_name		{ IfaceTyVar $1 boxedTypeKind }
 
 tv_bndrs	:: { [HsTyVar RdrName] }
 		:  			{ [] }
 		| tv_bndr tv_bndrs	{ $1 : $2 }
 
+---------------------------------------------------
 kind		:: { Kind }
 		: akind			{ $1 }
 		| akind '->' kind	{ mkArrowKind $1 $3 }
@@ -487,31 +574,33 @@ akind		:: { Kind }
 --------------------------------------------------------------------------
 
 id_info		:: { [HsIdInfo RdrName] }
-id_info		: 	 			{ [] }
+		: 	 			{ [] }
 		| id_info_item id_info		{ $1 : $2 }
+                | strict_info id_info		{ $1 ++ $2 }
 
 id_info_item	:: { HsIdInfo RdrName }
-id_info_item	: '__A' arity_info		{ HsArity $2 }
-		| strict_info			{ HsStrictness $1 }
+		: '__A' arity_info		{ HsArity $2 }
 		| '__U' core_expr		{ HsUnfold $1 (Just $2) }
                 | '__U' 		 	{ HsUnfold $1 Nothing }
-                | '__P' spec_tvs
-                     atypes '=' core_expr       { HsSpecialise $2 $3 $5 }
 		| '__C'                         { HsNoCafRefs }
 
+strict_info     :: { [HsIdInfo RdrName] }
+		: cpr worker			{ ($1:$2) }
+		| strict worker			{ ($1:$2) }
+		| cpr strict worker		{ ($1:$2:$3) }
 
-spec_tvs	:: { [HsTyVar RdrName] }
-spec_tvs	: '[' tv_bndrs ']' 		{ $2 }
-	
+cpr		:: { HsIdInfo RdrName }
+		: '__M'				{ HsCprInfo $1 }
 
-arity_info	:: { ArityInfo }
-arity_info	: INTEGER			{ exactArity (fromInteger $1) }
+strict		:: { HsIdInfo RdrName }
+		: '__S'				{ HsStrictness (HsStrictnessInfo $1) }
 
-strict_info	:: { HsStrictnessInfo RdrName }
-strict_info	: '__S' qvar_name '{' qdata_names '}' 	
-					{ HsStrictnessInfo $1 (Just ($2,$4)) }
-		| '__S' qvar_name 	{ HsStrictnessInfo $1 (Just ($2,[])) }
-		| '__S'			{ HsStrictnessInfo $1 Nothing }
+worker		:: { [HsIdInfo RdrName] }
+		: qvar_name 			{ [HsWorker $1] }
+		| {- nothing -}			{ [] }
+
+arity_info	:: { ArityInfo }
+		: INTEGER			{ exactArity (fromInteger $1) }
 
 -------------------------------------------------------
 core_expr	:: { UfExpr RdrName }
@@ -527,17 +616,18 @@ core_expr	: '\\' core_bndrs '->' core_expr	{ foldr UfLam $4 $2 }
 		| con_or_primop '{' core_args '}'	{ UfCon $1 $3 }
                 | '__litlit' STRING atype               { UfCon (UfLitLitCon $2 $3) [] }
 
-                | '__inline' core_expr               { UfNote UfInlineCall $2 }
-                | '__coerce' atype core_expr         { UfNote (UfCoerce $2) $3 }
-		| '__scc' core_expr                  { UfNote (UfSCC $1) $2  }
-		| fexpr				     { $1 }
+                | '__inline_me' core_expr               { UfNote UfInlineMe $2 }
+                | '__inline_call' core_expr             { UfNote UfInlineCall $2 }
+                | '__coerce' atype core_expr            { UfNote (UfCoerce $2) $3 }
+		| scc core_expr                         { UfNote (UfSCC $1) $2  }
+		| fexpr				        { $1 }
 
 fexpr   :: { UfExpr RdrName }
 fexpr   : fexpr core_arg				{ UfApp $1 $2 }
         | core_aexpr					{ $1 }
 
 core_arg	:: { UfExpr RdrName }
-		: '__a' atype                                  { UfType $2 }
+		: '@' atype                                     { UfType $2 }
                 | core_aexpr                                    { $1 }
 
 core_args	:: { [UfExpr RdrName] }
@@ -559,11 +649,13 @@ core_aexpr      : qvar_name				        { UfVar $1 }
 
 		| core_lit		 { UfCon (UfLitCon $1) [] }
 		| '(' core_expr ')'	 { $2 }
-		| '('  ')'	 	 { UfTuple (mkTupConRdrName 0) [] }
 		| '(' comma_exprs2 ')'	 { UfTuple (mkTupConRdrName (length $2)) $2 }
 		| '(#' core_expr '#)'	 { UfTuple (mkUbxTupConRdrName 1) [$2] }
 		| '(#' comma_exprs2 '#)' { UfTuple (mkUbxTupConRdrName (length $2)) $2 }
 
+-- This one is dealt with by qdata_name: see above comments
+--		| '('  ')'	 	 { UfTuple (mkTupConRdrName 0) [] }
+
 comma_exprs2	:: { [UfExpr RdrName] }	-- Two or more
 comma_exprs2	: core_expr ',' core_expr			{ [$1,$3] }
 		| core_expr ',' comma_exprs2			{ $1 : $3 }
@@ -592,38 +684,42 @@ core_pat	:: { (UfCon RdrName, [RdrName]) }
 core_pat	: core_lit			{ (UfLitCon  $1, []) }
 		| '__litlit' STRING atype	{ (UfLitLitCon $2 $3, []) }
 		| qdata_name var_names		{ (UfDataCon $1, $2) }
-		| '(' comma_var_names ')' 	{ (UfDataCon (mkTupConRdrName (length $2)), $2) }
+		| '(' comma_var_names1 ')' 	{ (UfDataCon (mkTupConRdrName (length $2)), $2) }
 		| '(#' comma_var_names1 '#)'	{ (UfDataCon (mkUbxTupConRdrName (length $2)), $2) }
 		| '__DEFAULT'			{ (UfDefault, []) }
 		| '(' core_pat ')'		{ $2 }
 
 
-comma_var_names :: { [RdrName] }	-- Zero, or two or more
-comma_var_names : 						{ [] }
-		| var_name ',' comma_var_names1		{ $1 : $3 }
-
 comma_var_names1 :: { [RdrName] }	-- One or more
 comma_var_names1 : var_name					{ [$1] }
 		 | var_name ',' comma_var_names1		{ $1 : $3 }
 
 core_lit	:: { Literal }
-core_lit	: INTEGER			{ mkMachInt_safe $1 }
+core_lit	: integer			{ mkMachInt_safe $1 }
 		| CHAR				{ MachChar $1 }
 		| STRING			{ MachStr $1 }
 		| '__string' STRING		{ NoRepStr $2 (panic "NoRepStr type") }
-		| RATIONAL			{ MachDouble $1 }
-		| '__float' RATIONAL		{ MachFloat $2 }
+		| rational			{ MachDouble $1 }
+		| '__float' rational		{ MachFloat $2 }
 
-		| '__integer' INTEGER		{ NoRepInteger  $2 (panic "NoRepInteger type") 
+		| '__integer' integer		{ NoRepInteger  $2 (panic "NoRepInteger type") 
 							-- The type checker will add the types
 						}
 
-		| '__rational' INTEGER INTEGER	{ NoRepRational ($2 % $3) 
+		| '__rational' integer integer	{ NoRepRational ($2 % $3) 
 				  		   (panic "NoRepRational type")
 							-- The type checker will add the type
 						}
 
-		| '__addr' INTEGER		{ MachAddr $2 }
+		| '__addr' integer		{ MachAddr $2 }
+
+integer		:: { Integer }
+		: INTEGER                       { $1 }
+		| '-' INTEGER		        { (-$2) }
+
+rational	:: { Rational }
+		: RATIONAL                      { $1 }
+		| '-' RATIONAL			{ (-$2) }
 
 core_bndr       :: { UfBinder RdrName }
 core_bndr       : core_val_bndr                                 { $1 }
@@ -637,18 +733,38 @@ core_val_bndr 	:: { UfBinder RdrName }
 core_val_bndr	: var_name '::' atype				{ UfValBinder $1 $3 }
 
 core_tv_bndr	:: { UfBinder RdrName }
-core_tv_bndr	:  '__a' tv_name '::' akind		{ UfTyBinder $2 $4 }
-		|  '__a' tv_name			{ UfTyBinder $2 boxedTypeKind }
+core_tv_bndr	:  '@' tv_name '::' akind		{ UfTyBinder $2 $4 }
+		|  '@' tv_name			        { UfTyBinder $2 boxedTypeKind }
 
 ccall_string	:: { FAST_STRING }
 		: STRING					{ $1 }
+		| CLITLIT					{ $1 }
 		| VARID						{ $1 }
 		| CONID						{ $1 }
 
+------------------------------------------------------------------------
+scc     :: { CostCentre }
+        :  '__sccC' '{' mod_name STRING '}'                      { AllCafsCC $3 $4 }
+        |  '__scc' '{' cc_name mod_name STRING cc_dup cc_caf '}'
+                             { NormalCC { cc_name = $3, cc_mod = $4, cc_grp = $5,
+                                          cc_is_dupd = $6, cc_is_caf = $7 } }
+
+cc_name :: { EncodedFS }
+        : CONID                 { $1 }
+        | VARID                 { $1 }
+  
+cc_dup  :: { IsDupdCC }
+cc_dup  :                       { OriginalCC }
+        | '!'                   { DupdCC }
+
+cc_caf  :: { IsCafCC }
+        :                       { NotCafCC }
+        | '__C'                 { CafCC }
+
 -------------------------------------------------------------------
 
 src_loc :: { SrcLoc }
-src_loc : 				{% getSrcLocIf }
+src_loc : 				{% getSrcLocP }
 
 checkVersion :: { () }
 	   : {-empty-}			{% checkVersion Nothing }
@@ -658,10 +774,13 @@ checkVersion :: { () }
 
 --			Haskell code 
 {
+happyError :: P a
+happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 
-data IfaceStuff = PIface 	ParsedIface
+data IfaceStuff = PIface 	EncodedFS{-.hi module name-} ParsedIface
 		| PIdInfo	[HsIdInfo RdrName]
 		| PType		RdrNameHsType
+		| PRules	[RdrNameRuleDecl]
 
 mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
 }