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

[ghc-hetmet.git] / ghc / compiler / parser / Parser.y

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 759c2dc..771748e 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.19 2000/01/28 20:52:39 lewie Exp $
+$Id: Parser.y,v 1.24 2000/02/25 14:55:42 panne Exp $
 
 Haskell grammar.
 
@@ -35,6 +35,8 @@ import GlaExts
 {-
 -----------------------------------------------------------------------------
 Conflicts: 14 shift/reduce
+       (note: it's currently 21 -- JRL, 31/1/2000)
+        (note2: it's currently 36, but not because of me -- SUP, 15/2/2000 :-)
 
 8 for abiguity in 'if x then y else z + 1'
        (shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
@@ -85,7 +87,6 @@ Conflicts: 14 shift/reduce
  'then'        { ITthen }
  'type'        { ITtype }
  'where'       { ITwhere }
- 'with'        { ITwith }
  '_scc_'       { ITscc }
 
  'forall'      { ITforall }                    -- GHC extension keywords
@@ -94,6 +95,7 @@ Conflicts: 14 shift/reduce
  'label'       { ITlabel } 
  'dynamic'     { ITdynamic }
  'unsafe'      { ITunsafe }
+ 'with'        { ITwith }
  'stdcall'      { ITstdcallconv }
  'ccall'        { ITccallconv }
  '_ccall_'     { ITccall (False, False, False) }
@@ -106,6 +108,7 @@ Conflicts: 14 shift/reduce
  '{-# INLINE'      { ITinline_prag }
  '{-# NOINLINE'    { ITnoinline_prag }
  '{-# RULES'      { ITrules_prag }
+ '{-# DEPRECATED'  { ITdeprecated_prag }
  '#-}'            { ITclose_prag }
 
 {-
@@ -174,7 +177,8 @@ Conflicts: 14 shift/reduce
  QCONID        { ITqconid   $$ }
  QVARSYM       { ITqvarsym  $$ }
  QCONSYM       { ITqconsym  $$ }
- IPVARID       { ITipvarid  $$ }
+
+ IPVARID       { ITipvarid  $$ }               -- GHC extension
 
  PRAGMA                { ITpragma   $$ }
 
@@ -187,7 +191,7 @@ Conflicts: 14 shift/reduce
  PRIMSTRING    { ITprimstring $$ }
  PRIMINTEGER   { ITprimint    $$ }
  PRIMFLOAT     { ITprimfloat  $$ }
- PRIMDOUBLE    { ITprimdouble  $$ }
+ PRIMDOUBLE    { ITprimdouble $$ }
  CLITLIT       { ITlitlit     $$ }
 
  UNKNOWN       { ITunknown  $$ }
@@ -201,11 +205,22 @@ Conflicts: 14 shift/reduce
 -----------------------------------------------------------------------------
 -- Module Header
 
+-- The place for module deprecation is really too restrictive, but if it
+-- was allowed at its natural place just before 'module', we get an ugly
+-- s/r conflict with the second alternative. Another solution would be the
+-- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
+-- either, and DEPRECATED is only expected to be used by people who really
+-- know what they are doing. :-)
+
 module         :: { RdrNameHsModule }
-       : srcloc 'module' modid maybeexports 'where' body 
-               { HsModule $3 Nothing $4 (fst $6) (snd $6) $1 }
-       | srcloc body   
-               { HsModule mAIN_Name Nothing Nothing (fst $2) (snd $2) $1 }
+       : srcloc 'module' modid maybemoddeprec maybeexports 'where' body 
+               { HsModule $3 Nothing $5 (fst $7) (snd $7) $4 $1 }
+       | srcloc body
+               { HsModule mAIN_Name Nothing Nothing (fst $2) (snd $2) Nothing $1 }
+
+maybemoddeprec :: { Maybe DeprecTxt }
+       : '{-# DEPRECATED' STRING '#-}'         { Just $2 }
+       |  {- empty -}                          { Nothing }
 
 body   :: { ([RdrNameImportDecl], [RdrNameHsDecl]) }
        :  '{'            top '}'               { $2 }
@@ -377,6 +392,7 @@ decl        :: { RdrBinding }
        | '{-# SPECIALISE' srcloc 'instance' inst_type '#-}'
                { RdrSig (SpecInstSig $4 $2) }
        | '{-# RULES' rules '#-}'       { $2 }
+       | '{-# DEPRECATED' deprecations '#-}'   { $2 }
 
 opt_phase :: { Maybe Int }
           : INTEGER                     { Just (fromInteger $1) }
@@ -456,6 +472,20 @@ rule_var :: { RdrNameRuleBndr }
                | '(' varid '::' ctype ')'              { RuleBndrSig $2 $4 }
 
 -----------------------------------------------------------------------------
+-- Deprecations
+
+deprecations :: { RdrBinding }
+       : deprecations ';' deprecation          { $1 `RdrAndBindings` $3 }
+       | deprecations ';'                      { $1 }
+       | deprecation                           { $1 }
+       | {- empty -}                           { RdrNullBind }
+
+-- SUP: TEMPORARY HACK, not checking for `module Foo'
+deprecation :: { RdrBinding }
+       : srcloc exportlist STRING
+               { foldr1 RdrAndBindings [ RdrSig (DeprecSig (Deprecation n $3) $1) | n <- $2 ] }
+
+-----------------------------------------------------------------------------
 -- Foreign import/export
 
 callconv :: { Int }
@@ -489,6 +519,7 @@ type :: { RdrNameHsType }
 
 btype :: { RdrNameHsType }
        : btype atype                   { MonoTyApp $1 $2 }
+       | IPVARID '::' type             { MonoIParamTy (mkSrcUnqual ipName $1) $3 }
        | atype                         { $1 }
 
 atype :: { RdrNameHsType }