Using a PPX Preprocessor

Our calculator is pretty much opaque: we feed it a string, and it displays a result (on an error message), but we have now way to know what the internal expression looks like.

In this chapter, we’re going to use a ppx deriver to generate a pp_expr function that can display expressions.

Prerequisites

Install ppx_deriving by running:

opam install ppx_deriving.5.2.1

Create a test

Add a new test in test/calc.t:

$ calc --debug-ast -e '2 * sin (pi / 2)'

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.

Use ppx_deriving.show

Add an [@@deriving show] attribute on types in lib/ast.ml:

type op =
  | Add
  | Mul
  | Div
[@@deriving show]

type expr =
  | Int of int
  | Float of float
  | Ident of string
  | Op of op * expr * expr
  | Call of string * expr
[@@deriving show]

This will generate pp_op, show_op, pp_expr, and show_expr functions.

To do do we need to instruct Dune to use ppx_deriving.show as a preprocessor by updating lib/dune:

(library
 (name calc)
 (libraries cmdliner)
 (preprocess
  (pps ppx_deriving.show))
 (foreign_stubs
  (language c)
  (names calc_stubs)))

Add a --debug-ast Flag

We have a few edits to make to lib/cli.ml.

First, add a new cmdliner flag to parse the command-line and pass it to repl and eval_lb:

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

Then, forward it from repl to eval_lb:

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

Finally, update eval_lb to use it:

let eval_lb ~debug_ast lb =
  try
    let expr = Parser.main Lexer.token lb in
    if debug_ast then Format.eprintf "[debug] %a\n" Ast.pp_exp expr;
    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

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

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))
 (preprocess
  (pps ppx_deriving.show)))

(ocamllex lexer)

(menhir
 (modules parser))

lib/ast.ml

type op =
  | Add
  | Mul
  | Div
[@@deriving show]

type exp =
  | Int of int
  | Float of float
  | Ident of string
  | Op of op * exp * exp
  | Call of string * exp
[@@deriving show]

lib/calc_stubs.c (unchanged)

#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 ~debug_ast lb =
  try
    let expr = Parser.main Lexer.token lb in
    if debug_ast then Format.eprintf "[debug] %a\n" Ast.pp_exp expr;
    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 ~debug_ast =
  while true do
    Printf.printf ">> %!";
    let lb = Lexing.from_channel Stdlib.stdin in
    eval_lb ~debug_ast 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" ]
  and+ debug_ast =
    let open Cmdliner.Arg in
    value & flag & info [ "debug-ast" ]
  in
  match expr_opt with
  | Some s -> eval_lb ~debug_ast (Lexing.from_string s)
  | None -> repl ~debug_ast

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

  $ calc --debug-ast -e '2 * sin (pi / 2)'
  2
  [debug] (Ast.Op (Ast.Mul, (Ast.Int 2),
             (Ast.Call ("sin",
                (Ast.Op (Ast.Div, (Ast.Ident "pi"), (Ast.Int 2)))))
             ))