Generalise Package Support

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

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 3066a0f..da16bff 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -32,7 +32,7 @@ import SrcLoc         ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
                          mkSrcLoc, mkSrcSpan )
 import Module
 import StaticFlags     ( opt_SccProfilingOn )
-import Type            ( Kind, mkArrowKind, liftedTypeKind )
+import Type            ( Kind, mkArrowKind, liftedTypeKind, unliftedTypeKind )
 import BasicTypes      ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
                          Activation(..), defaultInlineSpec )
 import OrdList
@@ -394,7 +394,7 @@ optqualified :: { Bool }
        : 'qualified'                           { True  }
        | {- empty -}                           { False }
 
-maybeas :: { Located (Maybe Module) }
+maybeas :: { Located (Maybe ModuleName) }
        : 'as' modid                            { LL (Just (unLoc $2)) }
        | {- empty -}                           { noLoc Nothing }
 
@@ -425,7 +425,7 @@ ops         :: { Located [Located RdrName] }
 -----------------------------------------------------------------------------
 -- Top-Level Declarations
 
-topdecls :: { OrdList (LHsDecl RdrName) }      -- Reversed
+topdecls :: { OrdList (LHsDecl RdrName) }
        : topdecls ';' topdecl          { $1 `appOL` $3 }
        | topdecls ';'                  { $1 }
        | topdecl                       { $1 }
@@ -439,9 +439,14 @@ topdecl :: { OrdList (LHsDecl RdrName) }
        | 'foreign' fdecl                       { unitOL (LL (unLoc $2)) }
        | '{-# DEPRECATED' deprecations '#-}'   { $2 }
        | '{-# RULES' rules '#-}'               { $2 }
-       | '$(' exp ')'                          { unitOL (LL $ SpliceD (SpliceDecl $2)) }
        | decl                                  { unLoc $1 }
 
+       -- Template Haskell Extension
+       | '$(' exp ')'                          { unitOL (LL $ SpliceD (SpliceDecl $2)) }
+       | TH_ID_SPLICE                          { unitOL (LL $ SpliceD (SpliceDecl $
+                                                       L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
+                                                 )) }
+
 tycl_decl :: { LTyClDecl RdrName }
        : 'type' type '=' ctype 
                -- Note type on the left of the '='; this allows
@@ -493,18 +498,18 @@ tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrNam
 -----------------------------------------------------------------------------
 -- Nested declarations
 
-decls  :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
+decls  :: { Located (OrdList (LHsDecl RdrName)) }      
        : decls ';' decl                { LL (unLoc $1 `appOL` unLoc $3) }
        | decls ';'                     { LL (unLoc $1) }
        | decl                          { $1 }
        | {- empty -}                   { noLoc nilOL }
 
 
-decllist :: { Located (OrdList (LHsDecl RdrName)) }    -- Reversed
+decllist :: { Located (OrdList (LHsDecl RdrName)) }
        : '{'            decls '}'      { LL (unLoc $2) }
        |     vocurly    decls close    { $2 }
 
-where  :: { Located (OrdList (LHsDecl RdrName)) }      -- Reversed
+where  :: { Located (OrdList (LHsDecl RdrName)) }
                                -- No implicit parameters
        : 'where' decllist              { LL (unLoc $2) }
        | {- empty -}                   { noLoc nilOL }
@@ -522,7 +527,7 @@ wherebinds :: { Located (HsLocalBinds RdrName) }    -- May have implicit parameters
 -----------------------------------------------------------------------------
 -- Transformation Rules
 
-rules  :: { OrdList (LHsDecl RdrName) }        -- Reversed
+rules  :: { OrdList (LHsDecl RdrName) }
        :  rules ';' rule                       { $1 `snocOL` $3 }
         |  rules ';'                           { $1 }
         |  rule                                        { unitOL $1 }
@@ -557,7 +562,7 @@ rule_var :: { RuleBndr RdrName }
 -----------------------------------------------------------------------------
 -- Deprecations (c.f. rules)
 
-deprecations :: { OrdList (LHsDecl RdrName) }  -- Reversed
+deprecations :: { OrdList (LHsDecl RdrName) }
        : deprecations ';' deprecation          { $1 `appOL` $3 }
        | deprecations ';'                      { $1 }
        | deprecation                           { $1 }
@@ -845,6 +850,7 @@ kind        :: { Kind }
 
 akind  :: { Kind }
        : '*'                   { liftedTypeKind }
+       | '!'                   { unliftedTypeKind }
        | '(' kind ')'          { $2 }
 
 
@@ -1099,7 +1105,7 @@ aexp2     :: { LHsExpr RdrName }
        | '(' qopm infixexp ')'         { LL $ SectionR $2 $3 }
        | '_'                           { L1 EWildPat }
        
-       -- MetaHaskell Extension
+       -- Template Haskell Extension
        | TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice 
                                        (L1 $ HsVar (mkUnqual varName 
                                                        (getTH_ID_SPLICE $1)))) } -- $x
@@ -1539,10 +1545,10 @@ close :: { () }
 -----------------------------------------------------------------------------
 -- Miscellaneous (mostly renamings)
 
-modid  :: { Located Module }
-       : CONID                 { L1 $ mkModuleFS (getCONID $1) }
+modid  :: { Located ModuleName }
+       : CONID                 { L1 $ mkModuleNameFS (getCONID $1) }
         | QCONID               { L1 $ let (mod,c) = getQCONID $1 in
-                                 mkModuleFS
+                                 mkModuleNameFS
                                   (mkFastString
                                     (unpackFS mod ++ '.':unpackFS c))
                                }