extractHsRhoRdrTyVars, extractGenericPatTyVars,
mkHsOpApp, mkClassDecl,
- mkHsNegApp, mkHsIntegral, mkHsFractional, mkHsIsString,
+ mkHsIntegral, mkHsFractional, mkHsIsString,
mkHsDo, mkHsSplice,
mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec,
mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
isRdrDataCon, isUnqual, getRdrName, isQual,
setRdrNameSpace )
import BasicTypes ( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
-import Lexer ( P, failSpanMsgP, extension, glaExtsEnabled, bangPatEnabled )
+import Lexer ( P, failSpanMsgP, extension, standaloneDerivingEnabled, bangPatEnabled )
import TysWiredIn ( unitTyCon )
import ForeignCall ( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
DNCallSpec(..), DNKind(..), CLabelString )
import Bag ( Bag, emptyBag, snocBag, consBag, foldrBag )
import Outputable
import FastString
-import Panic
import List ( isSuffixOf, nubBy )
import Monad ( unless )
tcdKindSig = ksig, tcdDerivs = maybe_deriv }
\end{code}
-\begin{code}
-mkHsNegApp :: LHsExpr RdrName -> HsExpr RdrName
--- RdrName If the type checker sees (negate 3#) it will barf, because negate
--- can't take an unboxed arg. But that is exactly what it will see when
--- we write "-3#". So we have to do the negation right now!
-mkHsNegApp (L loc e) = f e
- where f (HsLit (HsIntPrim i)) = HsLit (HsIntPrim (-i))
- f (HsLit (HsFloatPrim i)) = HsLit (HsFloatPrim (-i))
- f (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i))
- f expr = NegApp (L loc e) noSyntaxExpr
-\end{code}
-
%************************************************************************
%* *
\subsection[cvBinds-etc]{Converting to @HsBinds@, etc.}
-- arguments, and converts the type constructor back into a data constructor.
mkPrefixCon :: LHsType RdrName -> [LBangType RdrName]
- -> P (Located RdrName, HsConDetails RdrName (LBangType RdrName))
+ -> P (Located RdrName, HsConDeclDetails RdrName)
mkPrefixCon ty tys
= split ty tys
where
mkRecCon :: Located RdrName ->
[([Located RdrName], LBangType RdrName, Maybe (LHsDoc RdrName))] ->
- P (Located RdrName, HsConDetails RdrName (LBangType RdrName))
+ P (Located RdrName, HsConDeclDetails RdrName)
mkRecCon (L loc con) fields
= do data_con <- tyConToDataCon loc con
- return (data_con, RecCon [ (HsRecField l t d) | (ls, t, d) <- fields, l <- ls ])
+ return (data_con, RecCon [ ConDeclField l t d | (ls, t, d) <- fields, l <- ls ])
tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
tyConToDataCon loc tc
checkDerivDecl :: LDerivDecl RdrName -> P (LDerivDecl RdrName)
checkDerivDecl d@(L loc _) =
- do glaExtOn <- extension glaExtsEnabled
- if glaExtOn then return d
- else parseError loc "Illegal stand-alone deriving declaration (use -fglasgow-exts)"
+ do stDerivOn <- extension standaloneDerivingEnabled
+ if stDerivOn then return d
+ else parseError loc "Illegal stand-alone deriving declaration (use -XStandaloneDeriving)"
---------------------------------------------------------------------------
-- Checking statements in a do-expression
-- Overloaded numeric patterns (e.g. f 0 x = x)
-- Negation is recorded separately, so that the literal is zero or +ve
- -- NB. Negative *primitive* literals are already handled by
- -- RdrHsSyn.mkHsNegApp
+ -- NB. Negative *primitive* literals are already handled by the lexer
HsOverLit pos_lit -> return (mkNPat pos_lit Nothing)
NegApp (L _ (HsOverLit pos_lit)) _
-> return (mkNPat pos_lit (Just noSyntaxExpr))
ExplicitTuple es b -> mapM (\e -> checkLPat e) es >>= \ps ->
return (TuplePat ps b placeHolderType)
- RecordCon c _ (HsRecordBinds fs) -> mapM checkPatField fs >>= \fs ->
- return (ConPatIn c (RecCon (map (uncurry mkRecField) fs)))
+ RecordCon c _ (HsRecFields fs dd)
+ -> mapM checkPatField fs >>= \fs ->
+ return (ConPatIn c (RecCon (HsRecFields fs dd)))
-- Generics
HsType ty -> return (TypePat ty)
_ -> patFail loc
plus_RDR = mkUnqual varName FSLIT("+") -- Hack
bang_RDR = mkUnqual varName FSLIT("!") -- Hack
-checkPatField :: (Located RdrName, LHsExpr RdrName) -> P (Located RdrName, LPat RdrName)
-checkPatField (n,e) = do
- p <- checkLPat e
- return (n,p)
+checkPatField :: HsRecField RdrName (LHsExpr RdrName) -> P (HsRecField RdrName (LPat RdrName))
+checkPatField fld = do { p <- checkLPat (hsRecFieldArg fld)
+ ; return (fld { hsRecFieldArg = p }) }
patFail loc = parseError loc "Parse error in pattern"
mkRecConstrOrUpdate
:: LHsExpr RdrName
-> SrcSpan
- -> HsRecordBinds RdrName
+ -> ([HsRecField RdrName (LHsExpr RdrName)], Bool)
-> P (HsExpr RdrName)
-mkRecConstrOrUpdate (L l (HsVar c)) loc fs | isRdrDataCon c
- = return (RecordCon (L l c) noPostTcExpr fs)
-mkRecConstrOrUpdate exp loc fs@(HsRecordBinds (_:_))
- = return (RecordUpd exp fs [] [] [])
-mkRecConstrOrUpdate _ loc (HsRecordBinds [])
- = parseError loc "Empty record update"
+mkRecConstrOrUpdate (L l (HsVar c)) loc (fs,dd) | isRdrDataCon c
+ = return (RecordCon (L l c) noPostTcExpr (mk_rec_fields fs dd))
+mkRecConstrOrUpdate exp loc (fs,dd)
+ | null fs = parseError loc "Empty record update"
+ | otherwise = return (RecordUpd exp (mk_rec_fields fs dd) [] [] [])
+
+mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
+mk_rec_fields fs True = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
mkInlineSpec :: Maybe Activation -> Bool -> InlineSpec
-- The Maybe is becuase the user can omit the activation spec (and usually does)