Support basic function parameters

Author: R1kM

lib/ClangToAst.ml

@@ -14,6 +14,8 @@ let empty_env = {vars = []}
 
 let add_var env var = {vars = var :: env.vars }
 
+let find_var env var = EBound (KList.index (fun x -> x = var) env.vars)
+
 let extract_width = function | TInt w -> w | _ -> failwith "not an integer type"
 
 let get_id_name (dname: declaration_name) = match dname with
@@ -24,21 +26,24 @@ let translate_typ_name = function
   | "uint32_t" -> Helpers.uint32
   | _ -> failwith "unsupported name"
 
-let translate_typ (typ: qual_type) = match typ.desc with
-  | Pointer _ -> failwith "pointer type"
+let rec translate_typ (typ: qual_type) = match typ.desc with
+  | Pointer typ -> TBuf (translate_typ typ, false)
   | Typedef {name; _} -> get_id_name name |> translate_typ_name
+  | BuiltinType Void -> TUnit
+  | BuiltinType _ -> failwith "builtin type"
   | _ -> failwith "not pointer type"
 
-let translate_expr (t: typ) (e: expr) = match e.desc with
+let translate_expr (env: env) (t: typ) (e: expr) = match e.desc with
   | IntegerLiteral (Int n) -> EConstant (extract_width t, string_of_int n)
+  | DeclRef {name; _} -> get_id_name name |> find_var env
   | _ -> failwith "translate_expr"
 
 let translate_vardecl (env: env) (vdecl: var_decl_desc) : env * binder * Ast.expr =
   let name = vdecl.var_name in
   let typ = translate_typ vdecl.var_type in
   match vdecl.var_init with
   | None -> failwith "Variable declarations without definitions are not supported"
-  | Some e -> add_var env name, Helpers.fresh_binder name typ, Ast.with_type typ (translate_expr typ e)
+  | Some e -> add_var env name, Helpers.fresh_binder name typ, Ast.with_type typ (translate_expr env typ e)
 
 let rec translate_stmt (env: env) (s: stmt_desc) : expr' = match s with
   | Compound l -> begin match l with
@@ -56,27 +61,50 @@ let rec translate_stmt (env: env) (s: stmt_desc) : expr' = match s with
    end
   | _ -> EUnit
 
+let translate_param (p: parameter) : binder * string =
+  let p = p.desc in
+  let typ = translate_typ p.qual_type in
+  (* Not handling default expressions for function parameters *)
+  assert (p.default = None);
+  Helpers.fresh_binder p.name typ, p.name
+
 let translate_fundecl (fdecl: function_decl) =
   let name = get_id_name fdecl.name in
-  let body = match fdecl.body with | None -> EUnit | Some s -> translate_stmt empty_env s.desc in
-  let decl = Ast.(DFunction (None, [], 0, 0, TUnit, ([], name), [], with_type TUnit body)) in
+  let ret_type = translate_typ fdecl.function_type.result in
+  let args, vars = match fdecl.function_type.parameters with
+    | None -> [], []
+    | Some params ->
+        (* Not handling variadic parameters *)
+        assert (not (params.variadic));
+        List.map translate_param params.non_variadic |> List.split
+  in
+  (* To adopt a DeBruijn representation, the list must be reversed to
+   have the last binder as the first element of the environment *)
+  let env = {vars = List.rev vars} in
+  let body = match fdecl.body with | None -> EUnit | Some s -> translate_stmt env s.desc in
+  let decl = Ast.(DFunction (None, [], 0, 0, ret_type, ([], name), args, with_type ret_type body)) in
   KPrint.bprintf "Resulting decl %a\n" PrintAst.pdecl decl;
-  ()
+  decl
 
 
 let translate_decl (decl: decl) = match decl.desc with
   | Function fdecl ->
     let name = get_id_name fdecl.name in
     Printf.printf "Translating function %s\n" name;
-    if name = "test" || name = "quarter_round" then
-      translate_fundecl fdecl
-    else ()
-  | _ -> ()
+    if name = "test" then (* || name = "quarter_round" then *)
+      Some (translate_fundecl fdecl)
+    else None
+  | _ -> None
 
 let read_file () =
   let ast = parse_file "test.c" in
   (* Format.printf "@[%a@]@." (Refl.pp [%refl: Clang.Ast.translation_unit] []) ast; *)
   Printf.printf "Trying file %s\n" ast.desc.filename;
-  let _decls = List.map translate_decl ast.desc.items in
-  ()
+  let decls = List.filter_map translate_decl ast.desc.items in
+  let files = ["test", decls] in
+  let files = AstToMiniRust.translate_files files in
+  let files = OptimizeMiniRust.cleanup_minirust files in
+  let files = OptimizeMiniRust.infer_mut_borrows files in
+  let files = OptimizeMiniRust.simplify_minirust files in
+  OutputRust.write_all files
 

test.c

@@ -1,7 +1,7 @@
 #include <inttypes.h>
 
-void test() {
-  uint32_t x = 0;
+void test(uint32_t *st, uint32_t y, uint32_t z) {
+  uint32_t x = y;
 }