mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 13:37:57 +03:00
fix: release resources on break (#1153)
* fix: release resources on break * refactor: remove outdated reference to bangpatterns * refactor: rename searchBreak to searchForInnerBreak
This commit is contained in:
parent
d20414e87d
commit
59d43abf74
@ -813,6 +813,10 @@ findFunctionForMemberIncludePrimitives typeEnv env functionName functionType (me
|
|||||||
setDeletersOnInfo :: Maybe Info -> Set.Set Deleter -> Maybe Info
|
setDeletersOnInfo :: Maybe Info -> Set.Set Deleter -> Maybe Info
|
||||||
setDeletersOnInfo i deleters = fmap (\i' -> i' {infoDelete = deleters}) i
|
setDeletersOnInfo i deleters = fmap (\i' -> i' {infoDelete = deleters}) i
|
||||||
|
|
||||||
|
addDeletersToInfo :: Maybe Info -> Set.Set Deleter -> Maybe Info
|
||||||
|
addDeletersToInfo i deleters =
|
||||||
|
fmap (\i' -> i' {infoDelete = Set.union (infoDelete i') deleters}) i
|
||||||
|
|
||||||
-- | Helper function for setting the deleters for an XObj.
|
-- | Helper function for setting the deleters for an XObj.
|
||||||
del :: XObj -> Set.Set Deleter -> XObj
|
del :: XObj -> Set.Set Deleter -> XObj
|
||||||
del xobj deleters = xobj {xobjInfo = setDeletersOnInfo (xobjInfo xobj) deleters}
|
del xobj deleters = xobj {xobjInfo = setDeletersOnInfo (xobjInfo xobj) deleters}
|
||||||
@ -989,8 +993,9 @@ manageMemory typeEnv globalEnv root =
|
|||||||
manage xobj
|
manage xobj
|
||||||
pure $ do
|
pure $ do
|
||||||
okBody <- visitedBody
|
okBody <- visitedBody
|
||||||
|
let finalBody = searchForInnerBreak diff okBody
|
||||||
okBindings <- fmap (concatMap (\(n, x) -> [n, x])) (sequence visitedBindings)
|
okBindings <- fmap (concatMap (\(n, x) -> [n, x])) (sequence visitedBindings)
|
||||||
pure (XObj (Lst [letExpr, XObj (Arr okBindings) bindi bindt, okBody]) newInfo t)
|
pure (XObj (Lst [letExpr, XObj (Arr okBindings) bindi bindt, finalBody]) newInfo t)
|
||||||
-- Set!
|
-- Set!
|
||||||
[setbangExpr@(XObj SetBang _ _), variable, value] ->
|
[setbangExpr@(XObj SetBang _ _), variable, value] ->
|
||||||
let varInfo = xobjInfo variable
|
let varInfo = xobjInfo variable
|
||||||
@ -1108,7 +1113,8 @@ manageMemory typeEnv globalEnv root =
|
|||||||
XObj objExpr objInfo objTy = okExpr
|
XObj objExpr objInfo objTy = okExpr
|
||||||
newExprInfo = setDeletersOnInfo objInfo (afterExprDeleters \\ preDeleters)
|
newExprInfo = setDeletersOnInfo objInfo (afterExprDeleters \\ preDeleters)
|
||||||
newExpr = XObj objExpr newExprInfo objTy
|
newExpr = XObj objExpr newExprInfo objTy
|
||||||
pure (XObj (Lst [whileExpr, newExpr, okBody]) newInfo t)
|
finalBody = searchForInnerBreak diff okBody
|
||||||
|
pure (XObj (Lst [whileExpr, newExpr, finalBody]) newInfo t)
|
||||||
[ifExpr@(XObj If _ _), expr, ifTrue, ifFalse] ->
|
[ifExpr@(XObj If _ _), expr, ifTrue, ifFalse] ->
|
||||||
do
|
do
|
||||||
visitedExpr <- visit expr
|
visitedExpr <- visit expr
|
||||||
@ -1262,6 +1268,15 @@ manageMemory typeEnv globalEnv root =
|
|||||||
Right (XObj (Lst (okF : okArgs)) i t)
|
Right (XObj (Lst (okF : okArgs)) i t)
|
||||||
[] -> pure (Right xobj)
|
[] -> pure (Right xobj)
|
||||||
visitList _ = error "Must visit list."
|
visitList _ = error "Must visit list."
|
||||||
|
searchForInnerBreak :: Set.Set Deleter -> XObj -> XObj
|
||||||
|
searchForInnerBreak diff (XObj (Lst [(XObj Break i' t')]) xi xt) =
|
||||||
|
let ni = addDeletersToInfo i' diff
|
||||||
|
in XObj (Lst [(XObj Break ni t')]) xi xt
|
||||||
|
searchForInnerBreak _ x@(XObj (Lst ((XObj While _ _) : _)) _ _) = x
|
||||||
|
searchForInnerBreak diff (XObj (Lst elems) i' t') =
|
||||||
|
let newElems = map (searchForInnerBreak diff) elems
|
||||||
|
in XObj (Lst newElems) i' t'
|
||||||
|
searchForInnerBreak _ e = e
|
||||||
visitMatchCase :: (XObj, XObj) -> State MemState (Either TypeError ((Set.Set Deleter, (XObj, XObj)), [XObj]))
|
visitMatchCase :: (XObj, XObj) -> State MemState (Either TypeError ((Set.Set Deleter, (XObj, XObj)), [XObj]))
|
||||||
visitMatchCase (lhs@XObj {}, rhs@XObj {}) =
|
visitMatchCase (lhs@XObj {}, rhs@XObj {}) =
|
||||||
do
|
do
|
||||||
|
@ -602,8 +602,12 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
|
|||||||
XObj (Interface _ _) _ _ : _ ->
|
XObj (Interface _ _) _ _ : _ ->
|
||||||
pure ""
|
pure ""
|
||||||
-- Break
|
-- Break
|
||||||
[XObj Break _ _] -> do
|
[XObj Break minfo _] -> do
|
||||||
|
case minfo of
|
||||||
|
Just i -> delete indent i
|
||||||
|
Nothing -> return ()
|
||||||
appendToSrc (addIndent indent ++ "break;\n")
|
appendToSrc (addIndent indent ++ "break;\n")
|
||||||
|
appendToSrc (addIndent indent ++ "// Unreachable:\n")
|
||||||
pure ""
|
pure ""
|
||||||
-- Function application (functions with overridden names)
|
-- Function application (functions with overridden names)
|
||||||
func@(XObj (Sym _ (LookupGlobalOverride overriddenName)) _ _) : args ->
|
func@(XObj (Sym _ (LookupGlobalOverride overriddenName)) _ _) : args ->
|
||||||
|
Loading…
Reference in New Issue
Block a user