From 35a557b0606d842bb204cff215eac16f8cb8647d Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Wed, 20 Sep 2006 18:17:04 +0000 Subject: [PATCH] Clean up unused imports, definitions and arguments Mon Sep 18 17:17:20 EDT 2006 Manuel M T Chakravarty * Clean up unused imports, definitions and arguments Sun Aug 6 20:54:31 EDT 2006 Manuel M T Chakravarty * Clean up unused imports, definitions and arguments Wed Aug 2 11:05:33 EDT 2006 kevind@bu.edu --- compiler/basicTypes/MkId.lhs | 39 ++++++++++++++++++--------------------- compiler/stranal/WwLib.lhs | 20 ++++++++++---------- 2 files changed, 28 insertions(+), 31 deletions(-) diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs index fdc4300..52aff52 100644 --- a/compiler/basicTypes/MkId.lhs +++ b/compiler/basicTypes/MkId.lhs @@ -46,13 +46,11 @@ import TysPrim ( openAlphaTyVars, alphaTyVar, alphaTy, ) import TysWiredIn ( charTy, mkListTy ) import PrelRules ( primOpRules ) -import Type ( TyThing(..), mkForAllTy, tyVarsOfTypes, newTyConInstRhs, coreEqType, - PredType(..), - mkTopTvSubst, substTyVar ) +import Type ( TyThing(..), mkForAllTy, tyVarsOfTypes, + newTyConInstRhs, mkTopTvSubst, substTyVar ) import TcGadt ( gadtRefine, refineType, emptyRefinement ) import HsBinds ( ExprCoFn(..), isIdCoercion ) -import Coercion ( mkSymCoercion, mkUnsafeCoercion, - splitNewTypeRepCo_maybe, isEqPred ) +import Coercion ( mkSymCoercion, mkUnsafeCoercion, isEqPred ) import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy, mkTyConApp, mkTyVarTys, mkClassPred, isPredTy, mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy, tcEqType, @@ -64,25 +62,24 @@ import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding ) import Literal ( nullAddrLit, mkStringLit ) import TyCon ( TyCon, isNewTyCon, tyConDataCons, FieldLabel, tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon, - newTyConCo, tyConArity ) + newTyConCo ) import Class ( Class, classTyCon, classSelIds ) -import Var ( Id, TyVar, Var, setIdType, mkCoVar, mkWildCoVar ) +import Var ( Id, TyVar, Var, setIdType ) import VarSet ( isEmptyVarSet, subVarSet, varSetElems ) -import Name ( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..), - mkSysTvName ) +import Name ( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..)) import OccName ( mkOccNameFS, varName ) import PrimOp ( PrimOp, primOpSig, primOpOcc, primOpTag ) import ForeignCall ( ForeignCall ) import DataCon ( DataCon, DataConIds(..), dataConTyCon, dataConUnivTyVars, dataConFieldLabels, dataConRepArity, dataConResTys, dataConRepArgTys, dataConRepType, dataConFullSig, - dataConSig, dataConStrictMarks, dataConExStricts, + dataConStrictMarks, dataConExStricts, splitProductType, isVanillaDataCon, dataConFieldType, - dataConInstOrigArgTys, deepSplitProductType + deepSplitProductType ) import Id ( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal, mkTemplateLocals, mkTemplateLocalsNum, mkExportedLocalId, - mkTemplateLocal, idName, mkWildId + mkTemplateLocal, idName ) import IdInfo ( IdInfo, noCafIdInfo, setUnfoldingInfo, setArityInfo, setSpecInfo, setCafInfo, @@ -305,7 +302,7 @@ mkDataConIds wrap_name wkr_name data_con (zip (dict_args ++ id_args) all_strict_marks) i3 [] - con_app i rep_ids = Var wrk_id `mkTyApps` result_ty_args + con_app _ rep_ids = Var wrk_id `mkTyApps` result_ty_args `mkVarApps` ex_tvs `mkTyApps` map snd eq_spec `mkVarApps` reverse rep_ids @@ -329,7 +326,7 @@ mkDataConIds wrap_name wkr_name data_con Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))] MarkedUnboxed - -> unboxProduct i (Var arg) (idType arg) the_body result_ty + -> unboxProduct i (Var arg) (idType arg) the_body where the_body i con_args = body i (reverse con_args ++ rep_args) @@ -599,28 +596,28 @@ mkRecordSelId tycon field_label -- PairInt a b -> body [a,b] -- -- The Ints passed around are just for creating fresh locals -unboxProduct :: Int -> CoreExpr -> Type -> (Int -> [Id] -> CoreExpr) -> Type -> CoreExpr -unboxProduct i arg arg_ty body res_ty +unboxProduct :: Int -> CoreExpr -> Type -> (Int -> [Id] -> CoreExpr) -> CoreExpr +unboxProduct i arg arg_ty body = result where - result = mkUnpackCase the_id arg arg_ty con_args boxing_con rhs + result = mkUnpackCase the_id arg con_args boxing_con rhs (_tycon, _tycon_args, boxing_con, tys) = deepSplitProductType "unboxProduct" arg_ty ([the_id], i') = mkLocals i [arg_ty] (con_args, i'') = mkLocals i' tys rhs = body i'' con_args -mkUnpackCase :: Id -> CoreExpr -> Type -> [Id] -> DataCon -> CoreExpr -> CoreExpr +mkUnpackCase :: Id -> CoreExpr -> [Id] -> DataCon -> CoreExpr -> CoreExpr -- (mkUnpackCase x e args Con body) -- returns -- case (e `cast` ...) of bndr { Con args -> body } -- -- the type of the bndr passed in is irrelevent -mkUnpackCase bndr arg arg_ty unpk_args boxing_con body +mkUnpackCase bndr arg unpk_args boxing_con body = Case cast_arg (setIdType bndr bndr_ty) (exprType body) [(DataAlt boxing_con, unpk_args, body)] where (cast_arg, bndr_ty) = go (idType bndr) arg go ty arg - | res@(tycon, tycon_args, _, _) <- splitProductType "mkUnpackCase" ty + | (tycon, tycon_args, _, _) <- splitProductType "mkUnpackCase" ty , isNewTyCon tycon && not (isRecursiveTyCon tycon) = go (newTyConInstRhs tycon tycon_args) (unwrapNewTypeBody tycon tycon_args arg) @@ -692,7 +689,7 @@ mkReboxingAlt us con args rhs where stricts = dataConExStricts con ++ dataConStrictMarks con - go [] stricts us = ([], []) + go [] _stricts _us = ([], []) -- Type variable case go (arg:args) stricts us diff --git a/compiler/stranal/WwLib.lhs b/compiler/stranal/WwLib.lhs index 386c9e1..3383cb4 100644 --- a/compiler/stranal/WwLib.lhs +++ b/compiler/stranal/WwLib.lhs @@ -21,9 +21,9 @@ import MkId ( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID, mkUnpackCase, mkProductBox ) import TysWiredIn ( tupleCon ) import Type ( Type, isUnLiftedType, mkFunTys, - splitForAllTys, splitFunTys, splitRecNewType_maybe, isAlgType + splitForAllTys, splitFunTys, isAlgType ) -import Coercion ( Coercion, mkSymCoercion, splitNewTypeRepCo_maybe ) +import Coercion ( mkSymCoercion, splitNewTypeRepCo_maybe ) import BasicTypes ( Boxity(..) ) import Var ( Var, isId ) import UniqSupply ( returnUs, thenUs, getUniquesUs, UniqSM ) @@ -132,7 +132,7 @@ mkWwBodies fun_ty demands res_info one_shots mkWWcpr res_ty res_info else returnUs (id, id, res_ty) - ) `thenUs` \ (wrap_fn_cpr, work_fn_cpr, cpr_res_ty) -> + ) `thenUs` \ (wrap_fn_cpr, work_fn_cpr, _cpr_res_ty) -> returnUs ([idNewDemandInfo v | v <- work_args, isId v], Note InlineMe . wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var, @@ -341,13 +341,13 @@ mkWWstr_one arg -- Unpack case Eval (Prod cs) - | Just (arg_tycon, tycon_arg_tys, data_con, inst_con_arg_tys) + | Just (_arg_tycon, _tycon_arg_tys, data_con, inst_con_arg_tys) <- deepSplitProductType_maybe (idType arg) -> getUniquesUs `thenUs` \ uniqs -> let unpk_args = zipWith mk_ww_local uniqs inst_con_arg_tys unpk_args_w_ds = zipWithEqual "mkWWstr" set_worker_arg_info unpk_args cs - unbox_fn = mkUnpackCase (sanitiseCaseBndr arg) (Var arg) (idType arg) unpk_args data_con + unbox_fn = mkUnpackCase (sanitiseCaseBndr arg) (Var arg) unpk_args data_con rebox_fn = Let (NonRec arg con_app) con_app = mkProductBox unpk_args (idType arg) in @@ -431,7 +431,7 @@ mkWWcpr body_ty RetCPR con_app = mkProductBox [arg] body_ty in returnUs (\ wkr_call -> Case wkr_call (arg) (exprType con_app) [(DEFAULT, [], con_app)], - \ body -> workerCase (work_wild) body body_ty [arg] data_con (Var arg), + \ body -> workerCase (work_wild) body [arg] data_con (Var arg), con_arg_ty1) | otherwise -- The general case @@ -447,10 +447,10 @@ mkWWcpr body_ty RetCPR con_app = mkProductBox args body_ty in returnUs (\ wkr_call -> Case wkr_call (wrap_wild) (exprType con_app) [(DataAlt ubx_tup_con, args, con_app)], - \ body -> workerCase (work_wild) body body_ty args data_con ubx_tup_app, + \ body -> workerCase (work_wild) body args data_con ubx_tup_app, ubx_tup_ty) where - (_, tycon_arg_tys, data_con, con_arg_tys) = deepSplitProductType "mkWWcpr" body_ty + (_arg_tycon, _tycon_arg_tys, data_con, con_arg_tys) = deepSplitProductType "mkWWcpr" body_ty n_con_args = length con_arg_tys con_arg_ty1 = head con_arg_tys @@ -468,8 +468,8 @@ mkWWcpr body_ty other -- No CPR info -- This transform doesn't move work or allocation -- from one cost centre to another -workerCase bndr (Note (SCC cc) e) ty args con body = Note (SCC cc) (mkUnpackCase bndr e ty args con body) -workerCase bndr e ty args con body = mkUnpackCase bndr e ty args con body +workerCase bndr (Note (SCC cc) e) args con body = Note (SCC cc) (mkUnpackCase bndr e args con body) +workerCase bndr e args con body = mkUnpackCase bndr e args con body \end{code} -- 1.7.10.4