mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
fix: fix dynamic let bindings recursion and binder leaks (#1281)
This commit is contained in:
parent
f3944ce73d
commit
760726e001
@ -2,6 +2,7 @@ module Context
|
||||
( ContextError (..),
|
||||
replaceGlobalEnv,
|
||||
replaceInternalEnv,
|
||||
replaceInternalEnvMaybe,
|
||||
replaceTypeEnv,
|
||||
replaceHistory,
|
||||
replaceProject,
|
||||
@ -118,6 +119,13 @@ replaceInternalEnv :: Context -> Env -> Context
|
||||
replaceInternalEnv ctx env =
|
||||
ctx {contextInternalEnv = Just env}
|
||||
|
||||
-- | Replace a context's internal environment with a new environment or nothing.
|
||||
--
|
||||
-- The previous environment is completely replaced and will not be recoverable.
|
||||
replaceInternalEnvMaybe :: Context -> Maybe Env -> Context
|
||||
replaceInternalEnvMaybe ctx env =
|
||||
ctx {contextInternalEnv = env}
|
||||
|
||||
-- | Replace a context's global environment with a new environment.
|
||||
--
|
||||
-- The previous environment is completely replaced and will not be recoverable.
|
||||
|
@ -277,9 +277,9 @@ eval ctx xobj@(XObj o info ty) preference resolver =
|
||||
Right newCtx -> do
|
||||
(finalCtx, evaledBody) <- eval newCtx body (PreferLocal (map (\(name, _) -> (SymPath [] name)) binds)) ResolveLocal
|
||||
let Just e = contextInternalEnv finalCtx
|
||||
parentEnv = fromMaybe e (envParent e)
|
||||
parentEnv = envParent e
|
||||
pure
|
||||
( replaceInternalEnv finalCtx parentEnv,
|
||||
( replaceInternalEnvMaybe finalCtx parentEnv,
|
||||
do
|
||||
okBody <- evaledBody
|
||||
Right okBody
|
||||
@ -298,7 +298,7 @@ eval ctx xobj@(XObj o info ty) preference resolver =
|
||||
-- (let [f (fn [x] (if (= x 1) x (f (dec x))))] (f 10))
|
||||
let origin = (contextInternalEnv ctx')
|
||||
recFix = (E.recursive origin (Just "let-rec-env") 0)
|
||||
Right envWithSelf = E.insertX recFix (SymPath [] n) x
|
||||
Right envWithSelf = if isFn x then E.insertX recFix (SymPath [] n) x else Right recFix
|
||||
ctx'' = replaceInternalEnv ctx' envWithSelf
|
||||
(newCtx, res) <- eval ctx'' x preference resolver
|
||||
case res of
|
||||
|
@ -232,6 +232,11 @@ isMod :: XObj -> Bool
|
||||
isMod (XObj (Mod _ _) _ _) = True
|
||||
isMod _ = False
|
||||
|
||||
isFn :: XObj -> Bool
|
||||
isFn (XObj (Lst (XObj (Fn _ _) _ _ : _)) _ _) = True
|
||||
isFn (XObj (Lst (XObj (Sym (SymPath [] "fn") _) _ _ : _)) _ _) = True
|
||||
isFn _ = False
|
||||
|
||||
-- | This instance is needed for the dynamic Dictionary
|
||||
instance Ord Obj where
|
||||
compare (Str a) (Str b) = compare a b
|
||||
|
Loading…
Reference in New Issue
Block a user