├── .github └── workflows │ └── main.yml ├── .gitignore ├── .ocamlformat ├── LICENSE ├── README.md ├── bindgen.opam ├── bindgen ├── bindgen.ml ├── c.ml ├── caml.ml ├── codegen.ml ├── dune ├── dunefile.ml ├── ir.ml └── parser.ml ├── cli ├── dune └── main.ml ├── dune-project ├── examples ├── caml_doggo.c ├── doggo.c ├── doggo.h ├── doggo.ml ├── dune └── main.ml └── tests ├── basics ├── empty.t │ ├── empty.h │ └── run.t └── struct.t │ ├── cool_stuff.ml │ ├── run.t │ └── struct.h ├── dune └── libs └── libsql.t ├── libsql.h └── run.t /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Build & Test 2 | 3 | on: 4 | pull_request: 5 | push: 6 | schedule: 7 | # Prime the caches every Monday 8 | - cron: 0 1 * * MON 9 | 10 | permissions: read-all 11 | 12 | jobs: 13 | build: 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | os: 18 | - macos-latest 19 | - ubuntu-latest 20 | ocaml-compiler: 21 | - "5.0" 22 | allow-prerelease-opam: 23 | - true 24 | opam-repositories: 25 | - |- 26 | default: https://github.com/ocaml/opam-repository.git 27 | # include: 28 | # - os: windows-latest 29 | # ocaml-compiler: ocaml-variants.5.1.0+options,ocaml-option-mingw 30 | # allow-prerelease-opam: false 31 | # opam-repositories: |- 32 | # windows-5.0: https://github.com/dra27/opam-repository.git#windows-5.0 33 | # sunset: https://github.com/ocaml-opam/opam-repository-mingw.git#sunset 34 | # default: https://github.com/ocaml/opam-repository.git 35 | 36 | runs-on: ${{ matrix.os }} 37 | 38 | steps: 39 | - name: Checkout tree 40 | uses: actions/checkout@v4 41 | 42 | - name: Set-up OCaml 43 | uses: ocaml/setup-ocaml@v2 44 | with: 45 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 46 | allow-prerelease-opam: ${{ matrix.allow-prerelease-opam }} 47 | opam-repositories: ${{ matrix.opam-repositories }} 48 | 49 | - run: opam install . --deps-only --with-test 50 | 51 | - run: opam exec -- dune build 52 | 53 | - run: opam exec -- dune test 54 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | 11 | # ocamlbuild working directory 12 | _build/ 13 | 14 | # ocamlbuild targets 15 | *.byte 16 | *.native 17 | 18 | # oasis generated files 19 | setup.data 20 | setup.log 21 | 22 | # Merlin configuring file for Vim and Emacs 23 | .merlin 24 | 25 | # Dune generated files 26 | *.install 27 | 28 | # Local OPAM switch 29 | _opam/ 30 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocaml-sys/ocaml-bindgen/37c3a69da4ffaa7e84805db55e66763a692f495b/.ocamlformat -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 ocaml-sys 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `bindgen` 2 | 3 | `bindgen` automatically generates raw OCaml FFI bindings to C (and some C++) 4 | libraries both as OCaml external definitions, types, constants, and the 5 | appropriate C shim code. 6 | 7 | **Non-goals**: It does not aim to provide very safe, very idiomatic, pure 8 | bindings, but rather give you direct access to the underlying C library with a 9 | few conveniences. But you're more than welcome to build idiomatic, type-safe wrappers for bindgen generated libraries. 10 | 11 | For example, given the C header `doggo.h`: 12 | 13 | ```c 14 | typedef struct Doggo { 15 | int many; 16 | char wow; 17 | } Doggo; 18 | 19 | void eleven_out_of_ten_majestic_af(Doggo* pupper); 20 | ``` 21 | 22 | `bindgen` produces OCaml FFI code allowing you to call into the `doggo` library's function and use its types: 23 | 24 | ```ocaml 25 | (* automatically generated by ocaml-bindgen 0.0.1 *) 26 | 27 | type doggo = { 28 | many: int 29 | wow: char 30 | } 31 | 32 | external eleven_out_of_ten_majestic_af : doggo -> unit 33 | = "caml_eleven_out_of_ten_majestic_af" 34 | ``` 35 | 36 | And the follow C shim: 37 | 38 | ```c 39 | /* automatically generated by ocaml-bindgen 0.0.1 */ 40 | 41 | value caml_Doggo_to_value(struct Doggo *pupper) { 42 | CAMLparam0(); 43 | CAMLlocal1(caml_pupper); 44 | event = caml_alloc_tuple(2); 45 | Store_field(caml_pupper, 0, Val_int(pupper->many)); 46 | Store_field(caml_pupper, 1, Val_char(pupper->wow)); 47 | CAMLreturn(caml_pupper); 48 | } 49 | 50 | Doggo* caml_Doggo_of_value(value caml_pupper) { 51 | Doggo* pupper = malloc(sizeof(struct Doggo)); 52 | pupper.many = Int_val(Field(caml_pupper, 0)); 53 | pupper.wow = Char_val(Field(caml_pupper, 1)); 54 | return pupper 55 | } 56 | 57 | CAMLprim value caml_eleven_out_of_ten_majestic_af(value caml_pupper) { 58 | CAMLparam1(caml_pupper); 59 | Doggo* pupper = caml_Doggo_of_value(caml_pupper); 60 | // actual C call 61 | eleven_out_of_ten_majestic_af(pupper); 62 | CAMLreturn0(); 63 | } 64 | ``` 65 | -------------------------------------------------------------------------------- /bindgen.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "A short synopsis" 4 | description: "A longer description" 5 | maintainer: ["Leandro Ostera "] 6 | authors: ["Leandro Ostera "] 7 | license: "MIT" 8 | tags: ["topics" "to describe" "your" "project"] 9 | homepage: "https://github.com/ocaml-sys/ocaml-bindgen" 10 | bug-reports: "https://github.com/ocaml-sys/ocaml-bindgen/issues" 11 | depends: [ 12 | "clangml" {>= "4.8.0"} 13 | "ocaml" 14 | "dune" {>= "3.13"} 15 | "odoc" {with-doc} 16 | ] 17 | build: [ 18 | ["dune" "subst"] {dev} 19 | [ 20 | "dune" 21 | "build" 22 | "-p" 23 | name 24 | "-j" 25 | jobs 26 | "@install" 27 | "@runtest" {with-test} 28 | "@doc" {with-doc} 29 | ] 30 | ] 31 | dev-repo: "git+https://github.com/ocaml-sys/ocaml-bindgen.git" 32 | -------------------------------------------------------------------------------- /bindgen/bindgen.ml: -------------------------------------------------------------------------------- 1 | let translate ~file ~name = 2 | let ast = Parser.parse file in 3 | let ir = Ir.lift ~name ~header:file ast in 4 | let dunefile = Dunefile.from_ir ir in 5 | let caml = Caml.from_ir ir in 6 | let c = C.from_ir ir in 7 | Codegen.write_dune_file dunefile; 8 | Codegen.write_caml_files caml dunefile; 9 | Codegen.write_c_files c dunefile; 10 | () 11 | -------------------------------------------------------------------------------- /bindgen/c.ml: -------------------------------------------------------------------------------- 1 | let caml_ = "caml_" 2 | 3 | type c_type = Prim of string | Struct of string | Ptr of c_type | Void 4 | type c_prim = Int of int | Str of string 5 | 6 | type t = 7 | | C_function of { 8 | fn_ret : c_type; 9 | fn_name : string; 10 | fn_params : (c_type * string) list; 11 | fn_body : t list; 12 | } 13 | | C_call of { cc_name : string; cc_args : t list } 14 | | C_assign of { asg_var : t; asg_value : t } 15 | | C_decl of { dcl_name : string; dcl_type : c_type; dcl_value : t option } 16 | | C_prim of c_prim 17 | | C_ptr_field_access of { pfa_name : t; pfa_field : string } 18 | | C_field_access of { acc_name : t; acc_field : string } 19 | | C_variable of string 20 | | C_return of t 21 | | C_type of c_type 22 | | C_include of string 23 | 24 | type program = t list 25 | 26 | 27 | let pp_list sep pp_el fmt t = 28 | Format.pp_print_list 29 | ~pp_sep:(fun fmt () -> Format.fprintf fmt "%s" sep) 30 | pp_el fmt t 31 | 32 | let rec pp fmt program = List.iter (fun (t : t) -> pp_t fmt t) program 33 | 34 | and pp_t fmt t = 35 | match t with 36 | | C_function { fn_ret; fn_name; fn_params; fn_body } -> 37 | Format.fprintf fmt "%a %s(%a) {\n %a;\n}\n\n" pp_type fn_ret fn_name 38 | (pp_list ", " pp_arg) fn_params (pp_list ";\n " pp_t) fn_body 39 | | C_call { cc_name; cc_args } -> 40 | Format.fprintf fmt "%s(%a)" cc_name (pp_list ", " pp_t) cc_args 41 | | C_assign { asg_var; asg_value } -> 42 | Format.fprintf fmt "%a = %a" pp_t asg_var pp_t asg_value 43 | | C_decl { dcl_name; dcl_type; dcl_value = None } -> 44 | Format.fprintf fmt "%a %s" pp_type dcl_type dcl_name 45 | | C_decl { dcl_name; dcl_type; dcl_value = Some v } -> 46 | Format.fprintf fmt "%a %s = %a" pp_type dcl_type dcl_name pp_t v 47 | | C_prim prim -> pp_prim fmt prim 48 | | C_ptr_field_access { pfa_name; pfa_field } -> 49 | Format.fprintf fmt "%a->%s" pp_t pfa_name pfa_field 50 | | C_field_access { acc_name; acc_field } -> 51 | Format.fprintf fmt "%a.%s" pp_t acc_name acc_field 52 | | C_variable s -> Format.fprintf fmt "%s" s 53 | | C_return t -> Format.fprintf fmt "return %a" pp_t t 54 | | C_type t -> Format.fprintf fmt "%a" pp_type t 55 | | C_include s -> Format.fprintf fmt "#include %s\n" s 56 | 57 | and pp_arg fmt (ctype, name) = Format.fprintf fmt "%a %s" pp_type ctype name 58 | 59 | and pp_type fmt (ctype : c_type) = 60 | match ctype with 61 | | Prim x -> Format.fprintf fmt "%s" x 62 | | Struct s -> Format.fprintf fmt "struct %s" s 63 | | Ptr t -> Format.fprintf fmt "%a*" pp_type t 64 | | Void -> Format.fprintf fmt "void" 65 | 66 | and pp_prim fmt (prim : c_prim) = 67 | match prim with 68 | | Int d -> Format.fprintf fmt "%d" d 69 | | Str s -> Format.fprintf fmt "%s" s 70 | 71 | let decl dcl_type dcl_name dcl_value = C_decl { dcl_name; dcl_type; dcl_value } 72 | let call cc_name cc_args = C_call { cc_name; cc_args } 73 | let var x = C_variable x 74 | let assign asg_var asg_value = C_assign { asg_var; asg_value } 75 | let int x = C_prim (Int x) 76 | let string x = C_prim (Str x) 77 | let ptr_field pfa_name pfa_field = C_ptr_field_access { pfa_name; pfa_field } 78 | let typ t = C_type t 79 | let field acc_name acc_field = C_field_access { acc_name; acc_field } 80 | let return x = C_return x 81 | 82 | (* caml functions *) 83 | let caml_params x = call ("CAMLparam" ^ Int.to_string (List.length x)) x 84 | let caml_locals x = call ("CAMLlocal" ^ Int.to_string (List.length x)) x 85 | let caml_return0 = var "CAMLreturn0" 86 | let caml_return x = call "CAMLreturn" [ x ] 87 | 88 | let caml_alloc_tuple fields = 89 | call "caml_alloc_tuple" [ int (List.length fields) ] 90 | 91 | let store_field var idx value = call "Store_field" [ var; int idx; value ] 92 | let val_int var name = call "Val_int" [ ptr_field var name ] 93 | let int_val var idx = call "Int_val" [ call "Field" [ var; int idx] ] 94 | 95 | (* from_ir *) 96 | let rec ctype_of_ir (ir_type : Ir.ir_type) = 97 | match ir_type with 98 | | Ir.Abstract s -> Prim s 99 | | Ir.Record { rec_name; _ } -> Prim rec_name 100 | | Ir.Enum { enum_name; _ } -> Prim enum_name 101 | | Ir.Prim Ir.Int -> Prim "int" 102 | | Ir.Prim Ir.Bool -> Prim "bool" 103 | | Ir.Prim Ir.Char -> Prim "char" 104 | | Ir.Prim Ir.Void -> Void 105 | | Ir.Ptr t -> Ptr (ctype_of_ir t) 106 | | Ir.Func _ -> assert false 107 | 108 | let rec ctype_name typ = 109 | match typ with 110 | | Prim n -> n 111 | | Struct n -> n 112 | | Void -> "void" 113 | | Ptr t -> ctype_name t 114 | 115 | module Shims = struct 116 | let to_value name fields = 117 | C_function 118 | { 119 | fn_ret = Prim "value"; 120 | fn_name = caml_ ^ name ^ "_to_value"; 121 | fn_params = [ (Ptr (Struct name), "x") ]; 122 | fn_body = 123 | [ 124 | caml_params []; 125 | caml_locals [ var "caml_x" ]; 126 | assign (var "caml_x") (caml_alloc_tuple fields); 127 | ] 128 | @ Ir.( 129 | List.mapi 130 | (fun idx field -> 131 | store_field (var "caml_x") idx 132 | (val_int (var "x") field.fld_name)) 133 | fields) 134 | @ [ caml_return (var "caml_x") ]; 135 | } 136 | 137 | let of_value name fields = 138 | C_function 139 | { 140 | fn_ret = Ptr (Prim name); 141 | fn_name = caml_ ^ name ^ "_of_value"; 142 | fn_params = [ (Prim "value", "caml_x") ]; 143 | fn_body = 144 | [ 145 | decl (Ptr (Prim name)) "x" 146 | (Some (call "malloc" [ call "sizeof" [ typ (Struct name) ] ])); 147 | ] 148 | @ Ir.( 149 | List.mapi 150 | (fun idx fld -> 151 | assign 152 | (ptr_field (var "x") fld.fld_name) 153 | (int_val (var "caml_x") idx)) 154 | fields) 155 | @ [ return (var "x") ]; 156 | } 157 | 158 | let wrap_fun Ir.{ fndcl_name; fndcl_type } = 159 | match fndcl_type with 160 | | Func { fn_ret; fn_params } -> 161 | let fn_ret = ctype_of_ir fn_ret in 162 | 163 | let fn_body = 164 | let declare_params = 165 | [ caml_params (List.map (fun (name, _type) -> var (caml_^name)) fn_params ) ] 166 | in 167 | let maybe_declare_result = 168 | match fn_ret with 169 | | Void -> [] 170 | | _ -> [ caml_locals [ var "result" ] ] 171 | in 172 | 173 | let transform_values = 174 | List.map 175 | (fun (name, param_type) -> 176 | let c_type = ctype_of_ir param_type in 177 | let c_type_name = ctype_name c_type in 178 | decl c_type name 179 | (Some 180 | (call 181 | (caml_ ^ c_type_name ^ "_of_value") 182 | [ var (caml_ ^ name) ]))) 183 | fn_params 184 | in 185 | 186 | let call_and_return = 187 | let fn_call = 188 | call fndcl_name (List.map (fun (param, _) -> var param) fn_params) 189 | in 190 | match fn_ret with 191 | | Void -> [ fn_call; caml_return0 ] 192 | | _ -> [ assign (var "result") fn_call; caml_return (var "result") ] 193 | in 194 | 195 | List.flatten 196 | [ 197 | declare_params; 198 | maybe_declare_result; 199 | transform_values; 200 | call_and_return; 201 | ] 202 | in 203 | 204 | C_function 205 | { 206 | fn_ret; 207 | fn_params = 208 | List.map 209 | (fun (name, _type) -> (Prim "value", caml_ ^ name)) 210 | fn_params; 211 | fn_name = caml_ ^ fndcl_name; 212 | fn_body; 213 | } 214 | | _ -> assert false 215 | end 216 | 217 | let from_ir (ir : Ir.t) : program = 218 | [ 219 | C_include (Format.sprintf "%S" ir.header); 220 | C_include ""; 221 | C_include ""; 222 | C_include ""; 223 | C_include ""; 224 | C_include ""; 225 | C_include ""; 226 | ] 227 | @ 228 | (List.filter_map 229 | (fun node -> 230 | match node with 231 | | Ir.Ir_fun_decl fun_decl -> Some [ Shims.wrap_fun fun_decl ] 232 | | Ir.Ir_type (Record { rec_name; rec_fields }) -> 233 | Some 234 | [ 235 | Shims.of_value rec_name rec_fields; 236 | Shims.to_value rec_name rec_fields; 237 | ] 238 | | _ -> None) 239 | ir.items 240 | |> List.flatten) 241 | -------------------------------------------------------------------------------- /bindgen/caml.ml: -------------------------------------------------------------------------------- 1 | open Parsetree 2 | open Ast_helper 3 | 4 | let loc = !default_loc 5 | let with_loc txt : str = { txt; loc } 6 | 7 | let lid name = 8 | Location.mkloc 9 | (Longident.unflatten [ String.lowercase_ascii name ] |> Option.get) 10 | loc 11 | 12 | let type_name name = String.lowercase_ascii name |> with_loc 13 | 14 | let variant_from_enum (ir_enum : Ir.ir_enum_variant) : constructor_declaration = 15 | (* C enums don't carry data so most of the fields are left empty / default *) 16 | { 17 | pcd_name = with_loc ("C_" ^ ir_enum.variant_name); 18 | pcd_vars = []; 19 | pcd_args = Pcstr_tuple []; 20 | pcd_res = None; 21 | pcd_loc = loc; 22 | pcd_attributes = []; 23 | } 24 | 25 | let rec core_type_from_ir typ = 26 | match typ with 27 | | Ir.Abstract name -> Typ.constr (lid name) [] 28 | | Ir.Enum { enum_name; _ } -> Typ.constr (lid enum_name) [] 29 | | Ir.Record { rec_name; _ } -> Typ.constr (lid rec_name) [] 30 | | Ir.Prim Int -> Typ.constr (lid "int") [] 31 | | Ir.Prim Bool -> Typ.constr (lid "bool") [] 32 | | Ir.Prim Char -> Typ.constr (lid "char") [] 33 | | Ir.Prim Void -> Typ.constr (lid "unit") [] 34 | | Ir.Ptr t -> core_type_from_ir t 35 | | Ir.Func { fn_ret; fn_params } -> ( 36 | match fn_params with 37 | | [] -> 38 | (* If the C function declaration has no parameters we must introduce a `unit` param *) 39 | Typ.arrow Asttypes.Nolabel 40 | (core_type_from_ir (Ir.Prim Void)) 41 | (core_type_from_ir fn_ret) 42 | | params -> 43 | List.fold_left 44 | (fun acc (name, typ) -> 45 | let label = Asttypes.Labelled name in 46 | let typ = core_type_from_ir typ in 47 | Typ.arrow label typ acc) 48 | (core_type_from_ir fn_ret) params) 49 | 50 | let type_from_ir typ = 51 | match typ with 52 | | Ir.Abstract name -> Some (Type.mk ~loc (type_name name)) 53 | | Ir.Enum { enum_name; enum_variants } -> 54 | let variants = List.map variant_from_enum enum_variants in 55 | let kind = Ptype_variant variants in 56 | Some (Type.mk ~loc ~kind (type_name enum_name)) 57 | | Ir.Record { rec_name; rec_fields } -> 58 | let labels = 59 | List.map 60 | Ir.( 61 | fun fld -> 62 | let fld_type = core_type_from_ir fld.fld_type in 63 | Type.field (with_loc fld.fld_name) fld_type) 64 | rec_fields 65 | in 66 | let kind = Ptype_record labels in 67 | Some (Type.mk ~loc ~kind (type_name rec_name)) 68 | | _ -> None 69 | 70 | let str_type_from_ir typ = 71 | match type_from_ir typ with 72 | | Some typ -> Some (Str.type_ Nonrecursive [ typ ]) 73 | | None -> None 74 | 75 | let str_external_from_ir ({ fndcl_name; fndcl_type } : Ir.ir_fun_decl) = 76 | let prim = 77 | Val.mk 78 | ~prim:[ "caml_" ^ fndcl_name ] 79 | ~loc (with_loc fndcl_name) 80 | (core_type_from_ir fndcl_type) 81 | in 82 | Some (Str.primitive ~loc prim) 83 | 84 | let from_ir (ir : Ir.t) : Parsetree.structure = 85 | List.filter_map 86 | (fun node -> 87 | match node with 88 | | Ir.Ir_type typ -> str_type_from_ir typ 89 | | Ir.Ir_fun_decl fun_dcl -> str_external_from_ir fun_dcl) 90 | ir.items 91 | -------------------------------------------------------------------------------- /bindgen/codegen.ml: -------------------------------------------------------------------------------- 1 | let with_file file fn = 2 | let oc = open_out file in 3 | let fmt = Format.formatter_of_out_channel oc in 4 | fn fmt; 5 | close_out oc; 6 | () 7 | 8 | let write_dune_file (dune : Dunefile.t) = 9 | with_file "dune" @@ fun fmt -> 10 | Format.fprintf fmt 11 | {| 12 | ; automatically generated by ocaml-bindgen 0.0.1 13 | (library 14 | (name %s) 15 | (foreign_stubs 16 | (language c) 17 | (names %s) 18 | (flags 19 | (:standard -O2)))) 20 | |} 21 | dune.lib_name dune.c_file_name; 22 | Format.fprintf fmt "\n%!" 23 | 24 | let write_caml_files caml (dune : Dunefile.t) = 25 | with_file dune.caml_file_name @@ fun fmt -> 26 | Format.fprintf fmt "(* automatically generated by ocaml-bindgen 0.0.1 *)\n"; 27 | Format.fprintf fmt "%s\n%!" (Format.asprintf "%a" Pprintast.structure caml) 28 | 29 | let write_c_files (c : C.program) (dune : Dunefile.t) = 30 | with_file dune.c_file_name @@ fun fmt -> 31 | Format.fprintf fmt "/* automatically generated by ocaml-bindgen 0.0.1 */\n"; 32 | Format.fprintf fmt "%s\n%!" (Format.asprintf "%a" C.pp c) 33 | -------------------------------------------------------------------------------- /bindgen/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (public_name bindgen) 3 | (name bindgen) 4 | (preprocess 5 | (pps ppxlib.metaquot)) 6 | (libraries clangml ppxlib compiler-libs stringext)) 7 | -------------------------------------------------------------------------------- /bindgen/dunefile.ml: -------------------------------------------------------------------------------- 1 | type t = { lib_name : string; caml_file_name : string; c_file_name : string } 2 | 3 | let from_ir (ir : Ir.t) : t = 4 | { 5 | lib_name = ir.lib_name; 6 | caml_file_name = ir.lib_name ^ ".ml"; 7 | c_file_name = "caml_" ^ ir.lib_name ^ ".c"; 8 | } 9 | -------------------------------------------------------------------------------- /bindgen/ir.ml: -------------------------------------------------------------------------------- 1 | type ir_prim_type = Int | Bool | Char | Void 2 | 3 | type ir_type = 4 | | Abstract of string 5 | | Record of { rec_name : string; rec_fields : ir_field list } 6 | | Enum of { enum_name : string; enum_variants : ir_enum_variant list } 7 | | Prim of ir_prim_type 8 | | Ptr of ir_type 9 | | Func of { fn_ret : ir_type; fn_params : (string * ir_type) list } 10 | 11 | and ir_field = { fld_name : string; fld_type : ir_type } 12 | and ir_enum_variant = { variant_name : string; constant : int } 13 | 14 | type ir_fun_decl = { fndcl_name : string; fndcl_type : ir_type } 15 | type ir_item = Ir_type of ir_type | Ir_fun_decl of ir_fun_decl 16 | type t = { items : ir_item list; lib_name : string; header : string } 17 | 18 | module Lift = struct 19 | let lift_name name = 20 | match name with Clang.Ast.IdentifierName x -> x | _ -> assert false 21 | 22 | let rec lift_type (typ : Clang.Type.t) = 23 | (* Format.printf "lift_type: %S\n" (Clang.Type.show typ); *) 24 | match typ.desc with 25 | | Clang.Ast.BuiltinType Int -> Prim Int 26 | | Clang.Ast.BuiltinType Bool -> Prim Bool 27 | | Clang.Ast.BuiltinType Char_S -> Prim Char 28 | | Clang.Ast.BuiltinType Void -> Prim Void 29 | | Clang.Ast.Pointer t -> Ptr (lift_type t) 30 | | Clang.Ast.Typedef t -> Abstract (lift_name t.name) 31 | | _ -> assert false 32 | 33 | let lift_record_field (field : Clang.Ast.decl) = 34 | match field.desc with 35 | | Clang.Ast.Field { name; qual_type; _ } -> 36 | let fld_type = lift_type qual_type in 37 | { fld_name = name; fld_type } 38 | | _ -> assert false 39 | 40 | let lift_record (record : Clang.Ast.record_decl) = 41 | match (record.name, record.fields) with 42 | | "", _ -> None 43 | | _, [] -> Some (Ir_type (Abstract record.name)) 44 | | _ -> 45 | let rec_fields = List.map lift_record_field record.fields in 46 | Some (Ir_type (Record { rec_name = record.name; rec_fields })) 47 | 48 | let lift_enum name (constants : Clang.Ast.enum_constant list) 49 | _complete_definition _attributes = 50 | let ir_variants : ir_enum_variant list = 51 | List.mapi 52 | (fun i (constant : Clang.Ast.enum_constant) -> 53 | let desc = constant.desc in 54 | { variant_name = desc.constant_name; constant = i }) 55 | constants 56 | in 57 | if name = "" then None 58 | else Some (Ir_type (Enum { enum_name = name; enum_variants = ir_variants })) 59 | 60 | let lift_function_param (param : Clang.Ast.parameter) = 61 | (param.desc.name, lift_type param.desc.qual_type) 62 | 63 | let lift_function_type (fn_type : Clang.Ast.function_type) = 64 | let fn_ret = lift_type fn_type.result in 65 | let fn_params = 66 | match fn_type.parameters with 67 | | Some { non_variadic; _ } -> List.map lift_function_param non_variadic 68 | | None -> [] 69 | in 70 | Func { fn_ret; fn_params } 71 | 72 | let lift_function (fn : Clang.Ast.function_decl) = 73 | let fndcl_name = lift_name fn.name in 74 | let fndcl_type = lift_function_type fn.function_type in 75 | Some (Ir_fun_decl { fndcl_name; fndcl_type }) 76 | 77 | let lift ~name ~header (clang_ast : Clang.Ast.translation_unit) : t = 78 | let node : Clang.Ast.translation_unit_desc = clang_ast.desc in 79 | let items = 80 | List.filter_map 81 | (fun (x : Clang.Ast.decl) -> 82 | let desc : Clang.Ast.decl_desc = x.desc in 83 | match desc with 84 | | Clang.Ast.Function fn -> lift_function fn 85 | | Clang.Ast.RecordDecl record -> lift_record record 86 | | Clang.Ast.EnumDecl 87 | { name; constants; complete_definition; attributes } -> 88 | lift_enum name constants complete_definition attributes 89 | | Clang.Ast.TemplateDecl _ | Clang.Ast.TemplatePartialSpecialization _ 90 | | Clang.Ast.CXXMethod _ | Clang.Ast.Var _ | Clang.Ast.TypedefDecl _ 91 | | Clang.Ast.Field _ | Clang.Ast.IndirectField _ 92 | | Clang.Ast.AccessSpecifier _ | Clang.Ast.Namespace _ 93 | | Clang.Ast.UsingDirective _ | Clang.Ast.UsingDeclaration _ 94 | | Clang.Ast.Constructor _ | Clang.Ast.Destructor _ 95 | | Clang.Ast.LinkageSpec _ | Clang.Ast.TemplateTemplateParameter _ 96 | | Clang.Ast.Friend _ | Clang.Ast.NamespaceAlias _ 97 | | Clang.Ast.EmptyDecl | Clang.Ast.Directive _ 98 | | Clang.Ast.StaticAssert _ | Clang.Ast.TypeAlias _ 99 | | Clang.Ast.Decomposition _ | Clang.Ast.Concept _ | Clang.Ast.Export _ 100 | | Clang.Ast.UnknownDecl (_, _) -> 101 | None) 102 | node.items 103 | in 104 | { lib_name = name; header; items } 105 | end 106 | 107 | let lift = Lift.lift 108 | -------------------------------------------------------------------------------- /bindgen/parser.ml: -------------------------------------------------------------------------------- 1 | let parse file = Clang.Ast.parse_file file 2 | -------------------------------------------------------------------------------- /cli/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (public_name ocaml-bindgen) 3 | (name main) 4 | (libraries bindgen)) 5 | -------------------------------------------------------------------------------- /cli/main.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | let file = Sys.argv.(1) in 3 | let name = Sys.argv.(2) in 4 | Bindgen.translate ~file ~name 5 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.13) 2 | (using menhir 3.0) 3 | (using directory-targets 0.1) 4 | (cram enable) 5 | 6 | (name bindgen) 7 | 8 | (generate_opam_files true) 9 | 10 | (source 11 | (github ocaml-sys/ocaml-bindgen)) 12 | 13 | (authors "Leandro Ostera ") 14 | 15 | (maintainers "Leandro Ostera ") 16 | 17 | (license MIT) 18 | 19 | (package 20 | (name bindgen) 21 | (synopsis "A short synopsis") 22 | (description "A longer description") 23 | (depends 24 | (clangml (>= "4.8.0")) 25 | ocaml 26 | dune) 27 | (tags 28 | (topics "to describe" your project))) 29 | -------------------------------------------------------------------------------- /examples/caml_doggo.c: -------------------------------------------------------------------------------- 1 | /* automatically generated by ocaml-bindgen 0.0.1 */ 2 | #include "doggo.h" 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | Doggo* caml_Doggo_of_value(value caml_x) { 10 | Doggo* x = malloc(sizeof(struct Doggo)); 11 | x->many = Int_val(Field(caml_x, 0)); 12 | x->breed = Int_val(Field(caml_x, 1)); 13 | x->wow = Int_val(Field(caml_x, 2)); 14 | return x; 15 | } 16 | 17 | value caml_Doggo_to_value(struct Doggo* x) { 18 | CAMLparam0(); 19 | CAMLlocal1(caml_x); 20 | caml_x = caml_alloc_tuple(3); 21 | Store_field(caml_x, 0, Val_int(x->many)); 22 | Store_field(caml_x, 1, Val_int(x->breed)); 23 | Store_field(caml_x, 2, Val_int(x->wow)); 24 | CAMLreturn(caml_x); 25 | } 26 | 27 | void caml_eleven_out_of_ten_majestic_af(value caml_pupper) { 28 | CAMLparam1(caml_pupper); 29 | Doggo* pupper = caml_Doggo_of_value(caml_pupper); 30 | eleven_out_of_ten_majestic_af(pupper); 31 | CAMLreturn0; 32 | } 33 | 34 | void caml_no_input_no_output() { 35 | CAMLparam0(); 36 | no_input_no_output(); 37 | CAMLreturn0; 38 | } 39 | 40 | 41 | -------------------------------------------------------------------------------- /examples/doggo.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include "doggo.h" 3 | 4 | static const char* BreedToString[4] = { 5 | "Labrador", 6 | "Golden Retriever", 7 | "Pug", 8 | "Poodle" 9 | }; 10 | 11 | void eleven_out_of_ten_majestic_af(Doggo* pupper) { 12 | printf("doggo says %d\n", pupper->many); 13 | printf("doggo is a %s\n", BreedToString[pupper->breed]); 14 | } 15 | 16 | void no_input_no_output(void) { 17 | printf("We are doing nothing (of importance)\n"); 18 | } -------------------------------------------------------------------------------- /examples/doggo.h: -------------------------------------------------------------------------------- 1 | typedef enum breed { 2 | Labrador, 3 | _GoldenRetriever, 4 | pug, 5 | _poodle 6 | } breed; 7 | 8 | typedef struct Doggo { 9 | int many; 10 | breed breed; 11 | char wow; 12 | } Doggo; 13 | 14 | void eleven_out_of_ten_majestic_af(Doggo* pupper); 15 | 16 | void no_input_no_output(void); -------------------------------------------------------------------------------- /examples/doggo.ml: -------------------------------------------------------------------------------- 1 | (* automatically generated by ocaml-bindgen 0.0.1 *) 2 | type nonrec breed = 3 | | C_Labrador 4 | | C__GoldenRetriever 5 | | C_pug 6 | | C__poodle 7 | type nonrec doggo = { 8 | many: int ; 9 | breed: breed ; 10 | wow: char } 11 | external eleven_out_of_ten_majestic_af : 12 | pupper:doggo -> unit = "caml_eleven_out_of_ten_majestic_af" 13 | external no_input_no_output : unit -> unit = "caml_no_input_no_output" 14 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (foreign_stubs 4 | (language c) 5 | (names doggo caml_doggo) 6 | (flags 7 | (:standard -O2)))) 8 | 9 | (rule 10 | (alias all) 11 | (targets 12 | doggo.ml 13 | caml_doggo.c 14 | ) 15 | (deps doggo.h) 16 | (action 17 | (run 18 | %{bin:ocaml-bindgen} doggo.h doggo)) 19 | (mode 20 | (promote (until-clean)))) 21 | -------------------------------------------------------------------------------- /examples/main.ml: -------------------------------------------------------------------------------- 1 | Doggo.eleven_out_of_ten_majestic_af ~pupper:{ 2 | many=2112; 3 | wow='x'; 4 | breed=C_Labrador 5 | } 6 | -------------------------------------------------------------------------------- /tests/basics/empty.t/empty.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ocaml-sys/ocaml-bindgen/37c3a69da4ffaa7e84805db55e66763a692f495b/tests/basics/empty.t/empty.h -------------------------------------------------------------------------------- /tests/basics/empty.t/run.t: -------------------------------------------------------------------------------- 1 | $ ocaml-bindgen empty.h empty 2 | $ cat dune 3 | 4 | ; automatically generated by ocaml-bindgen 0.0.1 5 | (library 6 | (name empty) 7 | (foreign_stubs 8 | (language c) 9 | (names caml_empty.c) 10 | (flags 11 | (:standard -O2)))) 12 | 13 | $ cat empty.ml 14 | (* automatically generated by ocaml-bindgen 0.0.1 *) 15 | 16 | $ cat caml_empty.c 17 | /* automatically generated by ocaml-bindgen 0.0.1 */ 18 | 19 | -------------------------------------------------------------------------------- /tests/basics/struct.t/cool_stuff.ml: -------------------------------------------------------------------------------- 1 | (* automatically generated by ocaml-bindgen 0.0.1 *) 2 | type nonrec doggo = { 3 | many: int ; 4 | wow: char } 5 | external eleven_out_of_ten_majestic_af : pupper:doggo ptr -> unit 6 | -------------------------------------------------------------------------------- /tests/basics/struct.t/run.t: -------------------------------------------------------------------------------- 1 | $ ocaml-bindgen struct.h struct 2 | $ cat dune 3 | 4 | ; automatically generated by ocaml-bindgen 0.0.1 5 | (library 6 | (name struct) 7 | (foreign_stubs 8 | (language c) 9 | (names caml_struct.c) 10 | (flags 11 | (:standard -O2)))) 12 | 13 | $ cat struct.h 14 | typedef struct Doggo { 15 | int many; 16 | char wow; 17 | } Doggo; 18 | 19 | void eleven_out_of_ten_majestic_af(Doggo* pupper); 20 | $ cat struct.ml 21 | (* automatically generated by ocaml-bindgen 0.0.1 *) 22 | type nonrec doggo = { 23 | many: int ; 24 | wow: char } 25 | external eleven_out_of_ten_majestic_af : 26 | pupper:doggo ptr -> unit = "caml_eleven_out_of_ten_majestic_af" 27 | $ cat caml_struct.c 28 | /* automatically generated by ocaml-bindgen 0.0.1 */ 29 | Doggo* caml_Doggo_of_value(struct value* caml_x) { 30 | Doggo* x = malloc(sizeof(struct Doggo)); 31 | x->many = Int_val(Field(0, caml_x)); 32 | x->wow = Int_val(Field(1, caml_x)); 33 | return x; 34 | } 35 | 36 | value caml_Doggo_to_value(struct Doggo* x) { 37 | CAMLparam0(); 38 | CAMLlocal1(caml_x); 39 | caml_x = caml_alloc_tuple(2); 40 | Store_field(caml_x, 0, Val_int(x->many)); 41 | Store_field(caml_x, 1, Val_int(x->wow)); 42 | CAMLreturn(caml_x); 43 | } 44 | 45 | void caml_eleven_out_of_ten_majestic_af(value caml_pupper) { 46 | CAMLparam1(1); 47 | Doggo* pupper = caml_Doggo_of_value(caml_pupper); 48 | eleven_out_of_ten_majestic_af(pupper); 49 | CAMLreturn0(); 50 | } 51 | 52 | 53 | -------------------------------------------------------------------------------- /tests/basics/struct.t/struct.h: -------------------------------------------------------------------------------- 1 | typedef struct Doggo { 2 | int many; 3 | char wow; 4 | } Doggo; 5 | 6 | void eleven_out_of_ten_majestic_af(Doggo* pupper); 7 | -------------------------------------------------------------------------------- /tests/dune: -------------------------------------------------------------------------------- 1 | (cram 2 | (applies_to :whole_subtree) 3 | (deps %{bin:ocaml-bindgen})) 4 | -------------------------------------------------------------------------------- /tests/libs/libsql.t/libsql.h: -------------------------------------------------------------------------------- 1 | #ifndef LIBSQL_EXPERIMENTAL_H 2 | #define LIBSQL_EXPERIMENTAL_H 3 | 4 | #include 5 | 6 | typedef struct libsql_connection libsql_connection; 7 | 8 | typedef struct libsql_database libsql_database; 9 | 10 | typedef struct libsql_row libsql_row; 11 | 12 | typedef struct libsql_rows libsql_rows; 13 | 14 | typedef struct libsql_rows_future libsql_rows_future; 15 | 16 | typedef struct libsql_stmt libsql_stmt; 17 | 18 | typedef const libsql_database *libsql_database_t; 19 | 20 | typedef const libsql_connection *libsql_connection_t; 21 | 22 | typedef const libsql_stmt *libsql_stmt_t; 23 | 24 | typedef const libsql_rows *libsql_rows_t; 25 | 26 | typedef const libsql_rows_future *libsql_rows_future_t; 27 | 28 | typedef const libsql_row *libsql_row_t; 29 | 30 | typedef struct { 31 | const char *ptr; 32 | int len; 33 | } blob; 34 | 35 | #ifdef __cplusplus 36 | extern "C" { 37 | #endif // __cplusplus 38 | 39 | int libsql_sync(libsql_database_t db, const char **out_err_msg); 40 | 41 | int libsql_open_sync(const char *db_path, 42 | const char *primary_url, 43 | const char *auth_token, 44 | libsql_database_t *out_db, 45 | const char **out_err_msg); 46 | 47 | int libsql_open_ext(const char *url, libsql_database_t *out_db, const char **out_err_msg); 48 | 49 | int libsql_open_file(const char *url, libsql_database_t *out_db, const char **out_err_msg); 50 | 51 | int libsql_open_remote(const char *url, const char *auth_token, libsql_database_t *out_db, const char **out_err_msg); 52 | 53 | void libsql_close(libsql_database_t db); 54 | 55 | int libsql_connect(libsql_database_t db, libsql_connection_t *out_conn, const char **out_err_msg); 56 | 57 | void libsql_disconnect(libsql_connection_t conn); 58 | 59 | int libsql_prepare(libsql_connection_t conn, const char *sql, libsql_stmt_t *out_stmt, const char **out_err_msg); 60 | 61 | int libsql_bind_int(libsql_stmt_t stmt, int idx, long long value, const char **out_err_msg); 62 | 63 | int libsql_bind_float(libsql_stmt_t stmt, int idx, double value, const char **out_err_msg); 64 | 65 | int libsql_bind_null(libsql_stmt_t stmt, int idx, const char **out_err_msg); 66 | 67 | int libsql_bind_string(libsql_stmt_t stmt, int idx, const char *value, const char **out_err_msg); 68 | 69 | int libsql_bind_blob(libsql_stmt_t stmt, int idx, const unsigned char *value, int value_len, const char **out_err_msg); 70 | 71 | int libsql_execute_stmt(libsql_stmt_t stmt, libsql_rows_t *out_rows, const char **out_err_msg); 72 | 73 | void libsql_free_stmt(libsql_stmt_t stmt); 74 | 75 | int libsql_execute(libsql_connection_t conn, const char *sql, libsql_rows_t *out_rows, const char **out_err_msg); 76 | 77 | void libsql_free_rows(libsql_rows_t res); 78 | 79 | void libsql_free_rows_future(libsql_rows_future_t res); 80 | 81 | void libsql_wait_result(libsql_rows_future_t res); 82 | 83 | int libsql_column_count(libsql_rows_t res); 84 | 85 | int libsql_column_name(libsql_rows_t res, int col, const char **out_name, const char **out_err_msg); 86 | 87 | int libsql_column_type(libsql_rows_t res, libsql_row_t row, int col, int *out_type, const char **out_err_msg); 88 | 89 | uint64_t libsql_changes(libsql_connection_t conn); 90 | 91 | int64_t libsql_last_insert_rowid(libsql_connection_t conn); 92 | 93 | int libsql_next_row(libsql_rows_t res, libsql_row_t *out_row, const char **out_err_msg); 94 | 95 | void libsql_free_row(libsql_row_t res); 96 | 97 | int libsql_get_string(libsql_row_t res, int col, const char **out_value, const char **out_err_msg); 98 | 99 | void libsql_free_string(const char *ptr); 100 | 101 | int libsql_get_int(libsql_row_t res, int col, long long *out_value, const char **out_err_msg); 102 | 103 | int libsql_get_float(libsql_row_t res, int col, double *out_value, const char **out_err_msg); 104 | 105 | int libsql_get_blob(libsql_row_t res, int col, blob *out_blob, const char **out_err_msg); 106 | 107 | void libsql_free_blob(blob b); 108 | 109 | #ifdef __cplusplus 110 | } // extern "C" 111 | #endif // __cplusplus 112 | 113 | #endif /* LIBSQL_EXPERIMENTAL_H */ 114 | -------------------------------------------------------------------------------- /tests/libs/libsql.t/run.t: -------------------------------------------------------------------------------- 1 | $ ocaml-bindgen libsql.h libsql 2 | Fatal error: exception File "bindgen/ir.ml", line 30, characters 11-17: Assertion failed 3 | [2] 4 | $ cat dune 5 | cat: dune: No such file or directory 6 | [1] 7 | $ cat libsql.ml 8 | cat: libsql.ml: No such file or directory 9 | [1] 10 | $ cat caml_libsql.c 11 | cat: caml_libsql.c: No such file or directory 12 | [1] 13 | --------------------------------------------------------------------------------