[project @ 2002-03-27 12:09:00 by simonpj]

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

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 481500f..88c0ad9 100644 (file)
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-                                                             -*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.91 2002/03/03 03:59:03 sof Exp $
+$Id: Parser.y,v 1.93 2002/03/14 15:47:54 simonmar Exp $
 
 Haskell grammar.
 
@@ -9,12 +9,13 @@ Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
 -}
 
 {
-module Parser ( parseModule, parseStmt, parseIdentifier ) where
+module Parser ( parseModule, parseStmt, parseIdentifier, parseIface ) where
 
 import HsSyn
 import HsTypes         ( mkHsTupCon )
 
 import RdrHsSyn
+import RnMonad         ( ParsedIface(..) )
 import Lex
 import ParseUtil
 import RdrName
@@ -28,7 +29,7 @@ import OccName                ( UserFS, varName, tcName, dataName, tcClsName, tvName )
 import TyCon           ( DataConDetails(..) )
 import SrcLoc          ( SrcLoc )
 import Module
-import CmdLineOpts     ( opt_SccProfilingOn )
+import CmdLineOpts     ( opt_SccProfilingOn, opt_InPackage )
 import Type            ( Kind, mkArrowKind, liftedTypeKind )
 import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
                          NewOrData(..), StrictnessMark(..), Activation(..) )
@@ -222,6 +223,7 @@ Conflicts: 21 shift/reduce, -=chak[4Feb2]
 %name parseModule module
 %name parseStmt   maybe_stmt
 %name parseIdentifier  identifier
+%name parseIface iface
 %tokentype { Token }
 %%
 
@@ -258,6 +260,56 @@ cvtopdecls :: { [RdrNameHsDecl] }
        : topdecls                              { cvTopDecls (groupBindings $1)}
 
 -----------------------------------------------------------------------------
+-- Interfaces (.hi-boot files)
+
+iface   :: { ParsedIface }
+       : 'module' modid 'where' ifacebody
+         {         ParsedIface {
+                       pi_mod     = $2,
+                       pi_pkg     = opt_InPackage,
+                       pi_vers    = 1,                 -- Module version
+                       pi_orphan  = False,
+                       pi_exports = (1,[($2,mkIfaceExports $4)]),
+                       pi_usages  = [],
+                       pi_fixity  = [],
+                       pi_insts   = [],
+                       pi_decls   = map (\x -> (1,x)) $4,
+                       pi_rules   = (1,[]),
+                       pi_deprecs = Nothing
+                   }
+          }
+
+ifacebody :: { [RdrNameTyClDecl] }
+       :  '{'            ifacedecls '}'                { $2 }
+       |      layout_on  ifacedecls close              { $2 }
+
+ifacedecls :: { [RdrNameTyClDecl] }
+       : ifacedecl ';' ifacedecls                      { $1 : $3 }
+       | ';' ifacedecls                                { $2 }
+       | ifacedecl                                     { [$1] }
+       | {- empty -}                                   { [] }
+
+ifacedecl :: { RdrNameTyClDecl }
+       : srcloc 'data' tycl_hdr constrs 
+         { mkTyData DataType $3 (DataCons (reverse $4)) Nothing $1 }
+
+       | srcloc 'newtype' tycl_hdr '=' newconstr
+         { mkTyData NewType $3 (DataCons [$5]) Nothing $1 }
+
+       | srcloc 'class' tycl_hdr fds where
+               { let 
+                       (binds,sigs) = cvMonoBindsAndSigs cvClassOpSig 
+                                       (groupBindings $5) 
+                  in
+                  mkClassDecl $3 $4 sigs (Just binds) $1 }
+
+       | srcloc 'type' tycon tv_bndrs '=' ctype        
+         { TySynonym $3 $4 $6 $1 }
+
+       | srcloc var '::' sigtype
+         { IfaceSig $2 $4 [] $1 }
+
+-----------------------------------------------------------------------------
 -- The Export List
 
 maybeexports :: { Maybe [RdrNameIE] }
@@ -1217,35 +1269,35 @@ qvarid :: { RdrName }
 
 varid :: { RdrName }
        : varid_no_unsafe       { $1 }
-       | 'unsafe'              { mkUnqual varName SLIT("unsafe") }
-       | 'safe'                { mkUnqual varName SLIT("safe") }
-       | 'threadsafe'          { mkUnqual varName SLIT("threadsafe") }
+       | 'unsafe'              { mkUnqual varName FSLIT("unsafe") }
+       | 'safe'                { mkUnqual varName FSLIT("safe") }
+       | 'threadsafe'          { mkUnqual varName FSLIT("threadsafe") }
 
 varid_no_unsafe :: { RdrName }
        : VARID                 { mkUnqual varName $1 }
        | special_id            { mkUnqual varName $1 }
-       | 'forall'              { mkUnqual varName SLIT("forall") }
+       | 'forall'              { mkUnqual varName FSLIT("forall") }
 
 tyvar  :: { RdrName }
        : VARID                 { mkUnqual tvName $1 }
        | special_id            { mkUnqual tvName $1 }
-       | 'unsafe'              { mkUnqual tvName SLIT("unsafe") }
-       | 'safe'                { mkUnqual tvName SLIT("safe") }
-       | 'threadsafe'          { mkUnqual tvName SLIT("threadsafe") }
+       | 'unsafe'              { mkUnqual tvName FSLIT("unsafe") }
+       | 'safe'                { mkUnqual tvName FSLIT("safe") }
+       | 'threadsafe'          { mkUnqual tvName FSLIT("threadsafe") }
 
 -- These special_ids are treated as keywords in various places, 
 -- but as ordinary ids elsewhere.   'special_id' collects all these
 -- except 'unsafe' and 'forall' whose treatment differs depending on context
 special_id :: { UserFS }
 special_id
-       : 'as'                  { SLIT("as") }
-       | 'qualified'           { SLIT("qualified") }
-       | 'hiding'              { SLIT("hiding") }
-       | 'export'              { SLIT("export") }
-       | 'label'               { SLIT("label")  }
-       | 'dynamic'             { SLIT("dynamic") }
-       | 'stdcall'             { SLIT("stdcall") }
-       | 'ccall'               { SLIT("ccall") }
+       : 'as'                  { FSLIT("as") }
+       | 'qualified'           { FSLIT("qualified") }
+       | 'hiding'              { FSLIT("hiding") }
+       | 'export'              { FSLIT("export") }
+       | 'label'               { FSLIT("label")  }
+       | 'dynamic'             { FSLIT("dynamic") }
+       | 'stdcall'             { FSLIT("stdcall") }
+       | 'ccall'               { FSLIT("ccall") }
 
 -----------------------------------------------------------------------------
 -- ConIds
@@ -1283,7 +1335,7 @@ qvarsym1 : QVARSYM                { mkQual varName $1 }
 
 varsym :: { RdrName }
        : varsym_no_minus       { $1 }
-       | '-'                   { mkUnqual varName SLIT("-") }
+       | '-'                   { mkUnqual varName FSLIT("-") }
 
 varsym_no_minus :: { RdrName } -- varsym not including '-'
        : VARSYM                { mkUnqual varName $1 }
@@ -1292,9 +1344,9 @@ varsym_no_minus :: { RdrName } -- varsym not including '-'
 
 -- See comments with special_id
 special_sym :: { UserFS }
-special_sym : '!'      { SLIT("!") }
-           | '.'       { SLIT(".") }
-           | '*'       { SLIT("*") }
+special_sym : '!'      { FSLIT("!") }
+           | '.'       { FSLIT(".") }
+           | '*'       { FSLIT("*") }
 
 -----------------------------------------------------------------------------
 -- Literals