From 3e5bdc0698d727d350790f8f567dc2e2e0423d13 Mon Sep 17 00:00:00 2001
From: Scott Olsen <scg.olsen@gmail.com>
Date: Mon, 4 Apr 2022 13:05:54 -0400
Subject: [PATCH] feat: don't manage blittable types (#1407)

---
 src/Managed.hs   | 16 +++++++++++++---
 test/memory.carp | 27 +++++++++++++++++++++++++++
 2 files changed, 40 insertions(+), 3 deletions(-)

diff --git a/src/Managed.hs b/src/Managed.hs
index 0ef1ae52..0eb8e08e 100644
--- a/src/Managed.hs
+++ b/src/Managed.hs
@@ -7,15 +7,25 @@ import Types
 -- | Should this type be handled by the memory management system.
 -- Implementation note: This top-level pattern match should be able to just
 -- match on all types and see whether they implement 'delete', but for some
--- reson that doesn't work. Might need to handle generic types separately?
+-- reason that doesn't work. Might need to handle generic types separately?
+--
+-- TODO: When blit and delete are both implemented, issue a warning.
 isManaged :: TypeEnv -> Env -> Ty -> Bool
 isManaged typeEnv globalEnv structTy@StructTy {} =
-  interfaceImplementedForTy typeEnv globalEnv "delete" (FuncTy [structTy] UnitTy StaticLifetimeTy)
+  not (isBlittable typeEnv globalEnv structTy)
+    && interfaceImplementedForTy typeEnv globalEnv "delete" (FuncTy [structTy] UnitTy StaticLifetimeTy)
 isManaged typeEnv globalEnv funcTy@FuncTy {} =
-  interfaceImplementedForTy typeEnv globalEnv "delete" (FuncTy [funcTy] UnitTy StaticLifetimeTy)
+  not (isBlittable typeEnv globalEnv funcTy)
+    && interfaceImplementedForTy typeEnv globalEnv "delete" (FuncTy [funcTy] UnitTy StaticLifetimeTy)
 isManaged _ _ StringTy =
   True
 isManaged _ _ PatternTy =
   True
 isManaged _ _ _ =
   False
+
+-- | Returns true if this type implements the "blit" interface and is thus
+-- freely copyable.
+isBlittable :: TypeEnv -> Env -> Ty -> Bool
+isBlittable typeEnv globalEnv t =
+  interfaceImplementedForTy typeEnv globalEnv "blit" (FuncTy [t] t StaticLifetimeTy)
diff --git a/test/memory.carp b/test/memory.carp
index d3aaaca8..32ba8ad0 100644
--- a/test/memory.carp
+++ b/test/memory.carp
@@ -18,6 +18,32 @@
       (f)
       (assert-equal state 0l (Debug.memory-balance) descr)))
 
+(deftype BlitEnum Copy Move)
+(defmodule BlitEnum
+  (defn blit [x] (the BlitEnum x))
+  (implements blit blit)
+
+  (defn prn [x]
+    (match x
+      (BlitEnum.Copy) @"copy semantics"
+      (BlitEnum.Move) @"move semantics"))
+  (implements prn prn)
+
+  (defn change [x]
+    (match x
+      (BlitEnum.Copy) (BlitEnum.Move)
+      (BlitEnum.Move) (BlitEnum.Copy)))
+)
+
+(defn blit-1 []
+  ;; blit types are not borrow checked and have copy semantics
+  (let-do [enum (BlitEnum.Copy)
+           enum-copy enum]
+    (IO.println &(prn enum))
+    (IO.println &(prn enum-copy))
+    (IO.println &(prn (change enum)))
+    (IO.println &(prn (change enum-copy)))))
+
 (defn scope-1 []
   (let [s @""]
     ()))
@@ -568,4 +594,5 @@
   (assert-no-leak test sumtype-12 "sumtype-12 does not leak")
   (assert-no-leak test box-1 "box-1 does not leak")
   (assert-no-leak test box-2 "box-2 does not leak")
+  (assert-no-leak test blit-1 "blit-1 does not leak")
   )