Strict backend is complete w. no leaking

examples/ack.kha

@@ -1,12 +1,13 @@
+open Stdlib
 let rec ack m n : int -> int -> int =
-    if (Stdlib.(=) m 0) then
-       Stdlib.(+) n 1
+    if (m = 0) then
+       n + 1
     else
-    if (Stdlib.(=) n 0) then
-       ack (Stdlib.(-) m 1) 1
+    if (n = 0) then
+       ack (m - 1) 1
     else
-    ack (Stdlib.(-) m 1)
-    	(ack m (Stdlib.(-) n 1))
+    ack (m - 1)
+    	(ack m (n - 1))
 
 let main x : () -> () =
-    Stdlib.print_int (ack 3 2)
+    print_int $ ack 3 5

examples/fib.kha

@@ -7,4 +7,4 @@ let rec fib n : int -> int =
   else
     fib (n - 1) + fib (n - 2)
 
-let main x : () -> () = print_int $ fib 30
+let main x : () -> () = print_int $ fib 25

lib/backend/emit_c.ml

@@ -45,59 +45,84 @@ let lookup x (tbl : (khagmid * string) list) =
   | Some x -> x
   | None -> raise (Impossible "not_found")
 
+let counter = ref 0
+
+let gen_uniq_name () =
+  let tmp = !counter in
+  counter := !counter + 1;
+  "tmp_var_" ^ string_of_int tmp
+
+let emission = ref []
+let adds_default () = [ "IFELSETEMP" ]
+let adds = ref [ "IFELSETEMP" ]
 let emit_ptr tbl name = "make_raw_ptr(&" ^ mangle_top tbl name ^ ")"
+
 let emit_ref name = "ref(" ^ name ^ ")"
 
-let rec emit_tuple x tbl =
-  let tmp = List.map (fun x -> codegen_func x tbl) x in
-  let codes = List.map fst tmp in
-  let adds = List.flatten @@ List.map snd tmp in
-  ( "make_tuple("
+and gen_new s =
+  let n' = gen_uniq_name () in
+  emission := (n' ^ " = " ^ s ^ ";\n") :: !emission;
+  adds := n' :: !adds;
+  n'
+
+let rec emit_tuple tbl x =
+  let codes = List.map (fun x -> codegen_func x tbl) x in
+  gen_new
+    ("make_tuple("
     ^ (string_of_int @@ List.length x)
-    ^ ", " ^ String.concat ", " codes ^ ")",
-    adds )
+    ^ ", " ^ String.concat ", " codes ^ ")")
 
-and emit_call e1 e2 tbl =
-  let b1, add1 = codegen_func e1 tbl in
-  let b2, add2 = codegen_func e2 tbl in
-  ("call(" ^ b1 ^ ", " ^ b2 ^ ")", add1 @ add2)
+and emit_call tbl e1 e2 =
+  let b1 = codegen_func e1 tbl in
+  let b2 = codegen_func e2 tbl in
+  gen_new ("call(" ^ b1 ^ ", " ^ b2 ^ ")")
 
 and emit_unboxed b =
   match b with
-  | Int' x -> "make_int(" ^ x ^ ")"
-  | Float' x -> "make_float(" ^ x ^ ")"
-  | Bool' x -> if x then "1" else "0"
-  | String' x -> "make_string(\"" ^ Str.quote x ^ "\")"
+  | Float' s -> "make_float(" ^ s ^ ")"
+  | String' s -> "make_string(\"" ^ String.escaped s ^ "\")"
+  | Int' s -> "make_int(" ^ s ^ ")"
+  | Bool' b -> ( match b with true -> "make_int(1)" | false -> "make_int(0)")
+
+and add_to_emi s = emission := s :: !emission
 
 and codegen_func code tbl =
   match code with
-  | Val x ->
-      if is_toplevel x tbl then (emit_ptr tbl x, [])
-      else (emit_ref (mangle x), [])
-  | Unboxed b -> (emit_unboxed b, [])
-  | Tuple t -> emit_tuple t tbl
-  | Call (e1, e2) -> emit_call e1 e2 tbl
+  | Val v ->
+      if is_toplevel v tbl then gen_new (emit_ptr tbl v)
+      else gen_new (emit_ref (mangle v))
+  | Unboxed v -> gen_new (emit_unboxed v)
+  | Tuple t -> emit_tuple tbl t
+  | Call (e1, e2) -> emit_call tbl e1 e2
   | Seq (e1, e2) ->
-      let b1, add = codegen_func e1 tbl in
-      let b2, add2 = codegen_func e2 tbl in
-      ("(" ^ b1 ^ ", " ^ b2 ^ ")", add @ add2)
+      ignore @@ codegen_func e1 tbl;
+      codegen_func e2 tbl
   | Let (id, e1, e2) ->
-      let b1, add1 = codegen_func e1 tbl in
-      let b2, add2 = codegen_func e2 tbl in
-      ( "(" ^ mangle id ^ " = " ^ b1 ^ ", " ^ b2 ^ ")",
-        mangle id :: (add1 @ add2) )
+      let n' = codegen_func e1 tbl in
+      emission :=
+        ("kha_obj * " ^ mangle id ^ " = ref(" ^ n' ^ ");\n") :: !emission;
+      codegen_func e2 tbl
   | IfElse (c, e1, e2) ->
-      let c', add1 = codegen_func c tbl in
-      let b1, add2 = codegen_func e1 tbl in
-      let b2, add3 = codegen_func e2 tbl in
-      ("((" ^ c' ^ ")->data.i ? " ^ b1 ^ " : " ^ b2 ^ ")", add1 @ add2 @ add3)
+      let n1 = codegen_func c tbl in
+      add_to_emi ("if (" ^ n1 ^ "->data.i) {\n");
+      let t1 = codegen_func e1 tbl in
+      if t1 = "IFELSETEMP" then ()
+      else add_to_emi (";\n IFELSETEMP = ref(" ^ t1 ^ ");");
+      add_to_emi "} else {";
+      let t2 = codegen_func e2 tbl in
+      if t2 = "IFELSETEMP" then ()
+      else add_to_emi (";\n IFELSETEMP = ref(" ^ t2 ^ ");");
+      add_to_emi "}\n";
+      "IFELSETEMP"
 
 let ensure_notempty args str = match args with [] -> "/*EMPTY*/" | _ -> str
 
 let rec codegen code tbl =
   match code with
   | [] -> ""
   | x :: xs ->
+      adds := adds_default ();
+      emission := [];
       let part =
         match x with
         | Let (id, args, expr) ->
@@ -115,22 +140,27 @@ let rec codegen code tbl =
               ^ (String.concat ", "
                 @@ List.mapi
                      (fun i x ->
-                       "*" ^ mangle x ^ " = ref(a[" ^ string_of_int i ^ "])")
+                       "*" ^ mangle x ^ " = ref(a[" ^ string_of_int i ^ "])\n")
                      args)
-              ^ ";"
+              ^ ";\n"
             in
+            (* STATEFUL *)
+            let body = codegen_func expr tbl in
             let unrefs =
-              ensure_notempty args @@ String.concat " "
-              @@ List.map (fun x -> "; unref(" ^ mangle x ^ ");") args
+              (ensure_notempty args @@ String.concat " "
+              @@ List.map (fun x -> "unref(" ^ mangle x ^ ");\n") args)
+              ^ String.concat ""
+                  (List.map (fun x -> "unref(" ^ x ^ ");\n") (List.rev !adds))
             in
-            let body, adds = codegen_func expr tbl in
-            let adds =
-              ensure_notempty adds @@ "kha_obj "
-              ^ (String.concat ", " @@ List.map (fun x -> "*" ^ x) adds)
-              ^ ";"
+            let adds' =
+              ensure_notempty !adds @@ "kha_obj "
+              ^ (String.concat ", "
+                @@ List.map (fun x -> "*" ^ x ^ "= NULL") !adds)
+              ^ ";\n"
             in
-            scaf ^ ensure_enough_args ^ set_used ^ args_gen ^ adds
-            ^ "kha_obj * kha_return = " ^ body ^ ";\n" ^ unrefs
+            scaf ^ ensure_enough_args ^ args_gen ^ adds'
+            ^ String.concat "" (List.rev !emission)
+            ^ "kha_obj * kha_return = ref(" ^ body ^ ");\n" ^ unrefs ^ set_used
             ^ "; return kha_return;}\n"
         | Extern (id, index, name) ->
             "/* EXTERN " ^ string_of_int id ^ " " ^ mangle index ^ " " ^ name

lib/backend/native.ml

@@ -4,8 +4,13 @@ open Args
 let gen_main () =
   {|
 int main(void) {
-kha_obj * empty = make_tuple(0);
+  kha_obj * empty = make_tuple(0);
   kha_obj * ret = main_____Khasm(1, &empty);
+  if (ret->tag != TUPLE) {
+  fprintf(stderr, "RETURN VALUE NOT TUPLE - TYPE SYSTEM INVALID\n");
+  }  
+  unref(empty);
+  unref(ret);  
   return 0;  
 }
 |}

lib/runtime/builtins.c

@@ -16,13 +16,17 @@ KHAFUNC(khasm_Stdlib775896895_s1597980479_eq) {
   used = 2;
   kha_obj * b = a[0];
   kha_obj * c = a[1];
+  kha_obj * ret;
   if (b->tag != c->tag) {
-    return make_int(0);
+    ret =  make_int(0);
   }
   else if (b->data.i != c->data.i) {
-    return make_int(0);
+    ret =  make_int(0);
   }
-  return make_int(1);
+  else {
+    ret = make_int(1);
+  }
+  return ret;
 }
 
 KHAFUNC(khasm_Stdlib775896895_iadd) {
@@ -152,6 +156,8 @@ KHAFUNC(khasm_Stdlib775896895_print1597980479_int) {
   if (i < 1) {
     return NULL;
   }
+  used = 1;
+
   kha_obj *b = a[0];
   if (b->tag != INT) {
     fprintf(stderr, "INVALID PRINT INT\n");

lib/runtime/call.c

@@ -24,6 +24,8 @@ kha_obj *pap_call(kha_obj *f) {
     return f;
   }
   else {
+    // printf("called func %p\n", f->data.pap->func);
+
     if (ret->tag == PAP) {
       // add our args and recurse
       if (used >= argnum) {
@@ -49,7 +51,6 @@ ceed number of args %ld\n", used, argnum);
       }
 
       ret->data.pap->argnum += new_argnum;
-      unref(f);
       return pap_call(ret);
     }
     else if (ret->tag == PTR) {
@@ -68,8 +69,12 @@ ceed number of args %ld\n", used, argnum);
       kha_obj *new = make_pap(new_argnum,
 			      ret->data.ptr,
 			      unused);
-      unref(ret);
-      unref(f);
+      for(int i = 0; i < new_argnum; i++) {
+	ref(new->data.pap->args[i]);
+      }
+
+       unref(ret);
+       unref(f);
       return new;
     }
     else {
@@ -82,19 +87,19 @@ ceed number of args %ld\n", used, argnum);
 
 kha_obj *call(kha_obj *f, kha_obj *x) {
   if (f->tag == PAP) {
-    u64 argnum = f->data.pap->argnum;
-    f->data.pap->args =
-      realloc(f->data.pap->args,
+    kha_obj * new = copy(f);
+    u64 argnum = new->data.pap->argnum;
+    new->data.pap->args =
+      realloc(new->data.pap->args,
 	      (argnum + 1) * sizeof(kha_obj *));
-    f->data.pap->args[argnum] = ref(x);
-    f->data.pap->argnum++;
-    return pap_call(f);
+    new->data.pap->args[argnum] = ref(x);
+    new->data.pap->argnum++;
+    return pap_call(new);
   }
   else if (f->tag == PTR) {
     kha_obj ** args = malloc(sizeof(kha_obj *));
     args[0] = ref(x);
     kha_obj * pap = make_pap(1, f->data.ptr, args);
-    unref(f);
     return pap_call(pap);
   }
   else {

lib/runtime/gc.c

@@ -13,20 +13,26 @@ kha_obj * new_kha_obj(kha_obj_typ t) {
 
 
 kha_obj * ref(kha_obj * a) {
+  if (!a) {
+    // fprintf(stderr, "cannot ref nothing\n");
+    exit(1);
+  }
   a->gc += 1;
   //printf("ref  %d : %ld | %p\n",
-  //	 a->tag, a->gc, a);
+  // 	 a->tag, a->gc, a);
   return a;
 }
 
 void unref(kha_obj * a) {
+  if (!a) {
+    return;
+  }
   a->gc -= 1;
   //fprintf(stderr, "uref %d : %ld | %p\n",
   //  a->tag, a->gc, a);
   if (a->gc <= 0) {
     //fprintf(stderr, "free %d : %ld | %p\n",
-    //	    a->tag, a->gc, a);
-    int i;
+    // 	    a->tag, a->gc, a);
     switch (a->tag) {
     case INT:
     case FLOAT:
@@ -36,15 +42,16 @@ void unref(kha_obj * a) {
       break;
     case PAP: {
       for (int i = 0; i < a->data.pap->argnum; i++) {
-	unref(a->data.pap->args[i]);
+unref(a->data.pap->args[i]);
       }
+      free(a->data.pap->args);
       free(a->data.pap);
       free(a);
       break;
     }
     case ADT: {
       for (int i = 0; i < a->data.pap->argnum; i++) {
-	unref(a->data.adt->data[i]);
+unref(a->data.adt->data[i]);
       }
       free(a->data.adt->data);
       free(a->data.adt);
@@ -53,7 +60,7 @@ void unref(kha_obj * a) {
     }
     case TUPLE: {
       for (int i = 0; i < a->data.tuple->len; i++) {
-	unref(a->data.tuple->tups[i]);
+        unref(a->data.tuple->tups[i]);
       }
       free(a->data.tuple->tups);
       free(a->data.tuple);
@@ -71,5 +78,7 @@ void unref(kha_obj * a) {
     exit(1);
     }
     }
+
   }
+
 }

lib/runtime/obj.c

@@ -59,3 +59,30 @@ kha_obj * make_tuple(u64 num, ...) {
   k->gc = 1;
   return k;
 }
+
+kha_obj *copy(kha_obj * a) {
+  if (a->tag == PAP) {
+    kha_obj * new = new_kha_obj(PAP);
+    new->data.pap = malloc(sizeof(struct kha_obj_pap));
+    new->data.pap->argnum
+      = a->data.pap->argnum;
+    new->data.pap->func
+      = a->data.pap->func;
+    new->data.pap->args
+      = malloc(sizeof(kha_obj *)
+	       * a->data.pap->argnum);
+    memcpy(new->data.pap->args,
+	   a->data.pap->args,
+	   sizeof(kha_obj*)
+	   * a->data.pap->argnum);
+    for (int i = 0; i < a->data.pap->argnum; i++) {
+      ref(new->data.pap->args[i]);
+    }
+    new->gc = 1;
+    return new;
+  }
+  else {
+    fprintf(stderr, "TODO: copy other stuff");
+    exit(1);
+  }
+}