Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

reimplements C types printing functions #1503

Merged
merged 1 commit into from
Jun 7, 2022
Merged

reimplements C types printing functions #1503

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
117 changes: 117 additions & 0 deletions lib/bap_c/bap_c_type.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -262,3 +262,120 @@ let function_ ?(attrs=[]) ?(variadic=false) ?(return=`Void) args : t =
}

let is_function : t -> Bool.t = function `Function _ -> true | _ -> false


let pp_comma ppf () = Format.fprintf ppf ", "

let pp_attr ppf = function
| {Attr.name; args=[]} -> Format.fprintf ppf "%s" name
| {Attr.name; args} ->
Format.fprintf ppf "%s(%a)" name
(Format.pp_print_list ~pp_sep:pp_comma
Format.pp_print_string) args

let pp_attr_list ppf xs =
Format.pp_print_list ~pp_sep:pp_comma pp_attr ppf xs

let pp_attrs ppf = function
| [] -> ()
| attrs ->
Format.fprintf ppf " __attribute__((%a)) "
pp_attr_list attrs

let pp_qualifier name ppf = function
| false -> ()
| true -> Format.fprintf ppf " %s " name

let pp_cv ppf {Qualifier.const;volatile} =
Format.fprintf ppf "%a%a"
(pp_qualifier "const") const
(pp_qualifier "volatile") volatile

let pp_cvr ppf {Qualifier.const;volatile;restrict} =
Format.fprintf ppf "%a%a%a"
(pp_qualifier "const") const
(pp_qualifier "volatile") volatile
(pp_qualifier "restrict") restrict

let pp_size ppf = function
| None -> ()
| Some size -> Format.fprintf ppf "%d" size

let pp_enum_value ppf = function
| None -> Format.fprintf ppf ","
| Some v -> Format.fprintf ppf "= %Ld," v

let pp_enum_field ppf (name,value) =
Format.fprintf ppf "@,%s%a," name pp_enum_value value

let rec pp_enum_fields ppf =
List.iter ~f:(pp_enum_field ppf)

let string_of_basic t = match (t : basic) with
| `schar -> "signed char"
| `cdouble -> "double complex"
| `long_double -> "long double"
| `cfloat -> "float complex"
| `float -> "float"
| `clong_double -> "long double complex"
| `ulong_long -> "unsigned long long"
| `uint -> "unsigned"
| `slong -> "signed long"
| `bool -> "_Bool"
| `double -> "double"
| `slong_long -> "signed long long"
| `sshort -> "signed short"
| `ushort -> "unsigned short"
| `char -> "char"
| `sint -> "signed"
| `ulong -> "unsigned long"
| `uchar -> "unsigned char"
| `enum fields ->
Format.asprintf "@[<v>@[<v4>enum {%a@]@,}@;" pp_enum_fields fields

let pp_variadic ppf = function
| true -> Format.fprintf ppf ", ..."
| false -> ()

let pp_basic ppf t =
Format.pp_print_string ppf (string_of_basic t)

let rec pp ppf t = match (t : t) with
| `Void ->
Format.fprintf ppf "void"
| `Array { qualifier; t={ element; size }; attrs } ->
Format.fprintf ppf "@[<h>%a%a%a[%a]@]"
pp_attrs attrs pp_cvr qualifier pp_incomplete element pp_size size
|`Basic { qualifier; t; attrs } ->
Format.fprintf ppf "@[<h>%a%a%a@]"
pp_attrs attrs pp_cv qualifier pp_basic t
| `Function { t=proto; attrs } ->
Format.fprintf ppf "@[<h>%a%a;@]"
pp_proto proto pp_attrs attrs
| `Pointer { qualifier; t; attrs } ->
Format.fprintf ppf "@[<h>%a%a%a*@]"
pp_attrs attrs pp_incomplete t pp_cvr qualifier
| `Union { t={name;fields}; attrs }
| `Structure { t={name;fields}; attrs } as t ->
let kind = if is_structure t then "struct" else "union" in
Format.fprintf ppf "@[<v>@[<v4>%s %s {@,%a@]@,}@]%a;"
kind name pp_fields fields pp_attrs attrs
and pp_proto ppf { return; args; variadic } =
Format.fprintf ppf "%a (*)(%a%a)"
pp_incomplete return pp_args args pp_variadic variadic
and pp_args ppf = function
| [] -> Format.fprintf ppf "void"
| args ->
Format.pp_print_list ~pp_sep:pp_comma pp_arg ppf args
and pp_arg ppf (name,t) =
Format.fprintf ppf "%a %s" pp_incomplete t name
and pp_fields ppf fields =
Format.pp_print_list pp_field ppf fields
and pp_field ppf (name,t) =
Format.fprintf ppf "%a %s;" pp_incomplete t name
and pp_incomplete ppf t = match (t : t) with
| `Union { t={name} }
| `Structure { t={name} } as t ->
let kind = if is_structure t then "struct" else "union" in
Format.fprintf ppf "%s %s" kind name
| t -> pp ppf t
3 changes: 3 additions & 0 deletions lib/bap_c/bap_c_type.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -231,3 +231,6 @@ val function_ : ?attrs:attr list -> ?variadic:Bool.t -> ?return:t ->
(string * t) list -> t

val is_function : t -> Bool.t

val pp : Format.formatter -> t -> unit
val pp_proto : Format.formatter -> proto -> unit
49 changes: 1 addition & 48 deletions lib/bap_c/bap_c_type_printer.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,48 +1 @@
open Core_kernel[@@warning "-D"]
open Format
open Bap_c_type

let pr ppf x = fprintf ppf x

let pp_spec ppq ppt ppf {Spec.qualifier; t; attrs} =
pr ppf "%a%a" ppq qualifier ppt t

let pp_flag c ppf x = pr ppf "%s" (if x then c else "")
let pp_c,pp_v,pp_r = pp_flag "c", pp_flag "v", pp_flag "r"
let pp_cvr ppf {Qualifier.const=c;restrict=r;volatile=v} =
pr ppf "%a%a%a" pp_c c pp_v v pp_r r
let pp_cv ppf {Qualifier.const=c;volatile=v} =
pr ppf "%a%a" pp_c c pp_v v

let pp_basic ppf t = Sexp.pp ppf (sexp_of_basic t)

let pp_size ppf t = Option.iter t ~f:(Int.pp ppf)

let pp_or ppf () = pr ppf "@ | @ "
let pp_to ppf () = pr ppf "@ ->@ "
let pp_sc ppf () = pr ppf ";@ "
let pp_sp ppf () = pr ppf "@,"

let pp_list pp_sep field = pp_print_list ~pp_sep field

let rec pp ppf : t -> unit = function
| `Void -> pr ppf "void"
| `Basic spec -> pp_spec pp_cv pp_basic ppf spec
| `Pointer {Spec.t; qualifier} -> pr ppf "%a %aptr" pp t pp_cvr qualifier
| `Array {Spec.t={Array.element=et; size};qualifier} ->
pr ppf "%a %aptr[%a]" pp et pp_cvr qualifier pp_size size
| `Structure {Spec.t={Compound.fields; name}} ->
pr ppf "@[<2>%s.{%a}@]" name (pp_list pp_sc pp_field) fields
| `Union {Spec.t={Compound.fields; name}} ->
pr ppf "@[<2>%s.{%a}@]" name (pp_list pp_or pp_field) fields
| `Function {Spec.t} -> pp_proto ppf t
and pp_field ppf = function
| (name,t) -> pr ppf "%s:%a" name pp t
and pp_arg ppf = function
| "",t -> pr ppf "%a" pp t
| n,t -> pr ppf "%s:%a" n pp t
and pp_proto ppf {Proto.return; args} =
pr ppf "%a@ ->@ %a" pp_args args pp return
and pp_args ppf = function
| [] -> pp ppf `Void
| args -> (pp_list pp_to pp_arg ppf) args
let pp = Bap_c_type.pp and pp_proto = Bap_c_type.pp_proto