import FastString
import Maybes ( orElse )
+import Monad ( when )
import Outputable
import GLAEXTS
}
{-
-----------------------------------------------------------------------------
+26 July 2006
+
+Conflicts: 37 shift/reduce
+ 1 reduce/reduce
+
+The reduce/reduce conflict is weird. It's between tyconsym and consym, and I
+would think the two should never occur in the same context.
+
+ -=chak
+
+-----------------------------------------------------------------------------
Conflicts: 36 shift/reduce (1.25)
10 for abiguity in 'if x then y else z + 1' [State 178]
might be the start of the declaration with the activation being
empty. --SDM 1/4/2002
-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
They each add a SrcSpan to their argument.
L0 adds 'noSrcSpan', used for empty productions
+ -- This doesn't seem to work anymore -=chak
L1 for a production with a single token on the lhs. Grabs the SrcSpan
from that token.
'where' { L _ ITwhere }
'_scc_' { L _ ITscc } -- ToDo: remove
- 'forall' { L _ ITforall } -- GHC extension keywords
+ 'forall' { L _ ITforall } -- GHC extension keywords
'foreign' { L _ ITforeign }
'export' { L _ ITexport }
'label' { L _ ITlabel }
'threadsafe' { L _ ITthreadsafe }
'unsafe' { L _ ITunsafe }
'mdo' { L _ ITmdo }
+ 'iso' { L _ ITiso }
+ 'family' { L _ ITfamily }
'stdcall' { L _ ITstdcallconv }
'ccall' { L _ ITccallconv }
'dotnet' { L _ ITdotnet }
QCONSYM { L _ (ITqconsym _) }
IPDUPVARID { L _ (ITdupipvarid _) } -- GHC extension
- IPSPLITVARID { L _ (ITsplitipvarid _) } -- GHC extension
CHAR { L _ (ITchar _) }
STRING { L _ (ITstring _) }
: '(' exportlist ')' { Just $2 }
| {- empty -} { Nothing }
-exportlist :: { [LIE RdrName] }
- : exportlist ',' export { $3 : $1 }
- | exportlist ',' { $1 }
- | export { [$1] }
+exportlist :: { [LIE RdrName] }
+ : ',' { [] }
+ | exportlist1 { $1 }
+
+exportlist1 :: { [LIE RdrName] }
+ : export { [$1] }
+ | export ',' exportlist { $1 : $3 }
| {- empty -} { [] }
-- No longer allow things like [] and (,,,) to be exported
| 'module' modid { LL (IEModuleContents (unLoc $2)) }
qcnames :: { [RdrName] }
- : qcnames ',' qcname { unLoc $3 : $1 }
- | qcname { [unLoc $1] }
+ : qcnames ',' qcname_ext { unLoc $3 : $1 }
+ | qcname_ext { [unLoc $1] }
+
+qcname_ext :: { Located RdrName } -- Variable or data constructor
+ -- or tagged type constructor
+ : qcname { $1 }
+ | 'type' qcon { sL (comb2 $1 $2)
+ (setRdrNameSpace (unLoc $2)
+ tcClsName) }
+-- Cannot pull into qcname_ext, as qcname is also used in expression.
qcname :: { Located RdrName } -- Variable or data constructor
- : qvar { $1 }
- | qcon { $1 }
+ : qvar { $1 }
+ | qcon { $1 }
-----------------------------------------------------------------------------
-- Import Declarations
| {- empty -} { noLoc Nothing }
impspec :: { Located (Bool, [LIE RdrName]) }
- : '(' exportlist ')' { LL (False, reverse $2) }
- | 'hiding' '(' exportlist ')' { LL (True, reverse $3) }
+ : '(' exportlist ')' { LL (False, $2) }
+ | 'hiding' '(' exportlist ')' { LL (True, $3) }
-----------------------------------------------------------------------------
-- Fixity Declarations
| topdecl { $1 }
topdecl :: { OrdList (LHsDecl RdrName) }
- : tycl_decl { unitOL (L1 (TyClD (unLoc $1))) }
+ : cl_decl { unitOL (L1 (TyClD (unLoc $1))) }
+ | ty_decl { unitOL (L1 (TyClD (unLoc $1))) }
| 'instance' inst_type where
- { let (binds,sigs) = cvBindsAndSigs (unLoc $3)
- in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
+ { let (binds, sigs, ats) = cvBindsAndSigs (unLoc $3)
+ in unitOL (L (comb3 $1 $2 $3)
+ (InstD (InstDecl $2 binds sigs ats))) }
| 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) }
| 'foreign' fdecl { unitOL (LL (unLoc $2)) }
| '{-# DEPRECATED' deprecations '#-}' { $2 }
L1 $ HsVar (mkUnqual varName (getTH_ID_SPLICE $1))
)) }
-tycl_decl :: { LTyClDecl RdrName }
- : '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
+-- Type classes
+--
+cl_decl :: { LTyClDecl RdrName }
+ : 'class' tycl_hdr fds where
+ {% do { let { (binds, sigs, ats) =
+ cvBindsAndSigs (unLoc $4)
+ ; (ctxt, tc, tvs, tparms) = unLoc $2}
+ ; checkTyVars tparms -- only type vars allowed
+ ; checkKindSigs ats
+ ; return $ L (comb4 $1 $2 $3 $4)
+ (mkClassDecl (ctxt, tc, tvs)
+ (unLoc $3) sigs binds ats) } }
+
+-- Type declarations (toplevel)
+--
+ty_decl :: { LTyClDecl RdrName }
+ -- ordinary type synonyms
+ : 'type' type '=' ctype
+ -- Note ctype, not sigtype, on the right of '='
-- 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
- {% do { (tc,tvs) <- checkSynHdr $2
- ; return (LL (TySynonym tc tvs $4)) } }
-
+ --
+ -- Note the use of type for the head; this allows
+ -- infix type constructors to be declared
+ {% do { (tc, tvs, _) <- checkSynHdr $2 False
+ ; return (L (comb2 $1 $4)
+ (TySynonym tc tvs Nothing $4))
+ } }
+
+ -- type family declarations
+ | 'type' 'family' type opt_kind_sig
+ -- Note the use of type for the head; this allows
+ -- infix type constructors to be declared
+ --
+ {% do { (tc, tvs, _) <- checkSynHdr $3 False
+ ; let kind = case unLoc $4 of
+ Nothing -> liftedTypeKind
+ Just ki -> ki
+ ; return (L (comb3 $1 $3 $4)
+ (TyFunction tc tvs False kind))
+ } }
+
+ -- type instance declarations
+ | 'type' 'instance' type '=' ctype
+ -- Note the use of type for the head; this allows
+ -- infix type constructors and type patterns
+ --
+ {% do { (tc, tvs, typats) <- checkSynHdr $3 True
+ ; return (L (comb2 $1 $5)
+ (TySynonym tc tvs (Just typats) $5))
+ } }
+
+ -- ordinary data type or newtype declaration
| 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)) }
-
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
+ ; checkTyVars tparms -- no type pattern
+ ; return $
+ L (comb4 $1 $2 $3 $4)
+ -- We need the location on tycl_hdr in case
+ -- constrs and deriving are both empty
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
+ Nothing (reverse (unLoc $3)) (unLoc $4)) } }
+
+ -- ordinary GADT declaration
+ | data_or_newtype tycl_hdr opt_kind_sig
+ 'where' gadt_constrlist
+ deriving
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
+ ; checkTyVars tparms -- can have type pats
+ ; return $
+ L (comb4 $1 $2 $4 $5)
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
+ (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
+
+ -- data/newtype family
+ | data_or_newtype 'family' tycl_hdr opt_kind_sig
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
+ ; checkTyVars tparms -- no type pattern
+ ; let kind = case unLoc $4 of
+ Nothing -> liftedTypeKind
+ Just ki -> ki
+ ; return $
+ L (comb3 $1 $2 $4)
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
+ (Just kind) [] Nothing) } }
+
+ -- data/newtype instance declaration
+ | data_or_newtype 'instance' tycl_hdr constrs deriving
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
+ -- can have type pats
+ ; return $
+ L (comb4 $1 $3 $4 $5)
+ -- We need the location on tycl_hdr in case
+ -- constrs and deriving are both empty
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
+ Nothing (reverse (unLoc $4)) (unLoc $5)) } }
+
+ -- GADT instance declaration
+ | data_or_newtype 'instance' tycl_hdr opt_kind_sig
+ 'where' gadt_constrlist
+ deriving
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $3}
+ -- can have type pats
+ ; return $
+ L (comb4 $1 $3 $6 $7)
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
+ (unLoc $4) (reverse (unLoc $6)) (unLoc $7)) } }
+
+-- Associate type declarations
+--
+at_decl :: { LTyClDecl RdrName }
+ -- type family declarations
+ : 'type' type opt_kind_sig
+ -- Note the use of type for the head; this allows
+ -- infix type constructors to be declared
+ --
+ {% do { (tc, tvs, _) <- checkSynHdr $2 False
+ ; let kind = case unLoc $3 of
+ Nothing -> liftedTypeKind
+ Just ki -> ki
+ ; return (L (comb3 $1 $2 $3)
+ (TyFunction tc tvs False kind))
+ } }
+
+ -- type instance declarations
+ | 'type' type '=' ctype
+ -- Note the use of type for the head; this allows
+ -- infix type constructors and type patterns
+ --
+ {% do { (tc, tvs, typats) <- checkSynHdr $2 True
+ ; return (L (comb2 $1 $4)
+ (TySynonym tc tvs (Just typats) $4))
+ } }
+
+ -- data/newtype family
+ | data_or_newtype tycl_hdr '::' kind
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
+ ; checkTyVars tparms -- no type pattern
+ ; return $
+ L (comb3 $1 $2 $4)
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Nothing)
+ (Just (unLoc $4)) [] Nothing) } }
+
+ -- data/newtype instance declaration
+ | data_or_newtype tycl_hdr constrs deriving
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
+ -- can have type pats
+ ; return $
+ L (comb4 $1 $2 $3 $4)
+ -- We need the location on tycl_hdr in case
+ -- constrs and deriving are both empty
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
+ Nothing (reverse (unLoc $3)) (unLoc $4)) } }
+
+ -- GADT instance declaration
| data_or_newtype tycl_hdr opt_kind_sig
'where' gadt_constrlist
deriving
- { L (comb4 $1 $2 $4 $5)
- (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) }
+ {% do { let {(ctxt, tc, tvs, tparms) = unLoc $2}
+ -- can have type pats
+ ; return $
+ L (comb4 $1 $2 $5 $6)
+ (mkTyData (unLoc $1) (ctxt, tc, tvs, Just tparms)
+ (unLoc $3) (reverse (unLoc $5)) (unLoc $6)) } }
- | 'class' tycl_hdr fds where
- { let
- (binds,sigs) = cvBindsAndSigs (unLoc $4)
- in
- L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs
- binds) }
+opt_iso :: { Bool }
+ : { False }
+ | 'iso' { True }
data_or_newtype :: { Located NewOrData }
: 'data' { L1 DataType }
| 'newtype' { L1 NewType }
-opt_kind_sig :: { Maybe Kind }
- : { Nothing }
- | '::' kind { Just $2 }
+opt_kind_sig :: { Located (Maybe Kind) }
+ : { noLoc Nothing }
+ | '::' kind { LL (Just (unLoc $2)) }
--- tycl_hdr parses the header of a type or class decl,
+-- tycl_hdr parses the header of a class or data type decl,
-- which takes the form
-- T a b
-- Eq a => T a
-- (Eq a, Ord b) => T a b
+-- T Int [a] -- for associated types
-- Rather a lot of inlining here, else we get reduce/reduce errors
-tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
+tycl_hdr :: { Located (LHsContext RdrName,
+ Located RdrName,
+ [LHsTyVarBndr RdrName],
+ [LHsType RdrName]) }
: context '=>' type {% checkTyClHdr $1 $3 >>= return.LL }
| type {% checkTyClHdr (noLoc []) $1 >>= return.L1 }
-----------------------------------------------------------------------------
-- Nested declarations
+-- Type declaration or value declaration
+--
+tydecl :: { Located (OrdList (LHsDecl RdrName)) }
+tydecl : at_decl { LL (unitOL (L1 (TyClD (unLoc $1)))) }
+ | decl { $1 }
+
+tydecls :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
+ : tydecls ';' tydecl { LL (unLoc $1 `appOL` unLoc $3) }
+ | tydecls ';' { LL (unLoc $1) }
+ | tydecl { $1 }
+ | {- empty -} { noLoc nilOL }
+
+
+tydecllist
+ :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
+ : '{' tydecls '}' { LL (unLoc $2) }
+ | vocurly tydecls close { $2 }
+
+-- Form of the body of class and instance declarations
+--
+where :: { Located (OrdList (LHsDecl RdrName)) } -- Reversed
+ -- No implicit parameters
+ -- May have type declarations
+ : 'where' tydecllist { LL (unLoc $2) }
+ | {- empty -} { noLoc nilOL }
+
decls :: { Located (OrdList (LHsDecl RdrName)) }
: decls ';' decl { LL (unLoc $1 `appOL` unLoc $3) }
| decls ';' { LL (unLoc $1) }
: '{' decls '}' { LL (unLoc $2) }
| vocurly decls close { $2 }
-where :: { Located (OrdList (LHsDecl RdrName)) }
- -- No implicit parameters
- : 'where' decllist { LL (unLoc $2) }
- | {- empty -} { noLoc nilOL }
-
+-- Binding groups other than those of class and instance declarations
+--
binds :: { Located (HsLocalBinds RdrName) } -- May have implicit parameters
+ -- No type declarations
: 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 (HsLocalBinds RdrName) } -- May have implicit parameters
+ -- No type declarations
: 'where' binds { LL (unLoc $2) }
| {- empty -} { noLoc emptyLocalBinds }
-----------------------------------------------------------------------------
-- Foreign import and export declarations
--- for the time being, the following accepts foreign declarations conforming
--- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
---
--- * a flag indicates whether pre-standard declarations have been used and
--- triggers a deprecation warning further down the road
---
--- NB: The first two rules could be combined into one by replacing `safety1'
--- with `safety'. However, the combined rule conflicts with the
--- DEPRECATED rules.
---
fdecl :: { LHsDecl RdrName }
-fdecl : 'import' callconv safety1 fspec
+fdecl : 'import' callconv safety fspec
{% mkImport $2 $3 (unLoc $4) >>= return.LL }
- | 'import' callconv fspec
+ | 'import' callconv fspec
{% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
return (LL d) } }
| 'export' callconv fspec
{% mkExport $2 (unLoc $3) >>= return.LL }
- -- the following syntax is DEPRECATED
- | fdecl1DEPRECATED { L1 (ForD (unLoc $1)) }
- | fdecl2DEPRECATED { L1 (unLoc $1) }
-
-fdecl1DEPRECATED :: { LForeignDecl RdrName }
-fdecl1DEPRECATED
- ----------- DEPRECATED label decls ------------
- : 'label' ext_name varid '::' sigtype
- { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
- (CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
-
- ----------- DEPRECATED ccall/stdcall decls ------------
- --
- -- NB: This business with the case expression below may seem overly
- -- complicated, but it is necessary to avoid some conflicts.
-
- -- DEPRECATED variant #1: lack of a calling convention specification
- -- (import)
- | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
- { let
- target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
- in
- LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
- (CFunction target)) True }
-
- -- DEPRECATED variant #2: external name consists of two separate strings
- -- (module name and function name) (import)
- | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
- {% case $2 of
- DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
- CCall cconv -> return $
- let
- imp = CFunction (StaticTarget (getSTRING $4))
- in
- LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
-
- -- DEPRECATED variant #3: `unsafe' after entity
- | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
- {% case $2 of
- DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
- CCall cconv -> return $
- let
- imp = CFunction (StaticTarget (getSTRING $3))
- in
- LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
-
- -- DEPRECATED variant #4: use of the special identifier `dynamic' without
- -- an explicit calling convention (import)
- | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
- { LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS
- (CFunction DynamicTarget)) True }
-
- -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
- | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
- {% case $2 of
- DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
- CCall cconv -> return $
- LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS
- (CFunction DynamicTarget)) True }
-
- -- DEPRECATED variant #6: lack of a calling convention specification
- -- (export)
- | 'export' {-no callconv-} ext_name varid '::' sigtype
- { LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
- defaultCCallConv)) True }
-
- -- DEPRECATED variant #7: external name consists of two separate strings
- -- (module name and function name) (export)
- | 'export' callconv STRING STRING varid '::' sigtype
- {% case $2 of
- DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
- CCall cconv -> return $
- LL $ ForeignExport $5 $7
- (CExport (CExportStatic (getSTRING $4) cconv)) True }
-
- -- DEPRECATED variant #8: use of the special identifier `dynamic' without
- -- an explicit calling convention (export)
- | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
- { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS
- CWrapper) True }
-
- -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
- | 'export' callconv 'dynamic' varid '::' sigtype
- {% case $2 of
- DNCall -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
- CCall cconv -> return $
- LL $ ForeignImport $4 $6
- (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
-
- ----------- DEPRECATED .NET decls ------------
- -- NB: removed the .NET call declaration, as it is entirely subsumed
- -- by the new standard FFI declarations
-
-fdecl2DEPRECATED :: { LHsDecl RdrName }
-fdecl2DEPRECATED
- : 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
- -- left this one unchanged for the moment as type imports are not
- -- covered currently by the FFI standard -=chak
-
callconv :: { CallConv }
: 'stdcall' { CCall StdCallConv }
safety :: { Safety }
: 'unsafe' { PlayRisky }
- | 'safe' { PlaySafe False }
- | 'threadsafe' { PlaySafe True }
- | {- empty -} { PlaySafe False }
-
-safety1 :: { Safety }
- : 'unsafe' { PlayRisky }
| 'safe' { PlaySafe False }
| 'threadsafe' { PlaySafe True }
- -- only needed to avoid conflicts with the DEPRECATED rules
fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
: STRING var '::' sigtype { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
-- the meaning of an empty entity string depends on the calling
-- convention
--- DEPRECATED syntax
-ext_name :: { Maybe CLabelString }
- : STRING { Just (getSTRING $1) }
- | STRING STRING { Just (getSTRING $2) } -- Ignore "module name" for now
- | {- empty -} { Nothing }
-
-
-----------------------------------------------------------------------------
-- Type signatures
| '[' ctype ']' { LL $ HsListTy $2 }
| '[:' ctype ':]' { LL $ HsPArrTy $2 }
| '(' ctype ')' { LL $ HsParTy $2 }
- | '(' ctype '::' kind ')' { LL $ HsKindSig $2 $4 }
+ | '(' ctype '::' kind ')' { LL $ HsKindSig $2 (unLoc $4) }
-- Generics
| INTEGER { L1 (HsNumTy (getINTEGER $1)) }
tv_bndr :: { LHsTyVarBndr RdrName }
: tyvar { L1 (UserTyVar (unLoc $1)) }
- | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2) $4) }
+ | '(' tyvar '::' kind ')' { LL (KindedTyVar (unLoc $2)
+ (unLoc $4)) }
fds :: { Located [Located ([RdrName], [RdrName])] }
: {- empty -} { noLoc [] }
-----------------------------------------------------------------------------
-- Kinds
-kind :: { Kind }
+kind :: { Located Kind }
: akind { $1 }
- | akind '->' kind { mkArrowKind $1 $3 }
+ | akind '->' kind { LL (mkArrowKind (unLoc $1) (unLoc $3)) }
-akind :: { Kind }
- : '*' { liftedTypeKind }
- | '!' { unliftedTypeKind }
- | '(' kind ')' { $2 }
+akind :: { Located Kind }
+ : '*' { L1 liftedTypeKind }
+ | '!' { L1 unliftedTypeKind }
+ | '(' kind ')' { LL (unLoc $2) }
-----------------------------------------------------------------------------
{ 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
+ -- XXX revisit audreyt
| constr_stuff_record '::' sigtype
{ let (con,details) = unLoc $1 in
LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3)) }
alt :: { LMatch RdrName }
: infixexp opt_sig alt_rhs {% checkPattern $1 >>= \p ->
return (LL (Match [p] $2 (unLoc $3))) }
+ | '!' infixexp opt_sig alt_rhs {% checkPattern $2 >>= \p ->
+ return (LL (Match [LL $ BangPat p] $3 (unLoc $4))) }
alt_rhs :: { Located (GRHSs RdrName) }
: ralt wherebinds { LL (GRHSs (unLoc $1) (unLoc $2)) }
dbind : ipvar '=' exp { LL (IPBind (unLoc $1) $3) }
ipvar :: { Located (IPName RdrName) }
- : IPDUPVARID { L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
- | IPSPLITVARID { L1 (Linear (mkUnqual varName (getIPSPLITVARID $1))) }
+ : IPDUPVARID { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) }
-----------------------------------------------------------------------------
-- Deprecations
: VARID { L1 $! mkUnqual varName (getVARID $1) }
| special_id { L1 $! mkUnqual varName (unLoc $1) }
| 'forall' { L1 $! mkUnqual varName FSLIT("forall") }
+ | 'iso' { L1 $! mkUnqual varName FSLIT("iso") }
+ | 'family' { L1 $! mkUnqual varName FSLIT("family") }
qvarsym :: { Located RdrName }
: varsym { $1 }
-- 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
+-- except 'unsafe', 'forall', 'family', and 'iso' whose treatment differs
+-- depending on context
special_id :: { Located FastString }
special_id
: 'as' { L1 FSLIT("as") }
getQVARSYM (L _ (ITqvarsym x)) = x
getQCONSYM (L _ (ITqconsym x)) = x
getIPDUPVARID (L _ (ITdupipvarid x)) = x
-getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
getCHAR (L _ (ITchar x)) = x
getSTRING (L _ (ITstring x)) = x
getINTEGER (L _ (ITinteger x)) = x
projects / ghc-hetmet.git / blobdiff