@@ -53,7 +53,7 @@ type Cond = Set Node
5353data VarInfo = VI
5454 { viDeps :: DepSet -- dependencies drawn in by the variable
5555 , viFunArg :: Maybe Int -- which function argument this variable came from (defined only for patvars)
56− , viMethod :: Maybe Name -- name of the method represented by the var, if any
56+ , viMethod :: Maybe Name -- name of the metamethod represented by the var, if any
5757 }
5858 deriving Show
5959
@@ -297,26 +297,17 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
297297 vs' = M.fromList [(v, VI
298298 { viDeps = M.insertWith S.union (n, Arg j) (S.singleton (fn, varIdx)) (viDeps var)
299299 , viFunArg = viFunArg var
300− , viMethod = m
300+ , viMethod = meth j
301301 })
302− | (v, j, m) <- zip3 ns [0..] methodNames]
302+ | (v, j) <- zip ns [0..]]
303303
304304 -- this is safe because it's certainly a patvar
305305 varIdx = fromJust (viFunArg var)
306306
307− -- figure out method names, if "n" is an instance ctor
308− methodNames :: [Maybe Name]
309− methodNames = case n of
310− SN (InstanceCtorN className)
311− | Just cinfo <- lookupCtxtExact className ci
312− -> let methNames = map fst $ class_methods cinfo
313− in replicate (length ns - length methNames) Nothing -- initial type args to the instance ctor
314− ++ map Just methNames -- methods proper
315−
316− | otherwise
317− -> error $ "could not find class for the instance ctor " ++ show n
318−
319− _ -> repeat Nothing
307+ -- generate metamethod names, "n" is the instance ctor
308+ meth :: Int -> Maybe Name
309+ meth | SN (InstanceCtorN className) <- n = \j -> Just (mkField n j)
310+ | otherwise = \j -> Nothing
320311
321312 -- Named variables -> DeBruijn variables -> Conds/guards -> Term -> Deps
322313 getDepsTerm :: Vars -> [Cond -> Deps] -> Cond -> Term -> Deps
@@ -427,6 +418,15 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
427418
428419 -- Get the number of arguments that might be considered for erasure.
429420 getArity :: Name -> Int
421+ getArity (SN (WhereN i' ctorName (MN i field)))
422+ | [TyDecl (DCon _ _) ty] <- lookupDef ctorName ctx
423+ = let argTys = map snd $ getArgTys ty
424+ in if i <= length argTys
425+ then length $ getArgTys (argTys !! i)
426+ else error $ "invalid field number " ++ show i ++ " for " ++ show ctorName
427+
428+ | otherwise = error $ "unknown instance constructor: " ++ show ctorName
429+
430430 getArity n = case lookupDef n ctx of
431431 [CaseOp ci ty tys def tot cdefs] -> length tys
432432 [TyDecl (DCon tag arity) _] -> arity