Gdb debugging...

Last month my brother came to visit and we did what every normal family would do: have beer and talk comp-scy. When he asked me how we debugged programs I had to sheepishly admit that I use printf... Part of the issue is that ocaml doesn't have good support for elf debugging annotation (the patch in PR#4888 hopes to address some of that) but it also comes from the fact that I am just not really up to speed on my debugging tools... Printf debugging has nearly no learning curve but it is slow and painful. Tools like gdb,strace,gprof,valgrind come with a steeper learning curve (especially for higher level languages because they require you to peer under the abstraction) but are the way to go in the long run.

So this month is going to be the no printf debugging month which means that I will only start modifying the source code of a programmer to debug it only as a last resort.

Meet the culprit

Today I had a quick look at a problem with the compiler itself. The compiler segfaulted while compiling code with very long lists (PR#5368).

The following bash command will generate a file (big_list.ml) that will cause the failure:

cat > big_list.ml <<EOF
let big x =[
  $(yes "true;" | head -n 100000)
 ]
EOF

Looking at backtraces

This smelled like a stack overflow (the stack size is fixed if you have too many function call chained you blow your stack out and might get a segfault). Sure enough, after raising the size of the stack (ulimit -s 50000) the compilation ran fine... So we are probably looking for a stack overflow. Those are usually called by non-tail call reccursions and real easy to find:

• load the binary in gdb. with gdb --args ocamlopt.opt big_list.ml
  
• run it (run) until it blows up
  
• look at the stack (bt) and one or several function should appear all the time.
  

Using breakpoints

In my case the stacktrace was a bit anti climatic:

#0  0x000000000058150d in camlIdent__find_same_16167 ()
#1  0x0000000000000000 in ?? ()

The lack of proper backtrace could be due to one of several things:

• Ocamlopt's calling convention for function is not the same as C and this could throw of gdb
  
• the Ocaml run time has code to detect stack overflow (./asmrun/signals_asm.c). It works by registering a signal handler for the SIGSEGV signal and examining the address of the error and raising an exception if anything is wrong. This code is running inside a unix signal; this is a very restricted environment in which you are not allowed to do much (e.g. you cannot call malloc); it might be doing something illegal and/or messing up the stack.
  

We did however get one function name out of it: camlIdent__find_same_16167. The caml compiler assigns symbols to functions following this naming convention: caml<module name>__<function name>_<integer>. In this case the function is the find_name function in the Ident(typing/ident,ml) module. Let's have a look at who's calling this function by using break points. No before calling runin gdb we set a breakpoint on the function.

(gdb) break camlIdent__find_same_16167
Breakpoint 1 at 0x5814f0
(gdb) run
Starting program: /opt/ocaml-exp/bin/ocamlopt.opt big_list.ml

Breakpoint 1, 0x00000000005814f0 in camlIdent__find_same_16167 ()

We want to let cross this break point enough to have a nice a fat backtrace.

(gdb) ignore 1 500
Will ignore next 500 crossings of breakpoint 1.
(gdb) continue
Continuing.

Breakpoint 1, 0x00000000005814f0 in camlIdent__find_same_16167 ()

By looking at the backtrace we can now clearly see that: camlTypecore__type_construct_206357 is appearing a lot on the stack and, sure enough, the type_construct in typing/typecore.ml is not tail recursive. In our case the easiest solution is probably to change our code generator to output the list by chunks:

let v0=[]

let v1= true::true:: ..... ::v0
let v2= true::true:: ..... ::v1
....
let v = vn

Finding function's symbol

Last but not least: of you wanted to put a breakpoint in typecore.ml on the function type_argument you'd have to figure out the symbol name:

> nm /opt/ocaml-exp/bin/ocamlopt.opt | grep camlTypecore__type_argument
0000000000526b70 T camlTypecore__type_argument_206355

Command line parsing as a functional unparsing

Command line argument parsing is a puzzling subject: it seems simple and small enough that it wouldn’t gather much attention yet it pops up regularly through the blogosphere. There are many libraries for argument parsing but none of them seem to be unanimously loved. This has all the hallmarks of a surprisingly sneaky (and thus interesting) problem. A couple of long plane rides have allowed me to try taking a stab at argument parsing. This is however not intended to be a fully maintained and polished library; it is toy code used to test out a couple of ideas. The code uses a couple of clever tricks (functional unparsing, staging of functions, phantom types) but none of them are really new. A seasoned ocaml programmers should be able to tackle all the concepts involved without much of a headache. So, without further ado:

Getting started

We can usually see writing a command line interfaces as making one or several ocaml functions callable from the console (aka the entry points of our program). The library we’ve defined allows us to make those functions callable by giving a specification of their arguments (using functional unparsing). Throughout this post we shall incrementally refine a given command line interface. Each of those refinement will be exposed through the command line as a separate functions Our subject today is a basic cp function which takes its arguments in reverse order (thus cp_into). It doesn’t actually execute any action; instead it prints to stdout. We’ll get into why we are not using a function with the arguments in the standard order for cp soon.

let cp_into
    ?(recursive=false)
    ?(force=false)
    (dst:string)
    (src:string list) : unit =
  Printf.printf "cp_into\n\
    recursive:%b\n\
    force:%b\n\
    %s <- %s\n"
    recursive
    force
    dst
    (String.concat "," src)

Now that we know what we’ll be working on we can start looking at how to define the command line interface. The main function we’ll use is Unparse.choice which takes two unlabelled arguments: A specification (of type Unparse.t) which tells us which kind of command line arguments we expect and how to parse them and the function that we are embedding. Unparse.choice doesn’t actually parse the arguments straight away: it actually creates a value that can be used to define command line interface with several sub commands (à la busybox,git,hg etc..).

Embedding simple functions

The simple specifications are very straightforwardly driven by the type of the functions we are embedding. We provide little more information than the type of the function and names of the arguments (used for documentation purposes)

let basic_fun : string -> string list -> unit = fun dst srcs -> cp_into dst srcs

(* In this post we will gloss over the first parameter of the type `Unparse.t`
   it is a phantom type used to enforce some constraints on the specification. *)
let basic_spec : (_,string -> string list -> 'a,'a) Unparse.t =
  Unparse.(string "tgt" ++ non_empty_list (string "src"))

let basic_choice : unit Unparse.choice =
  Unparse.choice basic_spec
    ~f:basic_fun
    ~descr:"copy (without any flags)"
    ~name:"cp_basic"

At this point I owe you an explanation: why did we not take the target as last argument like the unix cp command?

A note on the argument parsing heuristic

The parsers we build are LL(1) parser. This means that there is no backtracking possible; if an operator successfully consumes an argument any solution that implies that operator failing will not even be considered The list operator is greedy and matches the longest possible list. If we had try to embed the classical cp function.

cp file... directory

with the specification:

list (string "file") ++ string "directory"

this would have resulted in an unusable function (since the first the list (string ...) would always have consumed all the remaining arguments).

let cp (_src:string list) (_tgt:string) : unit =
  (* This function is never going to get successfully called... *)
  assert false

let non_ll1_spec : (_,string list -> string -> 'a,'a) Unparse.t =
  Unparse.(non_empty_list (string "src") ++ string "tgt")

let non_ll1_choice : unit Unparse.choice =
  Unparse.choice non_ll1_spec
    ~descr:"broken will always fail because of the way the spec was defined"
    ~f:cp
    ~name:"cp_non_ll1"

Simple command line parsing with flags

Specifications for flags with no arguments match simple boolean values; iff the flag is present on the command the specification evaluates to true when parsing.

let basic_flag_fun : bool -> bool -> string -> string list -> unit =
  fun recursive force dst src -> cp_into ~recursive ~force dst src

let basic_flag_spec :
    (_,bool -> bool -> string -> string list -> 'a,'a) Unparse.t
    = Unparse.(
     bool_flag "recursive" ~descr:"do a recursive copy"
     ++ bool_flag "force" ~descr:"overwrite target without warning"
     ++ string "tgt"
     ++ non_empty_list (string "src"))

let basic_flag_choice =
  Unparse.choice basic_flag_spec
    ~f:basic_flag_fun
    ~descr:"first attempt to have flags"
    ~name:"cp_basic_flags"

More flags

At this point incremental rewrites of the same code are getting a bit tedious so I will introduce two concepts at once:

Non-boolean flags

will evaluate to Some of a value when the flag is specified on the command line, This value can be produced by a specification that consumes an element from the command line

Choice between flags

When put between two flags (<!>) this operator will return the value attached to the last flag specified on the command line. It can be chained used for more than two flags.

let flag_fun : bool option
       -> bool option
       -> string
       -> string list
       -> unit =
  fun recursive force dst src -> cp_into ?recursive ?force dst src

let recursive_flag_spec : (_,bool option -> 'a,  'a) Unparse.t =
  Unparse.(
    flag "recursive" ~descr:"do a recursive copy" (const true)
    <!> flag "no-recursive" ~descr:"" (const false))

let force_flag_spec : (_,bool option -> 'a,  'a) Unparse.t =
  Unparse.(
   flag "force" ~descr:"overwrite target without warning" (const true)
   <!> flag "no-force" ~descr:"" (const false))

let flag_spec :
    (_,bool option
       -> bool option
       -> string
       -> string list
       -> 'a,  'a) Unparse.t =
  Unparse.
    (recursive_flag_spec
     ++ force_flag_spec
     ++ string "tgt"
     ++ non_empty_list (string "src"))

let flag_choice : unit Unparse.choice =
  Unparse.choice flag_spec
    ~f:flag_fun
    ~descr:"first attempt to have flags"
    ~name:"cp_into_with_flags"

Labelling arguments of the called function

What we did above in order to call the function is that we mapped the function we were calling. This is still not a very satisfying solution because we would like to specify those labels locally when we define the spec. This is made possible by the interface which allows us to map the accumulator function locally.

let final_spec :
    (_,?recursive:bool ->
      ?force:bool ->
      string ->
      string list
      -> 'a,  'a) Unparse.t
    =
  Unparse.(
    mapf ~f:(fun f v -> f ?recursive:v)
      (flag "recursive" ~descr:"do a recursive copy" (const true))
    ++ mapf ~f:(fun f v -> f ?force:v)
          (flag "force" ~descr:"overwrite target without warning" (const true))
    ++ string "tgt"
    ++ non_empty_list (string "src"))

let final_choice : unit Unparse.choice  =
  Unparse.choice final_spec
    ~descr:"Our last example function"
    ~f:cp_into
    ~name:"cp_final"

Tying it all together

All we need to make that command line interface is to actually tie all those commands (i.e. `choice`s) we’ve defined together.

let () =
  Unparse.multi_run [
    basic_choice;
    non_ll1_choice;
    basic_flag_choice;
    flag_choice;
    final_choice
  ]

Conclusion

This is only a quick introduction to how this library can be used. If you want to understand what makes that library tick I invite you to read Olivier Danvy excellent article on functional unparsing. Hacks like this one might seem as a purely academical exercise to some but getting familiar with tricks like the ones used here makes them cheaper to use and, in the long run, a sound investment. Argument parsing is a small enough problem that allows us to demonstrate those techniques.

The power of doing nothing....

There's an ongoing discussion on COCAN on how to make errors explicit in function signatures (the proposed solution is to go exceptionless). I will not delve on why I do not think this is a standard that should be adopted. Instead we will explore a very lightweight solutions that preserves the stack unwinding capability of exceptions whilst making the possible errors explicit in the signatures of the function.

Basic types

When one of our function is applied there we can have either one of two possible outcomes: everything goes right or we are left over with an error (notice the cheap mnemonics). Now if we get rid of exceptions we want our return types to be able all this information. To do so we mimics Haskell's either type:

type ('a,'b) either = Left of 'a | Right of 'b

In case you haden't caught my subtle hints Right is used to hold results and Left to hold errors.

For our short example we shall have a limited number of possible errors:

type possible_exc = [`Too_Small|`Too_Big|`Div_by_zero|`Some_other_error]

that can be thrown in an exception:

exception MyExc of [< possible_exc]

(Allthough I may not be using any unsafe features of OCaml I am actually exploiting a bug in the type-checker here. The absence of this hack would make one of our functions a little less precise).

External interface

Ideally we'd want to choose functions should raise an exception or return a wrapped value. This choice has to be made at function application. Bearing this in mind our external interface is:

module type External = sig
  type ('a,'b) value constraint 'a = [< possible_exc ]
  val run : ('a -> ('b,'c) value) -> 'a -> 'c
  val run_exn : ('a -> ('b,'c) value) -> 'a -> ('b,'c) either
end

Internal interface

The idea behind this implementation is to use a phantom type attached to a value we shall pass along. This phantom type will be unified with every single single value we might raise thus acting as a "collector" for all the possible exceptions. Without further ado let proceed:

module type Internal = sig
  type 'a t constraint 'a = [< possible_exc ]
  type ('a,'b) value constraint 'a = [< possible_exc ]
  val create : unit -> 'a t
  val raise : 'a t -> 'a -> 'b
  val return : 'a t -> 'b -> ('a,'b) value
  val lift : 'a t -> ('a,'b) value -> 'b
end

The type t is our collector. It can only be created via the create function. raise and return are rather self explanatory, lift might come as more of a surprise: it is used to get the returned values from one our function. It ensures the possible errors of the called functions are unified with the "collector" of the callee. The internal interface does not expose functions like External.run because it discards the possible error cases.

Implementation

Our interfaces being set we will now present an implementation. It has been stated at the beginning of this post that we want it as lightweight as possible. Since we will (ab)use the identity functions let's get it out of the way:

let ident = fun i -> i

We are not using the more efficient external "%identity" function because it is, in essence, not type safe. If we consider that the unit value is a value that carries no information (the unit type being inhabited by only one value) and the identity function is a function that does nothing our implementation really doesn't do much:

module Impl = struct
  type 'a t = unit constraint 'a = [< possible_exc ]
  type ('a,'b) value = 'b constraint 'a = [< possible_exc ]
  let create = ident
  let raise () e = raise (MyExc e)
  let return () = ident
  let run = ident
  let lift () = ident
  let run_exn f v = try Right (f v) with  MyExc v -> Left v
end

Excercising it

Let's take our shiny new modules for a test run. The types commented are the inferred types and thus the most general ones.

module I:Internal = Impl

(* int -> ([< possible_exc > `Too_Big `Too_Small ], unit) I.value *)
let check_range i =
  let t = I.create () in
  if i > 5 then
    I.raise t `Too_Big
  else if i < -5 then
    I.raise t `Too_Small
  else
    I.return t ()

(* 'a -> int -> ([< possible_exc > `Div_by_zero ], int) I.value *)
let div x y =
  let t = I.create () in
  if y = 0 then
    I.raise t `Div_by_zero
  else
    I.return t 0

(*
 int ->
 int ->
 ([< possible_exc > `Div_by_zero `Too_Big `Too_Small ], int) I.value
*)
let div_in_range x y =
  let e = I.create () in
  I.lift e (check_range x);
  I.lift e (check_range y);
  I.return e (I.lift e (div x y))

Conclusion

Even though this actually works it does not scale well to multiple modules. It should be considered as a proof of concept rather than serious code.

As there name imply exception should be used to handle exceptional cases. A well designed library should only throw exception when it encounters an error or a bug. Exception should only be used for error recovery (they might be used internally for hacks such as bugtracking but should never trickle out of the library). It seems cumbersome to impose the callee of library functions to handle a long trail of more and more exotic error cases.

If one really desires to have explicit error handling combining our either type with monads seems to be the sane route. This is exactly what the haskell error monad does.

Talking about haskell, an interesting read is 8 ways to report errors in Haskell. It gives a good overview on how messy and uncoherent error reporting can get.

Bilingual "hello world"

Here is a fun (and slightly useless) hack:

#cd "."(*
echo "Hello world"
<<"OCAMLCODE_END"
*)
let () = print_endline "Bonjour le monde"
(*
OCAMLCODE_END
#*)

This program is both a shell program and an ocaml program. If you run it using sh it will print "Hello world" but if you run it in ocaml it will output "Bonjour le monde" (Ocaml is a french programming language after all).

There is actually a small interest in this hack: suppose you want to run an ocaml script but need to make a couple of checks before running it (for instance checking whether findlib is installed or the interpreter is recent enough) you can now bundle it as a shell executable that calls itself again after having done the checks as an ocaml program.

Preserving atomicity in IO operations

[Updated 26/07/07: unwind_protect now captures less variables.]

There are a bunch of operation that must be executed in pairs, for instance openned channel SHOULD be closed. That is: every call to an open_in on a file should be followed by a subsequent close_in on the openned channel.

Edging towards a solution:

Lispers actually have a neat way atomicity of file descriptor operations. with-open-file

with_open_file takes the name of the file to and a function working on the file handle, this function should not close the file handle. A first shot would look like:

let with_open_in file f=
 let ic=open_in file in
 let res=f ic in
 close_in ic;
 res

Although at a first glance this looks ok it will break down if an exception is raised in f. We will now introduce a new function from the lisp world. unwind-protect

Unwind-protect:

unwind_protect takes two functions, the second one being a cleanup function. unwind_protect f cleanup returns the result of running f (). Whatever happens in f (), cleanup () will be called.

let unwind_protect f g=
 let run f ()=
  match !f with
   | Some f -> f ()
   | None -> ()
 in
 let closeFun=ref (Some g) in
 at_exit (run closeFun);
 let res=
  try
   f ()
  with e ->
   g ();
   raise e
 in
 closeFun := None;
 g ();
 res

with_open_file can now be coded as:

let with_open_in filename f=
 let ch=open_in filename in
 unwind_protect (fun () -> f ch) (fun () -> close_in ch)

Wrapping it up:

We now would like to force the usage of our new functions instead of the old ones. We do not want to define a new type of channel and there is no way to 'hide' them from Pervasives, we can however override the functions we don't want to allow with an abstract type:

module Abstract:sig
 type t
 val v:t
end
=
struct
 type t=unit
 let v=()
end
let open_out=Abstract.v
let open_in=Abstract.v
let close_out=Abstract.v
let close_in=Abstract.v

Conclusion:

This looks like yet another modification one could wish for in OCaml standard library.

Phun with phantom types!!

Phantom types are a nifty trick: types are used to store additional information during the type-checking pass. These types have no implementations (there are no values actually having these types) but are still used as type parameter to tag values. This additional info is then used by the type system to statically ensure some conditions are met. As, I'm guessing this is all getting rather intriguing (or confusing) I propose to step through a very simple example.

Without phantom types

Let's start out with a very basic library to handle lists:

(*The empty list*)
let nil=[]
(*Appends an element in front of a list*)
let cons e l = e::l
(*Converts two list of same sizes to a list of couples *)
let combine = List.combine

Combine needs both of its arguments to be of the same length. This is typically a job for dependent types (i.e. types depending on a value) where list length would be encoded in their types. Ocaml doesn't have dependant type but we'll see how to leverage the type inference mechanism to encode lengths.

Encoding the length

Since our types cannot contain values we need to find a way to code integers in our type system. We will using an encoding based on Peano's axiom's:

type zero
type 'length succ

0 is represented by the type zero, 1 by succ zero, 2 by succ succ zero etc... There exist no values having these types: they are empty.

Using the phantom type

The previous type will be the "phantom type": it will be used to encode additional info but won't represent the type of any actual object.

The idea here is to make our lists depend on that type to store the length info. Instead of being 'a list our list type is now:

type ('a,'length) t

where 'length represents the length of the list. Giving types to our previous functions is now straightforward:

val nil:('a,zero) t
val cons:'a -> ('a,'length) t -> ('a,('length succ)) t
val combine:('a,'length) t -> ('b,'length) t -> (('a*'b),'length) t

and since under the hood we are using standard OCaml's list, converting from our list to a normal list is a plain identity. We'll now wrap everything in a nice module in order to hide the internals:

module DepList:
sig
 type zero
 type 'length succ
 type ('a,'length) t
 val nil:('a,zero) t
 val cons:'a -> ('a,'length) t -> ('a,('length succ)) t
 val toList:('a,'length) t -> 'a list
 val combine:('a,'length) t -> ('b,'length) t -> (('a*'b),'length) t
end
 =
struct
 type zero
 type 'b succ
 type ('a,'length) t='a list
 let nil=[]
 let cons e l = e::l
 let combine = List.combine
 let toList l = l
end

Testing it all

And it's now time to play with our library...

# open DepList;;
# let a=cons 5 (cons 6 nil);;
val a : (int, DepList.zero DepList.succ DepList.succ) DepList.t = <abstr>
# toList a;;
- : int list = [5; 6]
# let b=cons "a" nil;;
val b : (string, DepList.zero DepList.succ) DepList.t = <abstr>
# combine a b;;
Characters 10-11:
  combine a b;;
        ^
This expression has type (string, DepList.zero DepList.succ) DepList.t
but is here used with type
  (string, DepList.zero DepList.succ DepList.succ) DepList.t

That's right we've just statically caught an error because combine was called with two lists of different lengths!

Conclusion

Phantom types are a fun hack to play with, alas they are very restrictive and rarely useful. Their big brothers (GADT's and dependant types) require specific type systems and are tricky to groke.