From 760726e001c65a1b4cddda21a6b8d9bb55662fd3 Mon Sep 17 00:00:00 2001
From: Veit Heller <veit@veitheller.de>
Date: Thu, 15 Jul 2021 22:45:05 +0200
Subject: [PATCH] fix: fix dynamic let bindings recursion and binder leaks
 (#1281)

---
 src/Context.hs | 8 ++++++++
 src/Eval.hs    | 6 +++---
 src/Obj.hs     | 5 +++++
 3 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/src/Context.hs b/src/Context.hs
index 840727a0..8094f1c7 100644
--- a/src/Context.hs
+++ b/src/Context.hs
@@ -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.
diff --git a/src/Eval.hs b/src/Eval.hs
index d4b02077..505aa0b6 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -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
diff --git a/src/Obj.hs b/src/Obj.hs
index 75d83f49..60b02903 100644
--- a/src/Obj.hs
+++ b/src/Obj.hs
@@ -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