Commit 837c5eee authored by marton bognar's avatar marton bognar
Browse files

Some helper functions for constructors

parent e6389e0f
......@@ -92,5 +92,13 @@ isBind :: ConstructorDef -> Bool
isBind MkBindConstructor{} = True
isBind _ = False
cidens :: ConstructorDef -> [IdenName]
cidens MkVarConstructor{} = []
cidens ctor = map fst (clists ctor ++ csorts ctor) ++ map (\(n, _, _) -> n) (cfolds ctor)
cidenSorts :: ConstructorDef -> [SortName]
cidenSorts MkVarConstructor{} = []
cidenSorts ctor = map snd (clists ctor ++ csorts ctor) ++ map (\(_, s, _) -> s) (cfolds ctor)
-- | Complete definition of a language
type Language = ([NamespaceDef], [SortDef], [(String, [String])], [String])
......@@ -56,7 +56,7 @@ varAccessBySortName sd = map (\s -> (sname s, sortCanAccessVariables [] s)) sd
(\sortName ->
sortCanAccessVariables visited' (head (filter (\s -> sname s == sortName) sd))
)
(map snd (csorts ctor ++ clists ctor) ++ map (\(_, b, _) -> b) (cfolds ctor))
(cidenSorts ctor)
-- | Given a namespace name and a list of tuples containing a sort name
-- and assigned contexts, remove the contexts that use different namespaces
......@@ -78,7 +78,7 @@ sortNameForIden iden ctor = fromJust (lookup iden (dropFold (cfolds ctor) ++ cli
attrsByIden :: ConstructorDef -> [(IdenName, [AttributeDef])]
attrsByIden ctor = [
(iden, filter (\(l, _) -> liden l == iden) (cattrs ctor))
| (iden, _) <- (dropFold (cfolds ctor) ++ clists ctor ++ csorts ctor)]
| iden <- cidens ctor]
-- | Drops the third element from each tuple in a list
dropFold :: [(String, String, String)] -> [(String, String)]
......
......@@ -118,10 +118,7 @@ ef = EF {
boundVarFunctions :: Language -> [Function]
boundVarFunctions (_, sd, _, _) =
let ctxsBySname = map snameAndCtxs sd
varAccessBySname = varAccessBySortName sd
sortsWithVarAccess = filter (\(MkDefSort sname _ _ _) -> fromJust (lookup sname varAccessBySname)) sd
in map (\sort ->
map (\sort ->
Fn ("boundVariables" ++ sname sort)
(map (\ctor ->
(paramForCtor ef ctor,
......@@ -132,14 +129,14 @@ boundVarFunctions (_, sd, _, _) =
-> FnCall "nub" [
FnCall "concat"
[ListExpr (ListExpr [VarExpr "b"] :
boundVariableCallListForCtor (sname sort) ctor ctxsBySname varAccessBySname
boundVariableCallListForCtor (sname sort) ctor
)]
]
(MkDefConstructor {})
-> FnCall "nub" [
FnCall "concat"
[ListExpr (
boundVariableCallListForCtor (sname sort) ctor ctxsBySname varAccessBySname
boundVariableCallListForCtor (sname sort) ctor
)]
]
)
......@@ -149,8 +146,8 @@ boundVarFunctions (_, sd, _, _) =
-- | Generate a list of expressions, that when concatenated together give
-- the union of free variables for a given constructor (free variable
-- calls for every identifier of a sort that has access to variables)
boundVariableCallListForCtor :: SortName -> ConstructorDef -> [(SortName, [Context])] -> [(SortName, Bool)] -> [Expression]
boundVariableCallListForCtor sname ctor ctxsBySname varAccessBySname
boundVariableCallListForCtor :: SortName -> ConstructorDef -> [Expression]
boundVariableCallListForCtor sname ctor
= let folds = dropFold $ cfolds ctor
lists = clists ctor
idensAndAttrs = attrsByIden ctor
......
......@@ -84,7 +84,7 @@ wellFormed (namespaces, sorts, _, _)
--get the Identifiers of the arguments of a constructor (including the binder)
getIdentifiersConstructor :: ConstructorDef -> [String]
getIdentifiersConstructor (MkVarConstructor _ _) = []
getIdentifiersConstructor ctor = map fst (clists ctor) ++ map fst (csorts ctor) ++ map (\(x, _, _) -> x) (cfolds ctor) ++ maybe [] (\b -> [fst b]) (cbinder ctor)
getIdentifiersConstructor ctor = cidens ctor ++ maybe [] (\b -> [fst b]) (cbinder ctor)
--get the ids of the RightExpr that bind, including the binder added
getRightExprIdsConstructorBinding :: ConstructorDef -> [IdenName]
......@@ -100,7 +100,7 @@ wellFormed (namespaces, sorts, _, _)
-- get all the identifiers without the binder included
getIdentifiersWithoutBinding :: ConstructorDef -> [String]
getIdentifiersWithoutBinding (MkVarConstructor _ _) = []
getIdentifiersWithoutBinding ctor = map fst (csorts ctor) ++ map fst (clists ctor) ++ map (\(x, _, _) -> x) (cfolds ctor)
getIdentifiersWithoutBinding ctor = cidens ctor
--get the identifiers used in the rules defined in the constructor
getAllIds :: ConstructorDef -> [IdenName]
......@@ -139,7 +139,7 @@ wellFormed (namespaces, sorts, _, _)
--get the sorts used in the constructor
getSortsConstructor :: ConstructorDef -> [SortName]
getSortsConstructor (MkVarConstructor _ _) = []
getSortsConstructor ctor = map snd (csorts ctor) ++ map snd (clists ctor) ++ map (\(_, y, _) -> y) (cfolds ctor)
getSortsConstructor ctor = cidenSorts ctor
-- identifiers in Rules can only use contexts they are allowed to use
helpWellFormedRulesInstances :: [SortDef] -> [(SortName, [Context])] -> Either String ()
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment