a04b57d · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

on master help sign in

--dumpcases now dumps post unused arg erasure

a04b57dEdwin Brady14 years ago

src/IRTS/Compiler.hs+6−12

compare with master

unifiedsplit

@@ -54,8 +54,7 @@ compile target f tm

54 dumpDefun <- getDumpDefun

55 case dumpCases of

56 Nothing -> return ()

57− Just f -> do cs <- getCaseTrees (concat used)

58− liftIO $ writeFile f (showCaseTrees cs)

57+ Just f -> liftIO $ writeFile f (showCaseTrees tagged)

59 case dumpDefun of

58 case dumpDefun of

60 Nothing -> return ()

59 Nothing -> return ()

61 Just f -> liftIO $ writeFile f (dumpDefuns defuns)

60 Just f -> liftIO $ writeFile f (dumpDefuns defuns)

@@ -99,18 +98,13 @@ mkDecls t used

99 decls <- mapM build ds

98 decls <- mapM build ds

100 return decls

99 return decls

101

100

102−getCaseTrees :: [Name] -> Idris [(Name, Def)]

103−getCaseTrees used

104− = do i <- getIState

105− let ds = filter (\ (n, d) -> n `elem` used || isCon d) $ ctxtAlist (tt_ctxt i)

106− return ds

107−

108−showCaseTrees :: [(Name, Def)] -> String

101+showCaseTrees :: [(Name, LDecl)] -> String

109showCaseTrees ds = showSep "\n\n" (map showCT ds)

102showCaseTrees ds = showSep "\n\n" (map showCT ds)

110 where

103 where

111− showCT (n, CaseOp _ _ _ _ _ args sc)

104+ showCT (n, LFun f args lexp)

112− = show n ++ " " ++ showSep " " (map show args) ++ " = " ++ show sc

105+ = show n ++ " " ++ showSep " " (map show args) ++ " =\n\t "

113− showCT (n, _) = ""

106+ ++ show lexp

107+ showCT (n, LConstructor c t a) = "data " ++ show n ++ " " ++ show a

114

108

115isCon (TyDecl _ _) = True

109isCon (TyDecl _ _) = True

116isCon _ = False

110isCon _ = False

src/IRTS/Lang.hs+2

@@ -172,6 +172,8 @@ instance Show LExp where

172 show e = show' [] e where

173 show' env (LV (Loc i)) = env!!i

174 show' env (LV (Glob n)) = show n

175+ show' env (LLazyApp e args) = show e ++ "|(" ++

176+ showSep ", " (map (show' env) args) ++")"

175 show' env (LApp _ e args) = show' env e ++ "(" ++

177 show' env (LApp _ e args) = show' env e ++ "(" ++

176 showSep ", " (map (show' env) args) ++")"

178 showSep ", " (map (show' env) args) ++")"

177 show' env (LLazyExp e) = "%lazy(" ++ show' env e ++ ")"

179 show' env (LLazyExp e) = "%lazy(" ++ show' env e ++ ")"