on master help sign in
Using show to create the lambda name loses information
4a0be9cNiklas Larsson
src/IRTS/Lang.hs+6−6
@@ -133,7 +133,7 @@ data LiftState = LS Name Int [(Name, LDecl)]
133
133
134lname (NS n x) i = NS (lname n i) x
134lname (NS n x) i = NS (lname n i) x
135lname (UN n) i = MN i n
135lname (UN n) i = MN i n
136−lname x i = sMN i (show x ++ "_lam")
136+lname x i = sMN i (showCG x ++ "_lam")
137
137
138liftAll :: [(Name, LDecl)] -> [(Name, LDecl)]
138liftAll :: [(Name, LDecl)] -> [(Name, LDecl)]
139liftAll xs = concatMap (\ (x, d) -> lambdaLift x d) xs
139liftAll xs = concatMap (\ (x, d) -> lambdaLift x d) xs
@@ -216,7 +216,7 @@ allocUnique defs (n, LFun opts fn args e)
216 -- Keep track of 'updatable' names in the state, i.e. names whose heap
216 -- Keep track of 'updatable' names in the state, i.e. names whose heap
217 -- entry may be reused, along with the arity which was there
217 -- entry may be reused, along with the arity which was there
218 findUp :: LExp -> State [(Name, Int)] LExp
218 findUp :: LExp -> State [(Name, Int)] LExp
219− findUp (LApp t (LV (Glob n)) as)
219+ findUp (LApp t (LV (Glob n)) as)
220 | Just (LConstructor _ i ar) <- lookupCtxtExact n defs,
220 | Just (LConstructor _ i ar) <- lookupCtxtExact n defs,
221 ar == length as
221 ar == length as
222 = findUp (LCon Nothing i n as)
222 = findUp (LCon Nothing i n as)
@@ -242,7 +242,7 @@ allocUnique defs (n, LFun opts fn args e)
242 findUp (LOp o es) = LOp o <$> mapM findUp es
242 findUp (LOp o es) = LOp o <$> mapM findUp es
243 findUp (LCase Updatable e@(LV (Glob n)) as)
243 findUp (LCase Updatable e@(LV (Glob n)) as)
244 = LCase Updatable e <$> mapM (doUpAlt n) as
244 = LCase Updatable e <$> mapM (doUpAlt n) as
245− findUp (LCase t e as)
245+ findUp (LCase t e as)
246 = LCase t <$> findUp e <*> mapM findUpAlt as
246 = LCase t <$> findUp e <*> mapM findUpAlt as
247 findUp t = return t
247 findUp t = return t
248
248
@@ -253,7 +253,7 @@ allocUnique defs (n, LFun opts fn args e)
253 findUpAlt (LConstCase i rhs) = LConstCase i <$> findUp rhs
253 findUpAlt (LConstCase i rhs) = LConstCase i <$> findUp rhs
254 findUpAlt (LDefaultCase rhs) = LDefaultCase <$> findUp rhs
254 findUpAlt (LDefaultCase rhs) = LDefaultCase <$> findUp rhs
255
255
256− doUpAlt n (LConCase i t args rhs)
256+ doUpAlt n (LConCase i t args rhs)
257 = do avail <- get
257 = do avail <- get
258 put ((n, length args) : avail)
258 put ((n, length args) : avail)
259 rhs' <- findUp rhs
259 rhs' <- findUp rhs
@@ -283,7 +283,7 @@ usedIn env (LLet n v e) = usedIn env v ++ usedIn (env \\ [n]) e
283usedIn env (LLam ns e) = usedIn (env \\ ns) e
283usedIn env (LLam ns e) = usedIn (env \\ ns) e
284usedIn env (LCon v i n args) = let rest = concatMap (usedIn env) args in
284usedIn env (LCon v i n args) = let rest = concatMap (usedIn env) args in
285 case v of
285 case v of
286− Nothing -> rest
286+ Nothing -> rest
287 Just (Glob n) -> usedArg env n ++ rest
287 Just (Glob n) -> usedArg env n ++ rest
288usedIn env (LProj t i) = usedIn env t
288usedIn env (LProj t i) = usedIn env t
289usedIn env (LCase up e alts) = usedIn env e ++ concatMap (usedInA env) alts
289usedIn env (LCase up e alts) = usedIn env e ++ concatMap (usedInA env) alts
@@ -330,7 +330,7 @@ instance Show LExp where
330 Updatable -> "! "
330 Updatable -> "! "
331 fmt [] = ""
331 fmt [] = ""
332 fmt [alt]
332 fmt [alt]
333− = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ " ") alt
333+ = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ " ") alt
334 fmt (alt:as)
334 fmt (alt:as)
335 = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ ". ") alt
335 = "\t" ++ ind ++ "| " ++ showAlt env (ind ++ ". ") alt
336 ++ "\n" ++ fmt as
336 ++ "\n" ++ fmt as