Compile: Better alloc & refc debug facilities

2 files changed, 80 insertions, 57 deletions

diff --git a/src/Compile.hs b/src/Compile.hs
index 00b90e3..faf5c22 100644
--- a/src/Compile.hs
+++ b/src/Compile.hs
@@ -40,7 +40,7 @@ import qualified Prelude
 
 import Array
 import AST
-import AST.Pretty (ppSTy)
+import AST.Pretty (ppSTy, ppExpr)
 import qualified CHAD.Types as CHAD
 import Compile.Exec
 import Data
@@ -53,12 +53,16 @@ import qualified Util.IdGen as IdGen
 -- TODO: test that I'm properly incrementing and decrementing refcounts in all required places
 
 
+-- | Print the compiled AST
+debugPrintAST :: Bool; debugPrintAST = toEnum 0
 -- | Print the generated C source
 debugCSource :: Bool; debugCSource = toEnum 0
 -- | Print extra stuff about reference counts of arrays
 debugRefc :: Bool; debugRefc = toEnum 0
 -- | Print some shape-related information
 debugShapes :: Bool; debugShapes = toEnum 0
+-- | Print information on allocation
+debugAllocs :: Bool; debugAllocs = toEnum 0
 -- | Emit extra C code that checks stuff
 emitChecks :: Bool; emitChecks = toEnum 0
 
@@ -66,6 +70,7 @@ compile :: SList STy env -> Ex env t
         -> IO (SList Value env -> IO (Rep t))
 compile = \env expr -> do
   let source = compileToString env expr
+  when debugPrintAST $ hPutStrLn stderr $ "Compiled AST: <<<\n\x1B[2m" ++ ppExpr env expr ++ "\x1B[0m>>>"
   when debugCSource $ hPutStrLn stderr $ "Generated C source: <<<\n\x1B[2m" ++ source ++ "\x1B[0m>>>"
   lib <- buildKernel source ["kernel"]
 
@@ -346,6 +351,23 @@ compileToString env expr =
        ,showString "#include <math.h>\n\n"
        ,compose [printStructDecl sd . showString "\n" | sd <- structs]
        ,showString "\n"
+       ,showString "static void* malloc_instr(size_t n) {\n"
+       ,showString "  void *ptr = malloc(n);"
+       ,if debugAllocs then showString "printf(\"[chad-kernel] malloc(%zu) -> %p\\n\", n, ptr);\n"
+                       else id
+       ,showString "  return ptr;"
+       ,showString "}\n"
+       ,showString "static void* calloc_instr(size_t n) {\n"
+       ,showString "  void *ptr = calloc(n, 1);"
+       ,if debugAllocs then showString "printf(\"[chad-kernel] calloc(%zu) -> %p\\n\", n, ptr);\n"
+                       else id
+       ,showString "  return ptr;"
+       ,showString "}\n"
+       ,showString "static void free_instr(void *ptr) {\n"
+       ,if debugAllocs then showString "printf(\"[chad-kernel] free(%p)\\n\", ptr);\n"
+                       else id
+       ,showString "  free(ptr);"
+       ,showString "}\n\n"
        ,compose [showString str . showString "\n\n" | str <- toList (csTopLevelDecls s)]
        ,showString $
           "static " ++ repSTy (typeOf expr) ++ " typed_kernel(" ++
@@ -517,13 +539,13 @@ compile' :: SList (Const String) env -> Ex env t -> CompM CExpr
 compile' env = \case
   EVar _ t i -> do
     let Const var = slistIdx env i
-    incrementVarAlways Increment t var
+    incrementVarAlways "var" Increment t var
     return $ CELit var
 
   ELet _ rhs body -> do
     var <- compileAssign "" env rhs
     rete <- compile' (Const var `SCons` env) body
-    incrementVarAlways Decrement (typeOf rhs) var
+    incrementVarAlways "let" Decrement (typeOf rhs) var
     return rete
 
   EPair _ a b -> do
@@ -535,7 +557,7 @@ compile' env = \case
   EFst _ e -> do
     let STPair _ t2 = typeOf e
     e' <- compile' env e
-    case incrementVar Decrement t2 of
+    case incrementVar "fst" Decrement t2 of
       Nothing -> return $ CEProj e' "a"
       Just f -> do var <- genName
                    emit $ SVarDecl True (repSTy (typeOf e)) var e'
@@ -545,7 +567,7 @@ compile' env = \case
   ESnd _ e -> do
     let STPair t1 _ = typeOf e
     e' <- compile' env e
-    case incrementVar Decrement t1 of
+    case incrementVar "snd" Decrement t1 of
       Nothing -> return $ CEProj e' "b"
       Just f -> do var <- genName
                    emit $ SVarDecl True (repSTy (typeOf e)) var e'
@@ -584,8 +606,8 @@ compile' env = \case
     -- I know those are not variable names, but it's fine, probably
     (e2, stmts2) <- scope $ compile' (Const (var ++ ".l") `SCons` env) a
     (e3, stmts3) <- scope $ compile' (Const (var ++ ".r") `SCons` env) b
-    ((), stmtsRel1) <- scope $ incrementVarAlways Decrement t1 (var ++ ".l")
-    ((), stmtsRel2) <- scope $ incrementVarAlways Decrement t2 (var ++ ".r")
+    ((), stmtsRel1) <- scope $ incrementVarAlways "case1" Decrement t1 (var ++ ".l")
+    ((), stmtsRel2) <- scope $ incrementVarAlways "case2" Decrement t2 (var ++ ".r")
     retvar <- genName
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SBlock (pure (SVarDecl True (repSTy (typeOf e)) var e1)
@@ -613,7 +635,7 @@ compile' env = \case
     var <- genName
     (e2, stmts2) <- scope $ compile' env a
     (e3, stmts3) <- scope $ compile' (Const (var ++ ".j") `SCons` env) b
-    ((), stmtsRel) <- scope $ incrementVarAlways Decrement t (var ++ ".j")
+    ((), stmtsRel) <- scope $ incrementVarAlways "maybe" Decrement t (var ++ ".j")
     retvar <- genName
     emit $ SVarDeclUninit (repSTy (typeOf a)) retvar
     emit $ SBlock (pure (SVarDecl True (repSTy (typeOf e)) var e1)
@@ -639,7 +661,7 @@ compile' env = \case
   EBuild _ n esh efun -> do
     shname <- compileAssign "sh" env esh
 
-    arrname <- allocArray Malloc "arr" n (typeOf efun) Nothing (indexTupleComponents n shname)
+    arrname <- allocArray "build" Malloc "arr" n (typeOf efun) Nothing (indexTupleComponents n shname)
 
     idxargname <- genName' "ix"
     (funretval, funstmts) <- scope $ compile' (Const idxargname `SCons` env) efun
@@ -670,21 +692,21 @@ compile' env = \case
     -- unexpected. But it's exactly what we want, so we do it anyway.
     emit $ SVarDecl True (repSTy tIx) shszname (compileArrShapeSize n arrname)
 
-    resname <- allocArray Malloc "foldres" n t (Just (CELit shszname))
+    resname <- allocArray "fold" Malloc "foldres" n t (Just (CELit shszname))
                   [CELit (arrname ++ ".buf->sh[" ++ show i ++ "]") | i <- [0 .. fromSNat n - 1]]
 
     lenname <- genName' "n"
     emit $ SVarDecl True (repSTy tIx) lenname
                     (CELit (arrname ++ ".buf->sh[" ++ show (fromSNat n) ++ "]"))
 
-    ((), x0incrStmts) <- scope $ incrementVarAlways Increment t x0name
+    ((), x0incrStmts) <- scope $ incrementVarAlways "foldx0" Increment t x0name
 
     ivar <- genName' "i"
     jvar <- genName' "j"
     accvar <- genName' "tot"
     let arreltlit = arrname ++ ".buf->xs[" ++ lenname ++ " * " ++ ivar ++ " + " ++ jvar ++ "];"
     (funres, funStmts) <- scope $ compile' (Const arreltlit `SCons` Const accvar `SCons` env) efun
-    ((), arreltIncrStmts) <- scope $ incrementVarAlways Increment t arreltlit
+    ((), arreltIncrStmts) <- scope $ incrementVarAlways "foldelt" Increment t arreltlit
 
     emit $ SLoop (repSTy tIx) ivar (CELit "0") (CELit shszname) $
              pure (SVarDecl False (repSTy t) accvar (CELit x0name))
@@ -699,8 +721,8 @@ compile' env = \case
                         <> pure (SAsg accvar funres))
              <> pure (SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit accvar))
 
-    incrementVarAlways Decrement t x0name
-    incrementVarAlways Decrement (typeOf earr) arrname
+    incrementVarAlways "foldx0" Decrement t x0name
+    incrementVarAlways "foldarr" Decrement (typeOf earr) arrname
 
     return (CELit resname)
 
@@ -714,7 +736,7 @@ compile' env = \case
     -- This n is one less than the shape of the thing we're querying, like EFold1Inner.
     emit $ SVarDecl True (repSTy tIx) shszname (compileArrShapeSize n argname)
 
-    resname <- allocArray Malloc "sumres" n t (Just (CELit shszname))
+    resname <- allocArray "sum" Malloc "sumres" n t (Just (CELit shszname))
                   [CELit (argname ++ ".buf->sh[" ++ show i ++ "]") | i <- [0 .. fromSNat n - 1]]
 
     lenname <- genName' "n"
@@ -731,7 +753,7 @@ compile' env = \case
                 pure $ SVerbatim $ accvar ++ " += " ++ argname ++ ".buf->xs[" ++ lenname ++ " * " ++ ivar ++ " + " ++ jvar ++ "];"
              ,SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit accvar)]
 
-    incrementVarAlways Decrement (typeOf e) argname
+    incrementVarAlways "sum" Decrement (typeOf e) argname
 
     return (CELit resname)
 
@@ -741,7 +763,7 @@ compile' env = \case
     strname <- emitStruct typ
     name <- genName
     emit $ SVarDecl True strname name (CEStruct strname
-                  [("buf", CECall "malloc" [CELit (show (8 + sizeofSTy (typeOf e)))])])
+                  [("buf", CECall "malloc_instr" [CELit (show (8 + sizeofSTy (typeOf e)))])])
     emit $ SAsg (name ++ ".buf->refc") (CELit "1")
     emit $ SAsg (name ++ ".buf->xs[0]") e'
     return (CELit name)
@@ -756,7 +778,7 @@ compile' env = \case
     shszname <- genName' "shsz"
     emit $ SVarDecl True (repSTy tIx) shszname (compileArrShapeSize n argname)
 
-    resname <- allocArray Malloc "rep" (SS n) t
+    resname <- allocArray "repl1i" Malloc "rep" (SS n) t
                  (Just (CEBinop (CELit shszname) "*" (CELit lenname)))
                  ([CELit (argname ++ ".buf->sh[" ++ show i ++ "]") | i <- [0 .. fromSNat n - 1]]
                   ++ [CELit lenname])
@@ -768,7 +790,7 @@ compile' env = \case
                pure $ SAsg (resname ++ ".buf->xs[" ++ ivar ++ " * " ++ lenname ++ " + " ++ jvar ++ "]")
                            (CELit (argname ++ ".buf->xs[" ++ ivar ++ "]"))
 
-    incrementVarAlways Decrement (typeOf earg) argname
+    incrementVarAlways "repl1i" Decrement (typeOf earg) argname
 
     return (CELit resname)
 
@@ -785,7 +807,7 @@ compile' env = \case
     name <- genName
     emit $ SVarDecl True (repSTy t) name
               (CEIndex (CEPtrProj (CEProj (CELit arrname) "buf") "xs") (CELit "0"))
-    incrementVarAlways Decrement (STArr SZ t) arrname
+    incrementVarAlways "idx0" Decrement (STArr SZ t) arrname
     return (CELit name)
 
   -- EIdx1 _ a b -> error "TODO" -- EIdx1 ext (compile' a) (compile' b)
@@ -809,7 +831,7 @@ compile' env = \case
 
     resname <- genName' "ixres"
     emit $ SVarDecl True (repSTy t) resname (CEIndex (CELit (arrname ++ ".buf->xs")) (toLinearIdx n arrname idxname))
-    incrementVarAlways Decrement (STArr n t) arrname
+    incrementVarAlways "idx" Decrement (STArr n t) arrname
     return (CELit resname)
 
   EShape _ e -> do
@@ -820,7 +842,7 @@ compile' env = \case
     zeroRefcountCheck (typeOf e) "shape" name
     resname <- genName
     emit $ SVarDecl True (repSTy t) resname (compileShapeQuery n name)
-    incrementVarAlways Decrement (typeOf e) name
+    incrementVarAlways "shape" Decrement (typeOf e) name
     return (CELit resname)
 
   EOp _ op (EPair _ e1 e2) -> do
@@ -835,7 +857,7 @@ compile' env = \case
   ECustom _ _ _ _ earg _ _ e1 e2 -> do
     name1 <- compileAssign "" env e1
     name2 <- compileAssign "" env e2
-    case (incrementVar Decrement (typeOf e1), incrementVar Decrement (typeOf e2)) of
+    case (incrementVar "custom1" Decrement (typeOf e1), incrementVar "custom2" Decrement (typeOf e2)) of
       (Nothing, Nothing) -> compile' (Const name2 `SCons` Const name1 `SCons` SNil) earg
       (mfun1, mfun2) -> do
         name <- compileAssign "" (Const name2 `SCons` Const name1 `SCons` SNil) earg
@@ -853,7 +875,7 @@ compile' env = \case
     mcopy <- copyForWriting (CHAD.d2 t) name1
     accname <- genName' "accum"
     emit $ SVarDecl False actyname accname
-              (CEStruct actyname [("buf", CECall "malloc" [CELit (show (sizeofSTy (CHAD.d2 t)))])])
+              (CEStruct actyname [("buf", CECall "malloc_instr" [CELit (show (sizeofSTy (CHAD.d2 t)))])])
     emit $ SAsg (accname++".buf->ac") (maybe (CELit name1) id mcopy)
     emit $ SVerbatim $ "// initial accumulator constructed (" ++ name1 ++ ")."
 
@@ -861,7 +883,7 @@ compile' env = \case
 
     resname <- genName' "acret"
     emit $ SVarDecl True (repSTy (CHAD.d2 t)) resname (CELit (accname++".buf->ac"))
-    emit $ SVerbatim $ "free(" ++ accname ++ ".buf);"
+    emit $ SVerbatim $ "free_instr(" ++ accname ++ ".buf);"
 
     rettyname <- emitStruct (STPair (typeOf e2) (CHAD.d2 t))
     return $ CEStruct rettyname [("a", e2'), ("b", CELit resname)]
@@ -934,7 +956,7 @@ compile' env = \case
           initD2Maybe tj v
           accumRef tj prj' (v++".j") i
         accumRef (STArr n t') (SAPArrIdx prj' _) v i = do
-          (newarrName, newarrStmts) <- scope $ allocArray Calloc "prjarr" n t' Nothing (indexTupleComponents n (i++".a.b"))
+          (newarrName, newarrStmts) <- scope $ allocArray "accumRef" Calloc "prjarr" n t' Nothing (indexTupleComponents n (i++".a.b"))
           emit $ SIf (CEBinop (CELit (v++".tag")) "==" (CELit "0"))
                    (pure (SAsg (v++".tag") (CELit "1"))
                     <> newarrStmts
@@ -1018,7 +1040,7 @@ compile' env = \case
     dest <- accumRef t prj (nameacc++".buf->ac") nameidx
     add (acPrjTy prj t) dest nameval
 
-    incrementVarAlways Decrement (typeOf eval) nameval
+    incrementVarAlways "accumval" Decrement (typeOf eval) nameval
     emit $ SVerbatim $ "// compile EAccum end"
 
     return $ CEStruct (repSTy STNil) []
@@ -1052,14 +1074,14 @@ data Increment = Increment | Decrement
   deriving (Show)
 
 -- | Increment reference counts in the components of the given variable.
-incrementVar :: Increment -> STy a -> Maybe (String -> CompM ())
-incrementVar inc ty =
+incrementVar :: String -> Increment -> STy a -> Maybe (String -> CompM ())
+incrementVar marker inc ty =
   let tree = makeArrayTree ty
   in case tree of ATNoop -> Nothing
-                  _ -> Just $ \var -> incrementVar' inc var tree
+                  _ -> Just $ \var -> incrementVar' marker inc var tree
 
-incrementVarAlways :: Increment -> STy a -> String -> CompM ()
-incrementVarAlways inc ty var = maybe (pure ()) ($ var) (incrementVar inc ty)
+incrementVarAlways :: String -> Increment -> STy a -> String -> CompM ()
+incrementVarAlways marker inc ty var = maybe (pure ()) ($ var) (incrementVar marker inc ty)
 
 data ArrayTree = ATArray (Some SNat) (Some STy)  -- ^ we've arrived at an array we need to decrement the refcount of (contains rank and element type of the array)
                | ATNoop  -- ^ don't do anything here
@@ -1091,25 +1113,25 @@ makeArrayTree (STArr n t) = ATArray (Some n) (Some t)
 makeArrayTree (STScal _) = ATNoop
 makeArrayTree (STAccum _) = ATNoop
 
-incrementVar' :: Increment -> String -> ArrayTree -> CompM ()
-incrementVar' inc path (ATArray (Some n) (Some eltty)) =
+incrementVar' :: String -> Increment -> String -> ArrayTree -> CompM ()
+incrementVar' marker inc path (ATArray (Some n) (Some eltty)) =
   case inc of
     Increment -> do
       emit $ SVerbatim (path ++ ".buf->refc++;")
       when debugRefc $
-        emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p in+ -> %zu\\n\", " ++ path ++ ".buf, " ++ path ++ ".buf->refc);"
+        emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p in+ -> %zu <" ++ marker ++ ">\\n\", " ++ path ++ ".buf, " ++ path ++ ".buf->refc);"
     Decrement -> do
-      case incrementVar Decrement eltty of
+      case incrementVar (marker++".elt") Decrement eltty of
         Nothing ->
           if debugRefc
             then do
-              emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p de- -> %zu\", " ++ path ++ ".buf, " ++ path ++ ".buf->refc - 1);"
-              emit $ SVerbatim $ "if (--" ++ path ++ ".buf->refc == 0) { fprintf(stderr, \"; free(\"); free(" ++ path ++ ".buf); fprintf(stderr, \") ok\\n\"); } else fprintf(stderr, \"\\n\");"
+              emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p de- -> %zu <" ++ marker ++ ">\", " ++ path ++ ".buf, " ++ path ++ ".buf->refc - 1);"
+              emit $ SVerbatim $ "if (--" ++ path ++ ".buf->refc == 0) { fprintf(stderr, \"; free(\"); free_instr(" ++ path ++ ".buf); fprintf(stderr, \") ok\\n\"); } else fprintf(stderr, \"\\n\");"
             else do
-              emit $ SVerbatim $ "if (--" ++ path ++ ".buf->refc == 0) free(" ++ path ++ ".buf);"
+              emit $ SVerbatim $ "if (--" ++ path ++ ".buf->refc == 0) free_instr(" ++ path ++ ".buf);"
         Just f -> do
           when debugRefc $
-            emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p de- -> %zu recfree\\n\", " ++ path ++ ".buf, " ++ path ++ ".buf->refc - 1);"
+            emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p de- -> %zu <" ++ marker ++ "> recfree\\n\", " ++ path ++ ".buf, " ++ path ++ ".buf->refc - 1);"
           shszvar <- genName' "frshsz"
           ivar <- genName' "i"
           ((), eltDecrStmts) <- scope $ f (path ++ ".buf->xs[" ++ ivar ++ "]")
@@ -1117,15 +1139,15 @@ incrementVar' inc path (ATArray (Some n) (Some eltty)) =
                    (BList [SVarDecl True "size_t" shszvar (compileArrShapeSize n path)
                           ,SLoop "size_t" ivar (CELit "0") (CELit shszvar) $
                              eltDecrStmts
-                          ,SVerbatim $ "free(" ++ path ++ ".buf);"])
+                          ,SVerbatim $ "free_instr(" ++ path ++ ".buf);"])
                    mempty
-incrementVar' _ _ ATNoop = pure ()
-incrementVar' inc path (ATProj field t) = incrementVar' inc (path ++ "." ++ field) t
-incrementVar' inc path (ATCondTag t1 t2) = do
-  ((), stmts1) <- scope $ incrementVar' inc path t1
-  ((), stmts2) <- scope $ incrementVar' inc path t2
+incrementVar' _ _ _ ATNoop = pure ()
+incrementVar' marker inc path (ATProj field t) = incrementVar' (marker++"."++field) inc (path ++ "." ++ field) t
+incrementVar' marker inc path (ATCondTag t1 t2) = do
+  ((), stmts1) <- scope $ incrementVar' (marker++".t1") inc path t1
+  ((), stmts2) <- scope $ incrementVar' (marker++".t2") inc path t2
   emit $ SIf (CEBinop (CELit (path ++ ".tag")) "==" (CELit "0")) stmts1 stmts2
-incrementVar' inc path (ATBoth t1 t2) = incrementVar' inc path t1 >> incrementVar' inc path t2
+incrementVar' marker inc path (ATBoth t1 t2) = incrementVar' (marker++".1") inc path t1 >> incrementVar' (marker++".2") inc path t2
 
 toLinearIdx :: SNat n -> String -> String -> CExpr
 toLinearIdx SZ _ _ = CELit "0"
@@ -1146,8 +1168,8 @@ data AllocMethod = Malloc | Calloc
   deriving (Show)
 
 -- | The shape must have the outer dimension at the head (and the inner dimension on the right).
-allocArray :: AllocMethod -> String -> SNat n -> STy t -> Maybe CExpr -> [CExpr] -> CompM String
-allocArray method nameBase rank eltty mshsz shape = do
+allocArray :: String -> AllocMethod -> String -> SNat n -> STy t -> Maybe CExpr -> [CExpr] -> CompM String
+allocArray marker method nameBase rank eltty mshsz shape = do
   when (length shape /= fromSNat rank) $
     error "allocArray: shape does not match rank"
   let arrty = STArr rank eltty
@@ -1160,13 +1182,13 @@ allocArray method nameBase rank eltty mshsz shape = do
                            "+"
                            (CEBinop shsz "*" (CELit (show (sizeofSTy eltty))))
   emit $ SVarDecl True strname arrname $ CEStruct strname
-            [("buf", case method of Malloc -> CECall "malloc" [nbytesExpr]
-                                    Calloc -> CECall "calloc" [nbytesExpr, CELit "1"])]
+            [("buf", case method of Malloc -> CECall "malloc_instr" [nbytesExpr]
+                                    Calloc -> CECall "calloc_instr" [nbytesExpr])]
   forM_ (zip shape [0::Int ..]) $ \(dim, i) ->
     emit $ SAsg (arrname ++ ".buf->sh[" ++ show i ++ "]") dim
   emit $ SAsg (arrname ++ ".buf->refc") (CELit "1")
   when debugRefc $
-    emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p allocated\\n\", " ++ arrname ++ ".buf);"
+    emit $ SVerbatim $ "fprintf(stderr, \"[chad-kernel] arr %p allocated <" ++ marker ++ ">\\n\", " ++ arrname ++ ".buf);"
   return arrname
 
 compileShapeQuery :: SNat n -> String -> CExpr
@@ -1271,7 +1293,7 @@ compileExtremum nameBase opName operator env e = do
   -- unexpected. But it's exactly what we want, so we do it anyway.
   emit $ SVarDecl True (repSTy tIx) shszname (compileArrShapeSize n argname)
 
-  resname <- allocArray Malloc (nameBase ++ "res") n t (Just (CELit shszname))
+  resname <- allocArray nameBase Malloc (nameBase ++ "res") n t (Just (CELit shszname))
                 [CELit (argname ++ ".buf->sh[" ++ show i ++ "]") | i <- [0 .. fromSNat n - 1]]
 
   lenname <- genName' "n"
@@ -1293,7 +1315,7 @@ compileExtremum nameBase opName operator env e = do
               ]
            ,SAsg (resname ++ ".buf->xs[" ++ ivar ++ "]") (CELit redvar)]
 
-  incrementVarAlways Decrement (typeOf e) argname
+  incrementVarAlways nameBase Decrement (typeOf e) argname
 
   return (CELit resname)
 
@@ -1366,7 +1388,7 @@ copyForWriting topty var = case topty of
                   totalbytes = CEBinop (CELit (show (shbytes + 8))) "+" databytes
               in BList
                [SVarDecl True (repSTy tIx) shszname (compileArrShapeSize n var)
-               ,SAsg name (CEStruct (repSTy (STArr n t)) [("buf", CECall "malloc" [totalbytes])])
+               ,SAsg name (CEStruct (repSTy (STArr n t)) [("buf", CECall "malloc_instr" [totalbytes])])
                ,SVerbatim $ "memcpy(" ++ name ++ ".buf->sh, " ++ var ++ ".buf->sh, " ++
                                       show shbytes ++ ");"
                ,SAsg (name ++ ".buf->refc") (CELit "1")
@@ -1384,7 +1406,7 @@ copyForWriting topty var = case topty of
 
     name <- genName
     emit $ SVarDecl False (repSTy (STArr n t)) name
-             (CEStruct (repSTy (STArr n t)) [("buf", CECall "malloc" [totalbytes])])
+             (CEStruct (repSTy (STArr n t)) [("buf", CECall "malloc_instr" [totalbytes])])
     emit $ SVerbatim $ "memcpy(" ++ name ++ ".buf->sh, " ++ var ++ ".buf->sh, " ++
                                  show shbytes ++ ");"
     emit $ SAsg (name ++ ".buf->refc") (CELit "1")
diff --git a/src/Compile/Exec.hs b/src/Compile/Exec.hs
index b01b715..9b29486 100644
--- a/src/Compile/Exec.hs
+++ b/src/Compile/Exec.hs
@@ -39,7 +39,8 @@ buildKernel csource funnames = do
              ,"-shared", "-fPIC"
              ,"-std=c99", "-x", "c"
              ,"-o", outso, "-"
-             ,"-Wall", "-Wextra", "-Wno-unused-variable", "-Wno-unused-parameter"]
+             ,"-Wall", "-Wextra"
+             ,"-Wno-unused-variable", "-Wno-unused-parameter", "-Wno-unused-function"]
   (ec, gccStdout, gccStderr) <- readProcessWithExitCode "gcc" args csource
 
   -- Print the source before the GCC output.