diff options
Diffstat (limited to 'compiler/rename')
| -rw-r--r-- | compiler/rename/RnExpr.hs | 33 | ||||
| -rw-r--r-- | compiler/rename/RnPat.hs | 4 | ||||
| -rw-r--r-- | compiler/rename/RnSource.hs | 66 | ||||
| -rw-r--r-- | compiler/rename/RnTypes.hs | 9 | ||||
| -rw-r--r-- | compiler/rename/RnUtils.hs | 3 |
5 files changed, 11 insertions, 104 deletions
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 8478ab0322..937ffaf248 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -272,10 +272,6 @@ rnExpr (ExplicitList x _ exps) else return (ExplicitList x Nothing exps', fvs) } -rnExpr (ExplicitPArr x exps) - = do { (exps', fvs) <- rnExprs exps - ; return (ExplicitPArr x exps', fvs) } - rnExpr (ExplicitTuple x tup_args boxity) = do { checkTupleSection tup_args ; checkTupSize (length tup_args) @@ -342,10 +338,6 @@ rnExpr (ArithSeq x _ seq) else return (ArithSeq x Nothing new_seq, fvs) } -rnExpr (PArrSeq x seq) - = do { (new_seq, fvs) <- rnArithSeq seq - ; return (PArrSeq x new_seq, fvs) } - {- These three are pattern syntax appearing in expressions. Since all the symbols are reservedops we can simply reject them. @@ -841,7 +833,7 @@ rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside ; (guard_op, fvs2) <- if isListCompExpr ctxt then lookupStmtName ctxt guardMName else return (noSyntaxExpr, emptyFVs) - -- Only list/parr/monad comprehensions use 'guard' + -- Only list/monad comprehensions use 'guard' -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ] -- Here "gd" is a guard ; (thing, fvs3) <- thing_inside [] @@ -1020,12 +1012,11 @@ lookupStmtNamePoly ctxt name not_rebindable = return (HsVar noExt (noLoc name), emptyFVs) -- | Is this a context where we respect RebindableSyntax? --- but ListComp/PArrComp are never rebindable +-- but ListComp are never rebindable -- Neither is ArrowExpr, which has its own desugarer in DsArrows rebindableContext :: HsStmtContext Name -> Bool rebindableContext ctxt = case ctxt of ListComp -> False - PArrComp -> False ArrowExpr -> False PatGuard {} -> False @@ -1818,7 +1809,6 @@ isStrictPattern (L _ pat) = ListPat{} -> True TuplePat{} -> True SumPat{} -> True - PArrPat{} -> True ConPatIn{} -> True ConPatOut{} -> True LitPat{} -> True @@ -1977,7 +1967,6 @@ checkLastStmt ctxt lstmt@(L loc stmt) = case ctxt of ListComp -> check_comp MonadComp -> check_comp - PArrComp -> check_comp ArrowExpr -> check_do DoExpr -> check_do MDoExpr -> check_do @@ -2028,7 +2017,7 @@ pprStmtCat (XStmtLR {}) = panic "pprStmtCat: XStmtLR" emptyInvalid :: Validity -- Payload is the empty document emptyInvalid = NotValid Outputable.empty -okStmt, okDoStmt, okCompStmt, okParStmt, okPArrStmt +okStmt, okDoStmt, okCompStmt, okParStmt :: DynFlags -> HsStmtContext Name -> Stmt GhcPs (Located (body GhcPs)) -> Validity -- Return Nothing if OK, (Just extra) if not ok @@ -2044,7 +2033,6 @@ okStmt dflags ctxt stmt GhciStmtCtxt -> okDoStmt dflags ctxt stmt ListComp -> okCompStmt dflags ctxt stmt MonadComp -> okCompStmt dflags ctxt stmt - PArrComp -> okPArrStmt dflags ctxt stmt TransStmtCtxt ctxt -> okStmt dflags ctxt stmt ------------- @@ -2091,21 +2079,6 @@ okCompStmt dflags _ stmt ApplicativeStmt {} -> emptyInvalid XStmtLR{} -> panic "okCompStmt" ----------------- -okPArrStmt dflags _ stmt - = case stmt of - BindStmt {} -> IsValid - LetStmt {} -> IsValid - BodyStmt {} -> IsValid - ParStmt {} - | LangExt.ParallelListComp `xopt` dflags -> IsValid - | otherwise -> NotValid (text "Use ParallelListComp") - TransStmt {} -> emptyInvalid - RecStmt {} -> emptyInvalid - LastStmt {} -> emptyInvalid -- Should not happen (dealt with by checkLastStmt) - ApplicativeStmt {} -> emptyInvalid - XStmtLR{} -> panic "okPArrStmt" - --------- checkTupleSection :: [LHsTupArg GhcPs] -> RnM () checkTupleSection args diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 8f7c2e2309..4601b948d2 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -483,10 +483,6 @@ rnPatAndThen mk (ListPat _ pats) ; return (ListPat (Just to_list_name) pats')} False -> return (ListPat Nothing pats') } -rnPatAndThen mk (PArrPat x pats) - = do { pats' <- rnLPatsAndThen mk pats - ; return (PArrPat x pats') } - rnPatAndThen mk (TuplePat x pats boxed) = do { liftCps $ checkTupSize (length pats) ; pats' <- rnLPatsAndThen mk pats diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 502be23bc0..5e01f285b4 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -99,7 +99,6 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, hs_fords = foreign_decls, hs_defds = default_decls, hs_ruleds = rule_decls, - hs_vects = vect_decls, hs_docs = docs }) = do { -- (A) Process the fixity declarations, creating a mapping from @@ -187,12 +186,11 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on - (rn_vect_decls, src_fvs3) <- rnList rnHsVectDecl vect_decls ; - (rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ; - (rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ; - (rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ; - (rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ; - (rn_splice_decls, src_fvs8) <- rnList rnSpliceDecl splice_decls ; + (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; + (rn_ann_decls, src_fvs4) <- rnList rnAnnDecl ann_decls ; + (rn_default_decls, src_fvs5) <- rnList rnDefaultDecl default_decls ; + (rn_deriv_decls, src_fvs6) <- rnList rnSrcDerivDecl deriv_decls ; + (rn_splice_decls, src_fvs7) <- rnList rnSpliceDecl splice_decls ; -- Haddock docs; no free vars rn_docs <- mapM (wrapLocM rnDocDecl) docs ; @@ -210,13 +208,12 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, hs_annds = rn_ann_decls, hs_defds = rn_default_decls, hs_ruleds = rn_rule_decls, - hs_vects = rn_vect_decls, hs_docs = rn_docs } ; tcf_bndrs = hsTyClForeignBinders rn_tycl_decls rn_foreign_decls ; other_def = (Just (mkNameSet tcf_bndrs), emptyNameSet) ; - other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, src_fvs5, - src_fvs6, src_fvs7, src_fvs8] ; + other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, + src_fvs5, src_fvs6, src_fvs7] ; -- It is tiresome to gather the binders from type and class decls src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ; @@ -1106,53 +1103,6 @@ badRuleLhsErr name lhs bad_e HsUnboundVar _ uv -> text "Not in scope:" <+> ppr uv _ -> text "Illegal expression:" <+> ppr bad_e -{- -********************************************************* -* * -\subsection{Vectorisation declarations} -* * -********************************************************* --} - -rnHsVectDecl :: VectDecl GhcPs -> RnM (VectDecl GhcRn, FreeVars) --- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly --- typecheck a complex right-hand side without invoking 'vectType' from the vectoriser. -rnHsVectDecl (HsVect _ s var rhs@(L _ (HsVar _ _))) - = do { var' <- lookupLocatedOccRn var - ; (rhs', fv_rhs) <- rnLExpr rhs - ; return (HsVect noExt s var' rhs', fv_rhs `addOneFV` unLoc var') - } -rnHsVectDecl (HsVect _ _ _var _rhs) - = failWith $ vcat - [ text "IMPLEMENTATION RESTRICTION: right-hand side of a VECTORISE pragma" - , text "must be an identifier" - ] -rnHsVectDecl (HsNoVect _ s var) - = do { var' <- lookupLocatedTopBndrRn var -- only applies to local (not imported) names - ; return (HsNoVect noExt s var', unitFV (unLoc var')) - } -rnHsVectDecl (HsVectType (VectTypePR s tycon Nothing) isScalar) - = do { tycon' <- lookupLocatedOccRn tycon - ; return ( HsVectType (VectTypePR s tycon' Nothing) isScalar - , unitFV (unLoc tycon')) - } -rnHsVectDecl (HsVectType (VectTypePR s tycon (Just rhs_tycon)) isScalar) - = do { tycon' <- lookupLocatedOccRn tycon - ; rhs_tycon' <- lookupLocatedOccRn rhs_tycon - ; return ( HsVectType (VectTypePR s tycon' (Just rhs_tycon')) isScalar - , mkFVs [unLoc tycon', unLoc rhs_tycon']) - } -rnHsVectDecl (HsVectClass (VectClassPR s cls)) - = do { cls' <- lookupLocatedOccRn cls - ; return (HsVectClass (VectClassPR s cls'), unitFV (unLoc cls')) - } -rnHsVectDecl (HsVectInst instTy) - = do { (instTy', fvs) <- rnLHsInstType (text "a VECTORISE pragma") instTy - ; return (HsVectInst instTy', fvs) - } -rnHsVectDecl (XVectDecl {}) - = panic "RnSource.rnHsVectDecl: Unexpected 'XVectDecl'" - {- ************************************************************** * * Renaming type, class, instance and role declarations @@ -2187,8 +2137,6 @@ add gp@(HsGroup {hs_annds = ts}) l (AnnD _ d) ds = addl (gp { hs_annds = L l d : ts }) ds add gp@(HsGroup {hs_ruleds = ts}) l (RuleD _ d) ds = addl (gp { hs_ruleds = L l d : ts }) ds -add gp@(HsGroup {hs_vects = ts}) l (VectD _ d) ds - = addl (gp { hs_vects = L l d : ts }) ds add gp l (DocD _ d) ds = addl (gp { hs_docs = (L l d) : (hs_docs gp) }) ds add (HsGroup {}) _ (SpliceD _ (XSpliceDecl _)) _ = panic "RnSource.add" diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index b51a178e82..1f08856142 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -350,7 +350,7 @@ rnImplicitBndrs bind_free_tvs rnLHsInstType :: SDoc -> LHsSigType GhcPs -> RnM (LHsSigType GhcRn, FreeVars) -- Rename the type in an instance. --- The 'doc_str' is "an instance declaration" or "a VECTORISE pragma" +-- The 'doc_str' is "an instance declaration". -- Do not try to decompose the inst_ty in case it is malformed rnLHsInstType doc inst_ty = rnHsSigType (GenericCtx doc) inst_ty @@ -608,11 +608,6 @@ rnHsTyKi env t@(HsKindSig _ ty k) ; (k', fvs2) <- rnLHsTyKi (env { rtke_level = KindLevel }) k ; return (HsKindSig noExt ty' k', fvs1 `plusFV` fvs2) } -rnHsTyKi env t@(HsPArrTy _ ty) - = do { notInKinds env t - ; (ty', fvs) <- rnLHsTyKi env ty - ; return (HsPArrTy noExt ty', fvs) } - -- Unboxed tuples are allowed to have poly-typed arguments. These -- sometimes crop up as a result of CPR worker-wrappering dictionaries. rnHsTyKi env tupleTy@(HsTupleTy _ tup_con tys) @@ -1149,7 +1144,6 @@ collectAnonWildCards lty = go lty HsAppTy _ ty1 ty2 -> go ty1 `mappend` go ty2 HsFunTy _ ty1 ty2 -> go ty1 `mappend` go ty2 HsListTy _ ty -> go ty - HsPArrTy _ ty -> go ty HsTupleTy _ _ tys -> gos tys HsSumTy _ tys -> gos tys HsOpTy _ ty1 _ ty2 -> go ty1 `mappend` go ty2 @@ -1839,7 +1833,6 @@ extract_lty t_or_k (L _ ty) acc HsAppTy _ ty1 ty2 -> extract_lty t_or_k ty1 =<< extract_lty t_or_k ty2 acc HsListTy _ ty -> extract_lty t_or_k ty acc - HsPArrTy _ ty -> extract_lty t_or_k ty acc HsTupleTy _ _ tys -> extract_ltys t_or_k tys acc HsSumTy _ tys -> extract_ltys t_or_k tys acc HsFunTy _ ty1 ty2 -> extract_lty t_or_k ty1 =<< diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs index bbac43d304..99272c2943 100644 --- a/compiler/rename/RnUtils.hs +++ b/compiler/rename/RnUtils.hs @@ -374,7 +374,6 @@ data HsDocContext | GHCiCtx | SpliceTypeCtx (LHsType GhcPs) | ClassInstanceCtx - | VectDeclCtx (Located RdrName) | GenericCtx SDoc -- Maybe we want to use this more! withHsDocContext :: HsDocContext -> SDoc -> SDoc @@ -409,5 +408,3 @@ pprHsDocContext (ConDeclCtx [name]) = text "the definition of data constructor" <+> quotes (ppr name) pprHsDocContext (ConDeclCtx names) = text "the definition of data constructors" <+> interpp'SP names -pprHsDocContext (VectDeclCtx tycon) - = text "the VECTORISE pragma for type constructor" <+> quotes (ppr tycon) |