X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fparser%2FParser.y;h=88c0ad9bc47e8c22bfb784a60ad4a090bfd5cff3;hb=95581e0c3b2d4d6edd33fdd6e135aa3917072c4c;hp=481500f53dd862ca1bc68f8f8a5cd35c1c7d8636;hpb=bf4363c03d80ae9aa376bfceb88c6137031c1236;p=ghc-hetmet.git

diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 481500f..88c0ad9 100644
--- 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