- let eTy = typeOfExp (eextend venv (x, t)) tvenv e in
- Case (prepExp env b) (x,t)
- eTy
- [Adefault (prepExp (eextend venv (x,t),tvenv) e)]
- prepExp (venv,tvenv) (Let vdefg e) = Let vdefg' (prepExp (venv',tvenv) e)
- where (venv',vdefg') = prepVdefg (venv,tvenv) vdefg
- prepExp env@(venv,tvenv) (Case e vb t alts) = Case (prepExp env e) vb t (map (prepAlt (eextend venv vb,tvenv)) alts)
- prepExp env (Cast e t) = Cast (prepExp env e) t
- prepExp env (Note s e) = Note s (prepExp env e)
- prepExp _ (External s t) = External s t
-
- prepAlt (venv,tvenv) (Acon qdc tbs vbs e) = Acon qdc tbs vbs (prepExp (foldl' eextend venv vbs,foldl' eextend tvenv tbs) e)
- prepAlt env (Alit l e) = Alit l (prepExp env e)
- prepAlt env (Adefault e) = Adefault (prepExp env e)
+ scrut' <- prepExp env b
+ rhs' <- prepExp (eextend venv (x,t),tvenv) e
+ return $
+ let eTy = typeOfExp (eextend venv (x, t)) tvenv e in
+ Case scrut' (x,t) eTy [Adefault rhs']
+ prepExp (venv,tvenv) (Let vdefg e) = do
+ (venv',vdefg') <- prepVdefg (venv,tvenv) vdefg
+ rhs' <- prepExp (venv',tvenv) e
+ return $ Let vdefg' rhs'
+ prepExp env@(venv,tvenv) (Case e vb t alts) = do
+ e' <- prepExp env e
+ alts' <- mapM (prepAlt (eextend venv vb,tvenv)) alts
+ return $ Case e' vb t alts'
+ prepExp env (Cast e t) = do
+ e' <- prepExp env e
+ return $ Cast e' t
+ prepExp env (Note s e) = do
+ e' <- prepExp env e
+ return $ Note s e'
+ prepExp _ (External s t) = return $ External s t
+
+ prepAlt :: (Venv,Tvenv) -> Alt -> PrepM Alt
+ prepAlt (venv,tvenv) (Acon qdc tbs vbs e) = do
+ rhs' <- prepExp (foldl' eextend venv vbs,foldl' eextend tvenv tbs) e
+ return $ Acon qdc tbs vbs rhs'
+ prepAlt env (Alit l e) = (liftM (Alit l)) (prepExp env e)
+ prepAlt env (Adefault e) = (liftM Adefault) (prepExp env e)