git.iko.soy/Idris-dev
on master help sign in
Remove unsafeDebugIO and traceShow.
dd7a2b2Matus Tejiscak
src/IRTS/Compiler.hs−2
compare with master
unifiedsplit
@@ -58,8 +58,6 @@ compile codegen f tm
58
58
59 let minUse = minimalUsage depMap
59 let minUse = minimalUsage depMap
60 iLOG $ "MINIMAL USAGE:\n" ++ unlines (map (\(n,is) -> show n ++ " -> " ++ show (IS.toList is)) $ M.toList minUse)
60 iLOG $ "MINIMAL USAGE:\n" ++ unlines (map (\(n,is) -> show n ++ " -> " ++ show (IS.toList is)) $ M.toList minUse)
61−
62− iLOG $ "MAIN:\n" ++ show tm
63 -- END TODO
61 -- END TODO
64
62
65 maindef <- irMain tm
63 maindef <- irMain tm
src/Idris/Erasure.hs+2−16
@@ -12,7 +12,6 @@ import Idris.Core.TT
12import Idris.Core.Evaluate
12import Idris.Core.Evaluate
13
13
14import Debug.Trace
14import Debug.Trace
15−import System.IO.Unsafe
16
15
17import Control.Arrow
16import Control.Arrow
18import Control.Applicative
17import Control.Applicative
@@ -63,13 +62,8 @@ minimalUsage = gather . forwardChain
63
62
64forwardChain :: Deps -> Set Node
63forwardChain :: Deps -> Set Node
65forwardChain deps
64forwardChain deps
66− | Just trivials <- M.lookup S.empty deps
67− , ("==>", S.toList trivials) `traceShow` False = undefined
68−
69 | Just trivials <- M.lookup S.empty deps
65 | Just trivials <- M.lookup S.empty deps
70 = trivials `S.union` forwardChain (remove trivials . M.delete S.empty $ deps)
66 = trivials `S.union` forwardChain (remove trivials . M.delete S.empty $ deps)
71−
72− | unsafePerformIO prn `seq` False = undefined
73 | otherwise = S.empty
67 | otherwise = S.empty
74 where
68 where
75 -- Remove the given nodes from the Deps entirely,
69 -- Remove the given nodes from the Deps entirely,
@@ -77,11 +71,6 @@ forwardChain deps
77 remove :: Set Node -> Deps -> Deps
71 remove :: Set Node -> Deps -> Deps
78 remove ns = M.mapKeysWith S.union (S.\\ ns)
72 remove ns = M.mapKeysWith S.union (S.\\ ns)
79
73
80− printItem (cond, deps) = show (S.toList cond) ++ " -> " ++ show (S.toList deps)
81− prn = do
82− putStrLn $ "SINGLES:\n" ++ unlines (map show . filter ((==1) . S.size) $ M.keys deps)
83− putStrLn $ "USAGE SUB-ANALYSIS:\n" ++ unlines (map printItem . M.toList $ deps)
84−
85-- Build the dependency graph,
74-- Build the dependency graph,
86-- starting the depth-first search from a list of Names.
75-- starting the depth-first search from a list of Names.
87buildDepMap :: Context -> [Name] -> Deps
76buildDepMap :: Context -> [Name] -> Deps
@@ -164,8 +153,7 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns
164 getDepsSC fn es vs ImpossibleCase = M.empty
153 getDepsSC fn es vs ImpossibleCase = M.empty
165 getDepsSC fn es vs (UnmatchedCase msg) = M.empty
154 getDepsSC fn es vs (UnmatchedCase msg) = M.empty
166 getDepsSC fn es vs (ProjCase t alt) = error "ProjCase not supported"
155 getDepsSC fn es vs (ProjCase t alt) = error "ProjCase not supported"
167− getDepsSC fn [] vs (STerm t) = getDepsTerm vs [] (S.singleton (fn, Result)) t
156+ getDepsSC fn es vs (STerm t) = getDepsTerm vs [] (S.singleton (fn, Result)) (etaExpand es t)
168− getDepsSC fn es vs (STerm t) | ("EXPAND",es,t,"==>",etaExpand es t) `traceShow` True = getDepsTerm vs [] (S.singleton (fn, Result)) (etaExpand es t)
169 getDepsSC fn es vs (Case n alts) = unionMap (getDepsAlt fn es vs var) alts
157 getDepsSC fn es vs (Case n alts) = unionMap (getDepsAlt fn es vs var) alts
170 where
158 where
171 var = fromMaybe (error $ "nonpatvar in case: " ++ show n) (M.lookup n vs)
159 var = fromMaybe (error $ "nonpatvar in case: " ++ show n) (M.lookup n vs)
@@ -221,9 +209,7 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns
221 P Bound n _ -> var n `ins` unionMap (getDepsTerm vs bs cd) args
209 P Bound n _ -> var n `ins` unionMap (getDepsTerm vs bs cd) args
222
210
223 -- we interpret applied lambdas as lets in order to reuse code here
211 -- we interpret applied lambdas as lets in order to reuse code here
224− Bind n (Lam ty) t ->
225− ("REFORM", app, "==>", lamToLet [] app) `traceShow`
226− getDepsTerm vs bs cd (lamToLet [] app)
212+ Bind n (Lam ty) t -> getDepsTerm vs bs cd (lamToLet [] app)
227
213
228 _ -> error $ "cannot analyse application of: " ++ show fun
214 _ -> error $ "cannot analyse application of: " ++ show fun
229 where
215 where