on master help sign in
Merge pull request #3020 from melted/issue3019

Using show to create the lambda name loses information

commitb7093b1178dd825024247e037e7baae972a35b5c authorNiklas Larsson <metaniklas@gmail.com> dateSun 6 Mar 2016, 00:14 (11 years ago) parent36a3eda4a0be9c
1 file changed+6−6
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