fix: port #1440 by @scolsen to new machinery

Author: hellerve

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/Memory.hs

@@ -524,10 +524,13 @@ unmanage typeEnv globalEnv xobj =
                   then Left (UsingCapturedValue xobj)
                   else Left (UsingUnownedValue xobj)
             [one] ->
-              let newDeleters = Set.delete one (memStateDeleters m)
-               in do
-                    put $ m {memStateDeleters = newDeleters}
-                    pure (Right ())
+              if isSymbolThatCaptures xobj
+                then pure (Left (GivingAwayCapturedValue xobj))
+                else
+                  let newDeleters = Set.delete one (memStateDeleters m)
+                   in do
+                        put $ m {memStateDeleters = newDeleters}
+                        pure (Right ())
             tooMany -> error ("Too many variables with the same name in set: " ++ show tooMany)
         else pure (Right ())
 

src/TypeError.hs

@@ -64,6 +64,7 @@ data TypeError
   | FailedToAddLambdaStructToTyEnv SymPath XObj
   | FailedToInstantiateGenericType Ty
   | InvalidStructField XObj
+  | GivingAwayCapturedValue XObj
 
 instance Show TypeError where
   show (SymbolMissingType xobj env) =
@@ -334,6 +335,9 @@ instance Show TypeError where
       ++ " to the type environment."
   show (FailedToInstantiateGenericType ty) =
     "I couldn't instantiate the generic type " ++ show ty
+  show (GivingAwayCapturedValue xobj) =
+    "Can't give away the captured value '" ++ pretty xobj ++ "' at " ++ prettyInfoFromXObj xobj
+      ++ ". Captured values can be borrowed with `&` or copied with `@&`, not moved."
 
 machineReadableErrorStrings :: FilePathPrintLength -> TypeError -> [String]
 machineReadableErrorStrings fppl err =
@@ -460,6 +464,8 @@ machineReadableErrorStrings fppl err =
           ++ pretty xobj
           ++ " to the type environment."
       ]
+    (GivingAwayCapturedValue xobj) ->
+      [machineReadableInfoFromXObj fppl xobj ++ " Can't give away captured value '" ++ pretty xobj ++ "'."]
     _ ->
       [show err]
 

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

@@ -0,0 +1 @@
+lambda_leaking_capture.carp:6:18 Can't give away captured value 's'.

test/test-for-errors/lambda_leaking_capture.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 [s @""
+        f (fn [] s)]
+    (ignore (f))))