[project @ 2005-03-03 10:37:57 by simonmar]

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

diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index 9e0725f..d143540 100644 (file)
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -8,7 +8,7 @@
 -- ---------------------------------------------------------------------------
 
 {
-module Parser ( parseModule, parseStmt, parseIdentifier, parseIface, parseType,
+module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
                parseHeader ) where
 
 #define INCLUDE #include 
@@ -16,7 +16,7 @@ INCLUDE "HsVersions.h"
 
 import HsSyn
 import RdrHsSyn
-import HscTypes                ( ModIface, IsBootInterface, DeprecTxt )
+import HscTypes                ( IsBootInterface, DeprecTxt )
 import Lexer
 import RdrName
 import TysWiredIn      ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
@@ -36,7 +36,6 @@ import Type           ( Kind, mkArrowKind, liftedTypeKind )
 import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
                          Activation(..) )
 import OrdList
-import Bag             ( emptyBag )
 import Panic
 
 import FastString
@@ -275,7 +274,6 @@ TH_TY_QUOTE { L _ ITtyQuote       }      -- ''T
 %name parseModule module
 %name parseStmt   maybe_stmt
 %name parseIdentifier  identifier
-%name parseIface iface
 %name parseType ctype
 %partial parseHeader header
 %tokentype { Located Token }
@@ -335,38 +333,6 @@ header_body :: { [LImportDecl RdrName] }
        |      vocurly    importdecls           { $2 }
 
 -----------------------------------------------------------------------------
--- Interfaces (.hi-boot files)
-
-iface   :: { ModIface }
-       : 'module' modid 'where' ifacebody  { mkBootIface (unLoc $2) $4 }
-
-ifacebody :: { [HsDecl RdrName] }
-       :  '{'            ifacedecls '}'                { $2 }
-       |      vocurly    ifacedecls close              { $2 }
-
-ifacedecls :: { [HsDecl RdrName] }
-       : ifacedecl ';' ifacedecls      { $1 : $3 }
-       | ';' ifacedecls                { $2 }
-       | ifacedecl                     { [$1] }
-       | {- empty -}                   { [] }
-
-ifacedecl :: { HsDecl RdrName }
-       : var '::' sigtype      
-                { SigD (Sig $1 $3) }
-       | 'type' syn_hdr '=' ctype      
-               { let (tc,tvs) = $2 in TyClD (TySynonym tc tvs $4) }
-       | 'data' tycl_hdr constrs       -- No deriving in hi-boot
-               { TyClD (mkTyData DataType $2 Nothing (reverse (unLoc $3)) Nothing) }
-        | 'data' tycl_hdr 'where' gadt_constrlist      
-               { TyClD (mkTyData DataType $2 Nothing (reverse (unLoc $4)) Nothing) }
-       | 'newtype' tycl_hdr            -- Constructor is optional
-               { TyClD (mkTyData NewType $2 Nothing [] Nothing) }
-       | 'newtype' tycl_hdr '=' newconstr
-               { TyClD (mkTyData NewType $2 Nothing [$4] Nothing) }
-       | 'class' tycl_hdr fds
-               { TyClD (mkClassDecl (unLoc $2) (unLoc $3) [] emptyBag) }
-
------------------------------------------------------------------------------
 -- The Export List
 
 maybeexports :: { Maybe [LIE RdrName] }
@@ -470,15 +436,20 @@ topdecl :: { OrdList (LHsDecl RdrName) }
        | decl                                  { unLoc $1 }
 
 tycl_decl :: { LTyClDecl RdrName }
-       : 'type' syn_hdr '=' ctype      
-               -- Note ctype, not sigtype.
+       : 'type' type '=' ctype 
+               -- Note type on the left of the '='; this allows
+               -- infix type constructors to be declared
+               -- 
+               -- Note ctype, not sigtype, on the right
                -- We allow an explicit for-all but we don't insert one
                -- in   type Foo a = (b,b)
                -- Instead we just say b is out of scope
-               { LL $ let (tc,tvs) = $2 in TySynonym tc tvs $4 }
+               {% do { (tc,tvs) <- checkSynHdr $2
+                     ; return (LL (TySynonym tc tvs $4)) } }
 
        | 'data' tycl_hdr constrs deriving
-               { L (comb4 $1 $2 $3 $4)
+               { L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr 
+                                       -- in case constrs and deriving are both empty
                    (mkTyData DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) }
 
         | 'data' tycl_hdr opt_kind_sig 'where' gadt_constrlist -- No deriving for GADTs
@@ -500,12 +471,6 @@ opt_kind_sig :: { Maybe Kind }
        :                               { Nothing }
        | '::' kind                     { Just $2 }
 
-syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
-               -- We don't retain the syntax of an infix
-               -- type synonym declaration. Oh well.
-       : tycon tv_bndrs                { ($1, $2) }
-       | tv_bndr tyconop tv_bndr       { ($2, [$1,$3]) }
-
 -- tycl_hdr parses the header of a type or class decl,
 -- which takes the form
 --     T a b
@@ -513,7 +478,7 @@ syn_hdr :: { (Located RdrName, [LHsTyVarBndr RdrName]) }
 --     (Eq a, Ord b) => T a b
 -- Rather a lot of inlining here, else we get reduce/reduce errors
 tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
-       : context '=>' type             {% checkTyClHdr $1 $3 >>= return.LL }
+       : context '=>' type             {% checkTyClHdr $1         $3 >>= return.LL }
        | type                          {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
 
 -----------------------------------------------------------------------------