@@ -74,6 +74,7 @@ performUsageAnalysis = do
74 usage = M.toList minUse
74 usage = M.toList minUse
76 -- Print some debug info.
76 -- Print some debug info.
77+ logLvl 5 $ "Original deps:\n" ++ unlines (map fmtItem . M.toList $ depMap)
77 logLvl 3 $ "Reachable names:\n" ++ unlines (map (indent . show) . S.toList $ reachableNames)
78 logLvl 3 $ "Reachable names:\n" ++ unlines (map (indent . show) . S.toList $ reachableNames)
78 logLvl 4 $ "Minimal usage:\n" ++ fmtUseMap usage
79 logLvl 4 $ "Minimal usage:\n" ++ fmtUseMap usage
79 logLvl 5 $ "Residual deps:\n" ++ unlines (map fmtItem . M.toList $ residDeps)
80 logLvl 5 $ "Residual deps:\n" ++ unlines (map fmtItem . M.toList $ residDeps)
@@ -116,12 +117,13 @@ performUsageAnalysis = do
116 checkAccessibility opt (n, reachable)
117 checkAccessibility opt (n, reachable)
117 | [Optimise col nt forc rec inaccessible] <- lookupCtxt n opt
118 | [Optimise col nt forc rec inaccessible] <- lookupCtxt n opt
118 , eargs@(_:_) <- [fmt n (S.toList rs) | (i,n) <- inaccessible, rs <- maybeToList $ IM.lookup i reachable]
119 , eargs@(_:_) <- [fmt n (S.toList rs) | (i,n) <- inaccessible, rs <- maybeToList $ IM.lookup i reachable]
119− = ifail $ show n ++ ": inaccessible arguments reachable:\n " ++ intercalate "\n " eargs
120+ = warn $ show n ++ ": inaccessible arguments reachable:\n " ++ intercalate "\n " eargs
121 | otherwise = return ()
122 | otherwise = return ()
123 fmt n [] = show n ++ " (no more information available)"
124 fmt n [] = show n ++ " (no more information available)"
124 fmt n rs = show n ++ " from " ++ intercalate ", " [show rn ++ " arg# " ++ show ri | (rn,ri) <- rs]
125 fmt n rs = show n ++ " from " ++ intercalate ", " [show rn ++ " arg# " ++ show ri | (rn,ri) <- rs]
126-- Find the minimal consistent usage by forward chaining.
128-- Find the minimal consistent usage by forward chaining.
127minimalUsage :: Deps -> (Deps, (Set Name, UseMap))
129minimalUsage :: Deps -> (Deps, (Set Name, UseMap))
@@ -385,9 +387,9 @@ buildDepMap ci ctx mainName = addPostulates $ dfs S.empty M.empty [mainName]
385 -- If the symbol is unknown, we assume that it uses all its arguments.
387 -- If the symbol is unknown, we assume that it uses all its arguments.
386 getArity :: Name -> Int
388 getArity :: Name -> Int
387 getArity n = case lookupDef n ctx of
389 getArity n = case lookupDef n ctx of
388− [CaseOp ci ty tys def tot cdefs]
390+ [CaseOp ci ty tys def tot cdefs] -> length tys
389− -> length tys
391+ [TyDecl (DCon tag arity) _] -> arity
392 -- convert applications of lambdas to lets
394 -- convert applications of lambdas to lets
393 -- Note that this transformation preserves de bruijn numbering
395 -- Note that this transformation preserves de bruijn numbering