Copyright | (c) 2016 - 2017 Finn Teegen 2018 Kai-Oliver Prott |
---|---|
License | BSD-3-clause |
Maintainer | fte@informatik.uni-kiel.de |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
This library provides selector functions, test and update operations as well as some useful auxiliary functions for TypedFlatCurry data terms. Most of the provided functions are based on general transformation functions that replace constructors with user-defined functions. For recursive datatypes the transformations are defined inductively over the term structure. This is quite usual for transformations on TypedFlatCurry terms, so the provided functions can be used to implement specific transformations without having to explicitly state the recursion. Essentially, the tedious part of such transformations - descend in fairly complex term structures - is abstracted away, which hopefully makes the code more clear and brief.
Synopsis
- trTProg :: (String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b) -> TProg -> b
- tProgName :: TProg -> String
- tProgImports :: TProg -> [String]
- tProgTypes :: TProg -> [TypeDecl]
- tProgTFuncs :: TProg -> [TFuncDecl]
- tProgOps :: TProg -> [OpDecl]
- updTProg :: (String -> String) -> ([String] -> [String]) -> ([TypeDecl] -> [TypeDecl]) -> ([TFuncDecl] -> [TFuncDecl]) -> ([OpDecl] -> [OpDecl]) -> TProg -> TProg
- updTProgName :: Update TProg String
- updTProgImports :: Update TProg [String]
- updTProgTypes :: Update TProg [TypeDecl]
- updTProgTFuncs :: Update TProg [TFuncDecl]
- updTProgOps :: Update TProg [OpDecl]
- allVarsInTProg :: TProg -> [(VarIndex, TypeExpr)]
- updTProgTExps :: Update TProg TExpr
- rnmAllVarsInTProg :: Update TProg VarIndex
- updQNamesInTProg :: Update TProg QName
- rnmTProg :: String -> TProg -> TProg
- trTFunc :: (QName -> Int -> Visibility -> TypeExpr -> TRule -> b) -> TFuncDecl -> b
- tFuncName :: TFuncDecl -> QName
- tFuncArity :: TFuncDecl -> Int
- tFuncVisibility :: TFuncDecl -> Visibility
- tFuncType :: TFuncDecl -> TypeExpr
- tFuncTRule :: TFuncDecl -> TRule
- updTFunc :: (QName -> QName) -> (Int -> Int) -> (Visibility -> Visibility) -> (TypeExpr -> TypeExpr) -> (TRule -> TRule) -> TFuncDecl -> TFuncDecl
- updTFuncName :: Update TFuncDecl QName
- updTFuncArity :: Update TFuncDecl Int
- updTFuncVisibility :: Update TFuncDecl Visibility
- updFuncType :: Update TFuncDecl TypeExpr
- updTFuncTRule :: Update TFuncDecl TRule
- isPublicTFunc :: TFuncDecl -> Bool
- isExternal :: TFuncDecl -> Bool
- allVarsInTFunc :: TFuncDecl -> [(VarIndex, TypeExpr)]
- tFuncArgs :: TFuncDecl -> [(VarIndex, TypeExpr)]
- tFuncBody :: TFuncDecl -> TExpr
- tFuncRHS :: TFuncDecl -> [TExpr]
- rnmAllVarsInTFunc :: Update TFuncDecl VarIndex
- updQNamesInTFunc :: Update TFuncDecl QName
- updTFuncArgs :: Update TFuncDecl [(VarIndex, TypeExpr)]
- updTFuncBody :: Update TFuncDecl TExpr
- trTRule :: ([(VarIndex, TypeExpr)] -> TExpr -> b) -> (TypeExpr -> String -> b) -> TRule -> b
- tRuleArgs :: TRule -> [(VarIndex, TypeExpr)]
- tRuleBody :: TRule -> TExpr
- tRuleExtDecl :: TRule -> String
- isTRuleExternal :: TRule -> Bool
- updTRule :: (TypeExpr -> TypeExpr) -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> (TExpr -> TExpr) -> (String -> String) -> TRule -> TRule
- updTRuleType :: Update TRule TypeExpr
- updTRuleArgs :: Update TRule [(VarIndex, TypeExpr)]
- updTRuleBody :: Update TRule TExpr
- updTRuleExtDecl :: Update TRule String
- allVarsInTRule :: TRule -> [(VarIndex, TypeExpr)]
- rnmAllVarsInTRule :: Update TRule VarIndex
- updQNamesInTRule :: Update TRule QName
- varNr :: TExpr -> VarIndex
- literal :: TExpr -> Literal
- combType :: TExpr -> CombType
- combName :: TExpr -> QName
- combArgs :: TExpr -> [TExpr]
- missingCombArgs :: TExpr -> Int
- letBinds :: TExpr -> [((VarIndex, TypeExpr), TExpr)]
- letBody :: TExpr -> TExpr
- freeVars :: TExpr -> [(VarIndex, TypeExpr)]
- freeExpr :: TExpr -> TExpr
- orExps :: TExpr -> [TExpr]
- caseType :: TExpr -> CaseType
- caseExpr :: TExpr -> TExpr
- caseBranches :: TExpr -> [TBranchExpr]
- isTVarE :: TExpr -> Bool
- isTLit :: TExpr -> Bool
- isTComb :: TExpr -> Bool
- isTLet :: TExpr -> Bool
- isTFree :: TExpr -> Bool
- isTOr :: TExpr -> Bool
- isTCase :: TExpr -> Bool
- trTExpr :: (TypeExpr -> VarIndex -> b) -> (TypeExpr -> Literal -> b) -> (TypeExpr -> CombType -> QName -> [b] -> b) -> ([((VarIndex, TypeExpr), b)] -> b -> b) -> ([(VarIndex, TypeExpr)] -> b -> b) -> (b -> b -> b) -> (CaseType -> b -> [c] -> b) -> (TPattern -> b -> c) -> (b -> TypeExpr -> b) -> TExpr -> b
- updVars :: (TypeExpr -> VarIndex -> TExpr) -> TExpr -> TExpr
- updLiterals :: (TypeExpr -> Literal -> TExpr) -> TExpr -> TExpr
- updCombs :: (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr) -> TExpr -> TExpr
- updLets :: ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr
- updFrees :: ([(VarIndex, TypeExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr
- updOrs :: (TExpr -> TExpr -> TExpr) -> TExpr -> TExpr
- updCases :: (CaseType -> TExpr -> [TBranchExpr] -> TExpr) -> TExpr -> TExpr
- updBranches :: (TPattern -> TExpr -> TBranchExpr) -> TExpr -> TExpr
- updTypeds :: (TExpr -> TypeExpr -> TExpr) -> TExpr -> TExpr
- isFuncCall :: TExpr -> Bool
- isFuncPartCall :: TExpr -> Bool
- isConsCall :: TExpr -> Bool
- isConsPartCall :: TExpr -> Bool
- isGround :: TExpr -> Bool
- allVars :: TExpr -> [(VarIndex, TypeExpr)]
- rnmAllVars :: Update TExpr VarIndex
- updQNames :: Update TExpr QName
- trTBranch :: (TPattern -> TExpr -> b) -> TBranchExpr -> b
- tBranchTPattern :: TBranchExpr -> TPattern
- tBranchTExpr :: TBranchExpr -> TExpr
- updTBranch :: (TPattern -> TPattern) -> (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr
- updTBranchTPattern :: Update TBranchExpr TPattern
- updTBranchTExpr :: Update TBranchExpr TExpr
- trTPattern :: (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b) -> (TypeExpr -> Literal -> b) -> TPattern -> b
- tPatCons :: TPattern -> QName
- tPatArgs :: TPattern -> [(VarIndex, TypeExpr)]
- tPatLiteral :: TPattern -> Literal
- isConsPattern :: TPattern -> Bool
- updTPattern :: (TypeExpr -> TypeExpr) -> (QName -> QName) -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> (Literal -> Literal) -> TPattern -> TPattern
- updTPatType :: (TypeExpr -> TypeExpr) -> TPattern -> TPattern
- updTPatCons :: (QName -> QName) -> TPattern -> TPattern
- updTPatArgs :: ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> TPattern -> TPattern
- updTPatLiteral :: (Literal -> Literal) -> TPattern -> TPattern
- tPatExpr :: TPattern -> TExpr
- type Update a b = (b -> b) -> a -> a
- trType :: (QName -> Visibility -> [TVarIndex] -> [ConsDecl] -> a) -> (QName -> Visibility -> [TVarIndex] -> TypeExpr -> a) -> TypeDecl -> a
- typeName :: TypeDecl -> QName
- typeVisibility :: TypeDecl -> Visibility
- typeParams :: TypeDecl -> [TVarIndex]
- typeConsDecls :: TypeDecl -> [ConsDecl]
- typeSyn :: TypeDecl -> TypeExpr
- isTypeSyn :: TypeDecl -> Bool
- isDataTypeDecl :: TypeDecl -> Bool
- isExternalType :: TypeDecl -> Bool
- isPublicType :: TypeDecl -> Bool
- updType :: (QName -> QName) -> (Visibility -> Visibility) -> ([TVarIndex] -> [TVarIndex]) -> ([ConsDecl] -> [ConsDecl]) -> (TypeExpr -> TypeExpr) -> TypeDecl -> TypeDecl
- updTypeName :: Update TypeDecl QName
- updTypeVisibility :: Update TypeDecl Visibility
- updTypeParams :: Update TypeDecl [TVarIndex]
- updTypeConsDecls :: Update TypeDecl [ConsDecl]
- updTypeSynonym :: Update TypeDecl TypeExpr
- updQNamesInType :: Update TypeDecl QName
- trCons :: (QName -> Int -> Visibility -> [TypeExpr] -> a) -> ConsDecl -> a
- consName :: ConsDecl -> QName
- consArity :: ConsDecl -> Int
- consVisibility :: ConsDecl -> Visibility
- isPublicCons :: ConsDecl -> Bool
- consArgs :: ConsDecl -> [TypeExpr]
- updCons :: (QName -> QName) -> (Int -> Int) -> (Visibility -> Visibility) -> ([TypeExpr] -> [TypeExpr]) -> ConsDecl -> ConsDecl
- updConsName :: Update ConsDecl QName
- updConsArity :: Update ConsDecl Int
- updConsVisibility :: Update ConsDecl Visibility
- updConsArgs :: Update ConsDecl [TypeExpr]
- updQNamesInConsDecl :: Update ConsDecl QName
- tVarIndex :: TypeExpr -> TVarIndex
- domain :: TypeExpr -> TypeExpr
- range :: TypeExpr -> TypeExpr
- tConsName :: TypeExpr -> QName
- tConsArgs :: TypeExpr -> [TypeExpr]
- trTypeExpr :: (TVarIndex -> a) -> (QName -> [a] -> a) -> (a -> a -> a) -> ([TVarIndex] -> a -> a) -> TypeExpr -> a
- isTVar :: TypeExpr -> Bool
- isTCons :: TypeExpr -> Bool
- isFuncType :: TypeExpr -> Bool
- updTVars :: (TVarIndex -> TypeExpr) -> TypeExpr -> TypeExpr
- updTCons :: (QName -> [TypeExpr] -> TypeExpr) -> TypeExpr -> TypeExpr
- updFuncTypes :: (TypeExpr -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr
- argTypes :: TypeExpr -> [TypeExpr]
- typeArity :: TypeExpr -> Int
- resultType :: TypeExpr -> TypeExpr
- allVarsInTypeExpr :: TypeExpr -> [TVarIndex]
- allTypeCons :: TypeExpr -> [QName]
- rnmAllVarsInTypeExpr :: (TVarIndex -> TVarIndex) -> TypeExpr -> TypeExpr
- updQNamesInTypeExpr :: (QName -> QName) -> TypeExpr -> TypeExpr
- trOp :: (QName -> Fixity -> Integer -> a) -> OpDecl -> a
- opName :: OpDecl -> QName
- opFixity :: OpDecl -> Fixity
- opPrecedence :: OpDecl -> Integer
- updOp :: (QName -> QName) -> (Fixity -> Fixity) -> (Integer -> Integer) -> OpDecl -> OpDecl
- updOpName :: Update OpDecl QName
- updOpFixity :: Update OpDecl Fixity
- updOpPrecedence :: Update OpDecl Integer
- trCombType :: a -> (Int -> a) -> a -> (Int -> a) -> CombType -> a
- isCombTypeFuncCall :: CombType -> Bool
- isCombTypeFuncPartCall :: CombType -> Bool
- isCombTypeConsCall :: CombType -> Bool
- isCombTypeConsPartCall :: CombType -> Bool
- isPublic :: Visibility -> Bool
Documentation
trTProg :: (String -> [String] -> [TypeDecl] -> [TFuncDecl] -> [OpDecl] -> b) -> TProg -> b Source #
transform program
tProgImports :: TProg -> [String] Source #
get imports from program
tProgTypes :: TProg -> [TypeDecl] Source #
get type declarations from program
tProgTFuncs :: TProg -> [TFuncDecl] Source #
get functions from program
updTProg :: (String -> String) -> ([String] -> [String]) -> ([TypeDecl] -> [TypeDecl]) -> ([TFuncDecl] -> [TFuncDecl]) -> ([OpDecl] -> [OpDecl]) -> TProg -> TProg Source #
update program
allVarsInTProg :: TProg -> [(VarIndex, TypeExpr)] Source #
get all program variables (also from patterns)
rnmTProg :: String -> TProg -> TProg Source #
rename program (update name of and all qualified names in program)
trTFunc :: (QName -> Int -> Visibility -> TypeExpr -> TRule -> b) -> TFuncDecl -> b Source #
transform function
tFuncArity :: TFuncDecl -> Int Source #
get arity of function
tFuncVisibility :: TFuncDecl -> Visibility Source #
get visibility of function
tFuncTRule :: TFuncDecl -> TRule Source #
get rule of function
updTFunc :: (QName -> QName) -> (Int -> Int) -> (Visibility -> Visibility) -> (TypeExpr -> TypeExpr) -> (TRule -> TRule) -> TFuncDecl -> TFuncDecl Source #
update function
updTFuncVisibility :: Update TFuncDecl Visibility Source #
update visibility of function
isPublicTFunc :: TFuncDecl -> Bool Source #
is function public?
isExternal :: TFuncDecl -> Bool Source #
is function externally defined?
allVarsInTFunc :: TFuncDecl -> [(VarIndex, TypeExpr)] Source #
get variable names in a function declaration
tFuncArgs :: TFuncDecl -> [(VarIndex, TypeExpr)] Source #
get arguments of function, if not externally defined
updTFuncArgs :: Update TFuncDecl [(VarIndex, TypeExpr)] Source #
update arguments of function, if not externally defined
trTRule :: ([(VarIndex, TypeExpr)] -> TExpr -> b) -> (TypeExpr -> String -> b) -> TRule -> b Source #
transform rule
tRuleExtDecl :: TRule -> String Source #
get rules external declaration
isTRuleExternal :: TRule -> Bool Source #
is rule external?
updTRule :: (TypeExpr -> TypeExpr) -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> (TExpr -> TExpr) -> (String -> String) -> TRule -> TRule Source #
update rule
missingCombArgs :: TExpr -> Int Source #
get number of missing arguments if expression is combined
letBinds :: TExpr -> [((VarIndex, TypeExpr), TExpr)] Source #
get indices of variables in let declaration
freeVars :: TExpr -> [(VarIndex, TypeExpr)] Source #
get variable indices from declaration of free variables
caseBranches :: TExpr -> [TBranchExpr] Source #
get branch expressions from case expression
trTExpr :: (TypeExpr -> VarIndex -> b) -> (TypeExpr -> Literal -> b) -> (TypeExpr -> CombType -> QName -> [b] -> b) -> ([((VarIndex, TypeExpr), b)] -> b -> b) -> ([(VarIndex, TypeExpr)] -> b -> b) -> (b -> b -> b) -> (CaseType -> b -> [c] -> b) -> (TPattern -> b -> c) -> (b -> TypeExpr -> b) -> TExpr -> b Source #
transform expression
updVars :: (TypeExpr -> VarIndex -> TExpr) -> TExpr -> TExpr Source #
update all variables in given expression
updLiterals :: (TypeExpr -> Literal -> TExpr) -> TExpr -> TExpr Source #
update all literals in given expression
updCombs :: (TypeExpr -> CombType -> QName -> [TExpr] -> TExpr) -> TExpr -> TExpr Source #
update all combined expressions in given expression
updLets :: ([((VarIndex, TypeExpr), TExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr Source #
update all let expressions in given expression
updFrees :: ([(VarIndex, TypeExpr)] -> TExpr -> TExpr) -> TExpr -> TExpr Source #
update all free declarations in given expression
updOrs :: (TExpr -> TExpr -> TExpr) -> TExpr -> TExpr Source #
update all or expressions in given expression
updCases :: (CaseType -> TExpr -> [TBranchExpr] -> TExpr) -> TExpr -> TExpr Source #
update all case expressions in given expression
updBranches :: (TPattern -> TExpr -> TBranchExpr) -> TExpr -> TExpr Source #
update all case branches in given expression
updTypeds :: (TExpr -> TypeExpr -> TExpr) -> TExpr -> TExpr Source #
update all typed expressions in given expression
isFuncCall :: TExpr -> Bool Source #
is expression a call of a function where all arguments are provided?
isFuncPartCall :: TExpr -> Bool Source #
is expression a partial function call?
isConsCall :: TExpr -> Bool Source #
is expression a call of a constructor?
isConsPartCall :: TExpr -> Bool Source #
is expression a partial constructor call?
allVars :: TExpr -> [(VarIndex, TypeExpr)] Source #
get all variables (also pattern variables) in expression
tBranchTPattern :: TBranchExpr -> TPattern Source #
get pattern from branch expression
tBranchTExpr :: TBranchExpr -> TExpr Source #
get expression from branch expression
updTBranch :: (TPattern -> TPattern) -> (TExpr -> TExpr) -> TBranchExpr -> TBranchExpr Source #
update branch expression
updTBranchTPattern :: Update TBranchExpr TPattern Source #
update pattern of branch expression
updTBranchTExpr :: Update TBranchExpr TExpr Source #
update expression of branch expression
trTPattern :: (TypeExpr -> QName -> [(VarIndex, TypeExpr)] -> b) -> (TypeExpr -> Literal -> b) -> TPattern -> b Source #
transform pattern
tPatLiteral :: TPattern -> Literal Source #
get literal from literal pattern
isConsPattern :: TPattern -> Bool Source #
is pattern a constructor pattern?
updTPattern :: (TypeExpr -> TypeExpr) -> (QName -> QName) -> ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> (Literal -> Literal) -> TPattern -> TPattern Source #
update pattern
updTPatArgs :: ([(VarIndex, TypeExpr)] -> [(VarIndex, TypeExpr)]) -> TPattern -> TPattern Source #
update arguments of constructor pattern
trType :: (QName -> Visibility -> [TVarIndex] -> [ConsDecl] -> a) -> (QName -> Visibility -> [TVarIndex] -> TypeExpr -> a) -> TypeDecl -> a Source #
transform type declaration
typeVisibility :: TypeDecl -> Visibility Source #
get visibility of type declaration
typeParams :: TypeDecl -> [TVarIndex] Source #
get type parameters of type declaration
typeConsDecls :: TypeDecl -> [ConsDecl] Source #
get constructor declarations from type declaration
isDataTypeDecl :: TypeDecl -> Bool Source #
is type declaration declaring a regular type?
isExternalType :: TypeDecl -> Bool Source #
is type declaration declaring an external type?
updType :: (QName -> QName) -> (Visibility -> Visibility) -> ([TVarIndex] -> [TVarIndex]) -> ([ConsDecl] -> [ConsDecl]) -> (TypeExpr -> TypeExpr) -> TypeDecl -> TypeDecl Source #
update type declaration
updTypeVisibility :: Update TypeDecl Visibility Source #
update visibility of type declaration
updTypeConsDecls :: Update TypeDecl [ConsDecl] Source #
update constructor declarations of type declaration
trCons :: (QName -> Int -> Visibility -> [TypeExpr] -> a) -> ConsDecl -> a Source #
transform constructor declaration
consVisibility :: ConsDecl -> Visibility Source #
get visibility of constructor declaration
isPublicCons :: ConsDecl -> Bool Source #
Is the constructor declaration public?
updCons :: (QName -> QName) -> (Int -> Int) -> (Visibility -> Visibility) -> ([TypeExpr] -> [TypeExpr]) -> ConsDecl -> ConsDecl Source #
update constructor declaration
updConsVisibility :: Update ConsDecl Visibility Source #
update visibility of constructor declaration
updQNamesInConsDecl :: Update ConsDecl QName Source #
update all qualified names in constructor declaration
trTypeExpr :: (TVarIndex -> a) -> (QName -> [a] -> a) -> (a -> a -> a) -> ([TVarIndex] -> a -> a) -> TypeExpr -> a Source #
transform type expression
isFuncType :: TypeExpr -> Bool Source #
is type declaration a functional type?
updTCons :: (QName -> [TypeExpr] -> TypeExpr) -> TypeExpr -> TypeExpr Source #
update all type constructors
updFuncTypes :: (TypeExpr -> TypeExpr -> TypeExpr) -> TypeExpr -> TypeExpr Source #
update all functional types
resultType :: TypeExpr -> TypeExpr Source #
get result type from (nested) functional type
allVarsInTypeExpr :: TypeExpr -> [TVarIndex] Source #
get indexes of all type variables
allTypeCons :: TypeExpr -> [QName] Source #
yield the list of all contained type constructors
rnmAllVarsInTypeExpr :: (TVarIndex -> TVarIndex) -> TypeExpr -> TypeExpr Source #
rename variables in type expression
updQNamesInTypeExpr :: (QName -> QName) -> TypeExpr -> TypeExpr Source #
update all qualified names in type expression
opPrecedence :: OpDecl -> Integer Source #
get precedence of operator declaration
updOp :: (QName -> QName) -> (Fixity -> Fixity) -> (Integer -> Integer) -> OpDecl -> OpDecl Source #
update operator declaration
trCombType :: a -> (Int -> a) -> a -> (Int -> a) -> CombType -> a Source #
transform combination type
isCombTypeFuncCall :: CombType -> Bool Source #
is type of combination FuncCall?
isCombTypeFuncPartCall :: CombType -> Bool Source #
is type of combination FuncPartCall?
isCombTypeConsCall :: CombType -> Bool Source #
is type of combination ConsCall?
isCombTypeConsPartCall :: CombType -> Bool Source #
is type of combination ConsPartCall?
isPublic :: Visibility -> Bool Source #
Is this a public Visibility
?