Mentions légales du service

Skip to content
Snippets Groups Projects
Commit 7bb5e46c authored by Thierry Martinez's avatar Thierry Martinez
Browse files

Update for new clangml

parent ec170644
No related branches found
No related tags found
No related merge requests found
Pipeline #94975 failed
...@@ -18,7 +18,9 @@ let declare_tmp qual_type = ...@@ -18,7 +18,9 @@ let declare_tmp qual_type =
let tmp = fresh_var_name () in let tmp = fresh_var_name () in
let decl_tmp = Clang.Ast.node ~qual_type (Clang.Ast.Decl [ let decl_tmp = Clang.Ast.node ~qual_type (Clang.Ast.Decl [
Clang.Ast.node ~qual_type (Clang.Ast.Var (Clang.Ast.var tmp qual_type))]) in Clang.Ast.node ~qual_type (Clang.Ast.Var (Clang.Ast.var tmp qual_type))]) in
let tmp_var = Clang.Ast.node ~qual_type (Clang.Ast.DeclRef (Clang.Ast.identifier_name tmp)) in let tmp_var =
Clang.Ast.node ~qual_type
(Clang.Ast.DeclRef (Clang.Ast.identifier_name tmp)) in
tmp_var, decl_tmp tmp_var, decl_tmp
let assign_to_tmp ?qual_type expr = let assign_to_tmp ?qual_type expr =
...@@ -29,7 +31,7 @@ let assign_to_tmp ?qual_type expr = ...@@ -29,7 +31,7 @@ let assign_to_tmp ?qual_type expr =
let tmp_var, decl_tmp = declare_tmp qual_type in let tmp_var, decl_tmp = declare_tmp qual_type in
let assign_tmp = Clang.Ast.node ~qual_type (Clang.Ast.Expr ( let assign_tmp = Clang.Ast.node ~qual_type (Clang.Ast.Expr (
bin_op qual_type tmp_var Assign expr)) in bin_op qual_type tmp_var Assign expr)) in
tmp_var, [decl_tmp; assign_tmp] tmp_var, [decl_tmp; assign_tmp]
type transform_env = { type transform_env = {
statement_root : bool; statement_root : bool;
...@@ -87,17 +89,20 @@ let close_node ((stmt, _stmts) as node) = ...@@ -87,17 +89,20 @@ let close_node ((stmt, _stmts) as node) =
let rec name_anonymous_fields (decl : Clang.Ast.decl list) = let rec name_anonymous_fields (decl : Clang.Ast.decl list) =
match decl with match decl with
| [] -> [] | [] -> []
| { desc = RecordDecl ({ keyword; name = ""; _ } as record_decl); _} as record :: | { desc = RecordDecl ({ keyword; name = ""; _ } as record_decl); _}
as record ::
({ desc = Field { name; qual_type = { desc = ({ desc = Field { name; qual_type = { desc =
Elaborated ({ keyword = keyword'; Elaborated ({ keyword = keyword';
named_type = { desc = Record { name = IdentifierName ""; _ }; _ } as named_type; _ } as elaborated); _} named_type = { desc = Record { name = IdentifierName ""; _ }; _ }
as named_type; _ } as elaborated); _}
as qual_type; bitwidth; init }; _} as field) as qual_type; bitwidth; init }; _} as field)
:: tail when keyword = keyword' -> :: tail when keyword = keyword' ->
{ record with { record with
desc = Clang.Ast.RecordDecl { record_decl with name = "anon" }} :: desc = Clang.Ast.RecordDecl { record_decl with name = "anon" }} ::
{ field with desc = Field { name; bitwidth; init; { field with desc = Field { name; bitwidth; init;
qual_type = { qual_type with desc = Elaborated { elaborated with qual_type = { qual_type with desc = Elaborated { elaborated with
named_type = { named_type with desc = Record (Clang.Ast.identifier_name "anon") }}}}} :: named_type = { named_type with desc =
Record (Clang.Ast.identifier_name "anon") }}}}} ::
name_anonymous_fields tail name_anonymous_fields tail
| hd :: tl -> hd :: name_anonymous_fields tl | hd :: tl -> hd :: name_anonymous_fields tl
...@@ -217,7 +222,8 @@ let transform = object (self) ...@@ -217,7 +222,8 @@ let transform = object (self)
self#visit_expr { env with in_condition = true } cond in self#visit_expr { env with in_condition = true } cond in
let cond, delayed_stmts = make_condition delayed_stmts cond in let cond, delayed_stmts = make_condition delayed_stmts cond in
let tmp_var, stmts = assign_to_tmp ~qual_type:int cond in let tmp_var, stmts = assign_to_tmp ~qual_type:int cond in
[close_stmt (Free_monoid.plus delayed_stmts (Free_monoid.of_list stmts)) [close_stmt (Free_monoid.plus delayed_stmts
(Free_monoid.of_list stmts))
[{ stmt with desc = Return (Some tmp_var) }]] [{ stmt with desc = Return (Some tmp_var) }]]
| { desc = Expr ({ desc = Call _; _ } as expr); _} | { desc = Expr ({ desc = Call _; _ } as expr); _}
when (Clang.Type.of_node expr).desc <> BuiltinType Void -> when (Clang.Type.of_node expr).desc <> BuiltinType Void ->
...@@ -315,7 +321,8 @@ let transform = object (self) ...@@ -315,7 +321,8 @@ let transform = object (self)
qual_type = { desc = Pointer { desc = BuiltinType Void; _ }; _}; qual_type = { desc = Pointer { desc = BuiltinType Void; _ }; _};
operand = { desc = IntegerLiteral (Int 0); _ }} -> operand = { desc = IntegerLiteral (Int 0); _ }} ->
expr, monoid#zero expr, monoid#zero
| Cast { operand; _ } -> self#visit_expr env { expr with desc = operand.desc } | Cast { operand; _ } ->
self#visit_expr env { expr with desc = operand.desc }
(* liftConditionals *) (* liftConditionals *)
| ConditionalOperator { cond; then_branch; else_branch } -> | ConditionalOperator { cond; then_branch; else_branch } ->
let then_branch = let then_branch =
...@@ -327,7 +334,8 @@ let transform = object (self) ...@@ -327,7 +334,8 @@ let transform = object (self)
let else_branch = let else_branch =
self#visit_expr { env with assign_rhs = true } else_branch in self#visit_expr { env with assign_rhs = true } else_branch in
let qual_type = Clang.Type.of_node expr in let qual_type = Clang.Type.of_node expr in
make_conditional_operator qual_type monoid#zero cond then_branch else_branch make_conditional_operator qual_type monoid#zero cond then_branch
else_branch
| _ -> | _ ->
let expr, delayed_stmts = let expr, delayed_stmts =
super#visit_expr { env with statement_root = false; assign_rhs = false } super#visit_expr { env with statement_root = false; assign_rhs = false }
......
...@@ -56,6 +56,8 @@ ...@@ -56,6 +56,8 @@
Clang__.Clang__bindings.clang_ext_stringkind [@opaque] [@@rewrite] [@@remove] Clang__.Clang__bindings.clang_ext_stringkind [@opaque] [@@rewrite] [@@remove]
type clang_ext_overloadedoperatorkind = type clang_ext_overloadedoperatorkind =
Clang__.Clang__bindings.clang_ext_overloadedoperatorkind [@opaque] [@@rewrite] [@@remove] Clang__.Clang__bindings.clang_ext_overloadedoperatorkind [@opaque] [@@rewrite] [@@remove]
type clang_ext_exceptionspecificationtype =
Clang__.Clang__bindings.clang_ext_exceptionspecificationtype [@opaque] [@@rewrite] [@@remove]
end end
module%import Clang__types = struct module%import Clang__types = struct
type language = language [@opaque] [@@rewrite] [@@remove] type language = language [@opaque] [@@rewrite] [@@remove]
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment