[project @ 2001-02-20 15:36:55 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index c5d3d55..8181b64 100644 (file)
--- 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
 }