module Language.CSPM.AstUtils
(
removeSourceLocations
,removeParens
,removeModuleTokens
,unUniqueIdent
,showAst
,relabelAst
,computeFreeNames
)
where
import Language.CSPM.AST hiding (prologMode)
import qualified Language.CSPM.AST as AST
import qualified Language.CSPM.SrcLoc as SrcLoc
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Data
import Data.Generics.Schemes (everywhere,listify)
import Data.Generics.Aliases (mkT,extQ)
import Data.Generics.Basics (gmapQ,toConstr,showConstr)
removeSourceLocations :: LModule -> LModule
removeSourceLocations ast
= everywhere (mkT patchLabel) ast
where
patchLabel :: SrcLoc.SrcLoc -> SrcLoc.SrcLoc
patchLabel _ = SrcLoc.NoLocation
removeModuleTokens :: LModule -> LModule
removeModuleTokens t = t {unLabel = m}
where m = (unLabel t ) {moduleTokens = Nothing}
removeParens :: LModule -> LModule
removeParens ast
= everywhere (mkT patchExp) ast
where
patchExp :: LExp -> LExp
patchExp x = case unLabel x of
Parens e -> e
_ -> x
unUniqueIdent :: LModule -> LModule
unUniqueIdent ast
= everywhere (mkT patchIdent) ast
where
patchIdent :: Ident -> Ident
patchIdent (UIdent u) = Ident $ newName u
patchIdent _ = error "unUniqueIdent : did not expect and 'Ident' in the AST"
relabelAst ::
NodeId
-> LModule
-> LModule
relabelAst = error "relabel not yet implemented (TODO)"
showAst :: Data a => Labeled a -> String
showAst ast = gshow ast
where
gshow :: Data a => a -> String
gshow = mShow `extQ` (show :: String -> String)
mShow t = if (tyConString $ typeRepTyCon $ typeOf t) == "Language.CSPM.AST.Labeled"
then gmapQi 2 gshow t
else
"("
++ showConstr (toConstr t)
++ concat (gmapQ ((++) " " . gshow) t)
++ ")"
computeFreeNames :: Data a => a -> FreeNames
computeFreeNames syntax
= IntMap.difference (toIntMap used) (toIntMap def)
where
toIntMap :: [UniqueIdent] -> IntMap UniqueIdent
toIntMap
= IntMap.fromList . map (\x -> (uniqueIdentId x,x))
used :: [UniqueIdent]
used = map (\(Var x) -> unUIdent $ unLabel x) $ listify isUse syntax
def :: [UniqueIdent]
def = (map (\(VarPat x) -> unUIdent $ unLabel x) $ listify isDef syntax)
++(map (\(FunBind x _) -> unUIdent $ unLabel x) $ listify isFunDef syntax)
isUse :: Exp -> Bool
isUse (Var {}) = True
isUse _ = False
isDef :: Pattern -> Bool
isDef (VarPat {}) = True
isDef _ = False
isFunDef :: Decl -> Bool
isFunDef (FunBind {}) = True
isFunDef _ = False