[mercury-users] Paper on Mercury from AI practitioner's standpoint

[Peter Ross]

On Thu, Jan 13, 2005 at 12:33:50PM +1100, Peter Hawkins wrote:
> Hi...
> On Thu, 13 Jan 2005 11:26 am, Gregory D. Weber wrote:
> > I invite comments to help ensure that I do not misrepresent
> > the language to potential users.  A draft is posted at
> > http://mypage.iu.edu/~gdweber/papers/drafts/mercury.pdf.
> 
> One comment -- I should point out that you can avoid most of the effort in 
> threading the IO state around for debugging purposes by using unsafe IO 
> predicates. Although this is evil and wrong [tm], it's the a humane solution 
> for the programmer. You can live without purity when debugging...
> 
As we have to use the hlc.gc grade (due to problems binding with the IBM
MQ libraries, plus needing to use the MS Visual C compiler for other
projects) here at MC, it isn't possible to debug using the mercury
debugger.

Thus I was interested in developing a generic framework for logging,
that allowed one to easily disable/enable logging, including in contexts
where no io__state was available.  Investigation of log4j (a logging
package for java) lead me to believe that we essentially wanted the same
behaviour for logging in Mercury.

Hence log4m was born, see attached file.

The main difference is that log4j names loggers x.y.z, which would be
named ["z", "y", "x"] in Mercury.

The most useful predicate that I've added to log4m is impure_log_f

    impure impure_log_f(["z", "y", "x"], debug,
        ((func) = S :-
            expensive_calculation(X, S)
        ))

This predicate is impure to ensure that compiler doesn't optimize it
away because it is det and binds no variables.  We also have available
the full power of the Mercury system to build our logging string, but we
only pay this cost if the system determines that the string needs to
built.

Finally this can be used safely in any program because in effect
logging is like debugging, it does alter the outside world, but it
doesn't effect the execution path of our program, assuming that the
logging output is only used to debug programs.

Seeing that the call is safe, one can use :- pragma promise_pure to make
the logged predictes pure again.

Anyway I'm placing this code into the public domain, so that the Mercury
community can clean it up, and if they so desire add it to the Mercury
extras distribution.

I would love to hear peoples comments on how to improve the logging
interface.
-------------- next part --------------
%------------------------------------------------------------------------------%
/****M* libs/log4m/log4m.m/log4m
 * NAME
 *   log4m
 * PURPOSE
 *   A module for providing logging services.
 * AUTHOR
 *   Peter Ross <pro at missioncriticalit.com>
 * HISTORY
 *   $Id: log4m.m,v 1.8 2005/01/03 12:51:22 winx821 Exp $
 *   (use cvs log to get detailed history)
 * BUGS
 *   This module isn't thread-safe, as one updates to the logger state can
 *   be lost.
 * TODO
 *   Make the update of the internal log state thread-safe.
 * LICENSE
 *   I hearby place this module in the public domain.
 ****
 */
:- module log4m.

:- interface.

:- import_module bool, io, list.

/****T* libs/log4m/log4m.m/id
 * NAME
 *    Type: id
 * DESCRIPTION
 *    An id for identifying a logger.  The id's are hierachical.
 *    The root logger is [].
 *    A child of the root logger is ["Performance"]
 *    A child of the previous logger is ["Child", "Performance"]
 *    Note that the lists are in reverse order to the naming of loggers
 *    in log4j.
 * SOURCE
 */
:- type id == list(string).
/*****/

/****T* libs/log4m/log4m.m/level
 * NAME
 *    Type: level
 * DESCRIPTION
 *    A log message is given a level.  debug is the lowest level, fatal
 *    the highest.
 * SOURCE
 */
:- type level
    --->    debug
    ;       info
    ;       warn
    ;       error
    ;       fatal.
/*****/

/****T* libs/log4m/log4m.m/addivity
 * NAME
 *    Type: addivity
 * DESCRIPTION
 *    The addivity type is used to determine the whether to continue
 *    or stop searching for appenders.
 * SOURCE
 */
:- type addivity
    --->    stop
    ;       continue.
/*****/


/****T* libs/log4m/log4m.m/appender
 * NAME
 *    Typeclass: appender
 * DESCRIPTION
 *    The typeclass appender describes types which can be used to write
 *    a string to somewhere.
 * SOURCE
 */
:- typeclass appender(T) where [
    pred write_string(T::in, string::in, io::di, io::uo) is det
].  
/*****/


/****T* libs/log4m/log4m.m/appender(io__output_stream)
 * NAME
 *    Instance: appender(io__output_stream)
 * DESCRIPTION
 *    Write the specified string to the io__output_stream.
 * DERIVED FROM
 *    log4m/log4m.m/appender
 * SOURCE
 */
:- instance appender(io__output_stream).
/*****/

/****P* libs/log4m/log4m.m/debug 
 * NAME
 *    debug 
 * SYNOPSIS
 *    Resets the logger state to be empty, then sets the level of the
 *    root logger to be debug.
 *
 *    Note that all the appenders are lost.
 * SOURCE
 */
:- pred debug(io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/info 
 * NAME
 *    info 
 * SYNOPSIS
 *    Resets the logger state to be empty, then sets the level of the
 *    root logger to be info.
 *
 *    Note that all the appenders are lost.
 * SOURCE
 */
:- pred info(io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/warn 
 * NAME
 *    warn 
 * SYNOPSIS
 *    Resets the logger state to be empty, then sets the level of the
 *    root logger to be warn.
 *
 *    Note that all the appenders are lost.
 * SOURCE
 */
:- pred warn(io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/error 
 * NAME
 *    error 
 * SYNOPSIS
 *    Resets the logger state to be empty, then sets the level of the
 *    root logger to be error.
 *
 *    Note that all the appenders are lost.
 * SOURCE
 */
:- pred error(io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/fatal 
 * NAME
 *    fatal 
 * SYNOPSIS
 *    Resets the logger state to be empty, then sets the level of the
 *    root logger to be fatal.
 *
 *    Note that all the appenders are lost.
 * SOURCE
 */
:- pred fatal(io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/update_level 
 * NAME
 *    update_level 
 * SYNOPSIS
 *    Update the logging level of an id.
 * PARAMETERS
 *    id - The id of the logger whose level we are updating.
 *
 *    level - The level to set the logger to.
 * TODO
 *    Make this function thread safe.
 * SOURCE
 */
:- pred update_level(id::in, level::in, io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/add_appender 
 * NAME
 *    add_appender 
 * SYNOPSIS
 *    Add an appender to be called when logging at a specified id,
 *    and specify via the addivity whether to continue searching for
 *    appenders to call in the parent loggers.
 * FUNCTION
 *    The sequence of calls:
 *      add_appender(["L1"], stop, A1, !IO),
 *      add_appender(["L1"], continue, A2, !IO),
 *      add_appender(["L2", "L1"], stop, B1, !IO),
 *      add_appender(["L3, "L2", "L1"], continue, C1, !IO)
 *    will have the following behaviour.
 *
 *    When logging for ["L1"] appenders A1 and A2 will be called.
 *    The appenders for [] will not be called because we specified that
 *    the addivity stop, when setting the appender A1.  Setting the
 *    addivity to continue for A2 does not override the original stop.
 *
 *    When logging for ["L2", "L1"] only appender B1 will be called.
 *    The addivity stop prevents calling the appenders for ["L1"] and [].
 *
 *    When logging for ["L3, "L2", "L1"] the appenders C1 and B1.
 *    B1 is called because the addivity is set to continue and B1
 *    is implied by the level ["L2", "L1"].
 * TODO
 *    Determine if the setting of addivity continue after the setting
 *    of the addivity stop should override the stop.
 * SOURCE
 */
:- pred add_appender(id::in, addivity::in, T::in,
                io::di, io::uo) is det <= appender(T).
/*****/

/****P* libs/log4m/log4m.m/will_log 
 * NAME
 *    will_log 
 * SYNOPSIS
 *    For a given logger id at the specified level return an indicator
 *    of whether or not logging would occur.
 * SOURCE
 */
:- pred will_log(id::in, level::in, bool::out, io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/log 
 * NAME
 *    log 
 * SYNOPSIS
 *    If will_log < log4m/log4m.m/will_log > indicates that logging
 *    should occur then call the appenders implied by the logger id
 *    with the specified string.
 * SOURCE
 */
:- pred log(id::in, level::in, string::in, io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/log_f
 * NAME
 *    log_f
 * SYNOPSIS
 *    If will_log < log4m/log4m.m/will_log > indicates that logging
 *    should occur then call the appenders implied by the logger id
 *    with the result of evaluating the function which generates a string.
 *
 *    The idea behind this predicate is to avoid the possibly expensive
 *    creation of log messages, only to not have the message logged.
 *    This is done by passing a closure which creates the log message
 *    only when it is needed.  Note one still has to be careful that
 *    all the expensive calculations are done inside the closure.
 * SOURCE
 */
:- pred log_f(id::in, level::in, ((func) = string)::in, io::di, io::uo) is det.
/*****/

/****P* libs/log4m/log4m.m/unsafe_log_f
 * NAME
 *    unsafe_log_f
 * SYNOPSIS
 *    Gets a fake io__state and calls log_f.
 *    Unsafe because the compiler might decide to elimiate this call on you.
 * SOURCE
 */
:- pred unsafe_log_f(id::in, level::in, ((func) = string)::in) is det.
/*****/

/****P* libs/log4m/log4m.m/impure_log_f
 * NAME
 *    impure_log_f
 * SYNOPSIS
 *    Gets a fake io__state and calls log_f.
 * SOURCE
 */
:- impure pred impure_log_f(id::in, level::in, ((func) = string)::in) is det.
/*****/


/****P* libs/log4m/log4m.m/update_log 
 * NAME
 *    update_log 
 * SYNOPSIS
 *    Update the logger state with levels read from a file.
 *    Returns an error if the file couldn't be opened.
 * FUNCTION
 *    Expects a file where each line is in the following format.
 *
 *      set_level(["L1"], debug).
 *
 *    This predicate will throw an exception if the lines are of the
 *    incorrect format.
 * SOURCE
 */
:- pred update_log(string::in, io__res::out, io::di, io::uo) is det.
/*****/

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- implementation.

:- import_module map.

:- type log
    --->    log(level_map, appenders_map).

:- type level_map == map(id, level).

:- type appenders_map == map(id, appenders).

:- type appenders
    --->    stop(list(appender))
    ;       continue(list(appender))
    .

:- type appender
    --->    some [T] appender(T) => appender(T).


%------------------------------------------------------------------------------%

debug(!IO) :- set_log(debug, !IO).
info(!IO) :- set_log(info, !IO).
warn(!IO) :- set_log(warn, !IO).
error(!IO) :- set_log(error, !IO).
fatal(!IO) :- set_log(fatal, !IO).

:- func debug = log.
:- func info = log.
:- func warn = log.
:- func error = log.
:- func fatal = log.

debug = log(map__set(map__init, [], debug), map__init).
info = log(map__set(map__init, [], info), map__init).
warn = log(map__set(map__init, [], warn), map__init).
error = log(map__set(map__init, [], error), map__init).
fatal = log(map__set(map__init, [], fatal), map__init).

will_log(Id, Level, WillLog, !IO) :-
    get_log(Log, !IO),
    Log = log(LevelsMap, _),
    LoggerLevel = find_logger_level(Id, LevelsMap),
    compare(Res, Level, LoggerLevel),
    ( (Res = (=) ; Res = (>)) ->
        WillLog = yes
    ;
        WillLog = no
    ).

log(Id, Level, Msg, !IO) :-
    will_log(Id, Level, WillLog, !IO),
    ( WillLog = yes ->
        get_log(Log, !IO),
        Log = log(_, Appenders),
        write_levels(Id, Msg, Appenders, !IO)
    ;
        true
    ).

log_f(Id, Level, Func, !IO) :-
    will_log(Id, Level, WillLog, !IO),
    ( WillLog = yes ->
        get_log(Log, !IO),
        Log = log(_, Appenders),
        write_levels(Id, apply(Func), Appenders, !IO)
    ;
        true
    ).

:- func find_logger_level(id, level_map) = level.

find_logger_level([], LevelMap) = map__lookup(LevelMap, []).
find_logger_level([H|T], LevelMap) =
    ( map__search(LevelMap, [H|T], Level) ->
        Level
    ;
        find_logger_level(T, LevelMap)
    ).

%------------------------------------------------------------------------------%

:- pragma promise_pure(unsafe_log_f/3).
unsafe_log_f(Id, Level, Func) :-
    impure impure_log_f(Id, Level, Func).

impure_log_f(Id, Level, Func) :-
    impure IO = io,
    log_f(Id, Level, Func, IO, _).

:- impure func io = io.
:- mode io = uo is det.

:- pragma foreign_proc(c, io = (IO::uo), [will_not_call_mercury], "
    IO = 0;
").

%------------------------------------------------------------------------------%

:- pred write_levels(id::in, string::in,
                appenders_map::in, io::di, io::uo) is det.

write_levels([], String, Map, !IO) :-
    ( map__search(Map, [], Data) ->
        write_appenders(String, Data, !IO)
    ;
        true
    ).
write_levels([H|T], String, Map, !IO) :-
    ( map__search(Map, [H|T], Data) ->
        write_appenders(String, Data, !IO),
        ( Data = stop(_)
        ; Data = continue(_),
            write_levels(T, String, Map, !IO)
        )
    ;
        write_levels(T, String, Map, !IO)
    ).

:- pred write_appenders(string::in, appenders::in, io::di, io::uo) is det.

write_appenders(String, stop(Appenders), !IO) :-
        list__foldl(write_appender(String), Appenders, !IO).
write_appenders(String, continue(Appenders), !IO) :-
        list__foldl(write_appender(String), Appenders, !IO).

:- pred write_appender(string::in, appender::in, io::di, io::uo) is det.

write_appender(S, appender(A), !IO) :-
    write_string(A, S, !IO).

%------------------------------------------------------------------------------%

:- import_module require, string.

:- type logfile
    --->    set_level(id, level).

update_log(FileName, Result, !IO) :-
    io__open_input(FileName, OpenRes, !IO),
    ( OpenRes = ok(Stream),
        get_log(Log0, !IO),
        read_file(Stream, Log0, Log, !IO),
        set_log(Log, !IO),
        io__close_input(Stream, !IO),
        Result = ok
    ; OpenRes = error(E),
        Result = error(E)
    ).

:- pred read_file(io__input_stream::in,
                log::in, log::out, io::di, io::uo) is det.

read_file(Input, !Log, !IO) :-
    io__read(Input, Result, !IO),
    ( Result = ok(set_level(Id, Level)),
        !:Log = update_level(Id, Level, !.Log),
        read_file(Input, !Log, !IO)
    ; Result = eof,
        true
    ; Result = error(Msg, Line),
        error(format("log4m.read_file: line %d has error %s.",
                [i(Line), s(Msg)]))
    ).
    

%------------------------------------------------------------------------------%

update_level(Id, Level, !IO) :-
    get_log(Log, !IO),
    set_log(update_level(Id, Level, Log), !IO).

:- func update_level(id, level, log) = log.

update_level(Id, Level, log(M, A)) = log(map__set(M, Id, Level), A).

%------------------------------------------------------------------------------%

add_appender(Id, Addivity, Appender, !IO) :-
    get_log(Log0, !IO),
    Log0 = log(Levels, Appenders0),
    add_appender_2(Id, Addivity, Appender, Appenders0, Appenders),
    Log = log(Levels, Appenders),
    set_log(Log, !IO).

:- pred add_appender_2(id::in, addivity::in, T::in,
                appenders_map::in, appenders_map::out) is det <= appender(T).

add_appender_2(Id, Addivity, T, !Map) :-
    App = 'new appender'(T),
    ( map__search(!.Map, Id, Data0) ->
        ( Data0 = stop(Appenders),
            Data = stop([App | Appenders])
        ; Data0 = continue(Appenders),
            ( Addivity = stop,
                Data = stop([App | Appenders])
            ; Addivity = continue,
                Data = continue([App | Appenders])
            )
        )
    ;
        ( Addivity = stop,
            Data = stop([App])
        ; Addivity = continue,
            Data = continue([App])
        )
    ),
    !:Map = map__set(!.Map, Id, Data).

%------------------------------------------------------------------------------%

:- instance appender(io__output_stream) where [
    (write_string(S, Str, !.IO, !:IO) :-
        io__write_string(S, Str, !IO)
    )
].

%------------------------------------------------------------------------------%

    % XXX none of this thread safe.
:- pragma foreign_decl(c, local, "
static MR_Word LOG4M_log = (MR_Word) NULL;
").

:- pred get_log(log::out, io::di, io::uo) is det.
:- pragma promise_pure(get_log/3).

get_log(Log, !IO) :-
    ( impure get_log(Log0) ->
        Log = Log0
    ;
        Log = fatal
    ).

:- pred set_log(log::in, io::di, io::uo) is det.
:- pragma promise_pure(set_log/3).

set_log(Log, !IO) :-
    impure set_log(Log).

:- impure pred get_log(log::out) is semidet.
:- pragma foreign_proc(c, get_log(Log::out),
        [will_not_call_mercury], "
    if (LOG4M_log) {
        Log = LOG4M_log;
        SUCCESS_INDICATOR = MR_TRUE;
    } else {
        SUCCESS_INDICATOR = MR_FALSE;
    }
").

:- impure pred set_log(log::in) is det.
:- pragma foreign_proc(c, set_log(Log::in),
        [will_not_call_mercury], "
    LOG4M_log = Log;
").

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et tw=0 wm=0