Commit b0c0cae7 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Define ListSetOps.getNth, and use it

I was tracking down an error looking like
  Prelude.(!!): index too large
which is very unhelpful.  This patch replaces at least some uses
of (!!) in GHC with getNth, which has a more helpful error
message (with DEBUG anyway)
parent 545fd8b9
......@@ -330,7 +330,7 @@ mkDictSelId dflags no_unf name clas
val_index = assoc "MkId.mkDictSelId" sel_index_prs name
sel_index_prs = map idName (classAllSelIds clas) `zip` [0..]
the_arg_id = arg_ids !! val_index
the_arg_id = getNth arg_ids val_index
pred = mkClassPred clas (mkTyVarTys tyvars)
dict_id = mkTemplateLocal 1 pred
arg_ids = mkTemplateLocalsNum 2 arg_tys
......@@ -352,7 +352,7 @@ dictSelRule :: Int -> Arity
dictSelRule val_index n_ty_args _ _ id_unf args
| (dict_arg : _) <- drop n_ty_args args
, Just (_, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
= Just (con_args !! val_index)
= Just (getNth con_args val_index)
| otherwise
= Nothing
\end{code}
......
......@@ -877,8 +877,8 @@ lintCoercion the_co@(NthCo n co)
, n < length tys_s
-> return (ks, ts, tt)
where
ts = tys_s !! n
tt = tys_t !! n
ts = getNth tys_s n
tt = getNth tys_t n
ks = typeKind ts
_ -> failWithL (hang (ptext (sLit "Bad getNth:"))
......
......@@ -78,6 +78,7 @@ import Maybes
import ErrUtils
import DynFlags
import BasicTypes ( isAlwaysActive )
import ListSetOps
import Util
import Pair
import Outputable
......@@ -1195,7 +1196,7 @@ exprIsConApp_maybe id_unf expr
, let (dfun_tvs, _n_theta, _cls, dfun_res_tys) = tcSplitDFunTy (idType fun)
subst = zipOpenTvSubst dfun_tvs (stripTypeArgs (takeList dfun_tvs args))
mk_arg (DFunPolyArg e) = mkApps e args
mk_arg (DFunLamArg i) = args !! i
mk_arg (DFunLamArg i) = getNth args i
= dealWithCoercion co (con, substTys subst dfun_res_tys, map mk_arg ops)
-- Look through unfoldings, but only arity-zero one;
......@@ -1266,7 +1267,7 @@ dealWithCoercion co stuff@(dc, _dc_univ_args, dc_args)
dump_doc = vcat [ppr dc, ppr dc_univ_tyvars, ppr dc_ex_tyvars,
ppr arg_tys, ppr dc_args, ppr _dc_univ_args,
ppr ex_args, ppr val_args]
ppr ex_args, ppr val_args, ppr co, ppr _from_ty, ppr to_ty, ppr to_tc ]
in
ASSERT2( eqType _from_ty (mkTyConApp to_tc _dc_univ_args), dump_doc )
ASSERT2( all isTypeArg ex_args, dump_doc )
......
......@@ -68,6 +68,7 @@ import BasicTypes hiding ( TopLevel )
import DynFlags
import FastString
import ErrUtils( MsgDoc )
import ListSetOps( getNth )
import Util
import Control.Monad( when )
import MonadUtils
......@@ -754,7 +755,7 @@ dsEvTerm (EvTupleSel v n)
(tc, tys) = splitTyConApp scrut_ty
Just [dc] = tyConDataCons_maybe tc
xs = mkTemplateLocals tys
the_x = xs !! n
the_x = getNth xs n
; ASSERT( isTupleTyCon tc )
return $
Case tm' (mkWildValBinder scrut_ty) (idType the_x) [(DataAlt dc, xs, Var the_x)] }
......
......@@ -33,6 +33,7 @@ import SrcLoc
import Outputable
import FastString
import TcType
import ListSetOps( getNth )
import Util
\end{code}
......@@ -869,11 +870,11 @@ mkMcUnzipM _ fmap_op ys elt_tys
; tup_xs <- newSysLocalDs tup_ty
; let mk_elt i = mkApps fmap_op' -- fmap :: forall a b. (a -> b) -> n a -> n b
[ Type tup_ty, Type (elt_tys !! i)
[ Type tup_ty, Type (getNth elt_tys i)
, mk_sel i, Var ys]
mk_sel n = Lam tup_xs $
mkTupleSelector xs (xs !! n) tup_xs (Var tup_xs)
mkTupleSelector xs (getNth xs n) tup_xs (Var tup_xs)
; return (mkBigCoreTup (map mk_elt [0..length elt_tys - 1])) }
\end{code}
......@@ -754,7 +754,7 @@ mk_typeable_eqn orig tvs cls tycon tc_args mtheta
| isNothing mtheta -- deriving on a data type decl
= do { checkTc (cls `hasKey` typeableClassKey)
(ptext (sLit "Use deriving( Typeable ) on a data type declaration"))
; real_cls <- tcLookupClass (typeableClassNames !! tyConArity tycon)
; real_cls <- tcLookupClass (typeableClassNames `getNth` tyConArity tycon)
-- See Note [Getting base classes]
; mk_typeable_eqn orig tvs real_cls tycon [] (Just []) }
......
......@@ -15,6 +15,9 @@ module ListSetOps (
-- Duplicate handling
hasNoDups, runs, removeDups, findDupsEq,
equivClasses, equivClassesByUniq,
-- Indexing
getNth
) where
#include "HsVersions.h"
......@@ -27,6 +30,21 @@ import Util
import Data.List
\end{code}
---------
#ifndef DEBUG
getNth :: [a] -> Int -> a
getNth xs n = xs !! n
#else
getNth :: Outputable a => [a] -> Int -> a
getNth xs n = ASSERT2( xs `lengthAtLeast` n, ppr n $$ ppr xs )
xs !! n
#endif
----------
\begin{code}
getNth :: Outputable a => [a] -> Int -> a
getNth xs n = ASSERT2( xs `lengthExceeds` n, ppr n $$ ppr xs )
xs !! n
\end{code}
%************************************************************************
%* *
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment