{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module Language.Haskell.Refact.Refactoring.MoveDef
  ( liftToTopLevel
  , compLiftToTopLevel
  , liftOneLevel
  , compLiftOneLevel
  , demote
  , compDemote
  -- ,liftingInClientMod
  ) where

import qualified Data.Generics as SYB
import qualified GHC.SYB.Utils as SYB

import qualified Data.Generics.Zipper as Z


import qualified Exception             as GHC
import qualified GHC                   as GHC
import qualified Name                  as GHC
import qualified RdrName               as GHC

import Control.Exception
import Control.Monad.State
import Data.Foldable
import Data.List
import Data.Maybe

import qualified GhcMod as GM
import Language.Haskell.Refact.API

import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint

import Data.Generics.Strafunski.StrategyLib.StrategyLib

import System.Directory

-- import Debug.Trace

-- ---------------------------------------------------------------------

-- data Direction = UptoTopLevel | UpOneLevel | Down

{--------This function handles refactorings involving moving a definition--------

 According to the Haskell's syntax, a declaration may occur in one of
the following six contexts:

  1. A top level declaration in the module:
        old: HsModule SrcLoc ModuleName (Maybe [HsExportSpecI i]) [HsImportDeclI i] ds
        new: (HsGroup Name, [LImportDecl Name], Maybe [LIE Name], Maybe LHsDocString)
              HsGroup hs_valds :: HsValBinds id ...

  2. A local declaration in a Match: (of a FunBind)
        old: HsMatch SrcLoc i [p] (HsRhs e) ds
        new: Match [LPat id] (Maybe (LHsType id)) (GRHSs id)

  3. A local declaration in a pattern binding:
        old: HsPatBind SrcLoc p (HsRhs e) ds
        new: PatBind (LPat idL) (GRHSs idR) PostTcType NameSet (Maybe tickish)

  4. A local declaration in a Let expression:
        old: HsLet ds e
        new: HsLet (HsLocalBinds id) (LHsExpr id)

  5. A local declaration in a Case alternative:
        old: HsAlt SrcLoc p (HsRhs e) ds
        new: HsCase (LHsExpr id) (MatchGroup id)
           new is same as in a FunBind.

  6. A local declaration in a Do statement:
        old: HsLetStmt ds (HsStmt e p ds)
        new: LetStmt (HsLocalBindsLR idL idR)
             in context GRHS [LStmt id] (LHsExpr id)
-}

-- | Lift a definition to the top level
liftToTopLevel :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
liftToTopLevel settings opts fileName (row,col) = do
  absFileName <- canonicalizePath fileName
  runRefacSession settings opts (compLiftToTopLevel absFileName (row,col))

compLiftToTopLevel :: FilePath -> SimpPos
     -> RefactGhc [ApplyRefacResult]
compLiftToTopLevel fileName (row,col) = do
      parseSourceFileGhc fileName
      logParsedSource "liftToMod orig:"
      parsed  <- getRefactParsed
      nm <- getRefactNameMap

      let (Just (modName,_)) = getModuleName parsed
      let maybePn = locToRdrName (row, col) parsed
      case maybePn of
        Just ln@(GHC.L l _) -> liftToTopLevel' modName (GHC.L l (rdrName2NamePure nm ln))
        _       -> error "\nInvalid cursor position!\n"


{- Refactoring Names: 'liftToTopLevel'

   This refactoring lifts a local function/pattern binding to the top
   level of the module, so as to make it accessible to other functions in
   the current module, and those modules that import current module.

   In the current implementation, a definition will be lifted only if
   none of the identifiers defined in this definition will cause name
   clash/capture problems in the current module after lifting.

   In the case that the whole current module is exported implicitly,
   the lifted identifier will be exported automatically after lifting. If
   the identifier will cause name clash/ambiguous occurrence problem in a
   client module, it will be hided in the import declaration of the
   client module (Note: this might not be the best solution, we prefer
   hiding it in the server module instead of in the client module in the
   final version).

   In the case of indirect importing, it might be time-consuming to
   trace whether the lifted identifier will cause any problem in a client
   module that indirectly imports the current module. The current
   solution is: suppose a defintion is lifted to top level in module A,
   and module A is imported and exported by module B, then the lifted
   identifier will be hided in the import declaration of B no matter
  whether it causes problems in module B or not.

   Function name: liftToTopLevel
   parameters: fileName--current file name.
               mod -- the scoped abstract syntax tree of the module.
               pn  -- the function/pattern name to be lifted.
-}
liftToTopLevel' :: GHC.ModuleName
                -> GHC.Located GHC.Name
                -> RefactGhc [ApplyRefacResult]
liftToTopLevel' modName pn@(GHC.L _ n) = do
  renamed <- getRefactRenamed
  parsed  <- getRefactParsed
  nm      <- getRefactNameMap
  targetModule <- getRefactTargetModule
  logm $ "liftToTopLevel':pn=" ++ (showGhc pn)
  if isLocalFunOrPatName nm n parsed
      then do
              (refactoredMod,declPns) <- applyRefac liftToMod RSAlreadyLoaded

              logm $ "liftToTopLevel' applyRefac done "

              if modIsExported modName renamed
               then do clients <- clientModsAndFiles targetModule
                       logm $ "liftToTopLevel':(clients,declPns)=" ++ (showGhc (clients,declPns))
                       refactoredClients <- mapM (liftingInClientMod modName declPns) clients
                       return (refactoredMod:(concat refactoredClients))
               else do return [refactoredMod]
      else error "\nThe identifier is not a local function/pattern name!"

    where
       {-step1: divide the module's top level declaration list into three parts: 'parent'
                is the top level declaration containing the lifted declaration, 'before'
                and `after` are those declarations before and after 'parent'.
         step2: get the declarations to be lifted from parent, bind it to liftedDecls
         step3: remove the lifted declarations from parent and extra arguments
                may be introduced.
         step4. test whether there are any names need to be renamed.
       -}
       liftToMod = do
         parsed' <- getRefactParsed
         parsed  <- liftT $ balanceAllComments parsed'
         nm      <- getRefactNameMap
         -- logDataWithAnns "parsed after balanceAllComments" parsed
         declsp <- liftT $ hsDecls parsed
         (before,parent,after) <- divideDecls declsp pn
         {- ++AZ++TODO: reinstate this, hsDecls does : hsBinds does not return class or instance definitions
         when (isClassDecl $ ghead "liftToMod" parent)
               $ error "Sorry, the refactorer cannot lift a definition from a class declaration!"
         when (isInstDecl $ ghead "liftToMod" parent)
               $ error "Sorry, the refactorer cannot lift a definition from an instance declaration!"
         -}
         -- declsParent <- liftT $ hsDecls (ghead "liftToMod" parent)
         -- logm $ "liftToMod:(declsParent)=" ++ (showGhc declsParent)
         let liftedDecls = definingDeclsRdrNames nm [n] parent True True
             declaredPns = nub $ concatMap (definedNamesRdr nm) liftedDecls
             liftedSigs  = definingSigsRdrNames nm declaredPns parent
             mLiftedSigs = liftedSigs


         -- logDataWithAnns "liftedDecls" liftedDecls

         -- Check that the lifted declaration does not include a tuple pattern on the lhs
         when (any isTupleDecl liftedDecls) $ do
           error "Cannot lift a declaration assigning to a tuple pattern"

         -- TODO: what about declarations between this
         -- one and the top level that are used in this one?

         pns <- pnsNeedRenaming parsed parent liftedDecls declaredPns
         logm $ "liftToMod:(pns needing renaming)=" ++ (showGhc pns)

         decls <- liftT $ hsDecls parsed'
         let dd = getDeclaredVarsRdr nm decls
         logm $ "liftToMod:(ddd)=" ++ (showGhc dd)

         if null pns
           then do
             (parent',liftedDecls',mLiftedSigs') <- addParamsToParentAndLiftedDecl n dd parent liftedDecls mLiftedSigs

             let defName  = ghead "liftToMod" (definedNamesRdr nm (ghead "liftToMod2" parent'))
             parsed1 <- liftT $ replaceDecls parsed (before++parent'++after)
             parsed2 <- moveDecl1 parsed1 (Just defName) [GHC.unLoc pn] liftedDecls'
                                                            declaredPns mLiftedSigs'
             putRefactParsed parsed2 emptyAnns

             logParsedSource "liftToMod done:"

             return declaredPns

           else askRenamingMsg pns "lifting"

isTupleDecl :: GHC.LHsDecl GHC.RdrName -> Bool
isTupleDecl (GHC.L _ (GHC.ValD (GHC.PatBind (GHC.L _ GHC.TuplePat {}) _ _ _ _))) = True
isTupleDecl (GHC.L _ (GHC.ValD (GHC.PatBind (GHC.L _ (GHC.AsPat _ (GHC.L _ GHC.TuplePat {}))) _ _ _ _))) = True
isTupleDecl _ = False

-- ---------------------------------------------------------------------

-- | Move a definition one level up from where it is now
liftOneLevel :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
liftOneLevel settings opts fileName (row,col) = do
  absFileName <- canonicalizePath fileName
  runRefacSession settings opts (compLiftOneLevel absFileName (row,col))

compLiftOneLevel :: FilePath -> SimpPos
     -> RefactGhc [ApplyRefacResult]
compLiftOneLevel fileName (row,col) = do
      parseSourceFileGhc fileName
      parsed  <- getRefactParsed
      nm <- getRefactNameMap

      let (Just (modName,_)) = getModuleName parsed
      let maybePn = locToRdrName (row, col) parsed
      case maybePn of
        Just ln@(GHC.L l _) ->  do
            rs <- liftOneLevel' modName (GHC.L l (rdrName2NamePure nm ln))
            logm $ "compLiftOneLevel:rs=" ++ (show $ (refactDone rs,map (\((_,d),_) -> d) rs))
            if (refactDone rs)
              then return rs
              else error ( "Lifting this definition failed. "++
                       " This might be because that the definition to be "++
                       "lifted is defined in a class/instance declaration.")
        _       ->  error "\nInvalid cursor position!\n"

{- Refactoring Names: 'liftOneLevel'
   Description:
    this refactoring lifts a local function/pattern binding only one level up.
    By 'lifting one-level up' , I mean:

    case1: In a module (HsModule SrcLoc ModuleName (Maybe [HsExportSpecI i]) [HsImportDeclI i] ds):
           A local declaration D  will be lifted to the same level as the 'ds', if D is in the
           where clause of one of ds's element declaration.

        new: (HsModule mmn mexp imps ds mdepr _haddock)
           In pactice this means processing

           a.  Matches in a FunBind
                 (Match mln pats _typ (GRHSs grhs ds))
           b. A PatBind
               (PatBind lhs (GRHSs grhs ds) _typ _fvs _ticks)

           and lifting a decl D from ds to the top.

           VarBinds and AbsBinds are introduced by the type checker, so can be ignored here.
           A PatSynBind does not have decls in it, so is ignored.


    case2: In a match ( HsMatch SrcLoc i [p] (HsRhs e) ds) :
           A local declaration D  will be lifted to the same level as the 'ds', if D is in the
           where clause of one of ds's element declaration.
           A declaration D,say,in the rhs expression 'e' will be lifted to 'ds' if D is Not local to
           other declaration list in 'e'

           (in a FunBind)
        new: (Match mln pats _typ (GRHSs grhs lb))


    case3: In a pattern  binding (HsPatBind SrcLoc p (HsRhs e) ds):
           A local declaration D  will be lifted to the same level as the 'ds', if D is in the
           where clause of one of ds's element declaration.
           A declaration D,say,in the rhs expression 'e' will be lifted to 'ds' if D is Not local to
           other declaration list in 'e'

        new: (PatBind lhs (GRHSs grhs ds) _typ _fvs _ticks)


    case4: In the Let expression (Exp (HsLet ds e):
           A local declaration D  will be lifted to the same level as the 'ds', if D is in the
           where clause of one of ds's element declaration.
           A declaration D, say, in the expression 'e' will be lifted to 'ds' if D is not local to
           other declaration list in 'e'

        new: HsLet ds e


    case5: In the case Alternative expression:(HsAlt loc p rhs ds)
           A local declaration D  will be lifted to the same level as the 'ds', if D is in the
           where clause of one of ds's element declaration.
           A declaration D in 'rhs' will be lifted to 'ds' if D is not local to other declaration
           list in 'rhs'.

        new: HsCase (LHsExpr id) (MatchGroup id)
           new is same as in a FunBind.


    case6: In the do statement expression:(HsLetStmt ds stmts)
           A local declaration D  will be lifted to the same level as the 'ds', if D is in the
           where clause of one of ds's element declaration.
           A declaration D in 'stmts' will be lifted to 'ds' if D is not local to other declaration
           list in 'stmts'.

        new: LetStmt (HsLocalBindsLR idL idR)
             in context GRHS [LStmt id] (LHsExpr id)


Function name: liftOneLevel
parameters: fileName--current file name.
            mod -- the scoped abstract syntax tree of the module.
            pn  -- the function/pattern name to be lifted.

-}

liftOneLevel' :: GHC.ModuleName
                -> GHC.Located GHC.Name
                -> RefactGhc [ApplyRefacResult]

liftOneLevel' modName pn@(GHC.L _ n) = do
  renamed <- getRefactRenamed
  parsed  <- getRefactParsed
  nm      <- getRefactNameMap
  targetModule <- getRefactTargetModule
  if isLocalFunOrPatName nm n parsed
        then do
                (refactoredMod,(b,pns)) <- applyRefac doLiftOneLevel RSAlreadyLoaded
                logm $ "liftOneLevel':main refactoring done:(p,pns)=" ++ showGhc (b,pns)
                if b &&  modIsExported modName renamed
                  then do
                          logm $ "liftOneLevel':looking for clients"
                          clients <- clientModsAndFiles targetModule
                          logm $ "liftOneLevel':(clients,pns)=" ++ (showGhc (clients,pns))
                          refactoredClients <- mapM (liftingInClientMod modName pns) clients
                          return (refactoredMod:concat refactoredClients)
                  else do return [refactoredMod]
        else error "\nThe identifer is not a function/pattern name!"

   where
      doLiftOneLevel = do
             logm $ "in doLiftOneLevel"
             parsed <- getRefactParsed
             logDataWithAnns "doLiftOneLevel:parsed" parsed
             nm <- getRefactNameMap
             ans <- liftT getAnnsT
             zp <- ztransformStagedM SYB.Parser
                                (Nothing
                                `SYB.mkQ`  (liftToModQ   nm ans)
                                `SYB.extQ` (liftToMatchQ nm ans)
                                `SYB.extQ` (liftToLetQ   nm ans)
                                ) (Z.toZipper parsed)
             let parsed' = Z.fromZipper zp
             putRefactParsed parsed' emptyAnns
             liftedToTopLevel pn parsed'

           where
             isMatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Bool
             isMatch _ = True

             isHsLet :: GHC.LHsExpr GHC.RdrName -> Bool
             isHsLet (GHC.L _ (GHC.HsLet _ _)) = True
             isHsLet _               = False

             -- ------------------------

             liftToModQ ::
                           NameMap -> Anns
                        -> GHC.ParsedSource
                        -> Maybe (SYB.Stage
                                  -> Z.Zipper GHC.ParsedSource
                                  -> RefactGhc (Z.Zipper GHC.ParsedSource))
             liftToModQ nm ans (p :: GHC.ParsedSource)
                | nonEmptyList candidateBinds
                  = Just (doLiftZ p declsp)
                | otherwise = Nothing
                where
                 (declsp ,_,_) = runTransform ans (hsDecls p)
                 doOne bs = (definingDeclsRdrNames nm [n] declsbs False False,bs)
                   where
                     (declsbs,_,_) = runTransform ans (hsDeclsGeneric bs)

                 candidateBinds = map snd
                                $ filter (\(l,_bs) -> nonEmptyList l)
                                $ map doOne
                                $ declsp

             getHsDecls ans t = decls
               where (decls,_,_) = runTransform ans (hsDeclsGeneric t)

             -- ------------------------

             liftToMatchQ :: (SYB.Data a)
                          => NameMap -> Anns
                          -> GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
                          -> Maybe (SYB.Stage -> Z.Zipper a -> RefactGhc (Z.Zipper a))
             liftToMatchQ nm ans (m@(GHC.L _ (GHC.Match _ _pats _mtyp (GHC.GRHSs _rhs ds)))::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
                 | (nonEmptyList (definingDeclsRdrNames nm [n] (getHsDecls ans ds) False False))
                    = Just (doLiftZ m (getHsDecls ans  ds))
                 | otherwise = Nothing

             -- ------------------------

             liftToLetQ :: SYB.Data a
                        => NameMap -> Anns
                        -> GHC.LHsExpr GHC.RdrName -> Maybe (SYB.Stage -> Z.Zipper a -> RefactGhc (Z.Zipper a))
             liftToLetQ nm ans ll@(GHC.L _ (GHC.HsLet ds _e))
               | nonEmptyList (definingDeclsRdrNames nm [n] (getHsDecls ans ds) False  False)
                 = Just (doLiftZ ll (getHsDecls ans ll))
               | otherwise = Nothing
             liftToLetQ _ _ _ = Nothing

             -- ------------------------

             doLiftZ :: (SYB.Data t,SYB.Data a)
               => t -- ^Item containing the decls which contain the ones to be lifted
               -> [GHC.LHsDecl GHC.RdrName] -- ^decls containing the ones to be lifted.
                                            -- ++AZ++:TODO: these are redundant, can be pulled out of t
               -> SYB.Stage -- ++AZ++:TODO: get rid of this
               -> Z.Zipper a
               -> RefactGhc (Z.Zipper a)
             doLiftZ ds decls _stage z =
                  do
                    logm $ "doLiftZ entered"
                    logDataWithAnns "doLiftZ:ds" ds
                    logDataWithAnns "doLiftZ:decls" decls

                    let zu = case (Z.up z) of
                              Just zz -> fromMaybe (error $ "MoveDef.liftToLet.1" ++ SYB.showData SYB.Parser 0 decls)
                                  $ upUntil (False `SYB.mkQ` isMatch
                                                   `SYB.extQ` isHsLet
                                                   )
                                     zz
                              Nothing -> z

                    let
                      wtop (ren::GHC.ParsedSource) = do
                        logm $ "wtop entered"
                        nm <- getRefactNameMap
                        let (_,DN dd) = (hsFreeAndDeclaredRdr nm ren)
                        -- ++AZ++ : TODO: get rid of worker in favour of
                        -- workerTop
                        worker ren decls pn dd
                        -- workerTop ren decls dd


                      wmatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
                             -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
                      wmatch (m@(GHC.L _ (GHC.Match _mln _pats _typ grhss))) = do
                         logm $ "wmatch entered:" ++ SYB.showData SYB.Parser 0 m
                         nm <- getRefactNameMap
                         let (_,DN dd) = hsFreeAndDeclaredRdr nm grhss

                         decls' <- liftT $ hsDecls m
                         workerTop m decls' dd

                      wlet :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)
                      wlet l@(GHC.L _ (GHC.HsLet dsl _e)) = do
                         logm $ "wlet entered "
                         nm <- getRefactNameMap
                         let (_,DN dd) = hsFreeAndDeclaredRdr nm dsl
                         dsl' <- workerTop l decls dd
                         return dsl'
                      wlet x = return x

                    ds' <- Z.transM ( SYB.mkM   wtop
                                     `SYB.extM` wmatch
                                     `SYB.extM` wlet
                                    ) zu

                    return ds'

             -- ----------------------------------------


             -- This is currently used for everything but the top level
             workerTop :: (HasDecls t)
                => t -- ^The destination of the lift operation
                -> [GHC.LHsDecl GHC.RdrName] -- ^ list containing the decl to be
                                             -- lifted
                -> [GHC.Name] -- ^Declared variables in the destination
                -> RefactGhc t
             workerTop dest ds dd
                  =do
                      logm $ "MoveDef.worker: dest" ++ SYB.showData SYB.Parser 0 dest
                      logm $ "MoveDef.workerTop: ds=" ++ (showGhc ds)
                      done <- getRefactDone
                      if done then return dest
                        else do
                          setRefactDone
                          let parent = dest
                          nm <- getRefactNameMap
                          let liftedDecls = definingDeclsRdrNames' nm [n] parent
                              declaredPns = nub $ concatMap (definedNamesRdr nm) liftedDecls
                          logm $ "MoveDef.workerTop: n=" ++ (showGhc n)
                          logm $ "MoveDef.workerTop: liftedDecls=" ++ (showGhc liftedDecls)
                          pns <- pnsNeedRenaming dest parent liftedDecls declaredPns
                          logm $ "MoveDef.workerTop: pns=" ++ (showGhc pns)
                          if pns==[]
                            then do
                                    (parent',liftedDecls',mLiftedSigs')<-addParamsToParentAndLiftedDecl n dd
                                                                         parent liftedDecls []
                                    logm $ "MoveDef.workerTop: liftedDecls'=" ++ (showGhc liftedDecls')
                                    --True means the new decl will be at the same level with its parant.
                                    let toMove = parent'
                                    pdecls <- liftT $ hsDecls toMove
                                    -- logm $ "MoveDef.workerTop:toMove=" ++ SYB.showData SYB.Parser 0 toMove
                                    -- logm $ "MoveDef.workerTop:pdecls=" ++ (showGhc pdecls)
                                    let mAfter = case pdecls of
                                          [] -> Nothing
                                          _ -> (Just (ghead "worker" (definedNamesRdr nm (glast "workerTop" ds))))
                                    dest' <- moveDecl1 toMove
                                               mAfter
                                               [n] liftedDecls' declaredPns mLiftedSigs'
                                    return dest'
                            else askRenamingMsg pns "lifting"

             -- ----------------------------------------

             -- TODO: get rid of this in favour of workerTop
             worker :: (HasDecls t)
                => t -- ^The destination of the lift operation
                -> [GHC.LHsDecl GHC.RdrName] -- ^ list containing the decl to be
                                             -- lifted
                -> GHC.Located GHC.Name -- ^ The name of the decl to be lifted
                -> [GHC.Name] -- ^Declared variables in the destination
                -> RefactGhc t
             worker dest ds pnn dd
                  =do
                      -- logm $ "MoveDef.worker: dest" ++ (showGhc dest)
                      logm $ "MoveDef.worker: ds=" ++ (showGhc ds)
                      done <- getRefactDone
                      if done then return dest
                        else do
                          setRefactDone
                          (before,parent,after) <- divideDecls ds pnn -- parent is misnomer, it is the decl to be moved
                          logm $ "MoveDef.worker:(before,parent,after)" ++ showGhc (before,parent,after)
                          nm <- getRefactNameMap
                          let liftedDecls = definingDeclsRdrNames nm [n] parent True True
                              declaredPns = nub $ concatMap (definedNamesRdr nm) liftedDecls
                          pns <- pnsNeedRenaming dest parent liftedDecls declaredPns
                          logm $ "MoveDef.worker: pns=" ++ (showGhc pns)
                          if pns==[]
                            then do
                                    (parent',liftedDecls',mLiftedSigs')<-addParamsToParentAndLiftedDecl n dd
                                                                         parent liftedDecls []
                                    --True means the new decl will be at the same level with its parant.
                                    toMove <- liftT $ replaceDecls dest (before++parent'++after)
                                    dest' <- moveDecl1 toMove
                                               (Just (ghead "worker" (definedNamesRdr nm (ghead "worker" parent'))))
                                               [n] liftedDecls' declaredPns mLiftedSigs'
                                    return dest'
                            else askRenamingMsg pns "lifting"


-- ---------------------------------------------------------------------

-- | Move a definition one level down
demote :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
demote settings opts fileName (row,col) = do
  absFileName <- canonicalizePath fileName
  runRefacSession settings opts (compDemote absFileName (row,col))

compDemote ::FilePath -> SimpPos
         -> RefactGhc [ApplyRefacResult]
compDemote fileName (row,col) = do
      parseSourceFileGhc fileName
      parsed  <- getRefactParsed
      nm <- getRefactNameMap

      -- TODO: make the next one an API call, that also gets the
      -- parsed source
      let (Just (modName,_)) = getModuleName parsed
      let maybePn = locToRdrName (row, col) parsed
      case maybePn of
        Just pn@(GHC.L l _) -> demote' modName (GHC.L l (rdrName2NamePure nm pn))
        _       -> error "\nInvalid cursor position!\n"

-- ---------------------------------------------------------------------

moveDecl1 :: (SYB.Data t)
  => t -- ^ The syntax element to update
  -> Maybe GHC.Name -- ^ If specified, add defn after this one

  -> [GHC.Name]     -- ^ The first one is the decl to move
  -> [GHC.LHsDecl GHC.RdrName]
  -> [GHC.Name]     -- ^ The signatures to remove. May be multiple if
                    --   decl being moved has a patbind.
  -> [GHC.LSig GHC.RdrName] -- ^ lifted decls signature if present
  -> RefactGhc t    -- ^ The updated syntax element (and tokens in monad)
moveDecl1 t defName ns mliftedDecls sigNames mliftedSigs = do
  logm $ "moveDecl1:(defName,ns,sigNames,mliftedDecls)=" ++ showGhc (defName,ns,sigNames,mliftedDecls)
  -- logm $ "moveDecl1:(t)=" ++ SYB.showData SYB.Parser 0 (t)

  -- TODO: rmDecl can now remove the sig at the same time.
  (t'',_sigsRemoved) <- rmTypeSigs sigNames t
  -- logm $ "moveDecl1:after rmTypeSigs:t''" ++ SYB.showData SYB.Parser 0 t''
  logm $ "moveDecl1:mliftedSigs=" ++ showGhc mliftedSigs
  (t',_declRemoved,_sigRemoved) <- rmDecl (ghead "moveDecl3.1"  ns) False t''
  -- logm $ "moveDecl1:after rmDecl:t'" ++ SYB.showData SYB.Parser 0 t'
  let sigs = map wrapSig mliftedSigs
  r <- addDecl t' defName (sigs++mliftedDecls,Nothing)

  return r

-- ---------------------------------------------------------------------

askRenamingMsg :: [GHC.Name] -> String -> t
askRenamingMsg pns str
  = error ("The identifier(s): " ++ (intercalate "," $ map showPN pns) ++
           " will cause name clash/capture or ambiguity occurrence problem after "
           ++ str ++", please do renaming first!")

  where
    showPN pn = showGhc (pn,GHC.nameSrcLoc pn)

-- |Get the subset of 'pns' that need to be renamed before lifting.
pnsNeedRenaming :: (SYB.Data t1,SYB.Data t2) =>
  t1 -> t2 -> t3 -> [GHC.Name]
  -> RefactGhc [GHC.Name]
pnsNeedRenaming dest parent _liftedDecls pns
  = do
       logm $ "MoveDef.pnsNeedRenaming entered:pns=" ++ showGhc pns
       r <- mapM pnsNeedRenaming' pns
       return (concat r)
  where
     pnsNeedRenaming' pn
       = do
            logm $ "MoveDef.pnsNeedRenaming' entered"
            nm <- getRefactNameMap
            let (FN f,DN d) = hsFDsFromInsideRdr nm dest --f: free variable names that may be shadowed by pn
                                                         --d: declaread variables names that may clash with pn
            logm $ "MoveDef.pnsNeedRenaming':(f,d)=" ++ showGhc (f,d)
            DN vs <- hsVisibleDsRdr nm pn parent  --vs: declarad variables that may shadow pn
            logm $ "MoveDef.pnsNeedRenaming':vs=" ++ showGhc vs
            let vars = map pNtoName (nub (f `union` d `union` vs) \\ [pn]) -- `union` inscpNames
            isInScope <- isInScopeAndUnqualifiedGhc (pNtoName pn) Nothing
            logm $ "MoveDef.pnsNeedRenaming:(f,d,vs,vars,isInScope)=" ++ (showGhc (f,d,vs,vars,isInScope))
            -- if elem (pNtoName pn) vars  || isInScope && findEntity pn dest
            if elem (pNtoName pn) vars  || isInScope && findNameInRdr nm pn dest
               then return [pn]
               else return []
     pNtoName = showGhc

-- ---------------------------------------------------------------------

addParamsToParent :: (SYB.Data t) => GHC.Name -> [GHC.RdrName] -> t -> RefactGhc t
addParamsToParent _pn [] t = return t
addParamsToParent  pn params t = do
  logm $ "addParamsToParent:(pn,params)" ++ (showGhc (pn,params))
  nm <- getRefactNameMap
  applyTP (full_buTP (idTP  `adhocTP` (inExp nm))) t
  where
#if __GLASGOW_HASKELL__ <= 710
    inExp nm (e@(GHC.L l (GHC.HsVar n)) :: GHC.LHsExpr GHC.RdrName) = do
#else
    inExp nm (e@(GHC.L l (GHC.HsVar (GHC.L _ n))) :: GHC.LHsExpr GHC.RdrName) = do
#endif
      let ne = rdrName2NamePure nm (GHC.L l n)
      if GHC.nameUnique ne == GHC.nameUnique pn
         then addActualParamsToRhs pn params e
         else return e
    inExp _ e = return e

  -- addActualParamsToRhs pn params t


-- |Do refactoring in the client module. that is to hide the identifer
-- in the import declaration if it will cause any problem in the
-- client module.
liftingInClientMod :: GHC.ModuleName -> [GHC.Name] -> TargetModule
  -> RefactGhc [ApplyRefacResult]
liftingInClientMod serverModName pns targetModule = do
       logm $ "liftingInClientMod:targetModule=" ++ (show targetModule)
       getTargetGhc targetModule
       parsed <- getRefactParsed
       clientModule <- getRefactModule
       logm $ "liftingInClientMod:clientModule=" ++ (showGhc clientModule)
       modNames <- willBeUnQualImportedBy serverModName
       logm $ "liftingInClientMod:modNames=" ++ (showGhc modNames)
       if isJust modNames
        then do
             pns' <- namesNeedToBeHided clientModule (gfromJust "liftingInClientMod" modNames) pns
             let pnsRdr' = map GHC.nameRdrName pns'
             logm $ "liftingInClientMod:pns'=" ++ (showGhc pns')
             if (nonEmptyList pns')
                 then do (refactoredMod,_) <- applyRefac (addHiding serverModName parsed pnsRdr') RSAlreadyLoaded
                         return [refactoredMod]
                 else return []
        else return []

-- ---------------------------------------------------------------------

-- |Test whether an identifier defined in the modules specified by
-- 'names' will be exported by current module.
willBeExportedByClientMod :: [GHC.ModuleName] -> GHC.RenamedSource -> Bool
willBeExportedByClientMod names renamed =
  let (_,_,exps,_) = renamed
  in if isNothing exps
        then False
        else any isJust $ map (\y-> (find (\x-> (simpModule x==Just y)) (gfromJust "willBeExportedByClientMod" exps))) names
     where simpModule (GHC.L _ (GHC.IEModuleContents (GHC.L _ m))) = Just m
           simpModule _  = Nothing

-- |get the module name or alias name by which the lifted identifier
-- will be imported automatically.
-- TODO: maybe move this into TypeUtils
-- willBeUnQualImportedBy::HsName.ModuleName->HsModuleP->Maybe [HsName.ModuleName]
willBeUnQualImportedBy :: GHC.ModuleName -> RefactGhc (Maybe [GHC.ModuleName])
willBeUnQualImportedBy modName = do
   (_,imps,_,_) <- getRefactRenamed
   let ms = filter (\(GHC.L _ (GHC.ImportDecl _ (GHC.L _ modName1) _qualify _source _safe isQualified _isImplicit _as h))
                     -> modName == modName1 && (not isQualified) && (isNothing h || (isJust h && ((fst (fromJust h)) == True))))
                   imps

       res = if (emptyList ms) then Nothing
                               else Just $ nub $ map getModName ms

       getModName (GHC.L _ (GHC.ImportDecl _ (GHC.L _ modName2) _qualify _source _safe _isQualified _isImplicit as _h))
        = if isJust as then simpModName (fromJust as)
                       else modName2

       simpModName m = m

   logm $ "willBeUnQualImportedBy:(ms,res)=" ++ (showGhc (ms,res))

   return res

-- ---------------------------------------------------------------------

-- |get the subset of 'pns', which need to be hided in the import
-- declaration in module 'mod'
-- Note: these are newly exported from the module, so we cannot use
-- the GHC name resolution in this case.
namesNeedToBeHided :: GHC.Module -> [GHC.ModuleName] -> [GHC.Name]
   -> RefactGhc [GHC.Name]
namesNeedToBeHided clientModule modNames pns = do
  renamed <- getRefactRenamed
  parsed <- getRefactParsed
  logm $ "namesNeedToBeHided:willBeExportedByClientMod=" ++ (show $ willBeExportedByClientMod modNames renamed)
  gnames <- GHC.getNamesInScope
  let clientInscopes = filter (\n -> clientModule == GHC.nameModule n) gnames
  logm $ "namesNeedToBeHided:(clientInscopes)=" ++ (showGhc (clientInscopes))

  pnsMapped <- mapM getLocalEquiv pns
  logm $ "namesNeedToBeHided:pnsMapped=" ++ (showGhc pnsMapped)

  let pnsMapped' = filter (\(_,_,ns) -> not $ emptyList ns) pnsMapped

  if willBeExportedByClientMod modNames renamed
      then return pns
      else do
        ff <- mapM (needToBeHided parsed) pnsMapped'
        return $ concat ff
  where
    -- | Strip the package prefix from the name and return the
    -- stripped name together with any names in the local module that
    -- may match the stripped one
    getLocalEquiv :: GHC.Name -> RefactGhc (GHC.Name,String,[GHC.Name])
    getLocalEquiv pn = do
      let pnStr = stripPackage $ showGhc pn
      logm $ "MoveDef getLocalEquiv: about to parseName:" ++ (show pnStr)
      ecns <- GHC.gtry $ GHC.parseName pnStr
      let cns = case ecns of
                 Left (_e::SomeException) -> []
                 Right v -> v
      logm $ "MoveDef getLocalEquiv: cns:" ++ (showGhc cns)
      return (pn,pnStr,cns)

    stripPackage :: String -> String
    stripPackage str = reverse s
      where
        (s,_) = break (== '.') $ reverse str

    needToBeHided :: GHC.ParsedSource -> (GHC.Name,String,[GHC.Name]) -> RefactGhc [GHC.Name]
    needToBeHided parsed (pn,_pnStr,pnsLocal) = do
      let uwoq = map (\n -> usedWithoutQualR n parsed) pnsLocal

      -- logm $ "needToBeHided:(hsBinds renamed)=" ++ (showGhc (hsBinds renamed))
      logm $ "needToBeHided:(pn,uwoq)=" ++ (showGhc (pn,uwoq))

      if (any (== True) uwoq --the same name is used in the module unqualifiedly or
                --is exported unqualifiedly by an Ent decl

            -- TODO: ++AZ++ check if next line needs to be reinstated
            -- was || any (\m -> causeNameClashInExports oldPN pn m renamed) modNames)
            || False)
           then return [pn]
           else return []


-- **************************************************************************************************************--

-- ---------------------------------------------------------------------

-- |When liftOneLevel is complete, identify whether any new declarations have
-- been put at the top level
liftedToTopLevel :: GHC.Located GHC.Name -> GHC.ParsedSource -> RefactGhc (Bool,[GHC.Name])
liftedToTopLevel (GHC.L _ pn) parsed = do
  logm $ "liftedToTopLevel entered:pn=" ++ showGhc pn
  nm <- getRefactNameMap
  decls <- liftT $ hsDecls parsed
  let topDecs = definingDeclsRdrNames nm [pn] decls False False
  -- ++AZ++ :TODO: we are not updating the nameMap to reflect moved decls
  if nonEmptyList topDecs
     then do
       let liftedDecls = definingDeclsRdrNames nm [pn] topDecs False False
           declaredPns  = nub $ concatMap (definedNamesRdr nm) liftedDecls
       return (True, declaredPns)
     else return (False, [])

-- ---------------------------------------------------------------------

addParamsToParentAndLiftedDecl :: (SYB.Data t) =>
     GHC.Name   -- ^name of decl being lifted
  -> [GHC.Name] -- ^Declared names in parent
  -> t          -- ^parent
  -> [GHC.LHsDecl GHC.RdrName] -- ^ decls being lifted
  -> [GHC.LSig GHC.RdrName]    -- ^ lifted decls signature if present
  -> RefactGhc (t, [GHC.LHsDecl GHC.RdrName], [GHC.LSig GHC.RdrName])
addParamsToParentAndLiftedDecl pn dd parent liftedDecls mLiftedSigs
  =do
       logm $ "addParamsToParentAndLiftedDecl:liftedDecls=" ++ (showGhc liftedDecls)
       nm <- getRefactNameMap
       let (FN ef,_) = hsFreeAndDeclaredRdr nm parent
       let (FN lf,_) = hsFreeAndDeclaredRdr nm liftedDecls

       logm $ "addParamsToParentAndLiftedDecl:(ef,lf)=" ++ showGhc (ef,lf)

       -- parameters to be added to pn because of lifting
       let newParamsNames = ((nub lf) \\ (nub ef)) \\ dd
           newParams = map GHC.nameRdrName newParamsNames

       logm $ "addParamsToParentAndLiftedDecl:(newParams,ef,lf,dd)=" ++ (showGhc (newParams,ef,lf,dd))

       if newParams /= []
         then if  (any isComplexPatDecl liftedDecls)
                then error "This pattern binding cannot be lifted, as it uses some other local bindings!"
                else do -- first remove the decls to be lifted, so they are not disturbed
                        (parent'',liftedDecls'',_msig) <- rmDecl pn False parent

                        parent' <- addParamsToParent pn newParams parent''

                        liftedDecls' <- addParamsToDecls [liftedDecls''] pn newParams

                        mLiftedSigs' <- mapM (addParamsToSigs newParamsNames) mLiftedSigs

                        logm $ "addParamsToParentAndLiftedDecl:mLiftedSigs'=" ++ showGhc mLiftedSigs'

                        return (parent',liftedDecls', mLiftedSigs')
         else return (parent,liftedDecls,mLiftedSigs)

-- ---------------------------------------------------------------------
{-
-- TODO: perhaps move this to TypeUtils
addParamsToSigs :: [GHC.Name] -> GHC.LSig GHC.RdrName -> RefactGhc (GHC.LSig GHC.RdrName)
addParamsToSigs [] ms = return ms
addParamsToSigs newParams (GHC.L l (GHC.TypeSig lns ltyp pns)) = do
  mts <- mapM getTypeForName newParams
  let ts = catMaybes mts
  logm $ "addParamsToSigs:ts=" ++ showGhc ts
  logDataWithAnns "addParamsToSigs:ts=" ts
  let newStr = ":: " ++ (intercalate " -> " $ map printSigComponent ts) ++ " -> "
  logm $ "addParamsToSigs:newStr=[" ++ newStr ++ "]"
  typ' <- liftT $ foldlM addOneType ltyp (reverse ts)
  sigOk <- isNewSignatureOk ts
  logm $ "addParamsToSigs:(sigOk,newStr)=" ++ show (sigOk,newStr)
  if sigOk
    then return (GHC.L l (GHC.TypeSig lns typ' pns))
    else error $ "\nNew type signature may fail type checking: " ++ newStr ++ "\n"
  where
    addOneType :: GHC.LHsType GHC.RdrName -> GHC.Type -> Transform (GHC.LHsType GHC.RdrName)
    addOneType et t = do
      hst <- typeToLHsType t
      ss1 <- uniqueSrcSpanT
      hst1 <- case t of
        (GHC.FunTy _ _) -> do
          ss <- uniqueSrcSpanT
          let t1 = GHC.L ss (GHC.HsParTy hst)
          setEntryDPT hst (DP (0,0))
          addSimpleAnnT t1  (DP (0,0)) [((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]
          return t1
        _ -> return hst
      let typ = GHC.L ss1 (GHC.HsFunTy hst1 et)

      addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnRarrow),DP (0,1))]
      return typ

addParamsToSigs np ls = error $ "addParamsToSigs: no match for:" ++ showGhc (np,ls)

-- ---------------------------------------------------------------------

printSigComponent :: GHC.Type -> String
printSigComponent x = ppType x

-- ---------------------------------------------------------------------

-- |Fail any signature having a forall in it.
-- TODO: this is unnecesarily restrictive, but needs
-- a) proper reversing of GHC.Type to GHC.LhsType
-- b) some serious reverse type inference to ensure that the
--    constraints are modified properly to merge the old signature
--    part and the new.
isNewSignatureOk :: [GHC.Type] -> RefactGhc Bool
isNewSignatureOk types = do
  -- NOTE: under some circumstances enabling Rank2Types or RankNTypes
  --       can resolve the type conflict, this can potentially be checked
  --       for.
  -- NOTE2: perhaps proceed and reload the tentative refactoring into
  --        the GHC session and accept it only if it type checks
  let
    r = SYB.everythingStaged SYB.TypeChecker (++) []
          ([] `SYB.mkQ` usesForAll) types
    usesForAll (GHC.ForAllTy _ _) = [1::Int]
    usesForAll _                  = []

  return $ emptyList r

-- ---------------------------------------------------------------------

-- TODO: perhaps move this to TypeUtils
-- TODO: complete this
typeToLHsType :: GHC.Type -> Transform (GHC.LHsType GHC.RdrName)
typeToLHsType (GHC.TyVarTy v)   = do
  ss <- uniqueSrcSpanT
  let typ = GHC.L ss (GHC.HsTyVar (GHC.nameRdrName $ Var.varName v))
  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
  return typ

typeToLHsType (GHC.AppTy t1 t2) = do
  t1' <- typeToLHsType t1
  t2' <- typeToLHsType t2
  ss <- uniqueSrcSpanT
  return $ GHC.L ss (GHC.HsAppTy t1' t2')

typeToLHsType t@(GHC.TyConApp _tc _ts) = tyConAppToHsType t

typeToLHsType (GHC.FunTy t1 t2) = do
  t1' <- typeToLHsType t1
  t2' <- typeToLHsType t2
  ss <- uniqueSrcSpanT
  let typ = GHC.L ss (GHC.HsFunTy t1' t2')
  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnRarrow),DP (0,1))]
  return typ

typeToLHsType (GHC.ForAllTy _v t) = do
  t' <- typeToLHsType t
  ss1 <- uniqueSrcSpanT
  ss2 <- uniqueSrcSpanT
  return $ GHC.L ss1 (GHC.HsForAllTy GHC.Explicit Nothing (GHC.HsQTvs [] []) (GHC.L ss2 []) t')

typeToLHsType (GHC.LitTy (GHC.NumTyLit i)) = do
  ss <- uniqueSrcSpanT
  let typ = GHC.L ss (GHC.HsTyLit (GHC.HsNumTy (show i) i)) :: GHC.LHsType GHC.RdrName
  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
  return typ

typeToLHsType (GHC.LitTy (GHC.StrTyLit s)) = do
  ss <- uniqueSrcSpanT
  let typ = GHC.L ss (GHC.HsTyLit (GHC.HsStrTy "" s)) :: GHC.LHsType GHC.RdrName
  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
  return typ


{-
data Type
  = TyVarTy Var	-- ^ Vanilla type or kind variable (*never* a coercion variable)

  | AppTy         -- See Note [AppTy invariant]
	Type
	Type		-- ^ Type application to something other than a 'TyCon'. Parameters:
	                --
                        --  1) Function: must /not/ be a 'TyConApp',
                        --     must be another 'AppTy', or 'TyVarTy'
	                --
	                --  2) Argument type

  | TyConApp      -- See Note [AppTy invariant]
	TyCon
	[KindOrType]	-- ^ Application of a 'TyCon', including newtypes /and/ synonyms.
	                -- Invariant: saturated appliations of 'FunTyCon' must
	                -- use 'FunTy' and saturated synonyms must use their own
                        -- constructors. However, /unsaturated/ 'FunTyCon's
                        -- do appear as 'TyConApp's.
	                -- Parameters:
	                --
	                -- 1) Type constructor being applied to.
	                --
                        -- 2) Type arguments. Might not have enough type arguments
                        --    here to saturate the constructor.
                        --    Even type synonyms are not necessarily saturated;
                        --    for example unsaturated type synonyms
	                --    can appear as the right hand side of a type synonym.

  | FunTy
	Type
	Type		-- ^ Special case of 'TyConApp': @TyConApp FunTyCon [t1, t2]@
			-- See Note [Equality-constrained types]

  | ForAllTy
	Var         -- Type or kind variable
	Type	        -- ^ A polymorphic type

  | LitTy TyLit     -- ^ Type literals are simillar to type constructors.

-}

tyConAppToHsType :: GHC.Type -> Transform (GHC.LHsType GHC.RdrName)
tyConAppToHsType (GHC.TyConApp tc _ts) = r (show $ GHC.tyConName tc)
  where
    r str = do
      ss <- uniqueSrcSpanT
      let typ = GHC.L ss (GHC.HsTyLit (GHC.HsStrTy str $ GHC.mkFastString str)) :: GHC.LHsType GHC.RdrName
      addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,1))]
      return typ

-- tyConAppToHsType t@(GHC.TyConApp _tc _ts)
--    = error $ "tyConAppToHsType: unexpected:" ++ (SYB.showData SYB.TypeChecker 0 t)

{-
HsType
HsForAllTy HsExplicitFlag (LHsTyVarBndrs name) (LHsContext name) (LHsType name)
HsTyVar name
HsAppTy (LHsType name) (LHsType name)
HsFunTy (LHsType name) (LHsType name)
HsListTy (LHsType name)
HsPArrTy (LHsType name)
HsTupleTy HsTupleSort [LHsType name]
HsOpTy (LHsType name) (LHsTyOp name) (LHsType name)
HsParTy (LHsType name)
HsIParamTy HsIPName (LHsType name)
HsEqTy (LHsType name) (LHsType name)
HsKindSig (LHsType name) (LHsKind name)
HsQuasiQuoteTy (HsQuasiQuote name)
HsSpliceTy (HsSplice name) FreeVars PostTcKind
HsDocTy (LHsType name) LHsDocString
HsBangTy HsBang (LHsType name)
HsRecTy [ConDeclField name]
HsCoreTy Type
HsExplicitListTy PostTcKind [LHsType name]
HsExplicitTupleTy [PostTcKind] [LHsType name]
HsTyLit HsTyLit
HsWrapTy HsTyWrapper (HsType name)
-}

-}

--------------------------------End of Lifting-----------------------------------------

{-Refactoring : demote a function/pattern binding(simpe or complex) to the declaration where it is used.
  Descritption: if a declaration D, say, is only used by another declaration F,say, then D can be
                demoted into the local declaration list (where clause) in F.
                So currently, D can not be demoted if more than one declaration use it.

                In a multi-module context, a top-level definition can not be demoted if it is used
                by other modules. In the case that the demoted identifer is in the hiding list of
                import declaration in a client module, it should be removed from the hiding list.

 Function name:demote
 parameters: fileName--current file name.
             mod -- the scoped abstract syntax tree of the module.
             pn  -- the function/pattern name to be demoted.

-}

demote' ::
     GHC.ModuleName
  -- -> FilePath
  -- -> (ParseResult,[PosToken])
  -> GHC.Located GHC.Name
  -> RefactGhc [ApplyRefacResult]
demote' modName (GHC.L _ pn) = do
  renamed <- getRefactRenamed
  parsed  <- getRefactParsed
  nm      <- getRefactNameMap
  targetModule <- getRefactTargetModule
  if isFunOrPatName nm pn parsed
    then do
       isTl <- isTopLevelPN pn
       if isTl && isExplicitlyExported nm pn parsed
          then error "This definition can not be demoted, as it is explicitly exported by the current module!"
          else do
                  (refactoredMod,declaredPns) <- applyRefac (doDemoting pn) RSAlreadyLoaded
                  if isTl && modIsExported modName renamed
                    then do
                            logm $ "demote':isTl && isExported"
                            clients <- clientModsAndFiles targetModule
                            logm $ "demote':clients=" ++ (showGhc clients)
                            refactoredClients <-mapM (demotingInClientMod declaredPns) clients
                            return (refactoredMod:refactoredClients)
                    else do return [refactoredMod]
    else error "\nInvalid cursor position!"


-- |Do refactoring in the client module, that is:
--  a) Check whether the identifier is used in the module body
--  b) If the identifier is not used but is hided by the import
--     declaration, then remove it from the hiding.
demotingInClientMod ::
  [GHC.Name] -> TargetModule
  -> RefactGhc ApplyRefacResult
demotingInClientMod pns targetModule = do
  logm $ "demotingInClientMod:(pns,targetModule)=" ++ showGhc (pns,targetModule)
  getTargetGhc targetModule
  modu <- getRefactModule
  (refactoredMod,_) <- applyRefac (doDemotingInClientMod pns modu) RSAlreadyLoaded
  return refactoredMod


doDemotingInClientMod :: [GHC.Name] -> GHC.Module -> RefactGhc ()
doDemotingInClientMod pns modName = do
  logm $ "doDemotingInClientMod:(pns,modName)=" ++ showGhc (pns,modName)
  (GHC.L _ p) <- getRefactParsed
  nm <- getRefactNameMap
  if any (\pn -> findNameInRdr nm pn (GHC.hsmodDecls p) || findNameInRdr nm pn (GHC.hsmodExports p)) pns
     then error $ "This definition can not be demoted, as it is used in the client module '"++(showGhc modName)++"'!"
     else if any (\pn->findNameInRdr nm pn (GHC.hsmodImports p)) pns
             -- TODO: reinstate this
             then do -- (mod',((ts',m),_))<-runStateT (rmItemsFromImport mod pns) ((ts,unmodified),(-1000,0))
                     return ()
             else return ()

-- ---------------------------------------------------------------------

doDemoting :: GHC.Name -> RefactGhc [GHC.Name]
doDemoting  pn = do

  clearRefactDone -- Only do this action once

  parsed  <- getRefactParsed

  parsed' <- everywhereMStaged' SYB.Parser   (SYB.mkM   demoteInMod
                                             `SYB.extM` demoteInMatch
                                             `SYB.extM` demoteInPat
                                             `SYB.extM` demoteInLet
                                             `SYB.extM` demoteInStmt
                                            ) parsed
  putRefactParsed parsed' emptyAnns
  nm <- getRefactNameMap
  decls <- liftT $ hsDecls parsed
  let demotedDecls'= definingDeclsRdrNames nm [pn] decls True False
      declaredPnsRdr  = nub $ concatMap definedPNsRdr demotedDecls'
      declaredPns = map (rdrName2NamePure nm) declaredPnsRdr
  return declaredPns
    where
       --1. demote from top level
       demoteInMod x@(parsed :: GHC.ParsedSource) = do
         decls <- liftT $ hsDecls parsed
         nm <- getRefactNameMap
         if not $ emptyList (definingDeclsRdrNames nm [pn] decls False False)
           then do
              logm "MoveDef:demoteInMod" -- ++AZ++
              demoted <- doDemoting' parsed pn
              return demoted
           else return x

       --2. The demoted definition is a local decl in a match
       demoteInMatch match@(GHC.L _ (GHC.Match _ _pats _mt (GHC.GRHSs _ _ds))::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do
         -- decls <- liftT $ hsDecls ds
         decls <- liftT $ hsDecls match
         nm <- getRefactNameMap
         if not $ emptyList (definingDeclsRdrNames nm [pn] decls False False)
           then do
              logm "MoveDef:demoteInMatch" -- ++AZ++
              done <- getRefactDone
              match' <- if (not done)
                then doDemoting' match pn
                else return match
              return match'
           else return match

       --3. The demoted definition is a local decl in a pattern binding
       demoteInPat x@(pat@(GHC.L _ (GHC.ValD (GHC.PatBind _p (GHC.GRHSs _grhs _lb) _ _ _)))::GHC.LHsDecl GHC.RdrName) = do
         decls <- liftT $ hsDeclsPatBindD x
         nm <- getRefactNameMap
         if not $ emptyList (definingDeclsRdrNames nm [pn] decls False False)
           then do
              logm "MoveDef:demoteInPat" -- ++AZ++
              done <- getRefactDone
              pat' <- if (not done)
                then doDemoting' pat pn
                else return pat
              return pat'
           else return x
       demoteInPat x = return x

       --4: The demoted definition is a local decl in a Let expression
       demoteInLet x@(letExp@(GHC.L _ (GHC.HsLet _ds _e))::GHC.LHsExpr GHC.RdrName) = do
         decls <- liftT $ hsDecls x
         nm <- getRefactNameMap
         if not $ emptyList (definingDeclsRdrNames nm [pn] decls False False)
           then do
              logm "MoveDef:demoteInLet" -- ++AZ++
              done <- getRefactDone
              letExp' <- if (not done)
                 then doDemoting' letExp pn
                 else return letExp
              return letExp'
           else return x
       demoteInLet x = return x


       --6.The demoted definition is a local decl in a Let statement.
       -- demoteInStmt (letStmt@(HsLetStmt ds stmts):: (HsStmt (HsExpP) (HsPatP) [HsDeclP]))
       demoteInStmt (letStmt@(GHC.L _ (GHC.LetStmt _binds))::GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do
         decls <- liftT $ hsDecls letStmt
         nm <- getRefactNameMap
         if not $ emptyList (definingDeclsRdrNames nm [pn] decls False False)
           then do
              logm "MoveDef:demoteInStmt" -- ++AZ++
              done <- getRefactDone
              letStmt' <- if (not done)
                then doDemoting' letStmt pn
                else return letStmt
              return letStmt'
           else return letStmt
       demoteInStmt x = return x



-- |Demote the declaration of 'pn' in the context of 't'.
doDemoting' :: (UsedByRhs t) => t -> GHC.Name -> RefactGhc t
doDemoting' t pn = do
   nm <- getRefactNameMap
   -- origDecls <- liftT $ hsDecls t
   origDecls <- liftT $ hsDeclsGeneric t
   let
       demotedDecls'= definingDeclsRdrNames nm [pn] origDecls True False
       declaredPns = nub $ concatMap (definedNamesRdr nm) demotedDecls'
       pnsUsed = usedByRhsRdr nm t declaredPns
   logm $ "doDemoting':(pn,declaredPns)=" ++ showGhc (pn,declaredPns)
   -- logm $ "doDemoting':t=" ++ (SYB.showData SYB.Renamer 0 t)
   logm $ "doDemoting':(declaredPns,pnsUsed)=" ++ showGhc (declaredPns,pnsUsed)
   r <-  if not pnsUsed -- (usedByRhs t declaredPns)
       then do
              logm $ "doDemoting' no pnsUsed"
              -- dt <- liftT $ hsDecls t
              let dt = origDecls
              let demotedDecls = definingDeclsRdrNames nm [pn] dt True True
                  otherBinds = (deleteFirstsBy (sameBindRdr nm) dt demotedDecls)
                      {- From 'hsDecls t' to 'hsDecls t \\ demotedDecls'.
                         Bug fixed 06/09/2004 to handle direct recursive function.
                       -}
                  xx = map (\b -> (b,uses nm declaredPns [b])) otherBinds
                  useCount = sum $ concatMap snd xx
              logm $ "doDemoting': declaredPns=" ++ (showGhc declaredPns)
              logm $ "doDemoting': uses xx=" ++ (showGhc xx)
              logm $ "doDemoting': uses useCount=" ++ (show useCount)

              case useCount  of
                  0 ->do error "\n Nowhere to demote this function!\n"
                  1 -> --This function is only used by one friend function
                      do
                         logm "MoveDef.doDemoting':target location found" -- ++AZ++

                         let (FN f,_d) = hsFreeAndDeclaredRdr nm demotedDecls
                         (ds,removedDecl,_sigRemoved) <- rmDecl pn False t
                         (t',demotedSigs)             <- rmTypeSigs declaredPns ds

                         logDataWithAnns "MoveDef.doDemoting':after rmTypeSigs:demotedSigs=" demotedSigs

                         logm $ "MoveDef:declaredPns=" ++ (showGhc declaredPns) -- ++AZ++

                         dl <- mapM (flip (declaredNamesInTargetPlace nm) ds) declaredPns
                         logm $ "mapM declaredNamesInTargetPlace done"
                         --make sure free variable in 'f' do not clash with variables in 'dl',
                         --otherwise do renaming.
                         let clashedNames=filter (\x-> elem (id x) (map id f)) $ (nub.concat) dl
                         --rename clashed names to new names created automatically,update TOKEN STREAM as well.
                         if clashedNames/=[]
                            then error ("The identifier(s):" ++ showGhc clashedNames ++
                                       ", declared in where the definition will be demoted to, will cause name clash/capture"
                                       ++" after demoting, please do renaming first!")
                            else  --duplicate demoted declarations to the right place.
                                 do
                                    duplicateDecls declaredPns removedDecl demotedSigs t'
                  _ ->error "\nThis function/pattern binding is used by more than one friend bindings\n"

       else error "This function can not be demoted as it is used in current level!\n"

   return r

    where
          ---find how many matches/pattern bindings use  'pn'-------
          uses :: NameMap -> [GHC.Name] -> [GHC.LHsDecl GHC.RdrName] -> [Int]
          uses nm pns t2
               = concatMap used t2
                where

                  used :: GHC.LHsDecl GHC.RdrName -> [Int]
#if __GLASGOW_HASKELL__ <= 710
                  used (GHC.L _ (GHC.ValD (GHC.FunBind _n _ (GHC.MG matches _ _ _) _ _ _)))
#else
                  used (GHC.L _ (GHC.ValD (GHC.FunBind _n (GHC.MG (GHC.L _ matches) _ _ _) _ _ _)))
#endif
                     = concatMap (usedInMatch pns) matches

                  used (GHC.L _ (GHC.ValD (GHC.PatBind pat rhs _ _ _)))
                    | (not $ findNamesRdr nm pns pat) && findNamesRdr nm pns rhs
                    = [1::Int]
                  used  _ = []

                  usedInMatch pns' (GHC.L _ (GHC.Match _ pats _ rhs))
                    | (not $ findNamesRdr nm pns' pats) && findNamesRdr nm pns' rhs
                     = [1::Int]
                  usedInMatch _ _ = []


          duplicateDecls :: (SYB.Data t,SYB.Typeable t)
                         => [GHC.Name] -- ^ function names to be demoted
                         -> GHC.LHsDecl GHC.RdrName   -- ^Bind being demoted
                         -> [GHC.LSig GHC.RdrName]    -- ^Signatures being demoted, if any
                         -> t
                         -> RefactGhc t
          duplicateDecls pns demoted dsig o = do
            logm $ "duplicateDecls:t=" ++ SYB.showData SYB.Parser 0 o
            hasDeclsSybTransform workerHsDecls workerBind o
            where
              workerHsDecls :: forall t. HasDecls t => t -> RefactGhc t
              workerHsDecls t' = do
                dds <- liftT $ hsDecls t'
                ds'' <- duplicateDecls' pns demoted dsig dds
                liftT $ replaceDecls t' ds''

              workerBind :: (GHC.LHsBind GHC.RdrName -> RefactGhc (GHC.LHsBind GHC.RdrName))
              workerBind t'@(GHC.L _ (GHC.PatBind{})) = do
                dds <- liftT $ hsDeclsPatBind t'
                ds'' <- duplicateDecls' pns demoted dsig dds
                liftT $ replaceDeclsPatBind t' ds''
              workerBind x = error $ "MoveDef.duplicateDecls.workerBind:unmatched LHsBind:" ++ showGhc x


          -- duplicate demotedDecls to the right place (the outer most level where it is used).
          duplicateDecls' :: [GHC.Name] -- ^ function names to be demoted
                          -> GHC.LHsDecl GHC.RdrName   -- ^Bind being demoted
                          -> [GHC.LSig GHC.RdrName]    -- ^Signatures being demoted, if any
                          -> [GHC.LHsDecl GHC.RdrName] -- ^Binds of original top
                                                       -- level entiity,
                                                       -- including src and dst
                          -> RefactGhc [GHC.LHsDecl GHC.RdrName]
          duplicateDecls' pns demoted dsig decls
             = do
                  nm <- getRefactNameMap
                  everywhereMStaged' SYB.Parser (SYB.mkM (dupInMatch nm) -- top-down approach
                                                `SYB.extM` (dupInPat nm)) decls
               where
                 dupInMatch nm (match@(GHC.L _ (GHC.Match _ pats _mt rhs)) :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
                   | (not $ findNamesRdr nm pns pats) && findNamesRdr nm pns rhs
                   =  do
                        done <- getRefactDone
                        logm $ "duplicateDecls.dupInMatch:value of done=" ++ (show done) -- ++AZ++
                        if done
                          then return match
                          else do
                            logm "duplicateDecls:setting done"  -- ++AZ++
                            setRefactDone
                            match' <- foldParams pns match decls demoted dsig
                            return match'
                 dupInMatch _ x = return x

                 dupInPat nm ((GHC.PatBind pat rhs@(GHC.GRHSs grhs lb) ty fvs ticks) :: GHC.HsBind GHC.RdrName)
                    | (not $ findNamesRdr nm pns pat) && findNamesRdr nm pns rhs
                   = do
                       logm $ "duplicateDecls.dupInPat"
                       let declsToLift = definingDeclsRdrNames' nm pns t
                       lb' <- moveDecl1 lb Nothing pns declsToLift pns []
                       return (GHC.PatBind pat (GHC.GRHSs grhs lb') ty fvs ticks)
                 dupInPat _ x = return x

                 -- demotedDecls = definingDecls pns decls True False
          ---------------------------------------------------------------------

          declaredNamesInTargetPlace :: (SYB.Data t)
                            => NameMap -> GHC.Name -> t
                            -> RefactGhc [GHC.Name]

          declaredNamesInTargetPlace nm pn' t' = do
             logm $ "declaredNamesInTargetPlace:pn=" ++ (showGhc pn')
             res <- applyTU (stop_tdTU (failTU
                                           `adhocTU` inMatch
                                           `adhocTU` inPat)) t'
             logm $ "declaredNamesInTargetPlace:res=" ++ (showGhc res)
             return res
               where
                 inMatch ((GHC.Match _ _pats _ rhs) :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))
                    | findNameInRdr nm pn' rhs = do
                     logm $ "declaredNamesInTargetPlace:inMatch"
                     -- fds <- hsFDsFromInside rhs
                     let (_,DN ds) = hsFDsFromInsideRdr nm rhs
                     return ds
                 inMatch _ = return mzero

                 inPat ((GHC.PatBind pat rhs _ _ _) :: GHC.HsBind GHC.RdrName)
                    |findNameInRdr nm pn' rhs = do
                     logm $ "declaredNamesInTargetPlace:inPat"
                     let (_,DN ds) = hsFDsFromInsideRdr nm pat
                     return ds
                 inPat _=  return mzero

-- ---------------------------------------------------------------------


{- foldParams:remove parameters in the demotedDecls if possible
   parameters: pn -- the function/pattern name to be demoted in PName format
               match--where the demotedDecls will be demoted to
               demotedDecls -- the declarations to be demoted.
   example:
    module Test where        demote 'sq'       module Test where
    sumSquares x y               ===>          sumSquares x y =(sq 0) + (sq y)
      = sq x 0+ sq x y                               where sq y=x ^ y
    sq x y=x^y
-}
--PROBLEM: TYPE SIGNATURE SHOULD BE CHANGED.
--- TEST THIS FUNCTION!!!
foldParams :: [GHC.Name]             -- ^The (list?) function name being demoted
           -> GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)     -- ^The RHS of the place to receive the demoted decls
           -> [GHC.LHsDecl GHC.RdrName] -- ^Binds of original top level entiity, including src and dst
           -> GHC.LHsDecl GHC.RdrName   -- ^The decls being demoted
           -> [GHC.LSig GHC.RdrName]    -- ^Signatures being demoted, if any
           -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))
foldParams pns match@(GHC.L l (GHC.Match _mfn _pats _mt rhs)) _decls demotedDecls dsig

     =do
         logm $ "MoveDef.foldParams entered"
         nm <- getRefactNameMap

         let matches = concatMap matchesInDecls [demotedDecls]
             pn = ghead "foldParams" pns    --pns /=[]
         logm $ "MoveDef.foldParams before allParams"
         params <- allParams pn rhs []
         logm $ "foldParams:params=" ++ showGhc params
         if (length.nub.map length) params==1                  -- have same number of param
             && ((length matches)==1)      -- only one 'match' in the demoted declaration
           then do
                   let patsInDemotedDecls=(patsInMatch.(ghead "foldParams")) matches
                       subst = mkSubst nm patsInDemotedDecls params
                       fstSubst = map fst subst
                       sndSubst = map snd subst

                   rhs' <- rmParamsInParent pn sndSubst rhs

                   let ls = map (hsFreeAndDeclaredRdr nm) sndSubst
                   let newNames = ((concatMap (fn . fst) ls)) \\ (fstSubst)
                   --There may be name clashing because of introducing new names.
                   clashedNames <- getClashedNames nm fstSubst newNames (ghead "foldParams" matches)

                   logm $ "MoveDef.foldParams about to foldInDemotedDecls"

                   demotedDecls''' <- foldInDemotedDecls pns clashedNames subst [demotedDecls]
                   logm $ "MoveDef.foldParams foldInDemotedDecls done"

                   let match' = GHC.L l ((GHC.unLoc match) {GHC.m_grhss = rhs' })
                   match'' <- addDecl match' Nothing (demotedDecls''',Nothing)
                   logm $ "MoveDef.foldParams addDecl done 1"
                   return match''
           else  do
                     logm $ "foldParams:no params"
                     let sigs = map wrapSig dsig
                     match' <- addDecl match Nothing (sigs++[demotedDecls],Nothing)
                     logm "MoveDef.foldParams addDecl done 2"
                     return match'

    where

       matchesInDecls :: GHC.LHsDecl GHC.RdrName -> [GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)]
#if __GLASGOW_HASKELL__ <= 710
       matchesInDecls (GHC.L _ (GHC.ValD (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _))) = matches
#else
       matchesInDecls (GHC.L _ (GHC.ValD (GHC.FunBind _ (GHC.MG (GHC.L _ matches) _ _ _) _ _ _))) = matches
#endif
       matchesInDecls _x = []

       patsInMatch (GHC.L _ (GHC.Match _ pats' _ _)) = pats'

       foldInDemotedDecls :: [GHC.Name]  -- ^The (list?) of names to be demoted
                          -> [GHC.Name]  -- ^Any names that clash
                          -> [(GHC.Name, GHC.HsExpr GHC.RdrName)] -- ^Parameter substitutions required
                          -> [GHC.LHsDecl GHC.RdrName] -- ^Binds of original top level entity, including src and dst
                          -> RefactGhc [GHC.LHsDecl GHC.RdrName]
       foldInDemotedDecls  pns' clashedNames subst decls = do
          logm $ "foldInDemotedDecls:(pns',clashedNames,subst)=" ++ showGhc (pns',clashedNames,subst)
          logm $ "foldInDemotedDecls:decls=" ++ SYB.showData SYB.Parser 0 decls
          nm <- getRefactNameMap
          SYB.everywhereMStaged SYB.Parser (SYB.mkM (worker nm) `SYB.extM` (workerBind nm)) decls
          where
#if __GLASGOW_HASKELL__ <= 710
          worker nm (match'@(GHC.L _ (GHC.FunBind ln _ (GHC.MG _matches _ _ _) _ _ _)) :: GHC.LHsBind GHC.RdrName)
#else
          worker nm (match'@(GHC.L _ (GHC.FunBind ln (GHC.MG _matches _ _ _) _ _ _)) :: GHC.LHsBind GHC.RdrName)
#endif
            = do
                logm $ "foldInDemotedDecls:rdrName2NamePure nm ln=" ++ show (rdrName2NamePure nm ln)
                if isJust (find (== rdrName2NamePure nm ln) pns')
                  then do
                    logm $ "foldInDemotedDecls:found match'"
                    match''  <- foldM (flip autoRenameLocalVar) match' clashedNames
                    match''' <- foldM replaceExpWithUpdToks match'' subst
                    rmParamsInDemotedDecls (map fst subst) match'''
                  else return match'
          worker _ x = return x

          workerBind nm ((GHC.L ll (GHC.ValD d)) :: GHC.LHsDecl GHC.RdrName)
            = do
                (GHC.L _ d') <- worker nm (GHC.L ll d)
                return (GHC.L ll (GHC.ValD d'))
          workerBind _ x = return x

      ------Get all of the paramaters supplied to pn ---------------------------
            {- eg. sumSquares x1 y1 x2 y2 = rt x1 y1 + rt x2 y2
                   rt x y = x+y
              demote 'rt' to 'sumSquares',
              'allParams pn rhs []'  returns [[x1,x2],[y1,y2]]
                where pn is 'rt' and  rhs is 'rt x1 y1 + rt x2 y2'
           -}

       allParams :: GHC.Name -> GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName)
                 -> [[GHC.HsExpr GHC.RdrName]]
                 -> RefactGhc [[GHC.HsExpr GHC.RdrName]]
       allParams pn rhs1 initial  -- pn: demoted function/pattern name.
        =do
            nm <- getRefactNameMap
            let p = getOneParam nm pn rhs1
            -- putStrLn (show p)
            logm $ "allParams:p=" ++ showGhc p
            if (nonEmptyList p)
              then do rhs' <- rmOneParam pn rhs1
                      logDataWithAnns "allParams:rhs'=" rhs'
                      allParams pn rhs' (initial++[p])
              else return initial
        where
           getOneParam :: (SYB.Data t) => NameMap -> GHC.Name -> t -> [GHC.HsExpr GHC.RdrName]
           getOneParam nm pn1
              = SYB.everythingStaged SYB.Renamer (++) []
                   ([] `SYB.mkQ`  worker)
              -- =applyTU (stop_tdTU (failTU `adhocTU` worker))
                where
                  worker :: GHC.HsExpr GHC.RdrName -> [GHC.HsExpr GHC.RdrName]
                  worker (GHC.HsApp e1 e2)
                   |(expToNameRdr nm e1 == Just pn1) = [GHC.unLoc e2]
                  worker _ = []

           rmOneParam :: (SYB.Data t) => GHC.Name -> t -> RefactGhc t
           rmOneParam pn1 t
              -- This genuinely needs to be done once only. Damn.
              -- =applyTP (stop_tdTP (failTP `adhocTP` worker))
             = do
                -- _ <- clearRefactDone
                nm <- getRefactNameMap
                everywhereMStaged' SYB.Parser (SYB.mkM (worker nm)) t
                where
                  worker nm (GHC.L _ (GHC.HsApp e1 _e2 )) -- The param being removed is e2
                    |expToNameRdr nm e1 == Just pn1 = return e1
                  worker _ x = return x
{-
              AST output

                 addthree x y z

              becomes

                  (HsApp
                    (L {test/testdata/Demote/WhereIn6.hs:10:17-28}
                     (HsApp
                      (L {test/testdata/Demote/WhereIn6.hs:10:17-26}
                       (HsApp
                        (L {test/testdata/Demote/WhereIn6.hs:10:17-24}
                         (HsVar {Name: WhereIn6.addthree}))
                        (L {test/testdata/Demote/WhereIn6.hs:10:26}
                         (HsVar {Name: x}))))
                      (L {test/testdata/Demote/WhereIn6.hs:10:28}
                       (HsVar {Name: y}))))
                    (L {test/testdata/Demote/WhereIn6.hs:10:30}
                     (HsVar {Name: z})))

-----
                  (HsApp
                     (HsApp
                       (HsApp
                         (HsVar {Name: WhereIn6.addthree}))
                         (HsVar {Name: x}))))
                       (HsVar {Name: y}))))
                     (HsVar {Name: z})))

-----

                  sq p x

               becomes

                  (HsApp
                   (HsApp
                     (HsVar {Name: Demote.WhereIn4.sq}))
                     (HsVar {Name: p}))))
                   (HsVar {Name: x})))

----
                  sq x

               becomes

                  (HsApp
                   (HsVar {Name: sq}))
                   (HsVar {Name: x})))
-}


       -----------remove parameters in demotedDecls-------------------------------
       rmParamsInDemotedDecls :: [GHC.Name] -> GHC.LHsBind GHC.RdrName
                              -> RefactGhc (GHC.LHsBind GHC.RdrName)
       rmParamsInDemotedDecls ps bind
         -- =applyTP (once_tdTP (failTP `adhocTP` worker))
         = SYB.everywhereMStaged SYB.Parser (SYB.mkM worker) bind
            where worker :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))
                  worker (GHC.Match mfn' pats2 typ rhs1)
                    = do
                         nm <- getRefactNameMap
                         let pats'=filter (\x->not ((patToNameRdr nm x /= Nothing) &&
                                          elem (gfromJust "rmParamsInDemotedDecls" $ patToNameRdr nm x) ps)) pats2
                         return (GHC.Match mfn' pats' typ rhs1)

       ----------remove parameters in the parent functions' rhs-------------------
       rmParamsInParent :: GHC.Name -> [GHC.HsExpr GHC.RdrName]
                        -> GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName)
                        -> RefactGhc (GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName))
       rmParamsInParent pn es grhss = do
         nm <- getRefactNameMap
         -- =applyTP (full_buTP (idTP `adhocTP` worker))
         SYB.everywhereMStaged SYB.Renamer (SYB.mkM (worker nm)) grhss
            where worker nm expr@(GHC.L _ (GHC.HsApp e1 e2))
                   | findNamesRdr nm [pn] e1 && (elem (showGhc (GHC.unLoc e2)) (map (showGhc) es))
                      = do
                       liftT $ transferEntryDPT expr e1
                       return e1
                  worker nm (expr@(GHC.L _ (GHC.HsPar e1)))
                    |Just pn==expToNameRdr nm e1
                       = do
                         liftT $ transferEntryDPT expr e1
                         return e1
                  worker _ x =return x


       getClashedNames :: NameMap -> [GHC.Name] -> [GHC.Name]
                       -> GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)
                       -> RefactGhc [GHC.Name]
       getClashedNames nm oldNames newNames match'
         = do  let (_f,DN d) = hsFDsFromInsideRdr nm match'
               ds'' <- mapM (flip (hsVisibleDsRdr nm) match') oldNames
               let ds' = map (\(DN ds) -> ds) ds''
               -- return clashed names
               return (filter (\x->elem ({- pNtoName -} x) newNames)  --Attention: nub
                                   ( nub (d `union` (nub.concat) ds')))

       ----- make Substitions between formal and actual parameters.-----------------
       mkSubst :: NameMap
               -> [GHC.LPat GHC.RdrName] -> [[GHC.HsExpr GHC.RdrName]]
               -> [(GHC.Name,GHC.HsExpr GHC.RdrName)]
       mkSubst nm pats1 params
           = catMaybes (zipWith (\x y -> if (patToNameRdr nm x/=Nothing) && (length (nub $ map showGhc y)==1)
                                          then Just (gfromJust "mkSubst" $ patToNameRdr nm x,(ghead "mkSubst") y)
                                          else Nothing) pats1 params)


-- |substitute an old expression by new expression
replaceExpWithUpdToks :: GHC.LHsBind GHC.RdrName -> (GHC.Name, GHC.HsExpr GHC.RdrName)
                      -> RefactGhc (GHC.LHsBind GHC.RdrName)
replaceExpWithUpdToks  decls subst = do
  nm <- getRefactNameMap
  let
    worker (e@(GHC.L l _)::GHC.LHsExpr GHC.RdrName)
      |(expToNameRdr nm e) == Just (fst subst)
          = return (GHC.L l (snd subst))
    worker x=return x

  -- = applyTP (full_buTP (idTP `adhocTP` worker)) decls
  everywhereMStaged' SYB.Parser (SYB.mkM worker) decls

-- | return True if pn is a local function/pattern name
isLocalFunOrPatName :: SYB.Data t => NameMap -> GHC.Name -> t -> Bool
isLocalFunOrPatName nm pn scope
 = isLocalPN pn && isFunOrPatName nm pn scope

-- EOF