-- ---------------------------------------------------------------------------
{
-module Parser ( parseModule, parseStmt, parseIdentifier, parseIface, parseType ) where
+module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
+ parseHeader ) where
#define INCLUDE #include
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,
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
Activation(..) )
import OrdList
-import Bag ( emptyBag )
import Panic
import FastString
{-
-----------------------------------------------------------------------------
-Conflicts: 29 shift/reduce, [SDM 19/9/2002]
+Conflicts: 34 shift/reduce (1.15)
-10 for abiguity in 'if x then y else z + 1' [State 136]
+10 for abiguity in 'if x then y else z + 1' [State 178]
(shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
-1 for ambiguity in 'if x then y else z with ?x=3' [State 136]
- (shift parses as 'if x then y else (z with ?x=3)'
-
-1 for ambiguity in 'if x then y else z :: T' [State 136]
+1 for ambiguity in 'if x then y else z :: T' [State 178]
(shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
-4 for ambiguity in 'if x then y else z -< e'
+4 for ambiguity in 'if x then y else z -< e' [State 178]
(shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
+ There are four such operators: -<, >-, -<<, >>-
+
-8 for ambiguity in 'e :: a `b` c'. Does this mean [States 160,246]
+2 for ambiguity in 'case v of { x :: T -> T ... } ' [States 11, 253]
+ Which of these two is intended?
+ case v of
+ (x::T) -> T -- Rhs is T
+ or
+ case v of
+ (x::T -> T) -> .. -- Rhs is ...
+
+8 for ambiguity in 'e :: a `b` c'. Does this mean [States 11, 253]
(e::a) `b` c, or
(e :: (a `b` c))
+ As well as `b` we can have !, QCONSYM, and CONSYM, hence 3 cases
+ Same duplication between states 11 and 253 as the previous case
-1 for ambiguity in 'let ?x ...' [State 268]
+1 for ambiguity in 'let ?x ...' [State 329]
the parser can't tell whether the ?x is the lhs of a normal binding or
an implicit binding. Fortunately resolving as shift gives it the only
sensible meaning, namely the lhs of an implicit binding.
-1 for ambiguity in '{-# RULES "name" [ ... #-} [State 332]
+1 for ambiguity in '{-# RULES "name" [ ... #-} [State 382]
we don't know whether the '[' starts the activation or not: it
might be the start of the declaration with the activation being
empty. --SDM 1/4/2002
-1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 394]
+6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 393,394]
+ which are resolved correctly, and moreover,
+ should go away when `fdeclDEPRECATED' is removed.
+
+1 for ambiguity in '{-# RULES "name" forall = ... #-}' [State 474]
since 'forall' is a valid variable name, we don't know whether
to treat a forall on the input as the beginning of a quantifier
or the beginning of the rule itself. Resolving to shift means
This saves explicitly defining a grammar for the rule lhs that
doesn't include 'forall'.
-6 for conflicts between `fdecl' and `fdeclDEPRECATED', [States 384,385]
- which are resolved correctly, and moreover,
- should go away when `fdeclDEPRECATED' is removed.
-
-- ---------------------------------------------------------------------------
-- Adding location info
%name parseModule module
%name parseStmt maybe_stmt
%name parseIdentifier identifier
-%name parseIface iface
%name parseType ctype
+%partial parseHeader header
%tokentype { Located Token }
%%
module :: { Located (HsModule RdrName) }
: 'module' modid maybemoddeprec maybeexports 'where' body
{% fileSrcSpan >>= \ loc ->
- return (L loc (HsModule (Just (L (getLoc $2)
- (mkHomeModule (unLoc $2))))
- $4 (fst $6) (snd $6) $3)) }
+ return (L loc (HsModule (Just $2) $4 (fst $6) (snd $6) $3)) }
| missing_module_keyword top close
{% fileSrcSpan >>= \ loc ->
return (L loc (HsModule Nothing Nothing
: topdecls { cvTopDecls $1 }
-----------------------------------------------------------------------------
--- Interfaces (.hi-boot files)
-
-iface :: { ModIface }
- : 'module' modid 'where' ifacebody { mkBootIface (unLoc $2) $4 }
+-- Module declaration & imports only
-ifacebody :: { [HsDecl RdrName] }
- : '{' ifacedecls '}' { $2 }
- | vocurly ifacedecls close { $2 }
-
-ifacedecls :: { [HsDecl RdrName] }
- : ifacedecl ';' ifacedecls { $1 : $3 }
- | ';' ifacedecls { $2 }
- | ifacedecl { [$1] }
- | {- empty -} { [] }
+header :: { Located (HsModule RdrName) }
+ : 'module' modid maybemoddeprec maybeexports 'where' header_body
+ {% fileSrcSpan >>= \ loc ->
+ return (L loc (HsModule (Just $2) $4 $6 [] $3)) }
+ | missing_module_keyword importdecls
+ {% fileSrcSpan >>= \ loc ->
+ return (L loc (HsModule Nothing Nothing $2 [] Nothing)) }
-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) }
+header_body :: { [LImportDecl RdrName] }
+ : '{' importdecls { $2 }
+ | vocurly importdecls { $2 }
-----------------------------------------------------------------------------
-- The Export List
: 'qualified' { True }
| {- empty -} { False }
-maybeas :: { Located (Maybe ModuleName) }
+maybeas :: { Located (Maybe Module) }
: 'as' modid { LL (Just (unLoc $2)) }
| {- empty -} { noLoc Nothing }
| 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
: { 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
-- (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 }
-----------------------------------------------------------------------------
gadt_constrs :: { Located [LConDecl RdrName] }
: gadt_constrs ';' gadt_constr { LL ($3 : unLoc $1) }
+ | gadt_constrs ';' { $1 }
| gadt_constr { L1 [$1] }
gadt_constr :: { LConDecl RdrName }
-----------------------------------------------------------------------------
-- Miscellaneous (mostly renamings)
-modid :: { Located ModuleName }
- : CONID { L1 $ mkModuleNameFS (getCONID $1) }
+modid :: { Located Module }
+ : CONID { L1 $ mkModuleFS (getCONID $1) }
| QCONID { L1 $ let (mod,c) = getQCONID $1 in
- mkModuleNameFS
+ mkModuleFS
(mkFastString
(unpackFS mod ++ '.':unpackFS c))
}
projects / ghc-hetmet.git / blobdiff