Skip to content

Commit

Permalink
Support basic function parameters
Browse files Browse the repository at this point in the history
  • Loading branch information
R1kM committed Jan 8, 2025
1 parent 0a7ebaf commit 199109f
Show file tree
Hide file tree
Showing 2 changed files with 43 additions and 15 deletions.
54 changes: 41 additions & 13 deletions lib/ClangToAst.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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

4 changes: 2 additions & 2 deletions test.c
Original file line number Diff line number Diff line change
@@ -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;
}


Expand Down

0 comments on commit 199109f

Please sign in to comment.