'label' { ITlabel }
'dynamic' { ITdynamic }
'unsafe' { ITunsafe }
+ 'with' { ITwith }
'__interface' { ITinterface } -- interface keywords
'__export' { IT__export }
'__U' { ITunfold $$ }
'__S' { ITstrict $$ }
'__R' { ITrules }
+ '__D' { ITdeprecated }
'__M' { ITcprinfo $$ }
'..' { ITdotdot } -- reserved symbols
QCONID { ITqconid $$ }
QVARSYM { ITqvarsym $$ }
QCONSYM { ITqconsym $$ }
- IPVARID { ITipvarid $$ }
+
+ IPVARID { ITipvarid $$ } -- GHC extension
PRAGMA { ITpragma $$ }
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) }
import_part
instance_decl_part
decls_part
- rules_part
+ rules_and_deprecs
{ ( $2 -- Module name
, ParsedIface {
pi_mod = fromInteger $3, -- Module version
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
} ) }
--------------------------------------------------------------------------
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 }
-----------------------------------------------------------------------------
+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 }
+ | data_name { IEThingAbs $1 }
+
+-----------------------------------------------------------------------------
+
version :: { Version }
version : INTEGER { fromInteger $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
| 'label' { SLIT("label") }
| 'dynamic' { SLIT("dynamic") }
| 'unsafe' { SLIT("unsafe") }
+ | 'with' { SLIT("with") }
qvar_fs :: { (EncodedFS, EncodedFS) }
: QVARID { $1 }
| 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
}