b9a3a69 · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Fix missing case in Defunctionalise.hs

Compilation should assume that all names have been fully resolved and there is no ambiguity. This should solve the issue reported in #548, but I can't confirm without a test case.

commitb9a3a695608dbe8d72046462bbf7037cbdfe3ee2 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateSun 20 Oct 2013, 16:59 (13 years ago) parent45378f1

2 files changed+5−5

compare with master

unifiedsplit

src/IRTS/Compiler.hs+3−3 src/IRTS/Defunctionalise.hs+2−2

src/IRTS/Compiler.hs+3−3

@@ -113,7 +113,7 @@ irMain tm = do i <- ir tm

113113allNames :: [Name] -> Name -> Idris [Name]

114114allNames ns n | n `elem` ns = return []

115115allNames ns n = do i <- getIState

116− case lookupCtxt n (idris_callgraph i) of

116+ case lookupCtxtExact n (idris_callgraph i) of

117117 [ns'] -> do more <- mapM (allNames (n:ns)) (map fst (calls ns'))

118118 return (nub (n : concat more))

119119 _ -> return [n]

@@ -224,12 +224,12 @@ instance ToIR (TT Name) where

224224 Just tm -> return tm

225225 _ -> do

226226 let collapse

227− = case lookupCtxt n

227+ = case lookupCtxtExact n

228228 (idris_optimisation i) of

229229 [oi] -> collapsible oi

230230 _ -> False

231231 let unused

232− = case lookupCtxt n

232+ = case lookupCtxtExact n

233233 (idris_callgraph i) of

234234 [CGInfo _ _ _ _ unusedpos] ->

235235 unusedpos

src/IRTS/Defunctionalise.hs+2−2

@@ -80,14 +80,14 @@ addApps defs (n, LFun _ _ args e)

8080-- aa env e@(LApp tc (MN 0 "EVAL") [a]) = e

8181 aa env (LApp tc (LV (Glob n)) args)

8282 = do args' <- mapM (aa env) args

83− case lookupCtxt n defs of

83+ case lookupCtxtExact n defs of

8484 [LConstructor _ i ar] -> return $ DApp tc n args'

8585 [LFun _ _ as _] -> let arity = length as in

8686 fixApply tc n args' arity

8787 [] -> return $ chainAPPLY (DV (Glob n)) args'

8888 aa env (LLazyApp n args)

8989 = do args' <- mapM (aa env) args

90− case lookupCtxt n defs of

90+ case lookupCtxtExact n defs of

9191 [LConstructor _ i ar] -> return $ DApp False n args'

9292 [LFun _ _ as _] -> let arity = length as in

9393 fixLazyApply n args' arity