diff options
Diffstat (limited to 'compiler/parser/RdrHsSyn.hs')
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 275 |
1 files changed, 140 insertions, 135 deletions
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index dc35c124cb..68d152e62e 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -189,7 +189,7 @@ mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv ; return (L loc (DataDecl { tcdLName = tc, tcdTyVars = tyvars, tcdFixity = fixity, tcdDataDefn = defn, - tcdDataCusk = PlaceHolder, + tcdDataCusk = placeHolder, tcdFVs = placeHolderNames })) } mkDataDefn :: NewOrData @@ -289,10 +289,10 @@ mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs -- Typed splices are not allowed at the top level, thus we do not represent them -- as spliced declaration. See #10945 mkSpliceDecl lexpr@(L loc expr) - | HsSpliceE splice@(HsUntypedSplice {}) <- expr + | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr = SpliceD (SpliceDecl (L loc splice) ExplicitSplice) - | HsSpliceE splice@(HsQuasiQuote {}) <- expr + | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr = SpliceD (SpliceDecl (L loc splice) ExplicitSplice) | otherwise @@ -352,7 +352,7 @@ cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs) cvBindGroup binding = do { (mbs, sigs, fam_ds, tfam_insts, dfam_insts, _) <- cvBindsAndSigs binding ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts) - return $ ValBindsIn mbs sigs } + return $ ValBinds noExt mbs sigs } cvBindsAndSigs :: OrdList (LHsDecl GhcPs) -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs] @@ -483,28 +483,28 @@ splitCon ty = split apps' [] where -- This is used somewhere where HsAppsTy is not used - unrollApps (L _ (HsAppTy t u)) = u : unrollApps t + unrollApps (L _ (HsAppTy _ t u)) = u : unrollApps t unrollApps t = [t] apps = unrollApps ty - oneDoc = [ () | L _ (HsDocTy _ _) <- apps ] `lengthIs` 1 + oneDoc = [ () | L _ (HsDocTy{}) <- apps ] `lengthIs` 1 -- the trailing doc, if any, can be extracted first (apps', trailing_doc) = case apps of - L _ (HsDocTy t ds) : ts | oneDoc -> (t : ts, Just ds) + L _ (HsDocTy _ t ds) : ts | oneDoc -> (t : ts, Just ds) ts -> (ts, Nothing) -- A comment on the constructor is handled a bit differently - it doesn't -- remain an 'HsDocTy', but gets lifted out and returned as the third -- element of the tuple. - split [ L _ (HsDocTy con con_doc) ] ts = do + split [ L _ (HsDocTy _ con con_doc) ] ts = do (data_con, con_details, con_doc') <- split [con] ts return (data_con, con_details, con_doc' `mplus` Just con_doc) - split [ L l (HsTyVar _ (L _ tc)) ] ts = do + split [ L l (HsTyVar _ _ (L _ tc)) ] ts = do data_con <- tyConToDataCon l tc return (data_con, mk_rest ts, trailing_doc) - split [ L l (HsTupleTy HsBoxedOrConstraintTuple ts) ] [] + split [ L l (HsTupleTy _ HsBoxedOrConstraintTuple ts) ] [] = return ( L l (getRdrName (tupleDataCon Boxed (length ts))) , PrefixCon ts , trailing_doc @@ -514,9 +514,9 @@ splitCon ty split (u : us) ts = split us (u : ts) split _ _ = panic "RdrHsSyn:splitCon" - mk_rest [L _ (HsDocTy t@(L _ HsRecTy{}) _)] = mk_rest [t] - mk_rest [L l (HsRecTy flds)] = RecCon (L l flds) - mk_rest ts = PrefixCon ts + mk_rest [L _ (HsDocTy _ t@(L _ HsRecTy{}) _)] = mk_rest [t] + mk_rest [L l (HsRecTy _ flds)] = RecCon (L l flds) + mk_rest ts = PrefixCon ts tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName) -- See Note [Parsing data constructors is hard] @@ -539,9 +539,9 @@ tyConToDataCon loc tc -- | Split a type to extract the trailing doc string (if there is one) from a -- type produced by the 'btype_no_ops' production. splitDocTy :: LHsType GhcPs -> (LHsType GhcPs, Maybe LHsDocString) -splitDocTy (L l (HsAppTy t1 t2)) = (L l (HsAppTy t1 t2'), ds) +splitDocTy (L l (HsAppTy x t1 t2)) = (L l (HsAppTy x t1 t2'), ds) where ~(t2', ds) = splitDocTy t2 -splitDocTy (L _ (HsDocTy ty ds)) = (ty, Just ds) +splitDocTy (L _ (HsDocTy _ ty ds)) = (ty, Just ds) splitDocTy ty = (ty, Nothing) -- | Given a type that is a field to an infix data constructor, try to split @@ -627,17 +627,17 @@ mkGadtDecl names ty (mcxt, tau) = split_rho rho split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau })) - = (Just cxt, tau) - split_rho (L _ (HsParTy ty)) = split_rho ty - split_rho tau = (Nothing, tau) + = (Just cxt, tau) + split_rho (L _ (HsParTy _ ty)) = split_rho ty + split_rho tau = (Nothing, tau) (args, res_ty) = split_tau tau -- See Note [GADT abstract syntax] in HsDecls - split_tau (L _ (HsFunTy (L loc (HsRecTy rf)) res_ty)) - = (RecCon (L loc rf), res_ty) - split_tau (L _ (HsParTy ty)) = split_tau ty - split_tau tau = (PrefixCon [], tau) + split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty)) + = (RecCon (L loc rf), res_ty) + split_tau (L _ (HsParTy _ ty)) = split_tau ty + split_tau tau = (PrefixCon [], tau) setRdrNameSpace :: RdrName -> NameSpace -> RdrName -- ^ This rather gruesome function is used mainly by the parser. @@ -745,13 +745,13 @@ checkTyVars pp_what equals_or_where tc tparms = do { tvs <- mapM chk tparms ; return (mkHsQTvs tvs) } where - chk (L _ (HsParTy ty)) = chk ty + chk (L _ (HsParTy _ ty)) = chk ty -- Check that the name space is correct! - chk (L l (HsKindSig (L lv (HsTyVar _ (L _ tv))) k)) - | isRdrTyVar tv = return (L l (KindedTyVar (L lv tv) k)) - chk (L l (HsTyVar _ (L ltv tv))) - | isRdrTyVar tv = return (L l (UserTyVar (L ltv tv))) + chk (L l (HsKindSig _ (L lv (HsTyVar _ _ (L _ tv))) k)) + | isRdrTyVar tv = return (L l (KindedTyVar PlaceHolder (L lv tv) k)) + chk (L l (HsTyVar _ _ (L ltv tv))) + | isRdrTyVar tv = return (L l (UserTyVar PlaceHolder (L ltv tv))) chk t@(L loc _) = Left (loc, vcat [ text "Unexpected type" <+> quotes (ppr t) @@ -815,23 +815,23 @@ checkTyClHdr is_cls ty where goL (L l ty) acc ann fix = go l ty acc ann fix - go l (HsTyVar _ (L _ tc)) acc ann fix + go l (HsTyVar _ _ (L _ tc)) acc ann fix | isRdrTc tc = return (L l tc, acc, fix, ann) - go _ (HsOpTy t1 ltc@(L _ tc) t2) acc ann _fix + go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix | isRdrTc tc = return (ltc, t1:t2:acc, Infix, ann) - go l (HsParTy ty) acc ann fix = goL ty acc (ann ++ mkParensApiAnn l) fix - go _ (HsAppTy t1 t2) acc ann fix = goL t1 (t2:acc) ann fix - go _ (HsAppsTy ts) acc ann _fix + go l (HsParTy _ ty) acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix + go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (t2:acc) ann fix + go _ (HsAppsTy _ ts) acc ann _fix | Just (head, args, fixity) <- getAppsTyHead_maybe ts = goL head (args ++ acc) ann fixity - go _ (HsAppsTy [L _ (HsAppInfix (L loc star))]) [] ann fix + go _ (HsAppsTy _ [L _ (HsAppInfix _ (L loc star))]) [] ann fix | isStar star = return (L loc (nameRdrName starKindTyConName), [], fix, ann) | isUniStar star = return (L loc (nameRdrName unicodeStarKindTyConName), [], fix, ann) - go l (HsTupleTy HsBoxedOrConstraintTuple ts) [] ann fix + go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix = return (L l (nameRdrName tup_name), ts, fix, ann) where arity = length ts @@ -846,8 +846,8 @@ checkTyClHdr is_cls ty -- etc. and BlockArguments is not enabled. checkBlockArguments :: LHsExpr GhcPs -> P () checkBlockArguments expr = case unLoc expr of - HsDo DoExpr _ _ -> check "do block" - HsDo MDoExpr _ _ -> check "mdo block" + HsDo _ DoExpr _ -> check "do block" + HsDo _ MDoExpr _ -> check "mdo block" HsLam {} -> check "lambda expression" HsCase {} -> check "case expression" HsLamCase {} -> check "lambda-case expression" @@ -878,16 +878,17 @@ checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs) checkContext (L l orig_t) = check [] (L l orig_t) where - check anns (L lp (HsTupleTy HsBoxedOrConstraintTuple ts)) + check anns (L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts)) -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can -- be used as context constraints. = return (anns ++ mkParensApiAnn lp,L l ts) -- Ditto () -- don't let HsAppsTy get in the way - check anns (L _ (HsAppsTy [L _ (HsAppPrefix ty)])) + check anns (L _ (HsAppsTy _ [L _ (HsAppPrefix _ ty)])) = check anns ty - check anns (L lp1 (HsParTy ty))-- to be sure HsParTy doesn't get into the way + check anns (L lp1 (HsParTy _ ty)) + -- to be sure HsParTy doesn't get into the way = check anns' ty where anns' = if l == lp1 then anns else (anns ++ mkParensApiAnn lp1) @@ -902,10 +903,10 @@ checkContext (L l orig_t) checkNoDocs :: SDoc -> LHsType GhcPs -> P () checkNoDocs msg ty = go ty where - go (L _ (HsAppTy t1 t2)) = go t1 *> go t2 - go (L l (HsDocTy t ds)) = parseErrorSDoc l $ hsep - [ text "Unexpected haddock", quotes (ppr ds) - , text "on", msg, quotes (ppr t) ] + go (L _ (HsAppTy _ t1 t2)) = go t1 *> go t2 + go (L l (HsDocTy _ t ds)) = parseErrorSDoc l $ hsep + [ text "Unexpected haddock", quotes (ppr ds) + , text "on", msg, quotes (ppr t) ] go _ = pure () -- ------------------------------------------------------------------------- @@ -925,7 +926,7 @@ checkLPat msg e@(L l _) = checkPat msg l e [] checkPat :: SDoc -> SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs] -> P (LPat GhcPs) -checkPat _ loc (L l e@(HsVar (L _ c))) args +checkPat _ loc (L l e@(HsVar _ (L _ c))) args | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args))) | not (null args) && patIsRec c = patFail (text "Perhaps you intended to use RecursiveDo") l e @@ -935,7 +936,7 @@ checkPat msg loc e args -- OK to let this happen even if bang-patterns | Just (e', args') <- splitBang e = do { args'' <- checkPatterns msg args' ; checkPat msg loc e' (args'' ++ args) } -checkPat msg loc (L _ (HsApp f e)) args +checkPat msg loc (L _ (HsApp _ f e)) args = do p <- checkLPat msg e checkPat msg loc f (p : args) checkPat msg loc (L _ e) [] @@ -949,76 +950,76 @@ checkAPat msg loc e0 = do pState <- getPState let opts = options pState case e0 of - EWildPat -> return (WildPat placeHolderType) - HsVar x -> return (VarPat x) - HsLit (HsStringPrim _ _) -- (#13260) + EWildPat _ -> return (WildPat noExt) + HsVar _ x -> return (VarPat noExt x) + HsLit _ (HsStringPrim _ _) -- (#13260) -> parseErrorSDoc loc (text "Illegal unboxed string literal in pattern:" $$ ppr e0) - HsLit l -> return (LitPat l) + HsLit _ l -> return (LitPat noExt l) -- 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 the lexer - HsOverLit pos_lit -> return (mkNPat (L loc pos_lit) Nothing) - NegApp (L l (HsOverLit pos_lit)) _ + HsOverLit _ pos_lit -> return (mkNPat (L loc pos_lit) Nothing) + NegApp _ (L l (HsOverLit _ pos_lit)) _ -> return (mkNPat (L l pos_lit) (Just noSyntaxExpr)) - SectionR (L lb (HsVar (L _ bang))) e -- (! x) + SectionR _ (L lb (HsVar _ (L _ bang))) e -- (! x) | bang == bang_RDR -> do { hintBangPat loc e0 ; e' <- checkLPat msg e ; addAnnotation loc AnnBang lb - ; return (BangPat e') } + ; return (BangPat noExt e') } - ELazyPat e -> checkLPat msg e >>= (return . LazyPat) - EAsPat n e -> checkLPat msg e >>= (return . AsPat n) + ELazyPat _ e -> checkLPat msg e >>= (return . (LazyPat noExt)) + EAsPat _ n e -> checkLPat msg e >>= (return . (AsPat noExt) n) -- view pattern is well-formed if the pattern is - EViewPat expr patE -> checkLPat msg patE >>= - (return . (\p -> ViewPat expr p placeHolderType)) - ExprWithTySig e t -> do e <- checkLPat msg e - return (SigPatIn e t) + EViewPat _ expr patE -> checkLPat msg patE >>= + (return . (\p -> ViewPat noExt expr p)) + ExprWithTySig t e -> do e <- checkLPat msg e + return (SigPat t e) -- n+k patterns - OpApp (L nloc (HsVar (L _ n))) (L _ (HsVar (L _ plus))) _ - (L lloc (HsOverLit lit@(OverLit {ol_val = HsIntegral {}}))) + OpApp _ (L nloc (HsVar _ (L _ n))) (L _ (HsVar _ (L _ plus))) + (L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}}))) | extopt LangExt.NPlusKPatterns opts && (plus == plus_RDR) -> return (mkNPlusKPat (L nloc n) (L lloc lit)) - OpApp l (L cl (HsVar (L _ c))) _fix r + OpApp _ l (L cl (HsVar _ (L _ c))) r | isDataOcc (rdrNameOcc c) -> do l <- checkLPat msg l r <- checkLPat msg r return (ConPatIn (L cl c) (InfixCon l r)) - OpApp _l _op _fix _r -> patFail msg loc e0 + OpApp {} -> patFail msg loc e0 - HsPar e -> checkLPat msg e >>= (return . ParPat) - ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es - return (ListPat ps placeHolderType Nothing) + HsPar _ e -> checkLPat msg e >>= (return . (ParPat noExt)) + ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es + return (ListPat noExt ps placeHolderType Nothing) ExplicitPArr _ es -> do ps <- mapM (checkLPat msg) es - return (PArrPat ps placeHolderType) + return (PArrPat noExt ps) - ExplicitTuple es b + ExplicitTuple _ es b | all tupArgPresent es -> do ps <- mapM (checkLPat msg) - [e | L _ (Present e) <- es] - return (TuplePat ps b []) + [e | L _ (Present _ e) <- es] + return (TuplePat noExt ps b) | otherwise -> parseErrorSDoc loc (text "Illegal tuple section in pattern:" $$ ppr e0) - ExplicitSum alt arity expr _ -> do + ExplicitSum _ alt arity expr -> do p <- checkLPat msg expr - return (SumPat p alt arity placeHolderType) + return (SumPat noExt p alt arity) RecordCon { rcon_con_name = c, rcon_flds = HsRecFields fs dd } -> do fs <- mapM (checkPatField msg) fs return (ConPatIn c (RecCon (HsRecFields fs dd))) - HsSpliceE s | not (isTypedSplice s) - -> return (SplicePat s) + HsSpliceE _ s | not (isTypedSplice s) + -> return (SplicePat noExt s) _ -> patFail msg loc e0 placeHolderPunRhs :: LHsExpr GhcPs -- The RHS of a punned record field will be filled in by the renamer -- It's better not to make it an error, in case we want to print it when debugging -placeHolderPunRhs = noLoc (HsVar (noLoc pun_RDR)) +placeHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR)) plus_RDR, bang_RDR, pun_RDR :: RdrName plus_RDR = mkUnqual varName (fsLit "+") -- Hack @@ -1052,7 +1053,7 @@ checkValDef :: SDoc checkValDef msg _strictness lhs (Just sig) grhss -- x :: ty = rhs parses as a *pattern* binding = checkPatBind msg (L (combineLocs lhs sig) - (ExprWithTySig lhs (mkLHsSigWcType sig))) grhss + (ExprWithTySig (mkLHsSigWcType sig) lhs)) grhss checkValDef msg strictness lhs Nothing g@(L l (_,grhss)) = do { mb_fun <- isFunLhs lhs @@ -1105,7 +1106,7 @@ checkPatBind msg lhs (L _ (_,grhss)) ([],[])) } checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName) -checkValSigLhs (L _ (HsVar lrdr@(L _ v))) +checkValSigLhs (L _ (HsVar _ lrdr@(L _ v))) | isUnqual v , not (isDataOcc (rdrNameOcc v)) = return lrdr @@ -1127,9 +1128,9 @@ checkValSigLhs lhs@(L l _) -- A common error is to forget the ForeignFunctionInterface flag -- so check for that, and suggest. cf Trac #3805 -- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword - looks_like s (L _ (HsVar (L _ v))) = v == s - looks_like s (L _ (HsApp lhs _)) = looks_like s lhs - looks_like _ _ = False + looks_like s (L _ (HsVar _ (L _ v))) = v == s + looks_like s (L _ (HsApp _ lhs _)) = looks_like s lhs + looks_like _ _ = False foreign_RDR = mkUnqual varName (fsLit "foreign") default_RDR = mkUnqual varName (fsLit "default") @@ -1162,13 +1163,13 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr -- not be any OpApps inside the e's splitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs]) -- Splits (f ! g a b) into (f, [(! g), a, b]) -splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg)) - | op == bang_RDR = Just (l_arg, L l' (SectionR bang arg1) : argns) +splitBang (L _ (OpApp _ l_arg bang@(L _ (HsVar _ (L _ op))) r_arg)) + | op == bang_RDR = Just (l_arg, L l' (SectionR noExt bang arg1) : argns) where l' = combineLocs bang arg1 (arg1,argns) = split_bang r_arg [] - split_bang (L _ (HsApp f e)) es = split_bang f (e:es) - split_bang e es = (e,es) + split_bang (L _ (HsApp _ f e)) es = split_bang f (e:es) + split_bang e es = (e,es) splitBang _ = Nothing isFunLhs :: LHsExpr GhcPs @@ -1187,14 +1188,15 @@ isFunLhs :: LHsExpr GhcPs isFunLhs e = go e [] [] where - go (L loc (HsVar (L _ f))) es ann - | not (isRdrDataCon f) = return (Just (L loc f, Prefix, es, ann)) - go (L _ (HsApp f e)) es ann = go f (e:es) ann - go (L l (HsPar e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l) + go (L loc (HsVar _ (L _ f))) es ann + | not (isRdrDataCon f) = return (Just (L loc f, Prefix, es, ann)) + go (L _ (HsApp _ f e)) es ann = go f (e:es) ann + go (L l (HsPar _ e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l) -- Things of the form `!x` are also FunBinds -- See Note [FunBind vs PatBind] - go (L _ (SectionR (L _ (HsVar (L _ bang))) (L l (HsVar (L _ var))))) [] ann + go (L _ (SectionR _ (L _ (HsVar _ (L _ bang))) (L l (HsVar _ (L _ var))))) + [] ann | bang == bang_RDR , not (isRdrDataCon var) = return (Just (L l var, Prefix, [], ann)) @@ -1211,7 +1213,7 @@ isFunLhs e = go e [] [] -- ToDo: what about this? -- x + 1 `op` y = ... - go e@(L loc (OpApp l (L loc' (HsVar (L _ op))) fix r)) es ann + go e@(L loc (OpApp _ l (L loc' (HsVar _ (L _ op))) r)) es ann | Just (e',es') <- splitBang e = do { bang_on <- extension bangPatEnabled ; if bang_on then go e' (es' ++ es) ann @@ -1225,7 +1227,8 @@ isFunLhs e = go e [] [] Just (op', Infix, j : k : es', ann') -> return (Just (op', Infix, j : op_app : es', ann')) where - op_app = L loc (OpApp k (L loc' (HsVar (L loc' op))) fix r) + op_app = L loc (OpApp noExt k + (L loc' (HsVar noExt (L loc' op))) r) _ -> return Nothing } go _ _ _ = return Nothing @@ -1234,23 +1237,24 @@ isFunLhs e = go e [] [] -- (((~a) ~b) c) ~d ==> ((~a) ~ (b c)) ~ d splitTilde :: LHsType GhcPs -> P (LHsType GhcPs) splitTilde t = go t - where go (L loc (HsAppTy t1 t2)) - | L lo (HsBangTy (HsSrcBang NoSourceText NoSrcUnpack SrcLazy) t2') + where go (L loc (HsAppTy _ t1 t2)) + | L lo (HsBangTy _ (HsSrcBang NoSourceText NoSrcUnpack SrcLazy) t2') <- t2 = do moveAnnotations lo loc t1' <- go t1 - return (L loc (HsEqTy t1' t2')) + return (L loc (HsEqTy noExt t1' t2')) | otherwise = do t1' <- go t1 case t1' of - (L lo (HsEqTy tl tr)) -> do + (L lo (HsEqTy _ tl tr)) -> do let lr = combineLocs tr t2 moveAnnotations lo loc - return (L loc (HsEqTy tl (L lr (HsAppTy tr t2)))) + return (L loc (HsEqTy noExt tl + (L lr (HsAppTy noExt tr t2)))) t -> do - return (L loc (HsAppTy t t2)) + return (L loc (HsAppTy noExt t t2)) go t = return t @@ -1262,14 +1266,14 @@ splitTildeApps [] = return [] splitTildeApps (t : rest) = do rest' <- concatMapM go rest return (t : rest') - where go (L l (HsAppPrefix - (L loc (HsBangTy + where go (L l (HsAppPrefix _ + (L loc (HsBangTy noExt (HsSrcBang NoSourceText NoSrcUnpack SrcLazy) ty)))) = addAnnotation l AnnTilde tilde_loc >> return - [L tilde_loc (HsAppInfix (L tilde_loc eqTyCon_RDR)), - L l (HsAppPrefix ty)] + [L tilde_loc (HsAppInfix noExt (L tilde_loc eqTyCon_RDR)), + L l (HsAppPrefix noExt ty)] -- NOTE: no annotation is attached to an HsAppPrefix, so the -- surrounding SrcSpan is not critical where @@ -1305,34 +1309,35 @@ locMap :: (SrcSpan -> a -> P b) -> Located a -> P (Located b) locMap f (L l a) = f l a >>= (\b -> return $ L l b) checkCmd :: SrcSpan -> HsExpr GhcPs -> P (HsCmd GhcPs) -checkCmd _ (HsArrApp e1 e2 ptt haat b) = - return $ HsCmdArrApp e1 e2 ptt haat b -checkCmd _ (HsArrForm e mf args) = - return $ HsCmdArrForm e Prefix mf args -checkCmd _ (HsApp e1 e2) = - checkCommand e1 >>= (\c -> return $ HsCmdApp c e2) -checkCmd _ (HsLam mg) = - checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdLam mg') -checkCmd _ (HsPar e) = - checkCommand e >>= (\c -> return $ HsCmdPar c) -checkCmd _ (HsCase e mg) = - checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdCase e mg') -checkCmd _ (HsIf cf ep et ee) = do +checkCmd _ (HsArrApp _ e1 e2 haat b) = + return $ HsCmdArrApp noExt e1 e2 haat b +checkCmd _ (HsArrForm _ e mf args) = + return $ HsCmdArrForm noExt e Prefix mf args +checkCmd _ (HsApp _ e1 e2) = + checkCommand e1 >>= (\c -> return $ HsCmdApp noExt c e2) +checkCmd _ (HsLam _ mg) = + checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdLam noExt mg') +checkCmd _ (HsPar _ e) = + checkCommand e >>= (\c -> return $ HsCmdPar noExt c) +checkCmd _ (HsCase _ e mg) = + checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdCase noExt e mg') +checkCmd _ (HsIf _ cf ep et ee) = do pt <- checkCommand et pe <- checkCommand ee - return $ HsCmdIf cf ep pt pe -checkCmd _ (HsLet lb e) = - checkCommand e >>= (\c -> return $ HsCmdLet lb c) -checkCmd _ (HsDo DoExpr (L l stmts) ty) = - mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo (L l ss) ty) - -checkCmd _ (OpApp eLeft op _fixity eRight) = do + return $ HsCmdIf noExt cf ep pt pe +checkCmd _ (HsLet _ lb e) = + checkCommand e >>= (\c -> return $ HsCmdLet noExt lb c) +checkCmd _ (HsDo _ DoExpr (L l stmts)) = + mapM checkCmdLStmt stmts >>= + (\ss -> return $ HsCmdDo noExt (L l ss) ) + +checkCmd _ (OpApp _ eLeft op eRight) = do -- OpApp becomes a HsCmdArrForm with a (Just fixity) in it c1 <- checkCommand eLeft c2 <- checkCommand eRight - let arg1 = L (getLoc c1) $ HsCmdTop c1 placeHolderType placeHolderType [] - arg2 = L (getLoc c2) $ HsCmdTop c2 placeHolderType placeHolderType [] - return $ HsCmdArrForm op Infix Nothing [arg1, arg2] + let arg1 = L (getLoc c1) $ HsCmdTop noExt c1 + arg2 = L (getLoc c2) $ HsCmdTop noExt c2 + return $ HsCmdArrForm noExt op Infix Nothing [arg1, arg2] checkCmd l e = cmdFail l e @@ -1396,7 +1401,7 @@ mkRecConstrOrUpdate -> ([LHsRecField GhcPs (LHsExpr GhcPs)], Bool) -> P (HsExpr GhcPs) -mkRecConstrOrUpdate (L l (HsVar (L _ c))) _ (fs,dd) +mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd) | isRdrDataCon c = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) mkRecConstrOrUpdate exp@(L l _) _ (fs,dd) @@ -1405,23 +1410,23 @@ mkRecConstrOrUpdate exp@(L l _) _ (fs,dd) mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds - = RecordUpd { rupd_expr = exp - , rupd_flds = flds - , rupd_cons = PlaceHolder, rupd_in_tys = PlaceHolder - , rupd_out_tys = PlaceHolder, rupd_wrap = PlaceHolder } + = RecordUpd { rupd_ext = noExt + , rupd_expr = exp + , rupd_flds = flds } mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds - = RecordCon { rcon_con_name = con, rcon_flds = flds - , rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder } + = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds } mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg 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) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs -mk_rec_upd_field (HsRecField (L loc (FieldOcc rdr _)) arg pun) - = HsRecField (L loc (Unambiguous rdr PlaceHolder)) arg pun +mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) + = HsRecField (L loc (Unambiguous noExt rdr)) arg pun +mk_rec_upd_field (HsRecField (L _ (XFieldOcc _)) _ _) + = panic "mk_rec_upd_field" mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation -> InlinePragma @@ -1681,11 +1686,11 @@ data SumOrTuple mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs) -- Tuple -mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple es boxity) +mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity) -- Sum mkSumOrTuple Unboxed _ (Sum alt arity e) = - return (ExplicitSum alt arity e PlaceHolder) + return (ExplicitSum noExt alt arity e) mkSumOrTuple Boxed l (Sum alt arity (L _ e)) = parseErrorSDoc l (hang (text "Boxed sums not supported:") 2 (ppr_boxed_sum alt arity e)) where |