feat: end-to-end flow for generating .ml and .c files

bindgen/bindgen.ml

@@ -1,5 +1,8 @@
-let translate file = 
+let translate ~file ~name = 
   let ast = Parser.parse file in
   let ir = Ir.lift ast in
-  let caml = Codegen.to_caml ir in
-  Format.printf "%a" (Printast.structure 0) caml
+  let caml = Caml.from_ir ir in
+  let c = C.from_ir ir in
+  Codegen.write_caml_files caml (name ^ ".ml");
+  Codegen.write_c_files c ("caml_"^ name ^ ".c");
+  ()

bindgen/c.ml

@@ -0,0 +1,27 @@
+open Clang
+open Ast
+
+let from_ir (ir : Ir.t) : Clang.Ast.translation_unit =
+  let items =
+    List.map
+      (fun node ->
+        match node with
+        | Ir.Ir_record { rec_name } ->
+            let record =
+              {
+                keyword = Obj.magic 0;
+                attributes = [];
+                nested_name_specifier = None;
+                name = rec_name;
+                bases = [];
+                fields = [];
+                final = true;
+                complete_definition = true;
+                is_injected_class_name = false;
+              }
+            in
+            Ast.node (Ast.RecordDecl record))
+      ir
+  in
+  let desc = { filename = "file.c"; items } in
+  Ast.node desc

bindgen/caml.ml

@@ -0,0 +1,8 @@
+open Ast_helper
+
+let from_ir (ir: Ir.t): Parsetree.structure = 
+  let loc = !default_loc in
+  List.map (fun node ->
+    match node with 
+    | Ir.Ir_record {rec_name=_} -> [%stri type a ]
+  ) ir

bindgen/codegen.ml

@@ -1 +1,14 @@
-let to_caml (_ir: Ir.t): Parsetree.structure = []
+let write_file pp content file =
+
+  let oc = open_out file in
+  let fmt = Format.formatter_of_out_channel oc in
+  Format.fprintf fmt "(* automatically generated by ocaml-bindgen 0.0.1 *)\r\n";
+  Format.fprintf fmt "%a\r\n%!" pp content;
+  close_out oc;
+  ()
+
+let write_caml_files caml file =
+  write_file Pprintast.structure caml file
+
+let write_c_files (c: Clang.Ast.translation_unit) file =
+  write_file Clang.Printer.translation_unit c file

bindgen/dune

@@ -1,3 +1,4 @@
 (library
  (name bindgen)
- (libraries clangml))
+ (preprocess (pps  ppxlib.metaquot))
+ (libraries clangml ppxlib compiler-libs))

bindgen/ir.ml

@@ -1,3 +1,32 @@
-type t  = Noop
+type node = Ir_record of { rec_name : string }
+type t = node list
 
-let lift (_clang_ast : Clang.Ast.translation_unit): t = Noop
+module Lift = struct
+  let lift_record (record : Clang.Ast.record_decl) =
+    Ir_record { rec_name = record.name }
+
+  let lift (clang_ast : Clang.Ast.translation_unit) : t =
+    let node : Clang.Ast.translation_unit_desc = clang_ast.desc in
+    List.filter_map
+      (fun (x : Clang.Ast.decl) ->
+        let desc : Clang.Ast.decl_desc = x.desc in
+        match desc with
+        | Clang.Ast.RecordDecl record -> Some (lift_record record)
+        | Clang.Ast.EnumDecl _ | Clang.Ast.TemplateDecl _ | Clang.Ast.Function _
+        | Clang.Ast.TemplatePartialSpecialization _ | Clang.Ast.CXXMethod _
+        | Clang.Ast.Var _ | Clang.Ast.TypedefDecl _ | Clang.Ast.Field _
+        | Clang.Ast.IndirectField _ | Clang.Ast.AccessSpecifier _
+        | Clang.Ast.Namespace _ | Clang.Ast.UsingDirective _
+        | Clang.Ast.UsingDeclaration _ | Clang.Ast.Constructor _
+        | Clang.Ast.Destructor _ | Clang.Ast.LinkageSpec _
+        | Clang.Ast.TemplateTemplateParameter _ | Clang.Ast.Friend _
+        | Clang.Ast.NamespaceAlias _ | Clang.Ast.EmptyDecl
+        | Clang.Ast.Directive _ | Clang.Ast.StaticAssert _
+        | Clang.Ast.TypeAlias _ | Clang.Ast.Decomposition _
+        | Clang.Ast.Concept _ | Clang.Ast.Export _
+        | Clang.Ast.UnknownDecl (_, _) ->
+            None)
+      node.items
+end
+
+let lift = Lift.lift

cli/main.ml

@@ -1,3 +1,4 @@
 let () = 
-  let arg = Sys.argv.(1) in
-  Bindgen.translate arg
+  let file = Sys.argv.(1) in
+  let name = Sys.argv.(2) in
+  Bindgen.translate ~file ~name

tests/libs/libsql.t/libsql.h

@@ -0,0 +1,113 @@
+#ifndef LIBSQL_EXPERIMENTAL_H
+#define LIBSQL_EXPERIMENTAL_H
+
+#include <stdint.h>
+
+typedef struct libsql_connection libsql_connection;
+
+typedef struct libsql_database libsql_database;
+
+typedef struct libsql_row libsql_row;
+
+typedef struct libsql_rows libsql_rows;
+
+typedef struct libsql_rows_future libsql_rows_future;
+
+typedef struct libsql_stmt libsql_stmt;
+
+typedef const libsql_database *libsql_database_t;
+
+typedef const libsql_connection *libsql_connection_t;
+
+typedef const libsql_stmt *libsql_stmt_t;
+
+typedef const libsql_rows *libsql_rows_t;
+
+typedef const libsql_rows_future *libsql_rows_future_t;
+
+typedef const libsql_row *libsql_row_t;
+
+typedef struct {
+  const char *ptr;
+  int len;
+} blob;
+
+#ifdef __cplusplus
+extern "C" {
+#endif // __cplusplus
+
+int libsql_sync(libsql_database_t db, const char **out_err_msg);
+
+int libsql_open_sync(const char *db_path,
+                     const char *primary_url,
+                     const char *auth_token,
+                     libsql_database_t *out_db,
+                     const char **out_err_msg);
+
+int libsql_open_ext(const char *url, libsql_database_t *out_db, const char **out_err_msg);
+
+int libsql_open_file(const char *url, libsql_database_t *out_db, const char **out_err_msg);
+
+int libsql_open_remote(const char *url, const char *auth_token, libsql_database_t *out_db, const char **out_err_msg);
+
+void libsql_close(libsql_database_t db);
+
+int libsql_connect(libsql_database_t db, libsql_connection_t *out_conn, const char **out_err_msg);
+
+void libsql_disconnect(libsql_connection_t conn);
+
+int libsql_prepare(libsql_connection_t conn, const char *sql, libsql_stmt_t *out_stmt, const char **out_err_msg);
+
+int libsql_bind_int(libsql_stmt_t stmt, int idx, long long value, const char **out_err_msg);
+
+int libsql_bind_float(libsql_stmt_t stmt, int idx, double value, const char **out_err_msg);
+
+int libsql_bind_null(libsql_stmt_t stmt, int idx, const char **out_err_msg);
+
+int libsql_bind_string(libsql_stmt_t stmt, int idx, const char *value, const char **out_err_msg);
+
+int libsql_bind_blob(libsql_stmt_t stmt, int idx, const unsigned char *value, int value_len, const char **out_err_msg);
+
+int libsql_execute_stmt(libsql_stmt_t stmt, libsql_rows_t *out_rows, const char **out_err_msg);
+
+void libsql_free_stmt(libsql_stmt_t stmt);
+
+int libsql_execute(libsql_connection_t conn, const char *sql, libsql_rows_t *out_rows, const char **out_err_msg);
+
+void libsql_free_rows(libsql_rows_t res);
+
+void libsql_free_rows_future(libsql_rows_future_t res);
+
+void libsql_wait_result(libsql_rows_future_t res);
+
+int libsql_column_count(libsql_rows_t res);
+
+int libsql_column_name(libsql_rows_t res, int col, const char **out_name, const char **out_err_msg);
+
+int libsql_column_type(libsql_rows_t res, libsql_row_t row, int col, int *out_type, const char **out_err_msg);
+
+uint64_t libsql_changes(libsql_connection_t conn);
+
+int64_t libsql_last_insert_rowid(libsql_connection_t conn);
+
+int libsql_next_row(libsql_rows_t res, libsql_row_t *out_row, const char **out_err_msg);
+
+void libsql_free_row(libsql_row_t res);
+
+int libsql_get_string(libsql_row_t res, int col, const char **out_value, const char **out_err_msg);
+
+void libsql_free_string(const char *ptr);
+
+int libsql_get_int(libsql_row_t res, int col, long long *out_value, const char **out_err_msg);
+
+int libsql_get_float(libsql_row_t res, int col, double *out_value, const char **out_err_msg);
+
+int libsql_get_blob(libsql_row_t res, int col, blob *out_blob, const char **out_err_msg);
+
+void libsql_free_blob(blob b);
+
+#ifdef __cplusplus
+} // extern "C"
+#endif // __cplusplus
+
+#endif /* LIBSQL_EXPERIMENTAL_H */

tests/libs/libsql.t/run.t

@@ -0,0 +1,3 @@
+  $ ocaml-bindgen libsql.h libsql
+  $ cat libsql.ml
+  $ cat caml_libsql.c

tests/translate.t/run.t

@@ -1 +1,3 @@
-  $ ocaml-bindgen empty.c
+  $ ocaml-bindgen empty.c empty
+  $ cat empty.ml
+  $ cat caml_empty.c