HaRe-0.6: refactorer/SlicingUtils.hs

module SlicingUtils where

import AbstractIO
import Maybe
import List
import RefacUtils
import RefacRedunDec


checkCase (Exp(HsInfixApp e11 o e22 )) high wh
  | findEntity high e11 = do
                             (e, wh) <- checkCase e11 high wh
                             return (e, wh)
  | findEntity high e22 = do
                             (e, wh) <- checkCase e22 high wh
                             return (e,wh)

checkCase (Exp(HsParen e)) high wh 
                = do 
                     res <- checkCase e high wh
                     return res
checkCase (Exp(HsCase e alts)) high wh
                = do
                     newWhere <- checkAlts alts
                     return (high, (newWhere++wh))
                        where
                           checkAlts [] = do
                                             return []
                           checkAlts ((HsAlt _ _ _ ds):xs) 
                              = do
                                   decls <- removeRedunWhere ds high
                                   res <- checkAlts xs
                                   return (decls ++ res)

checkCase (exp@e) high wh  = do
                              decls <- removeRedunWhere wh e
                              return (exp, decls)


checkIfOrLet (Exp(HsParen e)) newExp tokList start end
                = do
                     res <- checkIfOrLet e newExp tokList start end
                     return (Exp(HsParen res))

checkIfOrLet (Exp(HsIf e1 e2 e3)) newExp tokList start end
                = do
                     let expRes = findExpInIf tokList
                                              start
                                              end
                                              e2
                     if expRes == defaultExp
                         then do
                                 let expRes' = findExpInIf tokList
                                                           start
                                                           end
                                                           e3
                                 if expRes' == defaultExp 
                                      then return (Exp(HsIf e1 e2 e3)) 
                                      else return (newExp)
                         else return (newExp)
checkIfOrLet (Exp(HsLet ds e)) newExp _ _ _ 
                = do
                     return (Exp(HsLet ds newExp))

checkIfOrLet (exp@_) newExp _ _ _ = do
                               return newExp
-- check whether the identifiers within the highlighted subexpression are 
-- used within the let statement - if they are then return the statement
checkLetAndLambda begin end tokList wh high exp
  = applyTU (full_tdTU (constTU [] `adhocTU` inLet)) exp
     where
           inLet (ex@(Exp(HsLet ds e))::HsExpP)
               = do 
                    let newExp = (Exp(HsLet ds high))
                    (decls, x) <- removeRedun wh newExp
                    res <- inLet e
                    if res == [defaultExp] then do
                                             return [x]
                                           else do
                                             let exp' = ammendDecs res x
                                             return [exp']
                                                where
                                                  ammendDecs ((Exp(HsLet ds e)):xs) ((Exp(HsLet decls e2))) 
                                                                 = (Exp(HsLet (decls++ds) e))
                                                  ammendDecs _ _ = defaultExp

           inLet (Exp(HsParen e)) = do res <- inLet e 
                                       return res
           inLet (Exp(HsInfixApp e1 _ e2)) = do
                                           res <- inLet e1
                                           if res == [defaultExp]
                                               then do
                                                  res' <- inLet e2
                                                  return res'
                                               else do
                                                  return res
           inLet (Exp(HsApp e1 e2)) = do
                                        res <- inLet e1
                                        if res == [defaultExp]
                                           then do
                                             res' <- inLet e2
                                             return res'
                                           else do
                                             return res
           inLet (Exp(HsCase e alts))
                = do 
                     return [(Exp(HsCase high alts))]

           inLet (exp@(Exp(HsDo _)))
               = do
                    if (locToExp begin end tokList exp) /= defaultExp
                       then do
                         error "Cannot perform a slicing on a monad"
                       else do return [exp] 

           inLet (exp@(Exp(HsListComp _))) = do
                                              if (locToExp begin end tokList exp) /= defaultExp
                                                then do
                                                  error "Cannot perform slicing with List Comprehension"
                                                else do return [defaultExp]

           inLet (_::HsExpP) = do
                                return [defaultExp]
                    

findExpInIf toks beginPos endPos t
  = fromMaybe (defaultExp)
              (applyTU (once_tdTU (failTU `adhocTU` inExp)) t)
        where
          inExp (exp@(_)::HsExpP)
           | locToExp beginPos endPos toks exp /= defaultExp
              = Just (exp)
          inExp _ = Nothing