Commit 564a9581 authored by marton bognar's avatar marton bognar
Browse files

Rename a function and clean up unused code

parent 4ddfc2ce
......@@ -12,7 +12,7 @@ import Utility
data ExternalFunctions = EF {
paramForCtor :: ConstructorDef -> [Parameter],
freeVarExprForVarCtor :: String -> Expression,
oneDeeper :: String -> [Expression] -> Expression,
transformForAddAttr :: String -> [Expression] -> Expression,
substHelperExprForVarCtor :: String -> String -> Expression,
includeBinders :: Bool
}
......@@ -325,7 +325,7 @@ applyInhCtxsToAttrs ef sname ctor (iden, idenAttrs) ctxsBySname (ctx:ctxs)
applyOneRuleLogic :: AttributeDef -> [Expression] -> Maybe Expression
applyOneRuleLogic (_, RightLHS _) _ = Nothing
applyOneRuleLogic (l, RightAdd expr _) params
= return (oneDeeper ef (xnamespace ctx) (nextStep ++ params))
= return (transformForAddAttr ef (xnamespace ctx) (nextStep ++ params))
where
nextStep = maybeToList (applyOneRuleLogic (l, expr) [])
applyOneRuleLogic (_, RightSub iden context) params
......
......@@ -153,7 +153,7 @@ _substExpr sname consName =
ef = EF {
paramForCtor = _getCtorParams,
freeVarExprForVarCtor = _varCtorFreeVar,
oneDeeper = _oneDeeper,
transformForAddAttr = _oneDeeper,
substHelperExprForVarCtor = _substExpr,
includeBinders = False
}
......@@ -54,8 +54,6 @@ _getCtorParams cons = [ConstrParam (upperFirst consName) ((map (\_ -> VarParam "
_varCtorFreeVar :: String -> Expression
_varCtorFreeVar name = IfExpr (FnCall "elem" [VarExpr "var", VarExpr "c"]) (ListExpr []) (ListExpr [VarExpr "var"])
_oneDeeper namespace expr = expr -- FnCall "concat" [ListExpr (ListExpr [VarExpr "b"] : expr)]
_substExpr sname consName =
IfExpr (EQExpr (VarExpr "var") (VarExpr "c"))
(VarExpr "sub")
......@@ -64,118 +62,9 @@ _substExpr sname consName =
ef = EF {
paramForCtor = _getCtorParams,
freeVarExprForVarCtor = _varCtorFreeVar,
oneDeeper = (\n e -> head e),
transformForAddAttr = (\n e -> head e),
substHelperExprForVarCtor = _substExpr,
includeBinders = True
}
-- Custom subst
-- getCustSubst :: Language -> [Function]
-- getCustSubst (nsd, sd, _, _) =
-- let filtered = filter (\(MkDefSort sname _ _ _) -> isJust (lookup (upperFirst sname) (varAccessBySortName sd))) sd
-- in concatMap (\(MkDefSort sname namespaceDecl constr rewrite) ->
-- let filteredNs = [INH x y | INH x y <- namespaceDecl]
-- in map (\ctx ->
-- let secondSort = sortNameForNamespaceName (xnamespace ctx) nsd
-- in Fn
-- (lowerFirst sname ++ secondSort ++ "Substitute")
-- (map (\c ->
-- (
-- [VarParam "orig", VarParam "sub"] ++ paramForCtor ef c
-- ,
-- getExpr sname secondSort c (map snameAndCtxs sd) (varAccessBySortName sd)
-- )
-- ) constr)
-- ) filteredNs
-- ) filtered
-- where
-- getExpr :: SortName -> SortName -> ConstructorDef -> [(SortName, [Context])] -> [(SortName, Bool)] -> Expression
-- getExpr sname secondSort (MkVarConstructor consName _) table _ =
-- IfExpr (EQExpr (VarExpr "var") (VarExpr "orig"))
-- (VarExpr "sub")
-- (ConstrInst (upperFirst consName) [VarExpr "var"])
-- getExpr sname secondSort cons table accessVarTable =
-- let binder = if isBind cons then [VarExpr "b"] else []
-- in ConstrInst (upperFirst (cname cons)) (binder ++ map process idRules ++ [VarExpr (lowerFirst x ++ show n) | (x, n) <- zip (cnatives cons) [1 :: Int ..]])
-- where
-- rules = cattrs cons
-- idRules = attrsByIden rules (folds ++ lists ++ sorts)
-- folds = dropFold (cfolds cons)
-- lists = clists cons
-- sorts = csorts cons
-- isBind MkBindConstructor{} = True
-- isBind _ = False
-- process (iden, idenRules)
-- | fromJust (lookup sortnameInUse accessVarTable) && elem iden (map fst folds) =
-- FnCall "fmap" [FnCall (lowerFirst sname ++ secondSort ++ "Substitute") (addedBinders), VarExpr (lowerFirst iden)]
-- | fromJust (lookup sortnameInUse accessVarTable) && elem iden (map fst lists) =
-- FnCall "map" [FnCall (lowerFirst sname ++ secondSort ++ "Substitute") (addedBinders), VarExpr (lowerFirst iden)]
-- | fromJust (lookup sortnameInUse accessVarTable) && elem iden (map fst sorts) =
-- FnCall (lowerFirst sname ++ secondSort ++ "Substitute") (addedBinders ++ [VarExpr (lowerFirst iden)])
-- | otherwise = VarExpr (lowerFirst iden)
-- where
-- addedBinders =
-- applyInhCtxsToAttrs
-- ef
-- sname
-- rules
-- (iden, idenRules)
-- folds
-- lists
-- sorts
-- table
-- (inhCtxsForSortName sortnameInUse table)
-- sortnameInUse = sortNameForIden iden cons
-- applyInhCtxsToAttrs :: ExternalFunctions -> SortName -> [AttributeDef] -> (IdenName, [AttributeDef]) -> [(IdenName, SortName)] -> [(IdenName, SortName)] -> [(IdenName, SortName)] -> [(SortName, [Context])] -> [Context] -> [Expression]
-- applyInhCtxsToAttrs ef sname rules (iden, rulesOfId) folds lists listSorts table = recurse
-- where
-- newString =
-- applyOneCtx
-- ef
-- sname
-- rules
-- (iden, rulesOfId)
-- folds
-- lists
-- listSorts
-- table
-- recurse :: [Context] -> [Expression]
-- recurse [] = [VarExpr "orig", VarExpr "sub"]
-- recurse (x:xs) = case newString x (recurse xs) of
-- Just ex -> ex
-- Nothing -> recurse xs
-- applyOneCtx :: ExternalFunctions -> SortName -> [AttributeDef] -> (IdenName, [AttributeDef]) -> [(IdenName, SortName)] -> [(IdenName, SortName)] -> [(IdenName, SortName)] -> [(SortName, [Context])] -> Context -> [Expression] -> Maybe [Expression]
-- applyOneCtx ef sname rules (_, rulesOfId) folds lists listSorts table currentCtx params
-- | isJust foundrule = applyOneRuleLogic ef sname currentCtx newrules (fromJust foundrule) folds lists listSorts newtable params
-- | otherwise = Nothing
-- where
-- foundrule = find (\x -> linst (fst x) == xinst currentCtx) rulesOfId
-- newtable = filterCtxsByNamespace (xnamespace currentCtx) table
-- newrules = filter (\(l, r) ->
-- let sortnameId = liden l
-- snameLookup = fromJust (lookup (upperFirst sname) table)
-- sortnameIdlookup = fromJust (lookup (sortNameForIden sortnameId (folds ++ lists ++ listSorts)) table)
-- in (sortnameId == "" && any (\ctx -> linst l == xinst ctx) snameLookup)
-- || any (\ctx -> linst l == xinst ctx) sortnameIdlookup
-- ) rules
-- applyOneRuleLogic :: ExternalFunctions -> SortName -> Context -> [AttributeDef] -> AttributeDef -> [(IdenName, SortName)] -> [(IdenName, SortName)] -> [(IdenName, SortName)] -> [(SortName, [Context])] -> [Expression] -> Maybe [Expression]
-- applyOneRuleLogic _ _ _ _ (_, RightLHS _) _ _ _ _ _ = Nothing
-- applyOneRuleLogic ef sname ctx rules (l, RightAdd expr _) folds lists listSorts table params =
-- return (fromMaybe [] (applyOneRuleLogic ef sname ctx rules (l, expr) folds lists listSorts table []) ++ params)
-- applyOneRuleLogic ef sname ctx rules (_, RightSub iden context) folds lists listSorts table params
-- | (elem iden (map fst lists) || elem iden (map fst folds)) && isJust newrule =
-- return [FnCall ("generateHnat" ++ xnamespace ctx) (FnCall "length" (VarExpr iden : nextStep) : params)]
-- | elem iden (map fst lists) || elem iden (map fst folds) =
-- return [FnCall ("generateHnat" ++ xnamespace ctx) (FnCall "length" [VarExpr iden] : params)]
-- | isJust newrule =
-- return [FnCall ("addToEnvironment" ++ fromJust (lookup iden listSorts) ++ context) ((VarExpr iden : nextStep) ++ params)]
-- | otherwise =
-- return [FnCall ("addToEnvironment" ++ fromJust (lookup iden listSorts) ++ context) (VarExpr iden : params)]
-- where
-- newrule = find (\(l, _) -> liden l == iden) rules
-- nextStep = fromMaybe [] (applyOneRuleLogic ef sname ctx rules (fromJust newrule) folds lists listSorts table [])
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