on master help sign in
Remove EVALs from generated code

Except where explicitly required by a Force

commit970e476a4e6631dc88eec14cdea442038f047f7a authorEdwin Brady <ecb10@st-andrews.ac.uk> dateThu 13 Feb 2014, 18:24 (13 years ago) parent130f437
1 file changed+7−7
src/IRTS/Defunctionalise.hs+7−7
src/IRTS/Defunctionalise.hs+7−7
@@ -98,22 +98,22 @@ addApps defs (n, LFun _ _ args e)
9898 aa env (LCon i n args) = liftM (DC i n) (mapM (aa env) args)
9999 aa env (LProj t@(LV (Glob n)) i)
100100 | n `elem` env = do t' <- aa env t
101− return $ DProj (DUpdate n (eEVAL t')) i
101+ return $ DProj (DUpdate n t') i
102102 aa env (LProj t i) = do t' <- aa env t
103− return $ DProj (eEVAL t') i
103+ return $ DProj t' i
104104 aa env (LCase e alts) = do e' <- aa env e
105105 alts' <- mapM (aaAlt env) alts
106− return $ DCase (eEVAL e') alts'
106+ return $ DCase e' alts'
107107 aa env (LConst c) = return $ DConst c
108108 aa env (LForeign l t n args) = liftM (DForeign l t n) (mapM (aaF env) args)
109109 aa env (LOp LFork args) = liftM (DOp LFork) (mapM (aa env) args)
110110 aa env (LOp f args) = do args' <- mapM (aa env) args
111− return $ DOp f (map eEVAL args')
111+ return $ DOp f args'
112112 aa env LNothing = return DNothing
113113 aa env (LError e) = return $ DError e
114114
115115 aaF env (t, e) = do e' <- aa env e
116− return (t, eEVAL e')
116+ return (t, e')
117117
118118 aaAlt env (LConCase i n args e)
119119 = liftM (DConCase i n args) (aa (args ++ env) e)
@@ -150,7 +150,7 @@ addApps defs (n, LFun _ _ args e)
150150
151151 preEval [] t = t
152152 preEval (x : xs) t
153− | needsEval x t = DLet x (eEVAL (DV (Glob x))) (preEval xs t)
153+ | needsEval x t = DLet x (DV (Glob x)) (preEval xs t)
154154 | otherwise = preEval xs t
155155
156156 needsEval x (DApp _ _ args) = or (map (needsEval x) args)
@@ -187,7 +187,7 @@ toCons ns (n, i)
187187 EvalCase (\tlarg ->
188188 (DConCase (-1) (mkFnCon n) (take i (genArgs 0))
189189 (dupdate tlarg
190− (eEVAL (DApp False n (map (DV . Glob) (take i (genArgs 0)))))))))
190+ (DApp False n (map (DV . Glob) (take i (genArgs 0))))))))
191191 : mkApplyCase n 0 i
192192 | otherwise = []
193193 where dupdate tlarg x = x