[project @ 2000-03-08 17:48:24 by simonmar]

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

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 70fc0a3..82e2286 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -36,6 +36,7 @@ import Maybes
 import Outputable
 
 import GlaExts
+import FastString      ( tailFS )
 
 #if __HASKELL1__ > 4
 import Ratio ( (%) )
@@ -79,6 +80,7 @@ import Ratio ( (%) )
  'label'       { ITlabel } 
  'dynamic'     { ITdynamic }
  'unsafe'      { ITunsafe }
+ 'with'                { ITwith }
 
  '__interface' { ITinterface }                 -- interface keywords
  '__export'    { IT__export }
@@ -331,7 +333,7 @@ pragma      : src_loc PRAGMA        { parseIface $2 PState{ bol = 0#, atbol = 1#,
 
 -----------------------------------------------------------------------------
 
-rules_and_deprecs :: { ([RdrNameRuleDecl], [(Maybe FAST_STRING, FAST_STRING)]) }
+rules_and_deprecs :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
 rules_and_deprecs : {- empty -}        { ([], []) }
                  | rules_and_deprecs rule_or_deprec
                                { let
@@ -342,7 +344,7 @@ rules_and_deprecs : {- empty -}     { ([], []) }
                                  in append2 $1 $2
                                }
 
-rule_or_deprec :: { ([RdrNameRuleDecl], [(Maybe FAST_STRING, FAST_STRING)]) }
+rule_or_deprec :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
 rule_or_deprec : pragma        { case $1 of
                             POk _ (PRules   rules)   -> (rules,[])
                             POk _ (PDeprecs deprecs) -> ([],deprecs)
@@ -364,17 +366,18 @@ rule_forall       : '__forall' '{' core_bndrs '}' { $3 }
                  
 -----------------------------------------------------------------------------
 
-deprecs        :: { [(Maybe FAST_STRING, FAST_STRING)] }
+deprecs        :: { [RdrNameDeprecation] }
 deprecs                : {- empty -}           { [] }
-               | deprecs ';' deprec    { $3 : $1 }
+               | deprecs deprec ';'    { $2 : $1 }
 
-deprec         :: { (Maybe FAST_STRING, FAST_STRING) }
-deprec         : STRING                { (Nothing, $1) }
-               | deprec_name STRING    { (Just $1, $2) }
+deprec         :: { RdrNameDeprecation }
+deprec         : STRING                { Deprecation (IEModuleContents undefined) $1 }
+               | deprec_name STRING    { Deprecation $1 $2 }
 
-deprec_name    :: { FAST_STRING }
-               : var_fs                { $1 }
-               | tc_fs                 { $1 }
+-- SUP: TEMPORARY HACK
+deprec_name    :: { RdrNameIE }
+               : var_name              { IEVar      $1 }
+               | data_name             { IEThingAbs $1 }
 
 -----------------------------------------------------------------------------
 
@@ -452,7 +455,7 @@ context_list1       : class                                 { [$1] }
 
 class          :: { HsPred RdrName }
 class          :  qcls_name atypes                     { (HsPClass $1 $2) }
-               |  IPVARID '::' type                    { (HsPIParam (mkSysUnqual ipName $1) $3) }
+               |  ipvar_name '::' type                 { (HsPIParam $1 $3) }
 
 types0         :: { [RdrNameHsType]                    {- Zero or more -}  }   
 types0         :  {- empty -}                          { [ ] }
@@ -480,7 +483,7 @@ atype               :  qtc_name                             { MonoTyVar $1 }
                |  '(#' types0 '#)'                     { MonoTupleTy $2 False{-unboxed-} }
                |  '[' type ']'                         { MonoListTy  $2 }
                |  '{' qcls_name atypes '}'             { MonoDictTy $2 $3 }
-               |  '{' IPVARID '::' type '}'            { MonoIParamTy (mkSysUnqual ipName $2) $4 }
+               |  '{' ipvar_name '::' type '}'         { MonoIParamTy $2 $4 }
                |  '(' type ')'                         { $2 }
 
 -- This one is dealt with via qtc_name
@@ -510,6 +513,7 @@ var_fs              :: { EncodedFS }
                | 'label'               { SLIT("label") }
                | 'dynamic'             { SLIT("dynamic") }
                | 'unsafe'              { SLIT("unsafe") }
+               | 'with'                { SLIT("with") }
 
 qvar_fs                :: { (EncodedFS, EncodedFS) }
                :  QVARID               { $1 }
@@ -525,6 +529,9 @@ qvar_name   :: { RdrName }
 qvar_name      :  var_name             { $1 }
                |  qvar_fs              { mkSysQual varName $1 }
 
+ipvar_name     :: { RdrName }
+               :  IPVARID              { mkSysUnqual ipName (tailFS $1) }
+
 var_names      :: { [RdrName] }
 var_names      :                       { [] }
                | var_name var_names    { $1 : $2 }
@@ -816,10 +823,10 @@ ccall_string      :: { FAST_STRING }
 
 ------------------------------------------------------------------------
 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 } }
+        :  '__sccC' '{' mod_name '}'                      { AllCafsCC $3 }
+        |  '__scc' '{' cc_name mod_name cc_dup cc_caf '}'
+                             { NormalCC { cc_name = $3, cc_mod = $4,
+                                          cc_is_dupd = $5, cc_is_caf = $6 } }
 
 cc_name :: { EncodedFS }
         : CONID                 { $1 }
@@ -853,7 +860,7 @@ data IfaceStuff = PIface    EncodedFS{-.hi module name-} ParsedIface
                | PIdInfo       [HsIdInfo RdrName]
                | PType         RdrNameHsType
                | PRules        [RdrNameRuleDecl]
-               | PDeprecs      [(Maybe FAST_STRING, FAST_STRING)]
+               | PDeprecs      [RdrNameDeprecation]
 
 mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
 }