From now and then, I found myself having to write some mechanical and repetitive code. The usual solution for this is to write a code generator; for instance in the form of a ppx rewriter in the case of OCaml code. This however comes with a cost: code generators are harder to review than plain code and it is a new syntax to learn for other developers. So when the repetitive pattern is local to a specific library or not widely used, it is often not worth the effort. Especially if the code in question is meant to be reviewed and maintained by several people.

Then there is the possibility of using a macro pre-processor such as cpp or cppo which is the equivalent of cpp but for OCaml. This can help in some cases but this has a cost as well:

macros generally make the code harder to read

errors tends to be harder to understand since they don’t point where you’d expect

you can say goodbye to merlin

In fact, when the repetitive pattern is specific to one particular case and of reasonable size, committing and reviewing the generated code is acceptable. That’s the problem Cinaps tries to solve.

What is cinaps?

Cinaps is an application that reads input files and recognize special syntactic forms. Such forms are expected to embed some OCaml code printing something to stdout. What they print is compared against what follow these special forms. The rest works exactly the same as expectation tests.

The special form is (*$ <ocaml-code> *) for ml source files, /*$ <ocaml-code> */ for C source files and #|$ <ocaml-code> |# for S-expression files.

For instance:

$ cat file.ml let x = 1 (*$ print_newline (); List.iter (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )

" s s) ["+"; "-"; "*"; "/"] *) (*$*) let y = 2 $ cinaps file.ml ---file.ml +++file.ml.corrected File "file.ml", line 5, characters 0-1: let x = 1 (*$ print_newline (); List.iter (fun s -> Printf.printf "let ( %s ) = Pervasives.( %s )

" s s) ["+"; "-"; "*"; "/"] *) +|let ( + ) = Pervasives.( + ) +|let ( - ) = Pervasives.( - ) +|let ( * ) = Pervasives.( * ) +|let ( / ) = Pervasives.( / ) (*$*) let y = 2 $ echo $? 1 $ cp file.ml.corrected file.ml $ cinaps file.ml $ echo $? 0

Real example

What follows is a real example where using Cinaps made the code much easier to write and maintain. However, I changed the names for this blog post since this code is not released publicly. Note also that this example shows one way we usually write C bindings at Jane Street. It is not meant as a model of how to write C bindings, and the excellent ctypes library should be the default choice in most cases. However, this code pre-dates ctypes and migrating it would be quite a lot of work.

The example itself is part of a C binding that I wrote a few years ago. While doing so I used Core.Flags in order to represent a few C enumerations on the OCaml side. Core.Flags is a module providing a nice abstraction for representing C flags.

The OCaml code looks like what you’d expect from code using Core.Flags :

module Open_flags = struct external get_rdonly : unit -> Int63 . t = "mylib_O_RDONLY" [@@ noalloc ] external get_wronly : unit -> Int63 . t = "mylib_O_WRONLY" [@@ noalloc ] external get_rdwr : unit -> Int63 . t = "mylib_O_RDWR" [@@ noalloc ] external get_nonblock : unit -> Int63 . t = "mylib_O_NONBLOCK" [@@ noalloc ] external get_append : unit -> Int63 . t = "mylib_O_APPEND" [@@ noalloc ] external get_creat : unit -> Int63 . t = "mylib_O_CREAT" [@@ noalloc ] external get_trunc : unit -> Int63 . t = "mylib_O_TRUNC" [@@ noalloc ] external get_excl : unit -> Int63 . t = "mylib_O_EXCL" [@@ noalloc ] external get_noctty : unit -> Int63 . t = "mylib_O_NOCTTY" [@@ noalloc ] external get_dsync : unit -> Int63 . t = "mylib_O_DSYNC" [@@ noalloc ] external get_sync : unit -> Int63 . t = "mylib_O_SYNC" [@@ noalloc ] external get_rsync : unit -> Int63 . t = "mylib_O_RSYNC" [@@ noalloc ] let rdonly = get_rdonly () let wronly = get_wronly () let rdwr = get_rdwr () let nonblock = get_nonblock () let append = get_append () let creat = get_creat () let trunc = get_trunc () let excl = get_excl () let noctty = get_noctty () let dsync = get_dsync () let sync = get_sync () let rsync = get_rsync () include Flags . Make ( struct let known = [ rdonly , "rdonly" ; wronly , "wronly" ; rdwr , "rdwr" ; nonblock , "nonblock" ; append , "append" ; creat , "creat" ; trunc , "trunc" ; excl , "excl" ; noctty , "noctty" ; dsync , "dsync" ; sync , "sync" ; rsync , "rsync" ] let remove_zero_flags = false let allow_intersecting = false let should_print_error = true end ) end

And there are about 3 modules like this in this file, plus the corresponding stubs in the C file. Writing this code initially was no fun, and adding new flags now that the C library has evolved is still no fun.

The rest of this section explains how to make it more fun with cinaps.

Setting up and using cinaps

First I add a rule in the build system to call cinaps appropriately. I use a few settings specific to our jenga based builds and it is currently not possible to replicate this outside of Jane Street, but assuming you have a Makefile , you can write:

.PHONY : cinaps cinaps : cinaps -i src/*.ml src/*.c

Now whenever you call make cinaps , all the files will be updated in place. You can then do git diff to see what changed.

Then I write a file src/cinaps_helpers . It is plain OCaml source file, however it is not suffixed with .ml so that it is not confused with a regular module of the library. It contains the various bits that are common between the ml/C files in the library:

(* -*- tuareg -*- *) let stub_prefix = "mylib_" let stub name = stub_prefix ^ name let open_flags = [ "O_RDONLY" ; "O_WRONLY" ; "O_RDWR" ; "O_NONBLOCK" ; "O_APPEND" ; "O_CREAT" ; "O_TRUNC" ; "O_EXCL" ; "O_NOCTTY" ; "O_DSYNC" ; "O_SYNC" ; "O_RSYNC" ] let other_flags = [ ... ] let yet_other_flags = [ ... ] let all_flags = open_flags @ other_flags @ yet_other_flags open StdLabels open Printf let pr fmt = printf ( fmt ^^ "

" ) let flags_module module_name flags ~ prefix ~ allow_intersection = < code to print an Open_flags like module >

Now, in my original .ml file, I can write:

(*$ #use "cinaps_helpers" $*) (*$ flags_module "Open_flags" open_flags ~prefix:"O_" ~allow_intersecting:false *) module Open_flags = struct external get_rdonly : unit -> Int63 . t = "mylib_O_RDONLY" [@@ noalloc ] external get_wronly : unit -> Int63 . t = "mylib_O_WRONLY" [@@ noalloc ] external get_rdwr : unit -> Int63 . t = "mylib_O_RDWR" [@@ noalloc ] external get_nonblock : unit -> Int63 . t = "mylib_O_NONBLOCK" [@@ noalloc ] external get_append : unit -> Int63 . t = "mylib_O_APPEND" [@@ noalloc ] external get_creat : unit -> Int63 . t = "mylib_O_CREAT" [@@ noalloc ] external get_trunc : unit -> Int63 . t = "mylib_O_TRUNC" [@@ noalloc ] external get_excl : unit -> Int63 . t = "mylib_O_EXCL" [@@ noalloc ] external get_noctty : unit -> Int63 . t = "mylib_O_NOCTTY" [@@ noalloc ] external get_dsync : unit -> Int63 . t = "mylib_O_DSYNC" [@@ noalloc ] external get_sync : unit -> Int63 . t = "mylib_O_SYNC" [@@ noalloc ] external get_rsync : unit -> Int63 . t = "mylib_O_RSYNC" [@@ noalloc ] let rdonly = get_rdonly () let wronly = get_wronly () let rdwr = get_rdwr () let nonblock = get_nonblock () let append = get_append () let creat = get_creat () let trunc = get_trunc () let excl = get_excl () let noctty = get_noctty () let dsync = get_dsync () let sync = get_sync () let rsync = get_rsync () include Flags . Make ( struct let known = [ rdonly , "rdonly" ; wronly , "wronly" ; rdwr , "rdwr" ; nonblock , "nonblock" ; append , "append" ; creat , "creat" ; trunc , "trunc" ; excl , "excl" ; noctty , "noctty" ; dsync , "dsync" ; sync , "sync" ; rsync , "rsync" ] let remove_zero_flags = false let allow_intersecting = false let should_print_error = true end ) end (*$*)

And cinaps will check that the text between the (*$ ... *) and (*$*) forms is what is printed by flags_module "Open_flags" ... . I write something similar in the .c file. Note the initial (*$ ... $*) form, which is not expected to print anything and is only used for its other side effects.

Adding new flags become trivial: add it to the list in src/cinaps_helper and execute make cinaps .

Pushing the system

Now I decide that I don’t like the fact that all my constant flags are initialized at runtime and I want them to be static constant on the ml side. A simple way to do this is to write a C program that include the right headers and output a .ml file defining these constants. I use cynaps to write this C file as well:

/*$ #use "cinaps_helpers" $*/ #include <stdio.h> #include <sys/types.h> #include <sys/stat.h> #include <fcntl.h> int main () { printf ( "open Core

" ); printf ( "let mk = Int63.of_int_exn

" ); /*$ printf "

"; let len = longest all_flags in List.iter all_flags ~f:(fun f -> pr {| printf("let _%-*s = mk %%d

", %-*s);|} len f len f ); printf " " */ printf ( "let _O_RDONLY = mk %d

" , O_RDONLY ); printf ( "let _O_WRONLY = mk %d

" , O_WRONLY ); printf ( "let _O_RDWR = mk %d

" , O_RDWR ); printf ( "let _O_NONBLOCK = mk %d

" , O_NONBLOCK ); printf ( "let _O_APPEND = mk %d

" , O_APPEND ); printf ( "let _O_CREAT = mk %d

" , O_CREAT ); printf ( "let _O_TRUNC = mk %d

" , O_TRUNC ); printf ( "let _O_EXCL = mk %d

" , O_EXCL ); printf ( "let _O_NOCTTY = mk %d

" , O_NOCTTY ); printf ( "let _O_DSYNC = mk %d

" , O_DSYNC ); printf ( "let _O_SYNC = mk %d

" , O_SYNC ); printf ( "let _O_RSYNC = mk %d

" , O_RSYNC ); /*$*/ return 0 ; }

Updating the various flag modules in the the ml code is as simple as editing src/cinaps_helpers and doing make cinaps :

(*$ flags_module "Open_flags" open_flags ~prefix:"O_" ~allow_intersecting:false *) module Open_flags = struct let rdonly = Consts . _ O_RDONLY let wronly = Consts . _ O_WRONLY let rdwr = Consts . _ O_RDWR let nonblock = Consts . _ O_NONBLOCK let append = Consts . _ O_APPEND let creat = Consts . _ O_CREAT let trunc = Consts . _ O_TRUNC let excl = Consts . _ O_EXCL let noctty = Consts . _ O_NOCTTY let dsync = Consts . _ O_DSYNC let sync = Consts . _ O_SYNC let rsync = Consts . _ O_RSYNC include Flags . Make ( struct let known = [ Consts . _ O_RDONLY , "rdonly" ; Consts . _ O_WRONLY , "wronly" ; Consts . _ O_RDWR , "rdwr" ; Consts . _ O_NONBLOCK , "nonblock" ; Consts . _ O_APPEND , "append" ; Consts . _ O_CREAT , "creat" ; Consts . _ O_TRUNC , "trunc" ; Consts . _ O_EXCL , "excl" ; Consts . _ O_NOCTTY , "noctty" ; Consts . _ O_DSYNC , "dsync" ; Consts . _ O_SYNC , "sync" ; Consts . _ O_RSYNC , "rsync" ] let remove_zero_flags = false let allow_intersecting = false let should_print_error = true end ) end (*$*)

Tweak: indenting the generated code

You can either write cinaps code that produce properly indented code, or you can use the styler option:

.PHONY : cinaps cinaps : cinaps -styler ocp-indent -i src/*.ml src/*.c

History behind the name

I initially wrote this tool while I did some work on the ocaml-migrate-parsetree project. ocaml-migrate-parsetree was started by Alain Frisch and continued by Frederic Bour and aims at providing a solid and stable base for authors of ppx rewriters or other tools using the OCaml frontend. I helped a bit during development and did some testing on a large scale while rebasing our ppx infrastructure on top it.

Due to its nature, this project contains a lot of repetitive code that cannot be factorized other than by using some kind of meta-programming. Initially we had a small pre-preprocessor that was interpreting a made-up syntax and was working like cpp does. The syntax was yet another DSL and the generated code was generated on the fly. This made the .ml and .mli files harder to understand since you had to decode this DSL in order to understand what the code was.

Cinaps replaced this tool and the name was chosen to emphasize that it is not a preprocessor. It means “Cinaps Is Not A Preprocessing System”.

Status

Cinaps is published on github and is part of the upcoming v0.9 Jane Street release. The version that is published doesn’t yet support the C/S-expression syntaxes but once the stable release has gone through, an updated version of Cinaps supporting these syntaxes will be released.