@@ -51,10 +51,11 @@ type Cond = Set Node
5151
5252-- Variables carry certain information with them.
5353data VarInfo = VI
54− { viDeps :: DepSet -- dependencies drawn in by the variable
55− , viFunArg :: Maybe Int -- which function argument this variable came from (defined only for patvars)
56− , viMethod :: Maybe (Name, Int) -- instance ctor name, method#
54+ { viDeps :: DepSet -- dependencies drawn in by the variable
55+ , 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
5757 }
58+ deriving Show
5859
5960type Vars = Map Name VarInfo
6061
@@ -296,17 +297,26 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
296297 vs' = M.fromList [(v, VI
297298 { viDeps = M.insertWith S.union (n, Arg j) (S.singleton (fn, varIdx)) (viDeps var)
298299 , viFunArg = viFunArg var
299− , viMethod = meth j
300+ , viMethod = m
300301 })
301− | (v,j) <- zip ns [0..]]
302+ | (v, j, m) <- zip3 ns [0..] methodNames]
302303
303304 -- this is safe because it's certainly a patvar
304305 varIdx = fromJust (viFunArg var)
305306
306− -- method info
307− meth = case n of
308− SN (InstanceCtorN className) -> \j -> Just (n, j)
309− _ -> \j -> Nothing
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
310320
311321 -- Named variables -> DeBruijn variables -> Conds/guards -> Term -> Deps
312322 getDepsTerm :: Vars -> [Cond -> Deps] -> Cond -> Term -> Deps
@@ -346,7 +356,6 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
346356 -- applications may add items to Cond
347357 getDepsTerm vs bs cd app@(App _ _)
348358 | (fun, args) <- unApply app = case fun of
349−
350359 -- constructors
351360 P (TCon _ _) n _ -> unconditionalDeps args -- does not depend on anything
352361 P (DCon _ _) n _ -> node n args -- depends on whether (n,#) is used
@@ -363,9 +372,9 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
363372 -- think: f x = x 0 <-- here, `x' _is_ used
364373 P _ n _
365374 -- local name that refers to a method
366− | Just var <- M.lookup n vs
367− , Just (cn, i) <- viMethod var
368− -> node (SN (WhereN i cn $ sMN i "field")) args
375+ | Just var <- M.lookup n vs
376+ , Just meth <- viMethod var
377+ -> node meth args -- use the method instead
369378
370379 -- local name
371380 | Just var <- M.lookup n vs
@@ -387,13 +396,6 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
387396 Bind n ( Let ty t') t -> getDepsTerm vs bs cd (App (Bind n (Lam ty) t) t')
388397 Bind n (NLet ty t') t -> getDepsTerm vs bs cd (App (Bind n (Lam ty) t) t')
389398
390− -- TODO: figure out what to do with methods
391− -- the following code marks them as completely used
392− Proj (P Ref n@(SN (InstanceN className parms)) _) i
393− | [CI ctorName ms ds dscs ps is] <- lookupCtxt className ci
394− -> M.fromList [((ctorName, Arg i), S.empty), ((n, Result), S.empty)]
395− `ins` unconditionalDeps args
396−
397399 Proj t i
398400 -> error $ "cannot[0] analyse projection !" ++ show i ++ " of " ++ show t
399401
@@ -425,24 +427,14 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
425427
426428 -- Get the number of arguments that might be considered for erasure.
427429 getArity :: Name -> Int
428−
429− -- method, derive arity from the type of the instance ctor
430− getArity (SN (WhereN i cn (MN i' field))) = case lookupDef cn ctx of
431− [TyDecl (DCon tag arity) ty]
432− -> let argTys = map snd $ getArgTys ty
433− in if i < length argTys
434− then length $ getArgTys (argTys !! i)
435− else error $ "invalid method number " ++ show i ++ " for " ++ show cn
436− _ -> error $ "could not find instance constructor " ++ show cn
437−
438− -- other names
439430 getArity n = case lookupDef n ctx of
440431 [CaseOp ci ty tys def tot cdefs] -> length tys
441432 [TyDecl (DCon tag arity) _] -> arity
442433 [TyDecl (Ref) ty] -> length $ getArgTys ty
443434 [Operator ty arity op] -> arity
444− [] -> error $ "definition not found: " ++ show n
445− df -> error $ "unrecognised entity '" ++ show n ++ "' with definition: " ++ show df
435+ [] -> error $ "Erasure/getArity: definition not found for " ++ show n
436+ df -> error $ "Erasure/getArity: unrecognised entity '"
437+ ++ show n ++ "' with definition: " ++ show df
446438
447439 -- convert applications of lambdas to lets
448440 -- Note that this transformation preserves de bruijn numbering
@@ -452,6 +444,12 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
452444 lamToLet (x:xs) t = App (lamToLet xs t) x
453445 lamToLet [] t = t
454446
447+ mkField :: Name -> Int -> Name
448+ mkField ctorName fieldNo = SN (WhereN fieldNo ctorName $ sMN fieldNo "field")
449+
450+ union :: Deps -> Deps -> Deps
451+ union = M.unionWith (M.unionWith S.union)
452+
455453 unions :: [Deps] -> Deps
456454 unions = M.unionsWith (M.unionWith S.union)
457455