-- ---------------------------------------------------------------------------
{
-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 ForeignCall ( Safety(..), CExportSpec(..), CLabelString,
CCallConv(..), CCallTarget(..), defaultCCallConv
)
-import OccName ( UserFS, varName, dataName, tcClsName, tvName )
+import OccName ( varName, dataName, tcClsName, tvName )
import DataCon ( DataCon, dataConName )
import SrcLoc ( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
SrcSpan, combineLocs, srcLocFile,
mkSrcLoc, mkSrcSpan )
import Module
-import CmdLineOpts ( opt_SccProfilingOn )
+import StaticFlags ( opt_SccProfilingOn )
import Type ( Kind, mkArrowKind, liftedTypeKind )
import BasicTypes ( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
- Activation(..) )
+ Activation(..), defaultInlineSpec )
import OrdList
-import Bag ( emptyBag )
-import Panic
import FastString
import Maybes ( orElse )
{-
-----------------------------------------------------------------------------
-Conflicts: 33 shift/reduce, [SDM 19/9/2002]
+Conflicts: 36 shift/reduce (1.25)
-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: -<, >-, -<<, >>-
+
+
+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 160,246]
+10 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 !, VARSYM, QCONSYM, and CONSYM, hence 5 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
'proc' { L _ ITproc } -- for arrow notation extension
'rec' { L _ ITrec } -- for arrow notation extension
- '{-# SPECIALISE' { L _ ITspecialise_prag }
+ '{-# INLINE' { L _ (ITinline_prag _) }
+ '{-# SPECIALISE' { L _ ITspec_prag }
+ '{-# SPECIALISE_INLINE' { L _ (ITspec_inline_prag _) }
'{-# SOURCE' { L _ ITsource_prag }
- '{-# INLINE' { L _ ITinline_prag }
- '{-# NOINLINE' { L _ ITnoinline_prag }
'{-# RULES' { L _ ITrules_prag }
'{-# CORE' { L _ ITcore_prag } -- hdaume: annotated core
'{-# SCC' { L _ ITscc_prag }
%name parseModule module
%name parseStmt maybe_stmt
%name parseIdentifier identifier
-%name parseIface iface
%name parseType ctype
+%partial parseHeader header
%tokentype { Located Token }
%%
-----------------------------------------------------------------------------
+-- Identifiers; one of the entry points
+identifier :: { Located RdrName }
+ : qvar { $1 }
+ | qcon { $1 }
+ | qvarop { $1 }
+ | qconop { $1 }
+
+-----------------------------------------------------------------------------
-- Module Header
-- The place for module deprecation is really too restrictive, but if it
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)
+-- Module declaration & imports only
-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 -} { [] }
+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
qcname :: { Located RdrName } -- Variable or data constructor
: qvar { $1 }
- | gcon { $1 }
+ | qcon { $1 }
-----------------------------------------------------------------------------
-- Import Declarations
: '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)
- (mkTyData DataType $2 Nothing (reverse (unLoc $3)) (unLoc $4)) }
+ | data_or_newtype tycl_hdr constrs deriving
+ { L (comb4 $1 $2 $3 $4) -- We need the location on tycl_hdr
+ -- in case constrs and deriving are both empty
+ (mkTyData (unLoc $1) (unLoc $2) Nothing (reverse (unLoc $3)) (unLoc $4)) }
- | 'data' tycl_hdr opt_kind_sig 'where' gadt_constrlist -- No deriving for GADTs
+ | data_or_newtype tycl_hdr opt_kind_sig
+ 'where' gadt_constrlist
+ deriving
{ L (comb4 $1 $2 $4 $5)
- (mkTyData DataType $2 $3 (reverse (unLoc $5)) Nothing) }
-
- | 'newtype' tycl_hdr '=' newconstr deriving
- { L (comb3 $1 $4 $5)
- (mkTyData NewType $2 Nothing [$4] (unLoc $5)) }
+ (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) }
| 'class' tycl_hdr fds where
{ let
L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
binds) }
+data_or_newtype :: { Located NewOrData }
+ : 'data' { L1 DataType }
+ | 'newtype' { L1 NewType }
+
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
-- (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 }
-----------------------------------------------------------------------------
: 'where' decllist { LL (unLoc $2) }
| {- empty -} { noLoc nilOL }
-binds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
- : decllist { L1 [cvBindGroup (unLoc $1)] }
- | '{' dbinds '}' { LL [HsIPBinds (unLoc $2)] }
- | vocurly dbinds close { L (getLoc $2) [HsIPBinds (unLoc $2)] }
+binds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
+ : decllist { L1 (HsValBinds (cvBindGroup (unLoc $1))) }
+ | '{' dbinds '}' { LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
+ | vocurly dbinds close { L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
-wherebinds :: { Located [HsBindGroup RdrName] } -- May have implicit parameters
+wherebinds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
: 'where' binds { LL (unLoc $2) }
- | {- empty -} { noLoc [] }
+ | {- empty -} { noLoc emptyLocalBinds }
-----------------------------------------------------------------------------
rule :: { LHsDecl RdrName }
: STRING activation rule_forall infixexp '=' exp
- { LL $ RuleD (HsRule (getSTRING $1) $2 $3 $4 $6) }
-
-activation :: { Activation } -- Omitted means AlwaysActive
- : {- empty -} { AlwaysActive }
- | explicit_activation { $1 }
+ { LL $ RuleD (HsRule (getSTRING $1)
+ ($2 `orElse` AlwaysActive)
+ $3 $4 $6) }
-inverse_activation :: { Activation } -- Omitted means NeverActive
- : {- empty -} { NeverActive }
- | explicit_activation { $1 }
+activation :: { Maybe Activation }
+ : {- empty -} { Nothing }
+ | explicit_activation { Just $1 }
explicit_activation :: { Activation } -- In brackets
: '[' INTEGER ']' { ActiveAfter (fromInteger (getINTEGER $2)) }
gentype :: { LHsType RdrName }
: btype { $1 }
| btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
- | btype '`' tyvar '`' gentype { LL $ HsOpTy $1 $3 $5 }
- | btype '->' gentype { LL $ HsFunTy $1 $3 }
+ | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
+ | btype '->' ctype { LL $ HsFunTy $1 $3 }
btype :: { LHsType RdrName }
: btype atype { LL $ HsAppTy $1 $2 }
: gtycon { L1 (HsTyVar (unLoc $1)) }
| tyvar { L1 (HsTyVar (unLoc $1)) }
| strict_mark atype { LL (HsBangTy (unLoc $1) $2) }
- | '(' type ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
+ | '(' ctype ',' comma_types1 ')' { LL $ HsTupleTy Boxed ($2:$4) }
| '(#' comma_types1 '#)' { LL $ HsTupleTy Unboxed $2 }
- | '[' type ']' { LL $ HsListTy $2 }
- | '[:' type ':]' { LL $ HsPArrTy $2 }
+ | '[' ctype ']' { LL $ HsListTy $2 }
+ | '[:' ctype ':]' { LL $ HsPArrTy $2 }
| '(' ctype ')' { LL $ HsParTy $2 }
| '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 }
-- Generics
| {- empty -} { [] }
comma_types1 :: { [LHsType RdrName] }
- : type { [$1] }
- | type ',' comma_types1 { $1 : $3 }
+ : ctype { [$1] }
+ | ctype ',' comma_types1 { $1 : $3 }
tv_bndrs :: { [LHsTyVarBndr RdrName] }
: tv_bndr tv_bndrs { $1 : $2 }
-----------------------------------------------------------------------------
-- Datatype declarations
-newconstr :: { LConDecl RdrName }
- : conid atype { LL $ ConDecl $1 [] (noLoc []) (PrefixCon [$2]) }
- | conid '{' var '::' ctype '}'
- { LL $ ConDecl $1 [] (noLoc []) (RecCon [($3, $5)]) }
-
gadt_constrlist :: { Located [LConDecl RdrName] }
: '{' gadt_constrs '}' { LL (unLoc $2) }
| vocurly gadt_constrs close { $2 }
gadt_constrs :: { Located [LConDecl RdrName] }
: gadt_constrs ';' gadt_constr { LL ($3 : unLoc $1) }
+ | gadt_constrs ';' { $1 }
| gadt_constr { L1 [$1] }
+-- We allow the following forms:
+-- C :: Eq a => a -> T a
+-- C :: forall a. Eq a => !a -> T a
+-- D { x,y :: a } :: T a
+-- forall a. Eq a => D { x,y :: a } :: T a
+
gadt_constr :: { LConDecl RdrName }
- : qcon '::' sigtype
- { LL (GadtDecl $1 $3) }
+ : con '::' sigtype
+ { LL (mkGadtDecl $1 $3) }
+ -- Syntax: Maybe merge the record stuff with the single-case above?
+ -- (to kill the mostly harmless reduce/reduce error)
+ -- XXX revisit autrijus
+ | constr_stuff_record '::' sigtype
+ { let (con,details) = unLoc $1 in
+ LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3)) }
+{-
+ | forall context '=>' constr_stuff_record '::' sigtype
+ { let (con,details) = unLoc $4 in
+ LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6)) }
+ | forall constr_stuff_record '::' sigtype
+ { let (con,details) = unLoc $2 in
+ LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4)) }
+-}
+
constrs :: { Located [LConDecl RdrName] }
: {- empty; a GHC extension -} { noLoc [] }
constr :: { LConDecl RdrName }
: forall context '=>' constr_stuff
{ let (con,details) = unLoc $4 in
- LL (ConDecl con (unLoc $1) $2 details) }
+ LL (ConDecl con Explicit (unLoc $1) $2 details ResTyH98) }
| forall constr_stuff
{ let (con,details) = unLoc $2 in
- LL (ConDecl con (unLoc $1) (noLoc []) details) }
+ LL (ConDecl con Explicit (unLoc $1) (noLoc []) details ResTyH98) }
forall :: { Located [LHsTyVarBndr RdrName] }
: 'forall' tv_bndrs '.' { LL $2 }
| oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.LL }
| btype conop btype { LL ($2, InfixCon $1 $3) }
+constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
+ : oqtycon '{' '}' {% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
+ | oqtycon '{' fielddecls '}' {% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
+
fielddecls :: { [([Located RdrName], LBangType RdrName)] }
: fielddecl ',' fielddecls { unLoc $1 : $3 }
| fielddecl { [unLoc $1] }
| gdrh { L1 [$1] }
gdrh :: { LGRHS RdrName }
- : '|' quals '=' exp { LL $ GRHS (reverse (L (getLoc $4) (ResultStmt $4) :
- unLoc $2)) }
+ : '|' quals '=' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
: infixexp '::' sigtype
return (LL $ unitOL (LL $ SigD s)) }
-- See the above notes for why we need infixexp here
| var ',' sig_vars '::' sigtype
- { LL $ toOL [ LL $ SigD (Sig n $5) | n <- $1 : unLoc $3 ] }
+ { LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
| infix prec ops { LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
| n <- unLoc $3 ] }
| '{-# INLINE' activation qvar '#-}'
- { LL $ unitOL (LL $ SigD (InlineSig True $3 $2)) }
- | '{-# NOINLINE' inverse_activation qvar '#-}'
- { LL $ unitOL (LL $ SigD (InlineSig False $3 $2)) }
+ { LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
- { LL $ toOL [ LL $ SigD (SpecSig $2 t)
+ { LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
| t <- $4] }
+ | '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
+ { LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
+ | t <- $5] }
| '{-# SPECIALISE' 'instance' inst_type '#-}'
{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
: '\\' aexp aexps opt_asig '->' exp
{% checkPatterns ($2 : reverse $3) >>= \ ps ->
return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
- (GRHSs (unguardedRHS $6) []
+ (GRHSs (unguardedRHS $6) emptyLocalBinds
)])) }
| 'let' binds 'in' exp { LL $ HsLet (unLoc $2) $4 }
| 'if' exp 'then' exp 'else' exp { LL $ HsIf $2 $4 $6 }
| '-' fexp { LL $ mkHsNegApp $2 }
| 'do' stmtlist {% let loc = comb2 $1 $2 in
- checkDo loc (unLoc $2) >>= \ stmts ->
- return (L loc (mkHsDo DoExpr stmts)) }
+ checkDo loc (unLoc $2) >>= \ (stmts,body) ->
+ return (L loc (mkHsDo DoExpr stmts body)) }
| 'mdo' stmtlist {% let loc = comb2 $1 $2 in
- checkMDo loc (unLoc $2) >>= \ stmts ->
- return (L loc (mkHsDo MDoExpr stmts)) }
-
+ checkDo loc (unLoc $2) >>= \ (stmts,body) ->
+ return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
| scc_annot exp { LL $ if opt_SccProfilingOn
then HsSCC (unLoc $1) $2
else HsPar $2 }
| '$(' exp ')' { LL $ HsSpliceE (mkHsSplice $2) } -- $( exp )
| TH_VAR_QUOTE qvar { LL $ HsBracket (VarBr (unLoc $2)) }
- | TH_VAR_QUOTE gcon { LL $ HsBracket (VarBr (unLoc $2)) }
+ | TH_VAR_QUOTE qcon { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE tyvar { LL $ HsBracket (VarBr (unLoc $2)) }
| TH_TY_QUOTE gtycon { LL $ HsBracket (VarBr (unLoc $2)) }
| '[|' exp '|]' { LL $ HsBracket (ExpBr $2) }
list :: { LHsExpr RdrName }
: exp { L1 $ ExplicitList placeHolderType [$1] }
| lexps { L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
- | exp '..' { LL $ ArithSeqIn (From $1) }
- | exp ',' exp '..' { LL $ ArithSeqIn (FromThen $1 $3) }
- | exp '..' exp { LL $ ArithSeqIn (FromTo $1 $3) }
- | exp ',' exp '..' exp { LL $ ArithSeqIn (FromThenTo $1 $3 $5) }
- | exp pquals { LL $ mkHsDo ListComp
- (reverse (L (getLoc $1) (ResultStmt $1) :
- unLoc $2)) }
+ | exp '..' { LL $ ArithSeq noPostTcExpr (From $1) }
+ | exp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
+ | exp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
+ | exp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
+ | exp pquals { sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
lexps :: { Located [LHsExpr RdrName] }
: lexps ',' exp { LL ($3 : unLoc $1) }
| exp { L1 $ ExplicitPArr placeHolderType [$1] }
| lexps { L1 $ ExplicitPArr placeHolderType
(reverse (unLoc $1)) }
- | exp '..' exp { LL $ PArrSeqIn (FromTo $1 $3) }
- | exp ',' exp '..' exp { LL $ PArrSeqIn (FromThenTo $1 $3 $5) }
- | exp pquals { LL $ mkHsDo PArrComp
- (reverse (L (getLoc $1) (ResultStmt $1) :
- unLoc $2))
- }
+ | exp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
+ | exp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
+ | exp pquals { sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
-- We are reusing `lexps' and `pquals' from the list case.
| gdpat { L1 [$1] }
gdpat :: { LGRHS RdrName }
- : '|' quals '->' exp { let r = L (getLoc $4) (ResultStmt $4)
- in LL $ GRHS (reverse (r : unLoc $2)) }
+ : '|' quals '->' exp { sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
-----------------------------------------------------------------------------
-- Statement sequences
| vocurly stmts close { $2 }
-- do { ;; s ; s ; ; s ;; }
--- The last Stmt should be a ResultStmt, but that's hard to enforce
+-- The last Stmt should be an expression, but that's hard to enforce
-- here, because we need too much lookahead if we see do { e ; }
-- So we use ExprStmts throughout, and switch the last one over
-- in ParseUtils.checkDo instead
stmt :: { LStmt RdrName }
: qual { $1 }
| infixexp '->' exp {% checkPattern $3 >>= \p ->
- return (LL $ BindStmt p $1) }
- | 'rec' stmtlist { LL $ RecStmt (unLoc $2) undefined undefined undefined }
+ return (LL $ mkBindStmt p $1) }
+ | 'rec' stmtlist { LL $ mkRecStmt (unLoc $2) }
qual :: { LStmt RdrName }
- : infixexp '<-' exp {% checkPattern $1 >>= \p ->
- return (LL $ BindStmt p $3) }
- | exp { L1 $ ExprStmt $1 placeHolderType }
+ : exp '<-' exp {% checkPattern $1 >>= \p ->
+ return (LL $ mkBindStmt p $3) }
+ | exp { L1 $ mkExprStmt $1 }
| 'let' binds { LL $ LetStmt (unLoc $2) }
-----------------------------------------------------------------------------
dbind :: { LIPBind RdrName }
dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
------------------------------------------------------------------------------
--- Variables, Constructors and Operators.
+ipvar :: { Located (IPName RdrName) }
+ : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
+ | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) }
-identifier :: { Located RdrName }
- : qvar { $1 }
- | gcon { $1 }
- | qvarop { $1 }
- | qconop { $1 }
+-----------------------------------------------------------------------------
+-- Deprecations
depreclist :: { Located [RdrName] }
depreclist : deprec_var { L1 [unLoc $1] }
deprec_var :: { Located RdrName }
deprec_var : var { $1 }
- | tycon { $1 }
-
-gcon :: { Located RdrName } -- Data constructor namespace
- : sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
- | qcon { $1 }
--- the case of '[:' ':]' is part of the production `parr'
-
-sysdcon :: { Located DataCon } -- Wired in data constructors
- : '(' ')' { LL unitDataCon }
- | '(' commas ')' { LL $ tupleCon Boxed $2 }
- | '[' ']' { LL nilDataCon }
-
-var :: { Located RdrName }
- : varid { $1 }
- | '(' varsym ')' { LL (unLoc $2) }
-
-qvar :: { Located RdrName }
- : qvarid { $1 }
- | '(' varsym ')' { LL (unLoc $2) }
- | '(' qvarsym1 ')' { LL (unLoc $2) }
--- We've inlined qvarsym here so that the decision about
--- whether it's a qvar or a var can be postponed until
--- *after* we see the close paren.
-
-ipvar :: { Located (IPName RdrName) }
- : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
- | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) }
+ | con { $1 }
+-----------------------------------------
+-- Data constructors
qcon :: { Located RdrName }
: qconid { $1 }
| '(' qconsym ')' { LL (unLoc $2) }
+ | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
+-- The case of '[:' ':]' is part of the production `parr'
-varop :: { Located RdrName }
- : varsym { $1 }
- | '`' varid '`' { LL (unLoc $2) }
-
-qvarop :: { Located RdrName }
- : qvarsym { $1 }
- | '`' qvarid '`' { LL (unLoc $2) }
+con :: { Located RdrName }
+ : conid { $1 }
+ | '(' consym ')' { LL (unLoc $2) }
+ | sysdcon { L1 $ nameRdrName (dataConName (unLoc $1)) }
-qvaropm :: { Located RdrName }
- : qvarsym_no_minus { $1 }
- | '`' qvarid '`' { LL (unLoc $2) }
+sysdcon :: { Located DataCon } -- Wired in data constructors
+ : '(' ')' { LL unitDataCon }
+ | '(' commas ')' { LL $ tupleCon Boxed $2 }
+ | '[' ']' { LL nilDataCon }
conop :: { Located RdrName }
: consym { $1 }
: qtyconsym { $1 }
| '`' qtycon '`' { LL (unLoc $2) }
-tyconop :: { Located RdrName } -- Unqualified
- : tyconsym { $1 }
- | '`' tycon '`' { LL (unLoc $2) }
-
qtycon :: { Located RdrName } -- Qualified or unqualified
: QCONID { L1 $! mkQual tcClsName (getQCONID $1) }
| tycon { $1 }
: CONSYM { L1 $! mkUnqual tcClsName (getCONSYM $1) }
-----------------------------------------------------------------------------
--- Any operator
+-- Operators
op :: { Located RdrName } -- used in infix decls
: varop { $1 }
| conop { $1 }
+varop :: { Located RdrName }
+ : varsym { $1 }
+ | '`' varid '`' { LL (unLoc $2) }
+
qop :: { LHsExpr RdrName } -- used in sections
: qvarop { L1 $ HsVar (unLoc $1) }
| qconop { L1 $ HsVar (unLoc $1) }
: qvaropm { L1 $ HsVar (unLoc $1) }
| qconop { L1 $ HsVar (unLoc $1) }
+qvarop :: { Located RdrName }
+ : qvarsym { $1 }
+ | '`' qvarid '`' { LL (unLoc $2) }
+
+qvaropm :: { Located RdrName }
+ : qvarsym_no_minus { $1 }
+ | '`' qvarid '`' { LL (unLoc $2) }
+
-----------------------------------------------------------------------------
--- VarIds
+-- Type variables
+
+tyvar :: { Located RdrName }
+tyvar : tyvarid { $1 }
+ | '(' tyvarsym ')' { LL (unLoc $2) }
+
+tyvarop :: { Located RdrName }
+tyvarop : '`' tyvarid '`' { LL (unLoc $2) }
+ | tyvarsym { $1 }
+
+tyvarid :: { Located RdrName }
+ : VARID { L1 $! mkUnqual tvName (getVARID $1) }
+ | special_id { L1 $! mkUnqual tvName (unLoc $1) }
+ | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
+ | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
+ | 'threadsafe' { L1 $! mkUnqual tvName FSLIT("threadsafe") }
+
+tyvarsym :: { Located RdrName }
+-- Does not include "!", because that is used for strictness marks
+-- or ".", because that separates the quantified type vars from the rest
+-- or "*", because that's used for kinds
+tyvarsym : VARSYM { L1 $! mkUnqual tvName (getVARSYM $1) }
+
+-----------------------------------------------------------------------------
+-- Variables
+
+var :: { Located RdrName }
+ : varid { $1 }
+ | '(' varsym ')' { LL (unLoc $2) }
+
+qvar :: { Located RdrName }
+ : qvarid { $1 }
+ | '(' varsym ')' { LL (unLoc $2) }
+ | '(' qvarsym1 ')' { LL (unLoc $2) }
+-- We've inlined qvarsym here so that the decision about
+-- whether it's a qvar or a var can be postponed until
+-- *after* we see the close paren.
qvarid :: { Located RdrName }
: varid { $1 }
| special_id { L1 $! mkUnqual varName (unLoc $1) }
| 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
-tyvar :: { Located RdrName }
- : VARID { L1 $! mkUnqual tvName (getVARID $1) }
- | special_id { L1 $! mkUnqual tvName (unLoc $1) }
- | 'unsafe' { L1 $! mkUnqual tvName FSLIT("unsafe") }
- | 'safe' { L1 $! mkUnqual tvName FSLIT("safe") }
- | 'threadsafe' { L1 $! 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 :: { Located UserFS }
-special_id
- : 'as' { L1 FSLIT("as") }
- | 'qualified' { L1 FSLIT("qualified") }
- | 'hiding' { L1 FSLIT("hiding") }
- | 'export' { L1 FSLIT("export") }
- | 'label' { L1 FSLIT("label") }
- | 'dynamic' { L1 FSLIT("dynamic") }
- | 'stdcall' { L1 FSLIT("stdcall") }
- | 'ccall' { L1 FSLIT("ccall") }
-
------------------------------------------------------------------------------
--- Variables
-
qvarsym :: { Located RdrName }
: varsym { $1 }
| qvarsym1 { $1 }
| special_sym { L1 $ mkUnqual varName (unLoc $1) }
--- See comments with special_id
-special_sym :: { Located UserFS }
+-- 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 :: { Located FastString }
+special_id
+ : 'as' { L1 FSLIT("as") }
+ | 'qualified' { L1 FSLIT("qualified") }
+ | 'hiding' { L1 FSLIT("hiding") }
+ | 'export' { L1 FSLIT("export") }
+ | 'label' { L1 FSLIT("label") }
+ | 'dynamic' { L1 FSLIT("dynamic") }
+ | 'stdcall' { L1 FSLIT("stdcall") }
+ | 'ccall' { L1 FSLIT("ccall") }
+
+special_sym :: { Located FastString }
special_sym : '!' { L1 FSLIT("!") }
| '.' { L1 FSLIT(".") }
| '*' { L1 FSLIT("*") }
-----------------------------------------------------------------------------
-- 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))
}
getPRIMFLOAT (L _ (ITprimfloat x)) = x
getPRIMDOUBLE (L _ (ITprimdouble x)) = x
getTH_ID_SPLICE (L _ (ITidEscape x)) = x
+getINLINE (L _ (ITinline_prag b)) = b
+getSPEC_INLINE (L _ (ITspec_inline_prag b)) = b
-- Utilities for combining source spans
comb2 :: Located a -> Located b -> SrcSpan
projects / ghc-hetmet.git / blobdiff