Interfacing with C

In this chapter, we’re going to extend our calculator with a new function. The difference with sin is that we’re going to use a C implementation of the function because it is not available in Stdlib. To do so, we’re going to use (foreign_stubs) to implement the function in C.

Create a test

Add a new test in test/calc.t:

  $ calc -e 'log10(123456)'

Run dune runtest and see the failure. Run dune promote to add the failure to the test file. Our goal in the rest of the chapter is to change the output of this test.

Lexing

We have a tiny change to make in lib/lexer.mll: extend function names so that they can contain numbers (but not at the beginning).

let ident = letter (letter | digit)+

Evaluation

Let’s extend our eval function in lib/cli.ml to handle a log10 function. Instead of implementing the function in OCaml, we declare it as an external (with its type).

external log10_c : float -> float = "calc_log10"

let rec eval = function
  | Ast.Int n -> VInt n
  | Float f -> VFloat f
  | Ident "pi" -> VFloat (2. *. Stdlib.acos 0.)
  | Ident _ -> failwith "unknown ident"
  | Op (Add, a, b) -> eval_number_op ( + ) ( +. ) (eval a) (eval b)
  | Op (Mul, a, b) -> eval_number_op ( * ) ( *. ) (eval a) (eval b)
  | Op (Div, a, b) -> eval_number_op ( / ) ( /. ) (eval a) (eval b)
  | Call ("sin", e) -> VFloat (Stdlib.sin (as_float (eval e)))
  | Call ("log10", e) -> VFloat (log10_c (as_float (eval e)))
  | Call _ -> failwith "unknown function"

Create Foreign Stubs

The final part is to implement calc_log10 as a C function and link it with our library.

Let’s create a file lib/calc_stubs.c:

#include <caml/alloc.h>
#include <caml/memory.h>
#include <math.h>

value calc_log10 (value vx)
{
    CAMLparam1(vx);
    double x = Double_val(vx);
    double r = log10(x);
    CAMLreturn(caml_copy_double(r));
}

Note

The interface between C and OCaml code uses a C type called value.

Values of this type can be converted from and to double using Double_val and caml_copy_double.

They need to be registered with the garbage collector using the CAMLparam1 and CAMLreturn macros.

And we finally we specify to Dune that this file is part of the library in lib/dune:

(library
 (name calc)
 (libraries cmdliner)
 (foreign_stubs
  (language c)
  (names calc_stubs)))

Run the tests again with dune runtest. At that point, the output should be correct. Call dune promote to update the expected output.

Conclusion

In this chapter, we’ve extended our library with some C code. The mechanism to do so is called foreign stubs.

Checkpoint

This is how the project looks like at the end of this chapter.

dune-project (unchanged)

(lang dune 3.0)
(using menhir 2.1)
(package (name calc))

bin/dune (unchanged)

(executable
 (public_name calc)
 (libraries calc))

bin/calc.ml (unchanged)

let () = Calc.Cli.main ()

lib/dune

(library
 (name calc)
 (libraries cmdliner)
 (foreign_stubs
  (language c)
  (names calc_stubs)))

(ocamllex lexer)

(menhir
 (modules parser))

lib/ast.ml (unchanged)

type op =
  | Add
  | Mul
  | Div

type exp =
  | Int of int
  | Float of float
  | Ident of string
  | Op of op * exp * exp
  | Call of string * exp

lib/calc_stubs.c

#include <caml/alloc.h>
#include <caml/memory.h>
#include <math.h>

value calc_log10 (value vx)
{
    CAMLparam1(vx);
    double x = Double_val(vx);
    double r = log10(x);
    CAMLreturn(caml_copy_double(r));
}

lib/cli.ml

type value = VInt of int | VFloat of float

let value_to_string = function
  | VInt n -> string_of_int n
  | VFloat f -> Printf.sprintf "%.6g" f

let eval_number_op f_int f_float va vb =
  match (va, vb) with
  | VInt na, VInt nb -> VInt (f_int na nb)
  | VFloat fa, VFloat fb -> VFloat (f_float fa fb)
  | VInt na, VFloat fb -> VFloat (f_float (float_of_int na) fb)
  | VFloat fa, VInt nb -> VFloat (f_float fa (float_of_int nb))

let as_float = function
  | VInt n -> float_of_int n
  | VFloat f -> f

external log10_c : float -> float = "calc_log10"

let rec eval = function
  | Ast.Int n -> VInt n
  | Float f -> VFloat f
  | Ident "pi" -> VFloat (2. *. Stdlib.acos 0.)
  | Ident _ -> failwith "unknown ident"
  | Op (Add, a, b) -> eval_number_op ( + ) ( +. ) (eval a) (eval b)
  | Op (Mul, a, b) -> eval_number_op ( * ) ( *. ) (eval a) (eval b)
  | Op (Div, a, b) -> eval_number_op ( / ) ( /. ) (eval a) (eval b)
  | Call ("sin", e) -> VFloat (Stdlib.sin (as_float (eval e)))
  | Call ("log10", e) -> VFloat (log10_c (as_float (eval e)))
  | Call _ -> failwith "unknown function"

let info = Cmdliner.Cmd.info "calc"

let eval_lb lb =
  try
    let expr = Parser.main Lexer.token lb in
    let v = eval expr in
    Printf.printf "%s\n" (value_to_string v)
  with Parser.Error ->
    Printf.printf "parse error near character %d" lb.lex_curr_pos

let repl () =
  while true do
    Printf.printf ">> %!";
    let lb = Lexing.from_channel Stdlib.stdin in
    eval_lb lb
  done

let term =
  let open Cmdliner.Term.Syntax in
  let+ expr_opt =
    let open Cmdliner.Arg in
    value & opt (some string) None & info [ "e" ]
  in
  match expr_opt with
  | Some s -> eval_lb (Lexing.from_string s)
  | None -> repl ()

let cmd = Cmdliner.Cmd.v info term
let main () = Cmdliner.Cmd.eval cmd |> Stdlib.exit

lib/lexer.mll

let space = [' ']+

let digit = ['0'-'9']+

let letter = ['a'-'z']

let ident = letter (letter | digit)+

rule token = parse
    | eof { Parser.Eof }
    | space { token lexbuf }
    | '\n' { Parser.Eof }
    | '+' { Parser.Plus }
    | '*' { Parser.Star }
    | '/' { Parser.Slash }
    | '(' { Parser.Lpar }
    | ')' { Parser.Rpar }
    | digit+ { Parser.Int (int_of_string (Lexing.lexeme lexbuf)) }
    | digit+ '.' digit+ { Parser.Float (float_of_string (Lexing.lexeme lexbuf)) }
    | ident { Parser.Ident (Lexing.lexeme lexbuf) }

lib/parser.mly (unchanged)

%token Eof
%token<int> Int
%token Plus
%token Star
%token Slash
%token Lpar Rpar
%token<float> Float
%token<string> Ident
%start<Ast.exp> main

%left Plus
%left Star Slash

%{ open Ast %}

%%

main: expr Eof { $1 }

expr:
| Int { Int $1 }
| expr Plus expr { Op (Add, $1, $3) }
| expr Star expr { Op (Mul, $1, $3) }
| expr Slash expr { Op (Div, $1, $3) }
| Ident Lpar expr Rpar { Call ($1, $3) }
| Float { Float $1 }
| Ident { Ident $1 }

%%

test/dune (unchanged)

(cram
 (deps %{bin:calc}))

test/calc.t

  $ calc -e '1+2'
  3

  $ calc -e '1+'
  parse error near character 2

  $ calc -e '1+2.5'
  3.5

  $ calc -e '1+pi'
  4.14159

  $ calc -e '1+2*3'
  7

  $ calc -e '4/2'
  2

  $ calc -e 'sin (pi / 6)'
  0.5

  $ calc -e 'log10(123456)'
  5.09151