git.iko.soy/Idris-dev
on master help sign in
Fix missing case in Defunctionalise.hs
b9a3a69Edwin Brady
src/IRTS/Compiler.hs+3−3
compare with master
unifiedsplit
@@ -113,7 +113,7 @@ irMain tm = do i <- ir tm
113allNames :: [Name] -> Name -> Idris [Name]
113allNames :: [Name] -> Name -> Idris [Name]
114allNames ns n | n `elem` ns = return []
114allNames ns n | n `elem` ns = return []
115allNames ns n = do i <- getIState
115allNames ns n = do i <- getIState
116− case lookupCtxt n (idris_callgraph i) of
116+ case lookupCtxtExact n (idris_callgraph i) of
117 [ns'] -> do more <- mapM (allNames (n:ns)) (map fst (calls ns'))
117 [ns'] -> do more <- mapM (allNames (n:ns)) (map fst (calls ns'))
118 return (nub (n : concat more))
118 return (nub (n : concat more))
119 _ -> return [n]
119 _ -> return [n]
@@ -224,12 +224,12 @@ instance ToIR (TT Name) where
224 Just tm -> return tm
224 Just tm -> return tm
225 _ -> do
225 _ -> do
226 let collapse
226 let collapse
227− = case lookupCtxt n
227+ = case lookupCtxtExact n
228 (idris_optimisation i) of
228 (idris_optimisation i) of
229 [oi] -> collapsible oi
229 [oi] -> collapsible oi
230 _ -> False
230 _ -> False
231 let unused
231 let unused
232− = case lookupCtxt n
232+ = case lookupCtxtExact n
233 (idris_callgraph i) of
233 (idris_callgraph i) of
234 [CGInfo _ _ _ _ unusedpos] ->
234 [CGInfo _ _ _ _ unusedpos] ->
235 unusedpos
235 unusedpos
src/IRTS/Defunctionalise.hs+2−2
@@ -80,14 +80,14 @@ addApps defs (n, LFun _ _ args e)
80-- aa env e@(LApp tc (MN 0 "EVAL") [a]) = e
80-- aa env e@(LApp tc (MN 0 "EVAL") [a]) = e
81 aa env (LApp tc (LV (Glob n)) args)
81 aa env (LApp tc (LV (Glob n)) args)
82 = do args' <- mapM (aa env) args
82 = do args' <- mapM (aa env) args
83− case lookupCtxt n defs of
83+ case lookupCtxtExact n defs of
84 [LConstructor _ i ar] -> return $ DApp tc n args'
84 [LConstructor _ i ar] -> return $ DApp tc n args'
85 [LFun _ _ as _] -> let arity = length as in
85 [LFun _ _ as _] -> let arity = length as in
86 fixApply tc n args' arity
86 fixApply tc n args' arity
87 [] -> return $ chainAPPLY (DV (Glob n)) args'
87 [] -> return $ chainAPPLY (DV (Glob n)) args'
88 aa env (LLazyApp n args)
88 aa env (LLazyApp n args)
89 = do args' <- mapM (aa env) args
89 = do args' <- mapM (aa env) args
90− case lookupCtxt n defs of
90+ case lookupCtxtExact n defs of
91 [LConstructor _ i ar] -> return $ DApp False n args'
91 [LConstructor _ i ar] -> return $ DApp False n args'
92 [LFun _ _ as _] -> let arity = length as in
92 [LFun _ _ as _] -> let arity = length as in
93 fixLazyApply n args' arity
93 fixLazyApply n args' arity