4a0be9c · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Using show to create the lambda name loses information

It can't disambugiate where the lambda comes from if there's two functions called the same in two where clauses in the same function. Fixes #3019

commit4a0be9cc1a71ae59a1006cb7eb8da2416c78d5f2 authorNiklas Larsson <niklas@mm.st> dateSat 5 Mar 2016, 23:32 (11 years ago) parent36a3eda

1 file changed+6−6

compare with master

unifiedsplit

src/IRTS/Lang.hs+6−6

src/IRTS/Lang.hs+6−6

@@ -133,7 +133,7 @@ data LiftState = LS Name Int [(Name, LDecl)]

133133

134134lname (NS n x) i = NS (lname n i) x

135135lname (UN n) i = MN i n

136−lname x i = sMN i (show x ++ "_lam")

136+lname x i = sMN i (showCG x ++ "_lam")

137137

138138liftAll :: [(Name, LDecl)] -> [(Name, LDecl)]

139139liftAll xs = concatMap (\ (x, d) -> lambdaLift x d) xs

@@ -216,7 +216,7 @@ allocUnique defs (n, LFun opts fn args e)

216216 -- Keep track of 'updatable' names in the state, i.e. names whose heap

217217 -- entry may be reused, along with the arity which was there

218218 findUp :: LExp -> State [(Name, Int)] LExp

219− findUp (LApp t (LV (Glob n)) as)

219+ findUp (LApp t (LV (Glob n)) as)

220220 | Just (LConstructor _ i ar) <- lookupCtxtExact n defs,

221221 ar == length as

222222 = findUp (LCon Nothing i n as)

@@ -242,7 +242,7 @@ allocUnique defs (n, LFun opts fn args e)

242242 findUp (LOp o es) = LOp o <$> mapM findUp es

243243 findUp (LCase Updatable e@(LV (Glob n)) as)

244244 = LCase Updatable e <$> mapM (doUpAlt n) as

245− findUp (LCase t e as)

245+ findUp (LCase t e as)

246246 = LCase t <$> findUp e <*> mapM findUpAlt as

247247 findUp t = return t

248248

@@ -253,7 +253,7 @@ allocUnique defs (n, LFun opts fn args e)

253253 findUpAlt (LConstCase i rhs) = LConstCase i <$> findUp rhs

254254 findUpAlt (LDefaultCase rhs) = LDefaultCase <$> findUp rhs

255255

256− doUpAlt n (LConCase i t args rhs)

256+ doUpAlt n (LConCase i t args rhs)

257257 = do avail <- get

258258 put ((n, length args) : avail)

259259 rhs' <- findUp rhs

@@ -283,7 +283,7 @@ usedIn env (LLet n v e) = usedIn env v ++ usedIn (env \\ [n]) e

283283usedIn env (LLam ns e) = usedIn (env \\ ns) e

284284usedIn env (LCon v i n args) = let rest = concatMap (usedIn env) args in

285285 case v of

286− Nothing -> rest

286+ Nothing -> rest

287287 Just (Glob n) -> usedArg env n ++ rest

288288usedIn env (LProj t i) = usedIn env t

289289usedIn env (LCase up e alts) = usedIn env e ++ concatMap (usedInA env) alts

@@ -330,7 +330,7 @@ instance Show LExp where

330330 Updatable -> "! "

331331 fmt [] = ""

332332 fmt [alt]

333− = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ " ") alt

333+ = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ " ") alt

334334 fmt (alt:as)

335335 = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ ". ") alt

336336 ++ "\n" ++ fmt as