Clerk: compilation to C

Author: AltGr

build_system/clerk_driver.ml

@@ -433,6 +433,9 @@ module Poll = struct
 
   let ocaml_link_flags : string list Lazy.t =
     lazy (snd (Lazy.force ocaml_include_and_lib_flags))
+
+  let c_runtime_dir : File.t Lazy.t =
+    lazy File.(Lazy.force ocaml_runtime_dir /../ "runtime_c")
 end
 
 (**{1 Building rules}*)
@@ -449,12 +452,16 @@ module Var = struct
   let catala_exe = make "CATALA_EXE"
   let catala_flags = make "CATALA_FLAGS"
   let catala_flags_ocaml = make "CATALA_FLAGS_OCAML"
+  let catala_flags_c = make "CATALA_FLAGS_C"
   let catala_flags_python = make "CATALA_FLAGS_PYTHON"
   let clerk_flags = make "CLERK_FLAGS"
   let ocamlc_exe = make "OCAMLC_EXE"
   let ocamlopt_exe = make "OCAMLOPT_EXE"
   let ocaml_flags = make "OCAML_FLAGS"
   let runtime_ocaml_libs = make "RUNTIME_OCAML_LIBS"
+  let cc_exe = make "CC"
+  let c_flags = make "CFLAGS"
+  let runtime_c_libs = make "RUNTIME_C_LIBS"
 
   (** Rule vars, Used in specific rules *)
 
@@ -484,6 +491,12 @@ let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
         | "-O" | "--optimize" | "--closure-conversion" -> true | _ -> false)
       test_flags
   in
+  let catala_flags_c =
+    List.filter
+      (function
+        | "-O" | "--optimize" -> true | _ -> false)
+      test_flags
+  in
   let catala_flags_python =
     List.filter
       (function
@@ -504,6 +517,7 @@ let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
       ];
     Nj.binding Var.catala_flags (catala_flags @ includes);
     Nj.binding Var.catala_flags_ocaml catala_flags_ocaml;
+    Nj.binding Var.catala_flags_c catala_flags_c;
     Nj.binding Var.catala_flags_python catala_flags_python;
     Nj.binding Var.clerk_flags
       ("-e"
@@ -515,6 +529,11 @@ let base_bindings catala_exe catala_flags build_dir include_dirs test_flags =
     Nj.binding Var.ocamlopt_exe ["ocamlopt"];
     Nj.binding Var.ocaml_flags (ocaml_flags @ includes);
     Nj.binding Var.runtime_ocaml_libs (Lazy.force Poll.ocaml_link_flags);
+    Nj.binding Var.cc_exe ["cc"];
+    Nj.binding Var.runtime_c_libs ["-I" ^ Lazy.force Poll.c_runtime_dir;
+                                   "-L" ^ Lazy.force Poll.c_runtime_dir;
+                                   "-lcatala_runtime"; "-lgmp"];
+    Nj.binding Var.c_flags (["-std=c89"; "-pedantic"; "-Wall"; "-Wno-unused-variable"; "-Werror"; Var.(!runtime_c_libs)] @ includes);
   ]
 
 let[@ocamlformat "disable"] static_base_rules =
@@ -552,6 +571,25 @@ let[@ocamlformat "disable"] static_base_rules =
       ]
       ~description:["<ocaml>"; "⇒"; !output];
 
+    Nj.rule "catala-c"
+      ~command:[!catala_exe; "c"; !catala_flags; !catala_flags_c;
+                !input; "-o"; !output]
+      ~description:["<catala>"; "c"; "⇒"; !output];
+
+    Nj.rule "c-object"
+      ~command:
+        [!cc_exe; !input; !c_flags; "-c"; "-o"; !output]
+      ~description:["<cc>"; "⇒"; !output];
+
+    Nj.rule "c-exec"
+      ~command: [
+        !cc_exe;
+        shellout [!catala_exe; "depends";
+                  "--prefix="^ !builddir; "--extension=c.o";
+                  !catala_flags; !orig_src];
+        !input; !c_flags; "-o"; !output]
+      ~description:["<cc>"; "⇒"; !output];
+
     Nj.rule "python"
       ~command:[!catala_exe; "python"; !catala_flags; !catala_flags_python;
                 !input; "-o"; !output]
@@ -607,12 +645,24 @@ let gen_build_statements
   in
   let ml_file = target_file "ml" in
   let py_file = target_file "py" in
-  let ocaml, python =
+  let c_file = target_file "c" in
+  let h_file = target_file "h" in
+  let ocaml, c, python =
     if item.extrnal then
       ( Nj.build "copy"
           ~implicit_in:[inc srcv]
           ~inputs:[src -.- "ml"]
           ~outputs:[ml_file],
+        List.to_seq [
+          Nj.build "copy"
+            ~implicit_in:[inc srcv]
+            ~inputs:[src -.- "c"]
+            ~outputs:[c_file];
+          Nj.build "copy"
+            ~implicit_in:[inc srcv]
+            ~inputs:[src -.- "h"]
+            ~outputs:[h_file]
+        ],
         Nj.build "copy"
           ~implicit_in:[inc srcv]
           ~inputs:[src -.- "py"]
@@ -621,6 +671,12 @@ let gen_build_statements
       ( Nj.build "catala-ocaml"
           ~inputs:[inc srcv]
           ~implicit_in:[!Var.catala_exe] ~outputs:[ml_file],
+        Seq.return
+          (Nj.build "catala-c"
+            ~inputs:[inc srcv]
+            ~implicit_in:[!Var.catala_exe]
+            ~outputs:[c_file]
+            ~implicit_out:[h_file]),
         Nj.build "python"
           ~inputs:[inc srcv]
           ~implicit_in:[!Var.catala_exe] ~outputs:[py_file] )
@@ -659,11 +715,26 @@ let gen_build_statements
     in
     [obj; modexec]
   in
+  let cc =
+    Nj.build "c-object"
+      ~inputs:[c_file]
+      ~implicit_in:(!Var.catala_exe :: h_file :: List.map (modfile ".h") modules)
+      ~outputs:[target_file "c.o"]
+    ::
+    if item.module_def <> None then []
+    else
+      [ Nj.build "c-exec"
+          ~implicit_in:(target_file "c.o" :: List.map (modfile ".c.o") modules)
+          ~outputs:[target_file "c.exe"]
+          ~vars:[Var.orig_src, [inc srcv]] ]
+  in
   let expose_module =
     match item.module_def with
     | Some m when List.mem (dirname src) include_dirs ->
-      Some (Nj.build "phony" ~outputs:[m ^ "@module"] ~inputs:[modd m])
-    | _ -> None
+      [Nj.build "phony" ~outputs:[m ^ "@module"] ~inputs:[modd m];
+       Nj.build "phony" ~outputs:[m ^ ".h"; m ^ ".c.o"]
+         ~inputs:[modfile ".h" m; modfile ".c.o" m]]
+    | _ -> []
   in
   let interp_deps =
     !Var.catala_exe
@@ -715,9 +786,11 @@ let gen_build_statements
          Seq.return def_src;
          Seq.return include_deps;
          Option.to_seq module_deps;
-         Option.to_seq expose_module;
+         List.to_seq expose_module;
          Seq.return ocaml;
          List.to_seq ocamlopt;
+         c;
+         List.to_seq cc;
          Seq.return python;
          List.to_seq tests;
          Seq.return interpret;

compiler/scalc/to_c.ml

@@ -209,10 +209,7 @@ let format_ctx
           let def = StructName.Map.find s ctx.ctx_structs in
           Format.fprintf ppc "@,%a" format_struct_decl (s, def);
           if TypeIdent.Set.mem tid ctx.ctx_public_types
-          then Format.fprintf pph "@,%a" format_struct_decl (s, def)
-          else Format.eprintf "NOT PUB: %a (pub: %a)@."
-              StructName.format s
-              (Format.pp_print_seq ~pp_sep:Format.pp_print_space TypeIdent.format) (TypeIdent.Set.to_seq ctx.ctx_public_types)
+          then Format.fprintf pph "@,%a" format_struct_decl (s, def);
       | TypeIdent.Enum e as tid ->
         if EnumName.path e = [] then
           let def = EnumName.Map.find e ctx.ctx_enums in
@@ -733,8 +730,8 @@ let format_program
   Format.fprintf pph "#ifndef __%s_H__@,#define __%s_H__@," module_id module_id;
   List.iter
     (fun (m, _intf_id) ->
-       ppboth @@ fun ppf -> Format.fprintf ppf "@,#include \"%s.h\""
-         (String.uncapitalize_ascii (ModuleName.to_string m)))
+       ppboth @@ fun ppf -> Format.fprintf ppf "@,#include <%s.h>"
+         ((* String.uncapitalize_ascii  *)(ModuleName.to_string m)))
     (Program.modules_to_list p.ctx.decl_ctx.ctx_modules);
   (* TODO: check the module hash ? *)
   format_ctx type_ordering ~ppc ~pph p.ctx.decl_ctx;
@@ -753,7 +750,8 @@ let format_program
             Re.(execp (compile (seq [str "__"; diff any digit])) (VarName.to_string var))
           in
           ppboth_if public (fun ppf ->
-              Format.fprintf ppf "@,@[<v 2>@[<hov 4>%a"
+              Format.fprintf ppf "@,@[<v 2>@[<hov 4>%s%a"
+                (if public then "" else "static")
                 (format_typ ~const:true p.ctx.decl_ctx (fun fmt ->
                      Format.pp_print_space fmt ();
                      VarName.format fmt var))
@@ -783,7 +781,8 @@ let format_program
           in
           ppboth_if public (fun ppf ->
               Format.fprintf ppf
-                "@,@[<v 2>@[<hov 4>%a@ @[<hv 1>(%a)@]@]"
+                "@,@[<v 2>@[<hov 4>%s%a@ @[<hv 1>(%a)@]@]"
+                (if public then "" else "static ")
                 (format_typ ~const:true ctx.decl_ctx (fun fmt ->
                      Format.pp_print_space fmt ();
                      FuncName.format fmt var))

runtimes/c/dune

@@ -10,3 +10,8 @@
  (target catala_runtime.a)
  (action
   (run ar rcs %{target} %{lib:dates_calc:c/dates_calc.o} %{deps})))
+
+(rule
+ (target dates_calc.h)
+ (action
+  (copy %{lib:dates_calc:c/dates_calc.h} %{target})))

runtimes/dune

@@ -26,5 +26,6 @@
 (install
  (files
   (c/catala_runtime.a as runtime_c/libcatala_runtime.a)
+  (c/dates_calc.h as runtime_c/dates_calc.h)
   (c/runtime.h as runtime_c/catala_runtime.h))
  (section lib))