Can load the core library without complaints. Tests still fail.

core/Map.carp

@@ -128,8 +128,9 @@
   (defn put [m k v]
     (let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
       (update-buckets m &(fn [b]
-        (let [n (Array.nth &b idx)]
-          (Array.aset b idx (Bucket.put @n k v)))))))
+        (let [n (Array.nth &b idx)
+              b2 (Bucket.put @n k v)]
+          (Array.aset b idx b2))))))
 
   (doc put! "Put a a value v into map m, using the key k, in place.")
   (defn put! [m k v]
@@ -160,7 +161,8 @@
               i (Bucket.find n k)]
           (if (<= 0 i)
             ;; currently can't write a Bucket.update that takes f due to bug #347
-            (Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
+            (let [new-b (Bucket.set-idx @n i &(~f (Bucket.get-idx n i)))]
+              (Array.aset b idx new-b))
             b))))))
 
   (doc update-with-default "Update value at key k in map with function f. If k doesn't exist in map, set k to (f v).")
@@ -168,10 +170,12 @@
     (let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
       (update-buckets m &(fn [b]
         (let [n (Array.nth &b idx)
-              i (Bucket.find n k)]
+              i (Bucket.find n @&k)] ;; Change type signature for Bucket.find to take a ref instead!
           (if (<= 0 i)
-            (Array.aset b idx (Bucket.set-idx @n i &(~f (Bucket.get-idx n i))))
-            (Array.aset b idx (Bucket.push-back @n k &(~f @&v)))))))))
+            (let [new-b (Bucket.set-idx @n i &(~f (Bucket.get-idx n i)))]
+              (Array.aset b idx new-b))
+            (let [new-b (Bucket.push-back @n k &(~f @&v))]
+              (Array.aset b idx new-b))))))))
 
   (doc length "Get the length of the map m.")
   (defn length [m]
@@ -193,8 +197,9 @@
   (defn remove [m k]
     (let [idx (Int.positive-mod (hash k) @(n-buckets &m))]
       (update-buckets m &(fn [b]
-        (let [n (Array.nth &b idx)]
-          (Array.aset b idx (Bucket.shrink @n k)))))))
+        (let [n (Array.nth &b idx)
+              new-b (Bucket.shrink @n k)]
+          (Array.aset b idx new-b))))))
 
   (doc all? "Do all key-value pairs pass the given predicate (of two arguments)?")
   (defn all? [pred m]
@@ -341,10 +346,12 @@
   (defn put [s k]
     (let [idx (Int.positive-mod (hash k) @(n-buckets &s))]
       (update-buckets s &(fn [b]
-        (let [n (Array.nth &b idx)]
-          (if (SetBucket.contains? n k)
+        (let [n (Array.nth &b idx)
+              kk @&k] ;; TODO: Fix this weird lifetime hackery!
+          (if (SetBucket.contains? n kk)
             b
-            (Array.aset b idx (SetBucket.grow n @k))))))))
+            (let [new-b (SetBucket.grow n @kk)]
+              (Array.aset b idx new-b))))))))
 
   (doc put! "Put a a key k into the set s, in place.")
   (defn put! [s k]
@@ -374,8 +381,9 @@
   (defn remove [s k]
     (let [idx (Int.positive-mod (hash k) @(n-buckets &s))]
       (update-buckets s &(fn [b]
-        (let [n (Array.nth &b idx)]
-          (Array.aset b idx (SetBucket.shrink n k)))))))
+        (let [n (Array.nth &b idx)
+              new-b (SetBucket.shrink n k)]
+          (Array.aset b idx new-b))))))
 
   (doc all? "Does the predicate hold for all values in this set?")
   (defn all? [pred set]

examples/lifetimes.carp

@@ -89,5 +89,14 @@
 ;;         z 123]
 ;;     (Int.+ x y)))
 
-(defn f []
-  &100)
+;; (defn f []
+;;   &100) ;; TODO: Number literals should create prim var deleter too!
+
+(use Map)
+(use Bucket)
+
+(defn put [k v]
+  (fn [b]
+    (let [n (Array.nth &b 0)
+          new-b (Bucket.put @n k v)]
+      (Array.aset b 0 new-b))))

src/Concretize.hs

@@ -1042,7 +1042,9 @@ manageMemory typeEnv globalEnv root =
             Just notThisType ->
               --trace ("Won't add to mappings! " ++ pretty xobj ++ " : " ++ show notThisType ++ " at " ++ prettyInfoFromXObj xobj) $
               return ()
-            _ -> return ()
+            _ ->
+              --trace ("No type on " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj) $
+              return ()
             where makeLifetimeMode xobj =
                     if internal then
                       LifetimeInsideFunction $
@@ -1066,7 +1068,7 @@ manageMemory typeEnv globalEnv root =
                                                                     )
                                             deleters
                      in case matchingDeleters of
-                          [] -> --trace ("Can't use reference " ++ pretty xobj ++ " (with lifetime '" ++ lt ++ "', depending on " ++ show deleterName ++ ") at " ++ prettyInfoFromXObj xobj ++ ", it's not alive here:\n" ++ show xobj ++ "\nMappings: " ++ show lifetimeMappings ++ "\nAlive: " ++ show deleters ++ "\n") $
+                          [] -> trace ("Can't use reference " ++ pretty xobj ++ " (with lifetime '" ++ lt ++ "', depending on " ++ show deleterName ++ ") at " ++ prettyInfoFromXObj xobj ++ ", it's not alive here:\n" ++ show xobj ++ "\nMappings: " ++ show lifetimeMappings ++ "\nAlive: " ++ show deleters ++ "\n") $
                             return (Right xobj)
                           _ ->
                             return (Right xobj)
@@ -1085,8 +1087,8 @@ manageMemory typeEnv globalEnv root =
 
         visitLetBinding :: (XObj, XObj) -> State MemState (Either TypeError (XObj, XObj))
         visitLetBinding  (name, expr) =
-          do addToLifetimesMappingsIfRef True expr
-             visitedExpr <- visit expr
+          do visitedExpr <- visit expr
+             addToLifetimesMappingsIfRef True expr
              result <- transferOwnership expr name
              return $ case result of
                         Left e -> Left e