[project @ 2000-02-25 14:55:31 by panne]

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

diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 950fe54..f821b31 100644 (file)
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -79,6 +79,7 @@ import Ratio ( (%) )
  'label'       { ITlabel } 
  'dynamic'     { ITdynamic }
  'unsafe'      { ITunsafe }
+ 'with'                { ITwith }
 
  '__interface' { ITinterface }                 -- interface keywords
  '__export'    { IT__export }
@@ -109,6 +110,7 @@ import Ratio ( (%) )
  '__U'         { ITunfold $$ }
  '__S'         { ITstrict $$ }
  '__R'         { ITrules }
+ '__D'         { ITdeprecated }
  '__M'         { ITcprinfo $$ }
 
  '..'          { ITdotdot }                    -- reserved symbols
@@ -145,7 +147,8 @@ import Ratio ( (%) )
  QCONID        { ITqconid   $$ }
  QVARSYM       { ITqvarsym  $$ }
  QCONSYM       { ITqconsym  $$ }
- IPVARID       { ITipvarid  $$ }
+
+ IPVARID       { ITipvarid  $$ }               -- GHC extension
 
  PRAGMA                { ITpragma   $$ }
 
@@ -165,9 +168,10 @@ import Ratio ( (%) )
 
 iface_stuff :: { IfaceStuff }
 iface_stuff : iface            { let (nm, iff) = $1 in PIface nm iff }
-           | type              { PType   $1 }
-           | id_info           { PIdInfo $1 }
-           | '__R' rules       { PRules  $2 }
+           | type              { PType    $1 }
+           | id_info           { PIdInfo  $1 }
+           | '__R' rules       { PRules   $2 }
+           | '__D' deprecs     { PDeprecs $2 }
 
 
 iface          :: { (ModuleName, ParsedIface) }
@@ -176,7 +180,7 @@ iface               : '__interface' mod_fs INTEGER orphans checkVersion 'where'
                   import_part
                  instance_decl_part
                  decls_part
-                 rules_part
+                 rules_and_deprecs
                  { ( $2                        -- Module name
                    , ParsedIface {
                        pi_mod = fromInteger $3,        -- Module version
@@ -185,7 +189,8 @@ iface               : '__interface' mod_fs INTEGER orphans checkVersion 'where'
                        pi_usages  = $8,        -- Usages
                        pi_insts   = $9,        -- Local instances
                        pi_decls   = $10,       -- Decls
-                       pi_rules   = $11        -- Rules 
+                       pi_rules   = fst $11,   -- Rules 
+                       pi_deprecs = snd $11    -- Deprecations 
                      } ) }
 
 --------------------------------------------------------------------------
@@ -311,32 +316,42 @@ decl    : src_loc var_name '::' type maybe_idinfo
 
 maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
 maybe_idinfo  : {- empty -}    { \_ -> [] }
-             | src_loc PRAGMA  { \x -> 
-                                  case parseIface $2
-                                          PState{bol = 0#, atbol = 1#,
-                                                 context = [],
-                                                 glasgow_exts = 1#,
-                                                 loc = $1 } of
+             | pragma          { \x -> case $1 of
                                     POk _ (PIdInfo id_info) -> id_info
                                     PFailed err -> 
                                        pprPanic "IdInfo parse failed" 
                                            (vcat [ppr x, err])
                                }
 
+pragma :: { ParseResult IfaceStuff }
+pragma : src_loc PRAGMA        { parseIface $2 PState{ bol = 0#, atbol = 1#,
+                                                       context = [],
+                                                       glasgow_exts = 1#,
+                                                       loc = $1 }
+                               }
+
 -----------------------------------------------------------------------------
 
-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_and_deprecs :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
+rules_and_deprecs : {- empty -}        { ([], []) }
+                 | rules_and_deprecs rule_or_deprec
+                               { let
+                                    append2 (xs1,ys1) (xs2,ys2) =
+                                       (xs1 `app` xs2, ys1 `app` ys2)
+                                    xs `app` [] = xs -- performance paranoia
+                                    xs `app` ys = xs ++ ys
+                                 in append2 $1 $2
                                }
 
+rule_or_deprec :: { ([RdrNameRuleDecl], [RdrNameDeprecation]) }
+rule_or_deprec : pragma        { case $1 of
+                            POk _ (PRules   rules)   -> (rules,[])
+                            POk _ (PDeprecs deprecs) -> ([],deprecs)
+                            PFailed err -> pprPanic "Rules/Deprecations parse failed" err
+                       }
+
+-----------------------------------------------------------------------------
+
 rules     :: { [RdrNameRuleDecl] }
           : {- empty -}        { [] }
           | rule ';' rules     { $1:$3 }
@@ -350,6 +365,20 @@ rule_forall        : '__forall' '{' core_bndrs '}' { $3 }
                  
 -----------------------------------------------------------------------------
 
+deprecs        :: { [RdrNameDeprecation] }
+deprecs                : {- empty -}           { [] }
+               | deprecs deprec ';'    { $2 : $1 }
+
+deprec         :: { RdrNameDeprecation }
+deprec         : STRING                { Deprecation (IEModuleContents undefined) $1 }
+               | deprec_name STRING    { Deprecation $1 $2 }
+
+-- SUP: TEMPORARY HACK
+deprec_name    :: { RdrNameIE }
+               : var_name              { IEVar $1 }
+
+-----------------------------------------------------------------------------
+
 version                :: { Version }
 version                :  INTEGER                              { fromInteger $1 }
 
@@ -452,6 +481,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 }
                |  '(' type ')'                         { $2 }
 
 -- This one is dealt with via qtc_name
@@ -481,6 +511,7 @@ var_fs              :: { EncodedFS }
                | 'label'               { SLIT("label") }
                | 'dynamic'             { SLIT("dynamic") }
                | 'unsafe'              { SLIT("unsafe") }
+               | 'with'                { SLIT("with") }
 
 qvar_fs                :: { (EncodedFS, EncodedFS) }
                :  QVARID               { $1 }
@@ -824,6 +855,7 @@ data IfaceStuff = PIface    EncodedFS{-.hi module name-} ParsedIface
                | PIdInfo       [HsIdInfo RdrName]
                | PType         RdrNameHsType
                | PRules        [RdrNameRuleDecl]
+               | PDeprecs      [RdrNameDeprecation]
 
 mkConDecl name (ex_tvs, ex_ctxt) details loc = ConDecl name ex_tvs ex_ctxt details loc
 }