git.iko.soy/Idris-dev
on master help sign in
Add some debug printouts.
d403d47Matus Tejiscak
src/IRTS/Compiler.hs+5−5
compare with master
unifiedsplit
@@ -47,9 +47,6 @@ compile codegen f tm
47 let tmnames = namesUsed (STerm tm)
47 let tmnames = namesUsed (STerm tm)
48 usedIn <- mapM (allNames []) tmnames
48 usedIn <- mapM (allNames []) tmnames
49 let used = sUN "prim__subBigInt" : sUN "prim__addBigInt" : concat usedIn
49 let used = sUN "prim__subBigInt" : sUN "prim__addBigInt" : concat usedIn
50− defsIn <- mkDecls tm used
51−
52− -- TODO: traverse all names correctly
53
50
54 -- TODO: DEBUG-ONLY, remove
51 -- TODO: DEBUG-ONLY, remove
55 ctx <- tt_ctxt <$> getIState
52 ctx <- tt_ctxt <$> getIState
@@ -65,11 +62,14 @@ compile codegen f tm
65 -- END TODO
62 -- END TODO
66
63
67 maindef <- irMain tm
64 maindef <- irMain tm
65+ iLOG $ "MAIN: " ++ show maindef
66+ iLOG $ "USED: " ++ show used
68 objs <- getObjectFiles codegen
67 objs <- getObjectFiles codegen
69 libs <- getLibs codegen
68 libs <- getLibs codegen
70 flags <- getFlags codegen
69 flags <- getFlags codegen
71 hdrs <- getHdrs codegen
70 hdrs <- getHdrs codegen
72 impdirs <- allImportDirs
71 impdirs <- allImportDirs
72+ defsIn <- mkDecls tm used
73 let defs = defsIn ++ [(sMN 0 "runMain", maindef)]
73 let defs = defsIn ++ [(sMN 0 "runMain", maindef)]
74 -- iputStrLn $ showSep "\n" (map show defs)
74 -- iputStrLn $ showSep "\n" (map show defs)
75 let (nexttag, tagged) = addTags 65536 (liftAll defs)
75 let (nexttag, tagged) = addTags 65536 (liftAll defs)
@@ -278,8 +278,8 @@ instance ToIR (TT Name) where
278 args' <- mapM (ir' env) args
278 args' <- mapM (ir' env) args
279 return (LApp False f' args')
279 return (LApp False f' args')
280 where mkUsed u i [] = []
280 where mkUsed u i [] = []
281− mkUsed u i (x : xs) | i `notElem` u = LNothing : mkUsed u (i + 1) xs
281+ mkUsed u i (x : xs) | i `elem` u = x : mkUsed u (i + 1) xs
282− | otherwise = x : mkUsed u (i + 1) xs
282+ | otherwise = LNothing : mkUsed u (i + 1) xs
283-- ir' env (P _ (NS (UN "Z") ["Nat", "Prelude"]) _)
283-- ir' env (P _ (NS (UN "Z") ["Nat", "Prelude"]) _)
284-- = return $ LConst (BI 0)
284-- = return $ LConst (BI 0)
285 ir' env (P _ n _) = return $ LV (Glob n)
285 ir' env (P _ n _) = return $ LV (Glob n)
src/Idris/Erasure.hs+3−1
@@ -143,7 +143,7 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns
143
143
144 -- the variables that arose as function arguments only depend on (n, i)
144 -- the variables that arose as function arguments only depend on (n, i)
145 varMap = M.fromList [(v, S.singleton (fn, Arg i)) | (v,i) <- zip vars [0..]]
145 varMap = M.fromList [(v, S.singleton (fn, Arg i)) | (v,i) <- zip vars [0..]]
146− (vars, sc) = cases_compiletime cdefs -- TODO: or cases_runtime?
146+ (vars, sc) = cases_runtime cdefs -- TODO: or cases_runtime?
147
147
148 etaExpand :: [Name] -> Term -> Term
148 etaExpand :: [Name] -> Term -> Term
149 etaExpand [] t = t
149 etaExpand [] t = t
@@ -215,6 +215,8 @@ buildDepMap ctx ns = addPostulates $ dfs S.empty M.empty ns
215 Bind n ( Let ty t') t -> getDepsTerm vs bs cd (App (Bind n (Lam ty) t) t')
215 Bind n ( Let ty t') t -> getDepsTerm vs bs cd (App (Bind n (Lam ty) t) t')
216 Bind n (NLet ty t') t -> getDepsTerm vs bs cd (App (Bind n (Lam ty) t) t')
216 Bind n (NLet ty t') t -> getDepsTerm vs bs cd (App (Bind n (Lam ty) t) t')
217
217
218+ Proj t i -> error $ "cannot analyse applied projection: " ++ show t ++ " !! " ++ show i
219+
218 _ -> error $ "cannot analyse application of: " ++ show fun
220 _ -> error $ "cannot analyse application of: " ++ show fun
219 where
221 where
220 ins = M.insertWith S.union cd
222 ins = M.insertWith S.union cd