fix: don't allow lambdas to leak captures

app/Main.hs

@@ -36,6 +36,7 @@ defaultProject =
             "-Wall",
             "-Werror",
             "-Wno-unused-variable",
+            "-Wno-unused-but-set-variable",
             "-Wno-self-assign"
           ],
       projectLibFlags = case platform of

examples/nested_lambdas.carp

@@ -1,5 +1,5 @@
-(defn my-curry [f] (fn [x] (fn [y] (f x y))))
-(defn double-curry [f] (fn [x] (fn [y] (fn [z] (f x y z)))))
+(defn my-curry [f] (fn [x] (fn [y] (~f x y))))
+(defn double-curry [f] (fn [x] (fn [y] (fn [z] (~f x y z)))))
 
 (defn make-cb []
   ((fn []
@@ -15,4 +15,4 @@
 (defn main []
   (do ((make-cb))
       ((make-cb2))
-      (((my-curry (fn [x y] (Int.+ x y))) 1) 2)))
+      (((my-curry &(fn [x y] (Int.+ x y))) 1) 2)))

src/Info.hs

@@ -10,6 +10,7 @@ module Info
     freshVar,
     machineReadableInfo,
     makeTypeVariableNameFromInfo,
+    deleterVar,
     setDeletersOnInfo,
     addDeletersToInfo,
     uniqueDeleter,

src/Memory.hs

@@ -111,6 +111,7 @@ manageMemory typeEnv globalEnv root =
       case lst of
         [defn@(XObj (Defn maybeCaptures) _ _), nameSymbol@(XObj (Sym _ _) _ _), args@(XObj (Arr argList) _ _), body] ->
           let captures = maybe [] Set.toList maybeCaptures
+              captureDeleters = Set.fromList (map (FakeDeleter . getName) captures)
            in do
                 mapM_ (manage typeEnv globalEnv) argList
                 -- Add the captured variables (if any, only happens in lifted lambdas) as fake deleters
@@ -129,10 +130,11 @@ manageMemory typeEnv globalEnv root =
                 mapM_ (addToLifetimesMappingsIfRef False) captures -- For captured variables inside of lifted lambdas
                 visitedBody <- visit body
                 result <- unmanage typeEnv globalEnv body
+                capturesRetained <- assertOwnershipRetained captureDeleters xobj
                 whenRightReturn result $
-                  do
-                    okBody <- visitedBody
-                    Right (XObj (Lst [defn, nameSymbol, args, okBody]) i t)
+                  do capturesRetained -- if any captures are given away in the body, it's an error
+                     okBody <- visitedBody
+                     Right (XObj (Lst [defn, nameSymbol, args, okBody]) i t)
 
         -- Fn / λ (Lambda)
         [fn@(XObj (Fn _ captures) _ _), args@(XObj (Arr _) _ _), body] ->
@@ -513,6 +515,19 @@ unmanage typeEnv globalEnv xobj =
             tooMany -> error ("Too many variables with the same name in set: " ++ show tooMany)
         else pure (Right ())
 
+-- | Assert that the current memory state retains ownership over a set of nodes.
+--
+-- If the provided set of deleters is not present in the memory state at the
+-- point at which this is called, the state has given up ownership of one or
+-- more of the values in the set.
+assertOwnershipRetained :: Set.Set Deleter -> XObj -> State MemState (Either TypeError ())
+assertOwnershipRetained deleters xobj =
+  do MemState deleters' _ _ <- get
+     if (deleters `Set.isSubsetOf` deleters')
+       then pure (Right ())
+       else let leaks = map deleterVar (Set.toList (deleters Set.\\ deleters'))
+             in pure (Left (FunctionLeaksCapture leaks xobj))
+
 -- | A combination of `manage` and `unmanage`.
 transferOwnership :: TypeEnv -> Env -> XObj -> XObj -> State MemState (Either TypeError ())
 transferOwnership typeEnv globalEnv from to =

src/Set.hs

@@ -54,3 +54,6 @@ size (Set s) = S.size s
 
 map :: Ord b => (a -> b) -> Set a -> Set b
 map f (Set s) = Set $ S.map f s
+
+isSubsetOf :: Ord v => Set v -> Set v -> Bool
+isSubsetOf (Set x) (Set y) = x `S.isSubsetOf` y

src/TypeError.hs

@@ -63,6 +63,7 @@ data TypeError
   | FailedToAddLambdaStructToTyEnv SymPath XObj
   | FailedToInstantiateGenericType Ty
   | InvalidStructField XObj
+  | FunctionLeaksCapture [String] XObj
 
 instance Show TypeError where
   show (SymbolMissingType xobj env) =
@@ -325,6 +326,9 @@ instance Show TypeError where
       ++ " to the type environment."
   show (FailedToInstantiateGenericType ty) =
     "I couldn't instantiate the generic type " ++ show ty
+  show (FunctionLeaksCapture leaks xobj) = 
+    "The function "  ++ pretty xobj ++ " gives away the captured variables: " 
+    ++ joinWithComma leaks ++ ". Functions must keep ownership of variables captured from another environment."
 
 machineReadableErrorStrings :: FilePathPrintLength -> TypeError -> [String]
 machineReadableErrorStrings fppl err =
@@ -443,6 +447,7 @@ machineReadableErrorStrings fppl err =
           ++ pretty xobj
           ++ " to the type environment."
       ]
+    e@(FunctionLeaksCapture _ xobj) -> [machineReadableInfoFromXObj fppl xobj ++ show e] 
     _ ->
       [show err]
 

test/output/test/test-for-errors/lambda_leaking_capture_ownership.carp.output.expected

@@ -0,0 +1,2 @@
+lambda_leaking_capture_ownership.carp:4:2 [ERROR] `I expected an array of valid arguments, but got: (let [string (copy "") leaks (fn [] s)])
+  - `defn` requires an array of arugments, but it got: (let [string (copy "") leaks (fn [] s)])

test/test-for-errors/lambda_leaking_capture_ownership.carp

@@ -0,0 +1,7 @@
+(Project.config "file-path-print-length" "short")
+
+;; see [issue #1040](https://github.com/carp-lang/Carp/issues/1040)
+(defn lambda-leak
+  (let [string @""
+        leaks (fn [] s)]) ;; disallow this
+  ())