Blog of Raivo Laanemets

Stories about web development, consulting and personal computers.

Reporting exception stack traces in a SWI-Prolog application

On 2015-03-13

The ISO-Prolog standard exception handling mechanism does not support any way to obtain application stack traces. I have been running Prolog web applications in production for some time and couple of times I have had to debug some errors where stack traces would have helped a lot. In this article I describe a way to obtain and log stack traces in SWI-Prolog.

For working with exceptions we have 2 basic predicates: throw/1 and catch/3. Catch has argument for the error term but has no argument for the stack trace. This means either the error term must contain the trace or the trace must be obtained in some other way.

Example (must_be/2 uses throw/1):

:- use_module(library(error)).

p(X):- q(X).

q(X):-
    must_be(atom, X),
    writeln(X).

Calling ?- p(X) results in an error message but without any clue where the error originates from:

?- p(X).
ERROR: Arguments are not sufficiently instantiated

Calling through catch/3 gives us the error term and the message is not printed:

?- catch(p(X), E, true).
E = error(instantiation_error, _G2301).

One way to debug it is to use the tracer:

?- trace.
true.

[trace]  ?- p(X).
   Call: (6) p(_G2269) ? creep
   Call: (7) q(_G2269) ? creep
   Call: (8) error:must_be(atom, _G2269) ? creep
ERROR: Arguments are not sufficiently instantiated

However, there are cases where you cannot easily use the tracer. One of them is a web application backend where you want to log all errors and include traces with them.

While catch/3 has no way to retrieve the stack trace (unless the error term was modified on some way) there is an hook predicate that allows to intercept the exception after it is raised and the trace is still intact. The hook can be used for printing stack traces into the application stderr:

:- use_module(library(prolog_stack)).
:- use_module(library(error)).

user:prolog_exception_hook(Exception, Exception, Frame, _):-
    (   Exception = error(Term)
    ;   Exception = error(Term, _)),
    get_prolog_backtrace(Frame, 20, Trace),
    format(user_error, 'Error: ~p', [Term]), nl(user_error),
    print_prolog_backtrace(user_error, Trace), nl(user_error), fail.

p(X):- q(X).

q(X):-
    must_be(atom, X),
    writeln(X).

The fail/0 call at the end of the hook body lets the caller know that we are not interested in modifying the exception as we only report it. The prolog_stack module import must also be added. This now prints the stack trace:

?- p(X).
Error: instantiation_error
  [11] throw(error(instantiation_error,_G2242))
   [7] q(_G2273) at /home/raivo/exception.pl:14
ERROR: Arguments are not sufficiently instantiated

The trace will be also written when the predicate is called through catch/3. Some call stack frames might be missing. This depends on optimizations. The call frame for p/1 is missing in the report above. If the definition of p/1 was more complex, and had choices, like:

p(X):- q(X).
p(1).

then p/1 would appear in the stacktrace too:

?- p(X).
Error: instantiation_error
  [11] throw(error(instantiation_error,_G314))
   [7] q(_G345) at /home/raivo/exception.pl:16
   [6] p(_G375) at /home/raivo/exception.pl:11

Using in a web backend

The SWI-Prolog HTTP package actually provides something like this by the http/http_error module. The module uses the same hook as described above (it's used for modifying error terms). However, it prints the stacktrace to the user with the status 500 page. It does not print the stacktrace into the application stderr. Not even the error message is printed.

As http/http_error might be either loaded or not, we must make sure that our reporting hook is coming first. This is because only the first successful hook is called. This can be done using the asserta/1 predicate:

:- asserta((user:prolog_exception_hook(Exception, Exception, Frame, _):-
    (   Exception = error(Term)
    ;   Exception = error(Term, _)),
    get_prolog_backtrace(Frame, 20, Trace),
    format(user_error, 'Error: ~p', [Term]), nl(user_error),
    print_prolog_backtrace(user_error, Trace), nl(user_error), fail)).

This will now intercept all the exceptions that are errors and prints their stack traces but also allows to use the http/http_error module independently. However, some errors are natively used for the HTTP control flow. One of them is timeout_error/2 that is used in the Keep-Alive implementation:

Error: timeout_error(read,<stream>(0x7f3cb0022dc0))
   [5] peek_code(<stream>(0x7f3cb0022dc0),_G156)
   ...

It is not easy to decide which of such errors are control-flow and which ones should be actually reported. Depending on application, some of them can be white-listed:

...
Term \= timeout_error(_, _),
Term \= existence_error(_, _), % 404 will not be reported
Term \= io_error(_, _) % client closes connection
...

The error messages and stack traces in the application stderr can now be logged and monitored. This makes debugging SWI-Prolog server/web applications a lot easier.