@@ -50,8 +50,12 @@ type DepSet = Map Node (Set Reason)
5050type Cond = Set Node
5151
5252-- Every variable draws in certain dependencies.
53−type Var = DepSet
54−type Vars = Map Name Var
53+data VarInfo = VI
54+ { viDeps :: DepSet -- dependencies drawn in by the variable
55+ , viFunArg :: Maybe Int -- which argument this variable came from (only valid for patvars)
56+ }
57+
58+type Vars = Map Name VarInfo
5559
5660-- Perform usage analysis, write the relevant information in the internal
5761-- structures, returning the list of reachable names.
@@ -229,19 +233,27 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
229233 getDepsDef fn (TyDecl ty t) = M.empty
230234 getDepsDef fn (Operator ty n' f) = M.empty -- TODO: what's this?
231235 getDepsDef fn (CaseOp ci ty tys def tot cdefs)
232− = getDepsSC fn etaVars (etaMap `union` varMap) sc
236+ = getDepsSC fn etaVars (etaMap `M.union` varMap) sc
233237 where
234− union = M.unionWith (M.unionWith S.union)
235−
236238 -- we must eta-expand the definition with fresh variables
237239 -- to capture these dependencies as well
238240 etaIdx = [length vars .. length tys - 1]
239241 etaVars = [eta i | i <- etaIdx]
240− etaMap = M.fromList [(eta i, M.singleton (fn, Arg i) S.empty) | i <- etaIdx]
242+ etaMap = M.fromList [(eta i, VI
243+ { viDeps = M.singleton (fn, Arg i) S.empty
244+ , viFunArg = Just i
245+ })
246+ | i <- etaIdx]
241247 eta i = MN i (pack "eta")
242248
243249 -- the variables that arose as function arguments only depend on (n, i)
244− varMap = M.fromList [(v, M.singleton (fn, Arg i) S.empty) | (v,i) <- zip vars [0..]]
250+ varMap = M.fromList
251+ [(v, VI
252+ { viDeps = M.singleton (fn, Arg i) S.empty
253+ , viFunArg = Just i
254+ }
255+ )
256+ | (v,i) <- zip vars [0..]]
245257 (vars, sc) = cases_runtime cdefs
246258 -- we use cases_runtime in order to have case-blocks
247259 -- resolved to top-level functions before our analysis
@@ -265,34 +277,39 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
265277
266278 addTagDep = case alts of
267279 [_] -> id -- single branch, tag not used
268− _ -> M.insertWith (M.unionWith S.union) (S.singleton (fn, Result)) casedVar
280+ _ -> M.insertWith (M.unionWith S.union) (S.singleton (fn, Result)) (viDeps casedVar)
269281 casedVar = fromMaybe (error $ "nonpatvar in case: " ++ show n) (M.lookup n vs)
270282
271− getDepsAlt :: Name -> [Name] -> Vars -> Var -> CaseAlt -> Deps
283+ getDepsAlt :: Name -> [Name] -> Vars -> VarInfo -> CaseAlt -> Deps
272284 getDepsAlt fn es vs var (FnCase n ns sc) = error "an FnCase encountered" -- TODO: what's this?
273285 getDepsAlt fn es vs var (ConstCase c sc) = getDepsSC fn es vs sc
274286 getDepsAlt fn es vs var (DefaultCase sc) = getDepsSC fn es vs sc
275287 getDepsAlt fn es vs var (SucCase n sc)
276288 = getDepsSC fn es (M.insert n var vs) sc -- we're not inserting the S-dependency here because it's special-cased
277289
290+{-
278291 -- instance constructors
279− getDepsAlt fn es vs var (ConCase ctn@(SN (InstanceCtorN cln)) cnt ns sc) = getDepsSC fn es vs (renameIn sc)
292+ getDepsAlt fn es vs var (ConCase ctn@(SN (InstanceCtorN cln)) cnt ns sc)
293+ = getDepsSC fn es vs sc -- TODO
280294 where
281295 renameIn = foldr ((.) . rename) id $ zip [0..] ns
282296 rename (i, n) = substSC n $ SN (WhereN i ctn $ sMN i "field")
297+-}
283298
284299 -- data constructors
285300 getDepsAlt fn es vs var (ConCase n cnt ns sc)
286− = getDepsSC fn es (vs' `union` vs) sc -- left-biased union
301+ = getDepsSC fn es (vs' `M.union` vs) sc -- left-biased union
287302 where
288− union = M.unionWith (M.unionWith S.union)
289−
290303 -- Here we insert dependencies that arose from pattern matching on a constructor.
291304 -- n = ctor name, j = ctor arg#, i = fun arg# of the cased var, cs = ctors of the cased var
292− vs' = M.fromList [(v, M.insertWith S.union (n, Arg j) (S.singleton (fn, varIdx)) var) | (v,j) <- zip ns [0..]]
305+ vs' = M.fromList [(v, VI
306+ { viDeps = M.insertWith S.union (n, Arg j) (S.singleton (fn, varIdx)) (viDeps var)
307+ , viFunArg = viFunArg var
308+ })
309+ | (v,j) <- zip ns [0..]]
293310
294− -- hack: get the index of the variable from its content
295− varIdx = head [i | (n, Arg i) <- M.keys var, n == fn]
311+ -- this is safe because it's certainly a patvar
312+ varIdx = fromJust (viFunArg var)
296313
297314 -- Named variables -> DeBruijn variables -> Conds/guards -> Term -> Deps
298315 getDepsTerm :: Vars -> [Cond -> Deps] -> Cond -> Term -> Deps
@@ -301,7 +318,7 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
301318 getDepsTerm vs bs cd (P _ n _)
302319 -- local variables
303320 | Just var <- M.lookup n vs
304− = M.singleton cd var
321+ = M.singleton cd (viDeps var)
305322
306323 -- sanity check: machine-generated names shouldn't occur at top-level
307324 | MN _ _ <- n
@@ -349,7 +366,7 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
349366 -- think: f x = x 0 <-- here, `x' _is_ used
350367 P _ n _
351368 | Just var <- M.lookup n vs
352− -> var `ins` unconditionalDeps args
369+ -> viDeps var `ins` unconditionalDeps args
353370 | otherwise
354371 -> node n args -- depends on whether the referred thing uses its argument
355372