HaRe-0.6: refactorer/RefacConDef.hs

module RefacConDef (subConstantDef) where

import PrettyPrint
import PosSyntax
import AbstractIO
import Maybe
import TypedIds
import UniqueNames hiding (srcLoc)
import PNT
import TiPNT
import List
import RefacUtils
import PFE0 (findFile)
import MUtils (( # ))

-- folding against a constant definition

subConstantDef args
  = do let fileName   = args!!0
           beginRow   = read (args!!1)::Int
           beginCol   = read (args!!2)::Int
           endRow     = read (args!!3)::Int
           endCol     = read (args!!4)::Int
       AbstractIO.putStrLn "subConstantDef"

       (inscps, exps, mod, tokList) <- parseSourceFile fileName


       let (pnt,subExp) = findDefNameAndExp tokList (beginRow, beginCol) (endRow, endCol) mod
       
       if isPatBind pnt 
         then do
           -- constant folding...
           
         else do
           -- function folding
       
           let exp = locToExp (beginRow, beginCol) (endRow, endCol) tokList mod
           (mod', ((tokList', m) , _)) <- runStateT (doSubstitution pnt exp mod) ((tokList,False),( 0, 0))
           writeRefactoredFiles False [((fileName, m), (tokList', mod'))]

findDefNameAndExp toks beginPos endPos t
   = fromMaybe (defaultPNT, defaultExp) (applyTU (once_tdTU (failTU `adhocTU` inMatch
                                                                    `adhocTU` inPat)) t)  --CAN NOT USE 'once_tdTU' here.

    where  --The selected sub-expression is in the rhs of a match
          inMatch (match@(HsMatch loc1  pnt pats rhs ds)::HsMatchP)
            | locToExp beginPos endPos toks rhs /= defaultExp
            = Just (pnt, locToExp beginPos endPos toks rhs)
          inMatch _ = Nothing

          --The selected sub-expression is in the rhs of a pattern-binding
          inPat (pat@(Dec (HsPatBind loc1 ps rhs ds))::HsDeclP)
            | locToExp beginPos endPos toks rhs /= defaultExp
            = if isSimplePatBind pat
               then Just (patToPNT ps, locToExp beginPos endPos toks rhs)
               else error "A complex pattern binding can not be generalised!"
          inPat _ = Nothing


doSubstitution p e = applyTP (stop_tdTP (failTP `adhocTP` subExp))
                       where
                             subExp exp@((Exp _)::HsExpP)
                               | sameOccurrence exp e == False = if toRelativeLocs e == toRelativeLocs exp then 
                                                                                   update exp (createFunc p) exp
                                                                             else
                                                                                   mzero
                               | otherwise                     = mzero

                             createFunc pat =
                                              (Exp (HsId (HsVar pat)))