ContentsIndex
RefacUtils
Contents
Program Analysis
Imports and exports
Variable analysis
Property checking
Identifiers, expressions, patterns and declarations
Modules and files
Locations
Program transformation
Declarations
Imports and exports
Updating, swapping and deleting entities
Renaming Identifiers
Adding/removing parameters
Miscellous
Parsing, writing and showing
Locations
Default values
Others
Description

This module contains a collection of program analysis and transformation functions(the API). In general, a program analysis function returns some information about the program, but does NOT modify the program; whereas a program transformation function transforms the program from one state to another state. This API is built on top of Programatica's abstract syntax for Haskell and Strafunski's traversal API for large abstract syntax trees, and is used extensively in the implementation of primitive refactorings. In HaRe, in order to preserve the comments and layout of refactored programs, a refactoring modifies not only the AST but also the token stream, and the program source after the refactoring is extracted from the token stream rather than the AST, for the comments and layout information is kept in the token steam instead of the AST. As a consequence, a program transformation function from this API modifies both the AST and the token stream (unless explicitly stated). So when you build your own program transformations, try to use the API to do the transformation, as this can liberate you from caring about the token stream.

As the API is based on Programatica's abstract syntax for Haskell, we have re-exported those related module from Programatica, so that you can browse the datatypes for the abstract syntax. Alternatively, you can go to Programatica's webpage at: http://www.cse.ogi.edu/~hallgren/Programatica/. For Strafunski, you can find it at: http://www.cs.vu.nl/Strafunski/.

This API is still in development. Any suggestions and comments are very much welcome.

Synopsis
module RefacTypeSyn
module PosSyntax
module SourceNames
module UniqueNames
module PNT
module Ents
module QualNames
module TypedIds
inScopeInfo :: InScopes -> [(String, NameSpace, ModuleName, Maybe ModuleName)]
isInScopeAndUnqualified :: String -> InScopes -> Bool
hsQualifier :: PNT -> InScopes -> [ModuleName]
exportInfo :: Exports -> [(String, NameSpace, ModuleName)]
isExported :: PNT -> Exports -> Bool
isExplictlyExported :: PName -> HsModuleP -> Bool
modIsExported :: HsModuleP -> Bool
hsPNs :: Term t => t -> [PName]
hsPNTs :: Term t => t -> [PNT]
hsDataConstrs :: Term t => ModuleName -> t -> ([PName], [PName])
hsTypeConstrsAndClasses :: Term t => ModuleName -> t -> ([PName], [PName])
hsTypeVbls :: Term t => t -> ([PName], [PName])
hsClassMembers :: Term t => String -> ModuleName -> t -> ([PName], [PName])
class Term t => HsDecls t where
hsDecls :: t -> [HsDeclI PNT]
replaceDecls :: t -> [HsDeclI PNT] -> t
isDeclaredIn :: PName -> t -> Bool
hsFreeAndDeclaredPNs :: (Term t, MonadPlus m) => t -> m ([PName], [PName])
hsFreeAndDeclaredNames :: (Term t, MonadPlus m) => t -> m ([String], [String])
hsVisiblePNs :: (Term t1, Term t2, FindEntity t1, MonadPlus m) => t1 -> t2 -> m [PName]
hsVisibleNames :: (Term t1, Term t2, FindEntity t1, MonadPlus m) => t1 -> t2 -> m [String]
hsFDsFromInside :: (Term t, MonadPlus m) => t -> m ([PName], [PName])
hsFDNamesFromInside :: (Term t, MonadPlus m) => t -> m ([String], [String])
isVarId :: String -> Bool
isConId :: String -> Bool
isOperator :: String -> Bool
isTopLevelPN :: PName -> Bool
isLocalPN :: PName -> Bool
isTopLevelPNT :: PNT -> Bool
isQualifiedPN :: PName -> Bool
isFunName :: Term t => PName -> t -> Bool
isPatName :: Term t => PName -> t -> Bool
isFunOrPatName :: Term t => PName -> t -> Bool
isTypeCon :: PNT -> Bool
isTypeSig :: HsDeclP -> Bool
isFunBind :: HsDeclP -> Bool
isPatBind :: HsDeclP -> Bool
isSimplePatBind :: HsDeclP -> Bool
isComplexPatBind :: HsDeclP -> Bool
isFunOrPatBind :: HsDeclP -> Bool
isClassDecl :: HsDeclP -> Bool
isInstDecl :: HsDeclP -> Bool
isDirectRecursiveDef :: HsDeclP -> Bool
usedWithoutQual :: Term t => String -> t -> Bool
canBeQualified :: Term t => PNT -> t -> Bool
hasFreeVars :: Term t => t -> Bool
isUsedInRhs :: Term t => PNT -> t -> Bool
findPNT :: Term t => PNT -> t -> Bool
findPN :: Term t => PName -> t -> Bool
findPNs :: Term t => [PName] -> t -> Bool
findEntity :: (FindEntity a, Term b) => a -> b -> Bool
sameOccurrence :: (Term t, Eq t) => t -> t -> Bool
defines :: PName -> HsDeclP -> Bool
definesTypeSig :: PName -> HsDeclP -> Bool
class Term t => HasModName t where
hasModName :: t -> Maybe ModuleName
class HasNameSpace t where
hasNameSpace :: t -> NameSpace
pNTtoPN :: PNT -> PName
pNTtoName :: PNT -> String
pNtoName :: PName -> String
nameToPNT :: String -> PNT
nameToPN :: String -> PName
pNtoPNT :: PName -> IdTy PId -> PNT
expToPNT :: HsExpP -> PNT
expToPN :: HsExpP -> PName
nameToExp :: String -> HsExpP
pNtoExp :: PName -> HsExpP
patToPNT :: HsPatP -> PNT
patToPN :: HsPatP -> PName
nameToPat :: String -> HsPatP
pNtoPat :: PName -> HsPatP
definingDecls :: [PName] -> [HsDeclP] -> Bool -> Bool -> [HsDeclP]
definedPNs :: HsDeclP -> [PName]
clientModsAndFiles :: (...) => ModuleName -> PFE0MT n i ds ext m [(ModuleName, String)]
serverModsAndFiles :: (...) => ModuleName -> PFE0MT n i ds ext m [(ModuleName, String)]
isAnExistingMod :: (...) => ModuleName -> PFE0MT n i ds ext m Bool
fileNameToModName :: (...) => String -> PFE0MT n i ds ext m ModuleName
strToModName :: String -> ModuleName
modNameToStr :: ModuleName -> String
defineLoc :: PNT -> SrcLoc
useLoc :: PNT -> SrcLoc
locToPNT :: Term t => String -> Int -> Int -> t -> PNT
locToPN :: Term t => String -> Int -> Int -> t -> PName
locToExp :: Term t => SimpPos -> SimpPos -> [PosToken] -> t -> HsExpP
getStartEndLoc :: (Term t, StartEndLoc t, Printable t) => [PosToken] -> t -> (SimpPos, SimpPos)
addImportDecl :: MonadState (([PosToken], Bool), t1) m => HsModuleP -> HsImportDeclP -> m HsModuleP
addDecl :: (...) => t -> Maybe PName -> ([HsDeclP], Maybe [PosToken]) -> Bool -> m t
duplicateDecl :: MonadState (([PosToken], Bool), t1) m => [HsDeclP] -> PName -> String -> m [HsDeclP]
rmDecl :: MonadState (([PosToken], Bool), t1) m => PName -> Bool -> [HsDeclP] -> m [HsDeclP]
rmTypeSig :: MonadState (([PosToken], Bool), t1) m => PName -> [HsDeclP] -> m [HsDeclP]
commentOutTypeSig :: MonadState (([PosToken], Bool), t1) m => PName -> [HsDeclP] -> m [HsDeclP]
moveDecl :: (...) => [PName] -> t -> Bool -> [HsDeclP] -> Bool -> m [HsDeclP]
addGuardsToRhs :: MonadState (([PosToken], Bool), t1) m => RhsP -> HsExpP -> m RhsP
simplifyDecl :: Monad m => HsDeclP -> m HsDeclP
addItemsToImport :: (...) => ModuleName -> Maybe PName -> Either [String] [EntSpecP] -> t -> m t
addHiding :: MonadState (([PosToken], Bool), t1) m => ModuleName -> HsModuleP -> [PName] -> m HsModuleP
rmItemsFromImport :: (...) => HsModuleP -> [PName] -> m HsModuleP
addItemsToExport :: (...) => HsModuleP -> Maybe PName -> Bool -> Either [String] [HsExportEntP] -> m HsModuleP
rmItemsFromExport :: (...) => HsModuleP -> Either ([ModuleName], [PName]) [HsExportEntP] -> m HsModuleP
rmSubEntsFromExport :: MonadState (([PosToken], Bool), t1) m => PName -> HsModuleP -> m HsModuleP
class (Term t, Term t1) => Update t t1 where
update :: (MonadPlus m, MonadState (([PosToken], Bool), t2) m) => t -> t -> t1 -> m t1
class (Term t, Term t1) => Swap t t1 where
swap :: MonadState (([PosToken], Bool), t2) m => t -> t -> t1 -> m t1
class (Term t, Term t1) => Delete t t1 where
delete :: (MonadPlus m, MonadState (([PosToken], Bool), t2) m) => t -> t1 -> m t1
qualifyPName :: ModuleName -> PName -> PName
rmQualifier :: (MonadState (([PosToken], Bool), t1) m, Term t) => [PName] -> t -> m t
renamePN :: (...) => PName -> Maybe ModuleName -> String -> Bool -> t -> m t
replaceNameInPN :: Maybe ModuleName -> PName -> String -> PName
autoRenameLocalVar :: (MonadPlus m, Term t) => Bool -> PName -> t -> m t
addParamsToDecls :: (...) => [HsDeclP] -> PName -> [PName] -> Bool -> m [HsDeclP]
rmParams :: (MonadPlus m, MonadState (([PosToken], Bool), t1) m) => PNT -> Int -> HsExpP -> m HsExpP
parseSourceFile :: (...) => FilePath -> m (InScopes, Exports, HsModuleP, [PosToken])
showEntities :: (Eq t, Term t) => (t -> String) -> [t] -> String
showPNwithLoc :: PName -> String
toRelativeLocs :: Term t => t -> t
rmLocs :: Term t => t -> t
defaultPN :: PName
defaultPNT :: PNT
defaultModName :: ModuleName
defaultExp :: HsExpP
defaultPat :: HsPatP
mkNewName :: String -> [String] -> Int -> String
Documentation
module RefacTypeSyn
module PosSyntax
module SourceNames
module UniqueNames
module PNT
module Ents
module QualNames
module TypedIds
Program Analysis
Imports and exports
inScopeInfo
:: InScopesThe inscope relation .
-> [(String, NameSpace, ModuleName, Maybe ModuleName)]The result
Process the inscope relation returned from the parsing and module analysis pass, and return a list of four-element tuples. Each tuple contains an identifier name, the identifier's namespace info, the identifier's defining module name and its qualifier name. The same identifier may have multiple entries in the result because it may have different qualifiers. This makes it easier to decide whether the identifier can be used unqualifiedly by just checking whether there is an entry for it with the qualifier field being Nothing.
isInScopeAndUnqualified
:: StringThe identifier name.
-> InScopesThe inscope relation
-> BoolThe result.
Return True if the identifier is inscope and can be used without a qualifier.
hsQualifier
:: PNTThe identifier.
-> InScopesThe in-scope relation.
-> [ModuleName]The result.
Return all the possible qualifiers for the identifier. The identifier is not inscope if the result is an empty list.
exportInfo
:: ExportsThe export relation.
-> [(String, NameSpace, ModuleName)]The result
Process the export relation returned from the parsing and module analysis pass, and return a list of trhee-element tuples. Each tuple contains an identifier name, the identifier's namespace info, and the identifier's define module.
isExported
:: PNTThe identifier.
-> ExportsThe export relation.
-> BoolThe result.
Return True if the identifier is exported either implicitly or explicitly.
isExplictlyExported
:: PNameThe identifier
-> HsModulePThe AST of the module
-> BoolThe result
Return True if an identifier is explicitly exported by the module.
modIsExported
:: HsModulePThe AST of the module
-> BoolThe result
Return True if the current module is exported either by default or by specifying the module name in the export.
Variable analysis
hsPNs :: Term t => t -> [PName]
Collect the identifiers (in PName format) in a given syntax phrase.
hsPNTs :: Term t => t -> [PNT]
Collect the identifiers (in PNT format) in a given syntax phrase.
hsDataConstrs
:: Term t
=> ModuleNameThe name of the module which t belongs to.
-> tThe given syntax phrase.
-> ([PName], [PName])The result.
Collect those data constructors that occur in the given syntax phrase, say t. In the result, the first list contains the data constructors that are declared in other modules, and the second list contains the data constructors that are declared in the current module.
hsTypeConstrsAndClasses
:: Term t
=> ModuleNameThe name of the module which t belongs to.
-> tThe given syntax phrase.
-> ([PName], [PName])The result.
Collect those type constructors and class names that occur in the given syntax phrase, say t. In the result, the first list contains the type constructor/classes which are declared in other modules, and the second list contains those type constructor/classes that are declared in the current module.
hsTypeVbls :: Term t => t -> ([PName], [PName])
Collect those type variables that are declared in a given syntax phrase t. In the returned result, the first list is always be empty.
hsClassMembers
:: Term t
=> StringThe class name.
-> ModuleNameThe module name.
-> tThe syntax phrase.
-> ([PName], [PName])The result.
Collect the class instances of the spcified class from the given syntax phrase. In the result, the first list contains those class instances which are declared in other modules, and the second list contains those class instances that are declared in the current module.
class Term t => HsDecls t where
The HsDecls class
Methods
hsDecls :: t -> [HsDeclI PNT]
Return the declarations that are directly enclosed in the given syntax phrase.
replaceDecls :: t -> [HsDeclI PNT] -> t
Replace the directly enclosed declaration list by the given declaration list. Note: This function does not modify the token stream.
isDeclaredIn :: PName -> t -> Bool
Return True if the specified identifier is declared in the given syntax phrase.
Instances
HsDecls HsMatchP
HsDecls HsDeclP
HsDecls [HsDeclP]
HsDecls HsModuleP
HsDecls RhsP
HsDecls HsExpP
HsDecls HsStmtP
HsDecls HsAltP
hsFreeAndDeclaredPNs :: (Term t, MonadPlus m) => t -> m ([PName], [PName])
Collect the free and declared variables (in the PName format) in a given syntax phrase t. In the result, the first list contains the free variables, and the second list contains the declared variables.
hsFreeAndDeclaredNames :: (Term t, MonadPlus m) => t -> m ([String], [String])
The same as hsFreeAndDeclaredPNs except that the returned variables are in the String format.
hsVisiblePNs :: (Term t1, Term t2, FindEntity t1, MonadPlus m) => t1 -> t2 -> m [PName]
Given syntax phrases e and t, if e occurs in t, then return those vairables which are declared in t and accessible to e, otherwise return [].
hsVisibleNames :: (Term t1, Term t2, FindEntity t1, MonadPlus m) => t1 -> t2 -> m [String]
Same as hsVisiblePNs except that the returned identifiers are in String format.
hsFDsFromInside :: (Term t, MonadPlus m) => t -> m ([PName], [PName])
hsFDsFromInside is different from hsFreeAndDeclaredPNs in that: given an syntax phrase t, hsFDsFromInside returns not only the declared variables that are visible from outside of t, but also those declared variables that are visible to the main expression inside t.
hsFDNamesFromInside :: (Term t, MonadPlus m) => t -> m ([String], [String])
The same as hsFDsFromInside except that the returned variables are in the String format.
Property checking
isVarId :: String -> Bool
Return True if a string is a lexically valid variable name.
isConId :: String -> Bool
Return True if a string is a lexically valid constructor name.
isOperator :: String -> Bool
Return True if a string is a lexically valid operator name.
isTopLevelPN :: PName -> Bool
Return True if a PName is a toplevel PName.
isLocalPN :: PName -> Bool
Return True if a PName is a local PName.
isTopLevelPNT :: PNT -> Bool
Return True if an PNT is a toplevel PNT.
isQualifiedPN :: PName -> Bool
Return True if a PName is a qualified PName.
isFunName :: Term t => PName -> t -> Bool
Return True if a PName is a function name defined in t.
isPatName :: Term t => PName -> t -> Bool
Return True if a PName is a pattern name defined in t.
isFunOrPatName :: Term t => PName -> t -> Bool
Return True if a PName is a function/pattern name defined in t.
isTypeCon :: PNT -> Bool
Return True if a PNT is a type constructor.
isTypeSig :: HsDeclP -> Bool
Return True if a declaration is a type signature declaration.
isFunBind :: HsDeclP -> Bool
Return True if a declaration is a function definition.
isPatBind :: HsDeclP -> Bool
Returns True if a declaration is a pattern binding.
isSimplePatBind :: HsDeclP -> Bool
Return True if a declaration is a pattern binding which only defines a variable value.
isComplexPatBind :: HsDeclP -> Bool
Return True if a declaration is a pattern binding but not a simple one.
isFunOrPatBind :: HsDeclP -> Bool
Return True if a declaration is a function/pattern definition.
isClassDecl :: HsDeclP -> Bool
Return True if a declaration is a Class declaration.
isInstDecl :: HsDeclP -> Bool
Return True if a declaration is a Class instance declaration.
isDirectRecursiveDef :: HsDeclP -> Bool
Return True if a function is a directly recursive function.
usedWithoutQual :: Term t => String -> t -> Bool
Return True is the identifier is unqualifiedly used in the given syntax phrase.
canBeQualified :: Term t => PNT -> t -> Bool
Return True if the identifier can become qualified.
hasFreeVars :: Term t => t -> Bool
Return True if the given syntax phrase contains any free variables.
isUsedInRhs :: Term t => PNT -> t -> Bool
Return True if the identifier is used in the RHS if a function/pattern binding.
findPNT :: Term t => PNT -> t -> Bool
Return True if the identifier(in PNT format) occurs in the given syntax phrase.
findPN :: Term t => PName -> t -> Bool
Return True if the identifier (in PName format) occurs in the given syntax phrase.
findPNs :: Term t => [PName] -> t -> Bool
Return True if any of the specified PNames ocuur in the given syntax phrase.
findEntity :: (FindEntity a, Term b) => a -> b -> Bool
Returns True is a syntax phrase, say a, is part of another syntax phrase, say b.
sameOccurrence :: (Term t, Eq t) => t -> t -> Bool
Return True if syntax phrases t1 and t2 refer to the same one.
defines :: PName -> HsDeclP -> Bool
Return True if the function/pattern binding defines the specified identifier.
definesTypeSig :: PName -> HsDeclP -> Bool
Return True if the declaration defines the type signature of the specified identifier.
class Term t => HasModName t where
Methods
hasModName :: t -> Maybe ModuleName
Fetch the module name from an identifier.
Instances
HasModName PNT
HasModName PName
class HasNameSpace t where
The HasNameSpace class.
Methods
hasNameSpace :: t -> NameSpace
Instances
HasNameSpace PNT
HasNameSpace ENT
Identifiers, expressions, patterns and declarations
pNTtoPN :: PNT -> PName
From PNT to PName.
pNTtoName :: PNT -> String
From PNT to Name. This function ingnores the qualifier.
pNtoName :: PName -> String
From PName to Name. This function ignores the qualifier.
nameToPNT :: String -> PNT
Compose a PNT form a String.
nameToPN :: String -> PName
Compose a PName from String.
pNtoPNT :: PName -> IdTy PId -> PNT
Compose a PNT from a PName and the PName's name space Information
expToPNT :: HsExpP -> PNT
If an expression consists of only one identifier then return this identifier in the PNT format, otherwise return the default PNT.
expToPN :: HsExpP -> PName
If an expression consists of only one identifier then return this identifier in the PName format, otherwise returns the default PName.
nameToExp :: String -> HsExpP
Compose an expression from a String.
pNtoExp :: PName -> HsExpP
Compose an expression from a pName.
patToPNT :: HsPatP -> PNT
If a pattern consists of only one identifier then return this identifier in the PNT format, otherwise returns the default PNT.
patToPN :: HsPatP -> PName
If a pattern consists of only one identifier then returns this identifier in the PName format, otherwise returns the default PName.
nameToPat :: String -> HsPatP
Compose a pattern from a String.
pNtoPat :: PName -> HsPatP
Compose a pattern from a pName.
definingDecls
:: [PName]The specified identifiers.
-> [HsDeclP]A collection of declarations.
-> BoolTrue means to include the type signature.
-> BoolTrue means to look at the local declarations as well.
-> [HsDeclP]The result.
Find those declarations(function/pattern binding and type signature) which define the specified PNames. incTypeSig indicates whether the corresponding type signature will be included.
definedPNs :: HsDeclP -> [PName]
Return the list of identifiers (in PName format) defined by a function/pattern binding.
Modules and files
clientModsAndFiles :: (...) => ModuleName -> PFE0MT n i ds ext m [(ModuleName, String)]
Return the client module and file names. The client modules of module, say m, are those modules which import m directly or indirectly.
serverModsAndFiles :: (...) => ModuleName -> PFE0MT n i ds ext m [(ModuleName, String)]
Return the server module and file names. The server modules of module, say m, are those modules which are directly or indirectly imported by module m.
isAnExistingMod :: (...) => ModuleName -> PFE0MT n i ds ext m Bool
Return True if the given module name exists in the project.
fileNameToModName :: (...) => String -> PFE0MT n i ds ext m ModuleName
From file name to module name.
strToModName :: String -> ModuleName
Compose ModuleName from String.
modNameToStr :: ModuleName -> String
From ModuleName to string.
Locations
defineLoc :: PNT -> SrcLoc
Return the identifier's defining location.
useLoc :: PNT -> SrcLoc
Return the identifier's source location.
locToPNT
:: Term t
=> StringThe file name
-> IntThe row number
-> IntThe column number
-> tThe syntax phrase
-> PNTThe result
Find the identifier(in PNT format) whose start position is (row,col) in the file specified by the fileName, and returns defaultPNT is such an identifier does not exist.
locToPN :: Term t => String -> Int -> Int -> t -> PName
The same as locToPNT, except that it returns the identifier in the PName format.
locToExp
:: Term t
=> SimpPosThe start position.
-> SimpPosThe end position.
-> [PosToken]The token stream which should at least contain the tokens for t.
-> tThe syntax phrase.
-> HsExpPThe result.
Given the syntax phrase (and the token stream), find the largest-leftmost expression contained in the region specified by the start and end position. If no expression can be found, then return the defaultExp.
getStartEndLoc :: (Term t, StartEndLoc t, Printable t) => [PosToken] -> t -> (SimpPos, SimpPos)
Return the start and end position of a given syntax phrase in the program source.
Program transformation
Declarations
addImportDecl
:: MonadState (([PosToken], Bool), t1) m
=> HsModulePThe module AST
-> HsImportDeclPThe import declaration to be added
-> m HsModulePThe result
Append an import declaration to the end of the imports in the module.
addDecl
:: (...)
=> tThe AST.
-> Maybe PNameIf this is Just, then the declaration will be added right after this identifier's definition.
-> ([HsDeclP], Maybe [PosToken])The declaration to be added, in both AST and Token stream format (optional).
-> BoolTrue means the declaration is a toplevel declaration.
-> m t
Adding a declaration to the declaration list of the given syntax phrase(so far only adding function/pattern binding has been tested). If the second argument is Nothing, then the declaration will be added to the beginning of the declaration list, but after the data type declarations is there is any.
duplicateDecl
:: MonadState (([PosToken], Bool), t1) m
=> [HsDeclP]The declaration list
-> PNameThe identifier whose definition is going to be duplicated
-> StringThe new name
-> m [HsDeclP]The result
Duplicate a functon/pattern binding declaration under a new name right after the original one.
rmDecl
:: MonadState (([PosToken], Bool), t1) m
=> PNameThe identifier whose definition is to be removed.
-> BoolTrue means including the type signature.
-> [HsDeclP]The declaration list.
-> m [HsDeclP]The result.
Remove the declaration (and the type signature is the second parameter is True) that defines the given identifier from the declaration list.
rmTypeSig
:: MonadState (([PosToken], Bool), t1) m
=> PNameThe identifier whose type signature is to be removed.
-> [HsDeclP]The declaration list
-> m [HsDeclP]The result
Remove the type signature that defines the given identifier's type from the declaration list.
commentOutTypeSig
:: MonadState (([PosToken], Bool), t1) m
=> PNameThe identifier.
-> [HsDeclP]The deckaration list.
-> m [HsDeclP]The result.
Comment out the type signature that defines pn's type in the token stream and remove it from the AST.
moveDecl
:: (...)
=> [PName]The identifier(s) whose defining declaration is to be moved. List is used to handle pattern bindings where multiple identifiers are defined.
-> tThe syntax phrase where the declaration is going to be moved to.
-> BoolTrue mean the function/pattern binding being moved is going to be at the same level with t. Otherwise it will be a local declaration of t.
-> [HsDeclP]The declaration list where the definition/pattern binding originally exists.
-> BoolTrue means the type signature will not be discarded.
-> m [HsDeclP]The result.
Move a function/pattern binding from one declaration list to another. This function doesnt' do any semantic analysis, so it is the user's responsibity to make sure the moving is legal.
addGuardsToRhs
:: MonadState (([PosToken], Bool), t1) m
=> RhsPThe RHS of the declaration.
-> HsExpPThe guard expression to be added.
-> m RhsPThe result.
Add a guard expression to the RHS of a function/pattern definition. If a guard already exists in the RHS, the new guard will be added to the beginning of the existing one.
simplifyDecl :: Monad m => HsDeclP -> m HsDeclP
If a function/pattern binding then convert it into a simple binding using case and/or if-then-else expressions. A simple function/pattern binding should satisfy: a) all the paraneters are simple variables; b). only has one equation; c). the RHS does not have guards. This function DOES NOT modify the token stream not AST.
Imports and exports
addItemsToImport
:: (...)
=> ModuleNameThe imported module name.
-> Maybe PNameThe condition identifier.
-> Either [String] [EntSpecP]The identifiers to add in either String or EntSpecP format.
-> tThe given syntax phrase.
-> m tThe result.
Add identifiers (given by the third argument) to the explicit entity list in the declaration importing the specified module name. The second argument serves as a condition: if it is like : Just p, then do the adding the if only p occurs in the entity list; if it is Nothing, then do the adding as normal. This function does nothing if the import declaration does not have an explicit entity list.
addHiding
:: MonadState (([PosToken], Bool), t1) m
=> ModuleNameThe imported module name
-> HsModulePThe current module
-> [PName]The items to be added
-> m HsModulePThe result
add items to the hiding list of an import declaration which imports the specified module.
rmItemsFromImport
:: (...)
=> HsModulePThe module AST
-> [PName]The items to be removed
-> m HsModulePThe result
Remove those specified items from the entity list in the import declaration.
addItemsToExport :: (...) => HsModuleP -> Maybe PName -> Bool -> Either [String] [HsExportEntP] -> m HsModuleP
Add identifiers to the export list of a module. If the second argument is like: Just p, then do the adding only if p occurs in the export list, and the new identifiers are added right after p in the export list. Otherwise the new identifiers are add to the beginning of the export list. In the case that the export list is emport, then if the third argument is True, then create an explict export list to contain only the new identifiers, otherwise do nothing.
rmItemsFromExport
:: (...)
=> HsModulePThe module AST.
-> Either ([ModuleName], [PName]) [HsExportEntP]The entities to remove.
-> m HsModulePThe result.
Remove the specified entities from the module's exports. The entities can be specified in either of two formats: i.e. either specify the module names and identifier names to be removed, so just given the exact AST for these entities.
rmSubEntsFromExport
:: MonadState (([PosToken], Bool), t1) m
=> PNameThe type constructor or class name
-> HsModulePThe module AST
-> m HsModulePThe result
Remove the sub entities of a type constructor or class from the export list.
Updating, swapping and deleting entities
class (Term t, Term t1) => Update t t1 where
The Update class,
Methods
update
:: (MonadPlus m, MonadState (([PosToken], Bool), t2) m)
=> tThe syntax phrase to be updated.
-> tThe new syntax phrase.
-> t1The contex where the old syntex phrase occurs.
-> m t1The result.
Update the occurrence of one syntax phrase in a given scope by another syntax phrase of the same type.
Instances
Term t => Update HsExpP t
Term t => Update PNT t
Term t => Update HsMatchP t
Term t => Update HsPatP t
Term t => Update [HsPatP] t
Term t => Update [HsDeclP] t
Term t => Update HsDeclP t
Term t => Update HsImportDeclP t
Term t => Update HsExportEntP t
class (Term t, Term t1) => Swap t t1 where
The Swap Class. The instances may be not complete, tell us what you need so that we can add it.
Methods
swap
:: MonadState (([PosToken], Bool), t2) m
=> tThe first syntax phrase.
-> tThe second syntax phrase.
-> t1The context where the two syntax phrases occur.
-> m t1The result.
Swap the occurrences of two syntax phrases( of the same type) in a given scope.
Instances
Term t => Swap HsExpP t
Term t => Swap HsPatP t
Term t => Swap HsTypeP t
class (Term t, Term t1) => Delete t t1 where
The Delete class.
Methods
delete
:: (MonadPlus m, MonadState (([PosToken], Bool), t2) m)
=> tThe syntax phrase to delete.
-> t1The contex where the syntax phrase occurs.
-> m t1The result.
Delete the occurrence of a syntax phrase in a given context.
Instances
Term t => Delete HsExpP t
Term t => Delete HsPatP t
Term t => Delete HsImportDeclP t
Renaming Identifiers
qualifyPName
:: ModuleNameThe qualifier.
-> PNameThe identifier.
-> PNameThe result.
Add a qualifier to an identifier if it is not qualified.
rmQualifier
:: (MonadState (([PosToken], Bool), t1) m, Term t)
=> [PName]The identifiers.
-> tThe syntax phrase.
-> m tThe result.
Remove the qualifier from the given identifiers in the given syntax phrase.
renamePN
:: (...)
=> PNameThe identifier to be renamed.
-> Maybe ModuleNameThe qualifier
-> StringThe new name
-> BoolTrue means modifying the token stream as well.
-> tThe syntax phrase
-> m t
Rename each occurrences of the identifier in the given syntax phrase with the new name. If the Bool parameter is True, then modify both the AST and the token stream, otherwise only modify the AST.
replaceNameInPN
:: Maybe ModuleNameThe new qualifier
-> PNameThe old PName
-> StringThe new name
-> PNameThe result
Replace the name (and qualifier if specified) by a new name (and qualifier) in a PName. The function does not modify the token stream.
autoRenameLocalVar
:: (MonadPlus m, Term t)
=> BoolTrue means modfiying the token stream as well.
-> PNameThe identifier.
-> tThe syntax phrase.
-> m tThe result.
Check whether the specified identifier is declared in the given syntax phrase t, if so, rename the identifier by creating a new name automatically. If the Bool parameter is True, the token stream will be modified, otherwise only the AST is modified.
Adding/removing parameters
addParamsToDecls
:: (...)
=> [HsDeclP]A declaration list where the function is defined and/or used.
-> PNameThe function name.
-> [PName]The parameters to be added.
-> BoolModify the token stream or not.
-> m [HsDeclP]The result.
rmParams
:: (MonadPlus m, MonadState (([PosToken], Bool), t1) m)
=> PNTThe identifier whose parameters are to be removed.
-> IntNumber of parameters to be removed.
-> HsExpPThe original expression.
-> m HsExpPThe result expression.
Remove the first n parameters of a given identifier in an expression.
Miscellous
Parsing, writing and showing
parseSourceFile :: (...) => FilePath -> m (InScopes, Exports, HsModuleP, [PosToken])
Parse a Haskell source files, and returns a four-element tuple. The first element in the result is the inscope relation, the second element is the export relation, the third is the AST of the module and the forth element is the token stream of the module.
showEntities :: (Eq t, Term t) => (t -> String) -> [t] -> String
Show a list of entities, the parameter f is a function that specifies how to format an entity.
showPNwithLoc :: PName -> String
Show a PName in a format like: pn(at row:r, col: c).
Locations
toRelativeLocs :: Term t => t -> t
Change the absolute define locations of local variables to relative ones, so that equality between expressions can be compared via alpha-renaming.
rmLocs :: Term t => t -> t
Remove source location information in the syntax tree.
Default values
defaultPN :: PName
Default identifier in the PName format.
defaultPNT :: PNT
Default identifier in the PNT format.
defaultModName :: ModuleName
Default module name.
defaultExp :: HsExpP
Default expression.
defaultPat :: HsPatP
Default pattern.
Others
mkNewName
:: StringThe old name
-> [String]The set of names which the new name cannot take
-> IntThe posfix value
-> StringThe result
Create a new name base on the old name. Suppose the old name is f, then the new name would be like f_i where i is an integer.
Produced by Haddock version 0.6