5b62302 · Idris-dev · git.iko.soy

src/IRTS/Compiler.hs+13−1

compare with master

unifiedsplit

@@ -18,6 +18,7 @@ import Util.LLVMStubs

18import IRTS.Inliner

19

20import Idris.AbsSyntax

21+import Idris.AbsSyntaxTree

21import Idris.Erasure

22import Idris.Erasure

22import Idris.Error

23import Idris.Error

23

24

@@ -149,7 +150,18 @@ mkLDecl n (CaseOp ci _ _ _ pats cd)

149 = let (args, sc) = cases_runtime cd in

150 = let (args, sc) = cases_runtime cd in

150 do e <- ir (args, sc)

151 do e <- ir (args, sc)

151 return (declArgs [] (case_inlinable ci) n e)

152 return (declArgs [] (case_inlinable ci) n e)

153+

154+mkLDecl n (TyDecl (DCon t a) _) = do

155+ cg <- idris_callgraph <$> getIState

152−mkLDecl n (TyDecl (DCon t a) _) = return $ LConstructor n t a

156+ return $ LConstructor n t a

157+{-

158+ case lookupCtxt n cg of

159+ [CGInfo _ _ _ _ [(i, _)]]

160+ | -> iLOG $ "USED: " ++ show n ++ ": " ++ show used

161+ [CGInfo _ _ _ _ used] -> iLOG $ "USED: " ++ show n ++ ": " ++ show used

162+ _ -> return $ LConstructor n t a

163+-}

164+

153mkLDecl n (TyDecl (TCon t a) _) = return $ LConstructor n (-1) a

165mkLDecl n (TyDecl (TCon t a) _) = return $ LConstructor n (-1) a

154mkLDecl n _ = return $ (declArgs [] True n LNothing) -- postulate, never run

166mkLDecl n _ = return $ (declArgs [] True n LNothing) -- postulate, never run

155

167

src/Idris/AbsSyntaxTree.hs+2−1

@@ -847,7 +847,8 @@ data OptInfo = Optimise { collapsible :: Bool,

847 -- Let's store a list and convert it to IntMap whenever needed.

848 forceable :: [(Int, Forceability)],

849 recursive :: [Int],

850− inaccessible :: [(Int,Name)] } -- arg name for error reporting

850+ inaccessible :: [(Int,Name)], -- names for error reporting

851+ detaggable :: Bool }

851 deriving Show

852 deriving Show

852{-!

853{-!

853deriving instance Binary OptInfo

854deriving instance Binary OptInfo

src/Idris/DataOpts.hs+2−2

@@ -23,7 +23,7 @@ forceArgs typeName n expforce t = do

23 ist <- getIState

24 let fargs = getForcedArgs ist typeName t

25 copt = case lookupCtxt n (idris_optimisation ist) of

26− [] -> Optimise False False [] [] []

26+ [] -> Optimise False False [] [] [] False

27 op:_ -> op

28 opts = addDef n (copt { forceable = M.toList fargs ++

29 zip expforce (repeat Unconditional) })

@@ -129,7 +129,7 @@ collapseCons tn ctors = do

129 (oi:_) -> do let oi' = oi { collapsible = True }

130 let opts = addDef n oi' (idris_optimisation i)

131 putIState (i { idris_optimisation = opts })

132− [] -> do let oi = Optimise True False [] [] []

132+ [] -> do let oi = Optimise True False [] [] [] False

133 let opts = addDef n oi (idris_optimisation i)

134 putIState (i { idris_optimisation = opts })

135 addIBC (IBCOpt n)

src/Idris/DeepSeq.hs+2−2

@@ -290,8 +290,8 @@ instance NFData ClassInfo where

290 rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` ()

291

292instance NFData OptInfo where

293− rnf (Optimise x1 x2 x3 x4 x5)

293+ rnf (Optimise x1 x2 x3 x4 x5 x6)

294− = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()

294+ = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` ()

295

296instance NFData TypeInfo where

297 rnf (TI x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()

src/Idris/ElabDecls.hs+3−3

@@ -188,7 +188,7 @@ saveInaccArgs n is = do

188

189 _ -> do

190 putIState ist{ idris_optimisation =

191− addDef n (Optimise False False [] [] is) (idris_optimisation ist) }

191+ addDef n (Optimise False False [] [] is False) (idris_optimisation ist) }

192 addIBC (IBCOpt n)

193

194-- Get the list of (index, name) of inaccessible arguments from the type.

@@ -951,7 +951,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in

951 do ctxt <- getContext

952 ist <- getIState

953 let inacc = case lookupCtxt n (idris_optimisation ist) of

954− [Optimise _ _ _ _ inacc] -> map fst inacc

954+ [Optimise _ _ _ _ inacc _] -> map fst inacc

955 _ -> []

956 -- Check n actually exists, with no definition yet

957 let tys = lookupTy n ctxt

@@ -989,7 +989,7 @@ elabClauses info fc opts n_in cs = let n = liftname info n_in in

989 [oi] -> do let opts = addDef n (oi { collapsible = True })

990 (idris_optimisation ist)

991 putIState (ist { idris_optimisation = opts })

992− _ -> do let opts = addDef n (Optimise True False [] [] [])

992+ _ -> do let opts = addDef n (Optimise True False [] [] [] False)

993 (idris_optimisation ist)

994 putIState (ist { idris_optimisation = opts })

995 addIBC (IBCOpt n)

src/Idris/Erasure.hs+1−1

@@ -115,7 +115,7 @@ performUsageAnalysis = do

115

116 checkAccessibility :: Ctxt OptInfo -> (Name, IntMap (Set Reason)) -> Idris ()

117 checkAccessibility opt (n, reachable)

118− | [Optimise col nt forc rec inaccessible] <- lookupCtxt n opt

118+ | [Optimise col nt forc rec inaccessible dt] <- lookupCtxt n opt

119 , eargs@(_:_) <- [fmt n (S.toList rs) | (i,n) <- inaccessible, rs <- maybeToList $ IM.lookup i reachable]

120 = warn $ show n ++ ": inaccessible arguments reachable:\n " ++ intercalate "\n " eargs

121

src/Idris/IBC.hs+4−2

@@ -2100,19 +2100,21 @@ instance Binary ClassInfo where

2100 return (CI x1 x2 x3 x4 x5 [])

2101

2102instance Binary OptInfo where

2103− put (Optimise x1 x2 x3 x4 x5)

2103+ put (Optimise x1 x2 x3 x4 x5 x6)

2104 = do put x1

2105 put x2

2106 put x3

2107 put x4

2108 put x5

2109+ put x6

2109 get

2110 get

2110 = do x1 <- get

2111 = do x1 <- get

2111 x2 <- get

2112 x2 <- get

2112 x3 <- get

2113 x3 <- get

2113 x4 <- get

2114 x4 <- get

2114 x5 <- get

2115 x5 <- get

2116+ x6 <- get

2115− return (Optimise x1 x2 x3 x4 x5)

2117+ return (Optimise x1 x2 x3 x4 x5 x6)

2116

2118

2117instance Binary TypeInfo where

2119instance Binary TypeInfo where

2118 put (TI x1 x2 x3 x4) = do put x1

2120 put (TI x1 x2 x3 x4) = do put x1