X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FParseIface.y;h=8181b64e5120a34752b5b88ecbe7c8f8b69a5878;hb=db7041f72b7c7d0114e47b7305058fae48fb0ade;hp=c5d3d55fbd1132c5b57ff1e0d953d51d70e242f0;hpb=83eef621e4a4fbb6c1343304ec638cafd6c9dc09;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index c5d3d55..8181b64 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -28,7 +28,7 @@ Import declarations
 
 
 {
-module ParseIface ( parseIface, IfaceStuff(..) ) where
+module ParseIface ( parseIface, parseType, parseRules, parseIdInfo ) where
 
 #include "HsVersions.h"
 
@@ -43,7 +43,7 @@ import BasicTypes	( Fixity(..), FixityDirection(..),
 			)
 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
 import CallConv         ( cCallConv )
-import Type		( Kind, mkArrowKind, boxedTypeKind, openTypeKind, usageTypeKind )
+import Type		( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind )
 import IdInfo           ( exactArity, InlinePragInfo(..) )
 import PrimOp           ( CCall(..), CCallTarget(..) )
 import Lex		
@@ -56,7 +56,7 @@ import HscTypes         ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..),
 import RdrName          ( RdrName, mkRdrUnqual, mkIfaceOrig )
 import Name		( OccName )
 import OccName          ( mkSysOccFS,
-			  tcName, varName, ipName, dataName, clsName, tvName,
+			  tcName, varName, dataName, clsName, tvName,
 			  EncodedFS 
 			)
 import Module           ( ModuleName, PackageName, mkSysModuleNameFS, mkModule )
@@ -69,7 +69,11 @@ import GlaExts
 import FastString	( tailFS )
 }
 
-%name	    parseIface
+%name	    parseIface      iface
+%name	    parseType       type
+%name	    parseIdInfo     id_info
+%name	    parseRules      rules_and_deprecs
+
 %tokentype  { Token }
 %monad	    { P }{ thenP }{ returnP }
 %lexer      { lexer } { ITeof }
@@ -193,17 +197,6 @@ import FastString	( tailFS )
  UNKNOWN	{ ITunknown  $$ }
 %%
 
--- iface_stuff is the main production.
--- It recognises (a) a whole interface file
---		 (b) a type (so that type sigs can be parsed lazily)
---		 (c) the IdInfo part of a signature (same reason)
-
-iface_stuff :: { IfaceStuff }
-iface_stuff : iface		{ PIface   $1 }
-      	    | type		{ PType    $1 }
-      	    | id_info		{ PIdInfo  $1 }
-	    | rules_and_deprecs	{ PRulesAndDeprecs $1 }
-
 iface		:: { ParsedIface }
 iface		: '__interface' package mod_name 
 			version sub_versions
@@ -254,6 +247,7 @@ whats_imported      :: { WhatsImported OccName }
 whats_imported      :                                           	{ NothingAtAll }
 		    | '::' version					{ Everything $2 }
                     | '::' version version version name_version_pairs   { Specifically $2 (Just $3) $5 $4 }
+                    | '::' version version name_version_pairs		{ Specifically $2 Nothing $4 $3 }
 
 name_version_pairs  ::	{ [(OccName, Version)] }
 name_version_pairs  :  						{ [] }
@@ -368,7 +362,7 @@ maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 maybe_idinfo  : {- empty -} 	{ \_ -> [] }
 	      | pragma		{ \x -> if opt_IgnoreIfacePragmas then [] 
 					else case $1 of
-						POk _ (PIdInfo id_info) -> id_info
+						POk _ id_info -> id_info
 						PFailed err -> pprPanic "IdInfo parse failed" 
 								        (vcat [ppr x, err])
 				}
@@ -389,8 +383,15 @@ maybe_idinfo  : {- empty -} 	{ \_ -> [] }
        dates from a time where we picked up a .hi file first if it existed.]
     -}
 
-pragma	:: { ParseResult IfaceStuff }
-pragma	: src_loc PRAGMA	{ parseIface $2 PState{ bol = 0#, atbol = 1#,
+pragma	:: { ParseResult [HsIdInfo RdrName] }
+pragma	: src_loc PRAGMA	{ parseIdInfo $2 PState{ bol = 0#, atbol = 1#,
+							context = [],
+							glasgow_exts = 1#,
+							loc = $1 }
+				}
+
+rules_prag :: { ParseResult ([RdrNameRuleDecl], IfaceDeprecs) }
+rules_prag : src_loc PRAGMA	{ parseRules $2 PState{ bol = 0#, atbol = 1#,
 							context = [],
 							glasgow_exts = 1#,
 							loc = $1 }
@@ -400,8 +401,8 @@ pragma	: src_loc PRAGMA	{ parseIface $2 PState{ bol = 0#, atbol = 1#,
 
 rules_and_deprecs_part :: { ([RdrNameRuleDecl], IfaceDeprecs) }
 rules_and_deprecs_part : {- empty -}	{ ([], Nothing) }
-		       | pragma		{ case $1 of
-					     POk _ (PRulesAndDeprecs rds) -> rds
+		       | rules_prag	{ case $1 of
+					     POk _ rds -> rds
 					     PFailed err -> pprPanic "Rules/Deprecations parse failed" err
 					}
 
@@ -626,7 +627,7 @@ qvar_name	:  var_name		{ $1 }
 		|  qvar_fs      	{ mkIfaceOrig varName $1 }
 
 ipvar_name	:: { RdrName }
-		:  IPVARID		{ mkRdrUnqual (mkSysOccFS ipName (tailFS $1)) }
+		:  IPVARID		{ mkRdrUnqual (mkSysOccFS varName (tailFS $1)) }
 
 qvar_names1	:: { [RdrName] }
 qvar_names1	: qvar_name		{ [$1] }
@@ -692,7 +693,7 @@ tv_name		:: { RdrName }
 
 tv_bndr		:: { HsTyVarBndr RdrName }
 		:  tv_name '::' akind	{ IfaceTyVar $1 $3 }
-		|  tv_name		{ IfaceTyVar $1 boxedTypeKind }
+		|  tv_name		{ IfaceTyVar $1 liftedTypeKind }
 
 tv_bndrs	:: { [HsTyVarBndr RdrName] }
 		: tv_bndrs1		{ $1 }
@@ -725,7 +726,7 @@ kind		:: { Kind }
 
 akind		:: { Kind }
 		: VARSYM		{ if $1 == SLIT("*") then
-						boxedTypeKind
+						liftedTypeKind
 					  else if $1 == SLIT("?") then
 						openTypeKind
 					  else if $1 == SLIT("\36") then
@@ -894,7 +895,7 @@ core_val_bndr	: var_name '::' atype				{ UfValBinder $1 $3 }
 
 core_tv_bndr	:: { UfBinder RdrName }
 core_tv_bndr	:  '@' tv_name '::' akind		{ UfTyBinder $2 $4 }
-		|  '@' tv_name			        { UfTyBinder $2 boxedTypeKind }
+		|  '@' tv_name			        { UfTyBinder $2 liftedTypeKind }
 
 ccall_string	:: { FAST_STRING }
 		: STRING					{ $1 }
@@ -940,10 +941,5 @@ checkVersion :: { () }
 happyError :: P a
 happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
 
-data IfaceStuff = PIface 	   ParsedIface
-		| PIdInfo	   [HsIdInfo RdrName]
-		| PType		   RdrNameHsType
-		| PRulesAndDeprecs ([RdrNameRuleDecl], IfaceDeprecs)
-
 mk_con_decl name (ex_tvs, ex_ctxt) details loc = mkConDecl name ex_tvs ex_ctxt details loc
 }