1:- module(format_spec, [ format_error/2
    2                       , format_spec/2
    3                       , format_spec//1
    4                       , spec_arity/2
    5                       , spec_types/2
    6                       ]).    7
    8:- use_module(library(dcg/basics), [eos//0, integer//1, string_without//2]).    9:- use_module(library(error)).   10:- use_module(library(when), [when/2]).   11
   12% TODO loading this module is optional
   13% TODO it's for my own convenience during development
   14%:- use_module(library(mavis)).
 format_error(+Goal, -Error:string) is nondet
True if Goal exhibits an Error in its format string. The Error string describes what is wrong with Goal. Iterates each error on backtracking.

Goal may be one of the following predicates:

   27format_error(format(Format,Args), Error) :-
   28    format_error_(Format, Args,Error).
   29format_error(format(_,Format,Args), Error) :-
   30    format_error_(Format,Args,Error).
   31format_error(debug(_,Format,Args), Error) :-
   32    format_error_(Format,Args,Error).
   33
   34format_error_(Format,Args,Error) :-
   35    format_spec(Format, Spec),
   36    !,
   37    is_list(Args),
   38    spec_types(Spec, Types),
   39    types_error(Args, Types, Error).
   40format_error_(Format,_,Error) :-
   41    % \+ format_spec(Format, _),
   42    format(string(Error), "Invalid format string: ~q", [Format]).
   43
   44types_error(Args, Types, Error) :-
   45    length(Types, TypesLen),
   46    length(Args, ArgsLen),
   47    TypesLen =\= ArgsLen,
   48    !,
   49    format( string(Error)
   50          , "Wrong argument count. Expected ~d, got ~d"
   51          , [TypesLen, ArgsLen]
   52          ).
   53types_error(Args, Types, Error) :-
   54    types_error_(Args, Types, Error).
   55
   56types_error_([Arg|_],[Type|_],Error) :-
   57    ground(Arg),
   58    \+ is_of_type(Type,Arg),
   59    message_to_string(error(type_error(Type,Arg),_Location),Error).
   60types_error_([_|Args],[_|Types],Error) :-
   61    types_error_(Args, Types, Error).
   62
   63
   64% check/0 augmentation
   65:- multifile check:checker/2.   66:- dynamic check:checker/2.   67check:checker(format_spec:checker, "format/2 strings and arguments").
   68
   69:- dynamic format_fail/3.   70
   71checker :-
   72    prolog_walk_code([ module_class([user])
   73                     , infer_meta_predicates(false)
   74                     , autoload(false)  % format/{2,3} are always loaded
   75                     , undefined(ignore)
   76                     , trace_reference(_)
   77                     , on_trace(check_format)
   78                     ]),
   79    retract(format_fail(Goal,Location,Error)),
   80    print_message(warning, format_error(Goal,Location,Error)),
   81    fail.  % iterate all errors
   82checker.  % succeed even if no errors are found
   83
   84check_format(Module:Goal, _Caller, Location) :-
   85    predicate_property(Module:Goal, imported_from(Source)),
   86    memberchk(Source, [system,prolog_debug]),
   87    can_check(Goal),
   88    format_error(Goal, Error),
   89    assert(format_fail(Goal, Location, Error)),
   90    fail.
   91check_format(_,_,_).  % succeed to avoid printing goals
   92
   93% true if format_error/2 can check this goal
   94can_check(Goal) :-
   95    once(clause(format_error(Goal,_),_)).
   96
   97prolog:message(format_error(Goal,Location,Error)) -->
   98    prolog:message_location(Location),
   99    ['~n    In goal: ~q~n    ~s'-[Goal,Error]].
 format_spec(-Spec)//
DCG for parsing format strings. It doesn't yet generate format strings from a spec. See format_spec/2 for details.
  106format_spec([]) -->
  107    eos.
  108format_spec([escape(Numeric,Modifier,Action)|Rest]) -->
  109    "~",
  110    numeric_argument(Numeric),
  111    modifier_argument(Modifier),
  112    action(Action),
  113    format_spec(Rest).
  114format_spec([text(String)|Rest]) -->
  115    { when((ground(String);ground(Codes)),string_codes(String, Codes)) },
  116    string_without("~", Codes),
  117    { Codes \= [] },
  118    format_spec(Rest).
 format_spec(+Format, -Spec:list) is semidet
Parse a format string. Each element of Spec is one of the following:

Num represents the optional numeric portion of an esape. Colon represents the optional colon in an escape. Action is an atom representing the action to be take by this escape.

  131format_spec(Format, Spec) :-
  132    when((ground(Format);ground(Codes)),text_codes(Format, Codes)),
  133    once(phrase(format_spec(Spec), Codes, [])).
 spec_arity(+FormatSpec, -Arity:positive_integer) is det
True if FormatSpec requires format/2 to have Arity arguments.
  138spec_arity(Spec, Arity) :-
  139    spec_types(Spec, Types),
  140    length(Types, Arity).
 spec_types(+FormatSpec, -Types:list(type)) is det
True if FormatSpec requires format/2 to have arguments of Types. Each value of Types is a type as described by error:has_type/2. This notion of types is compatible with library(mavis).
  148spec_types(Spec, Types) :-
  149    phrase(spec_types(Spec), Types).
  150
  151spec_types([]) -->
  152    [].
  153spec_types([Item|Items]) -->
  154    item_types(Item),
  155    spec_types(Items).
  156
  157item_types(text(_)) -->
  158    [].
  159item_types(escape(Numeric,_,Action)) -->
  160    numeric_types(Numeric),
  161    action_types(Action).
  162
  163numeric_types(number(_)) -->
  164    [].
  165numeric_types(character(_)) -->
  166    [].
  167numeric_types(star) -->
  168    [number].
  169numeric_types(nothing) -->
  170    [].
  171
  172action_types(Action) -->
  173    { atom_codes(Action, [Code]) },
  174    { action_types(Code, Types) },
  175    phrase(Types).
 text_codes(Text:text, Codes:codes)
  179text_codes(Var, Codes) :-
  180    var(Var),
  181    !,
  182    string_codes(Var, Codes).
  183text_codes(Atom, Codes) :-
  184    atom(Atom),
  185    !,
  186    atom_codes(Atom, Codes).
  187text_codes(String, Codes) :-
  188    string(String),
  189    !,
  190    string_codes(String, Codes).
  191text_codes(Codes, Codes) :-
  192    is_of_type(codes, Codes).
  193
  194
  195numeric_argument(number(N)) -->
  196    integer(N).
  197numeric_argument(character(C)) -->
  198    "`",
  199    [C].
  200numeric_argument(star) -->
  201    "*".
  202numeric_argument(nothing) -->
  203    "".
  204
  205
  206modifier_argument(colon) -->
  207    ":".
  208modifier_argument(no_colon) -->
  209    \+ ":".
  210
  211
  212action(Action) -->
  213    [C],
  214    { is_action(C) },
  215    { atom_codes(Action, [C]) }.
 is_action(+Action:integer) is semidet
is_action(-Action:integer) is multi
True if Action is a valid format/2 action character. Iterates all acceptable action characters, if Action is unbound.
  223is_action(Action) :-
  224    action_types(Action, _).
 action_types(?Action:integer, ?Types:list(type))
True if Action consumes arguments matching Types. An action (like ~), which consumes no arguments, has Types=[]. For example, 
?- action_types(0'~, Types).
Types = [].
?- action_types(0'a, Types).
Types = [atom].
  235action_types(0'~, []).
  236action_types(0'a, [atom]).
  237action_types(0'c, [integer]).  % specifically, a code
  238action_types(0'd, [integer]).
  239action_types(0'D, [integer]).
  240action_types(0'e, [float]).
  241action_types(0'E, [float]).
  242action_types(0'f, [float]).
  243action_types(0'g, [float]).
  244action_types(0'G, [float]).
  245action_types(0'i, [any]).
  246action_types(0'I, [integer]).
  247action_types(0'k, [any]).
  248action_types(0'n, []).
  249action_types(0'N, []).
  250action_types(0'p, [any]).
  251action_types(0'q, [any]).
  252action_types(0'r, [integer]).
  253action_types(0'R, [integer]).
  254action_types(0's, [text]).
  255action_types(0'@, [callable]).
  256action_types(0't, []).
  257action_types(0'|, []).
  258action_types(0'+, []).
  259action_types(0'w, [any]).
  260action_types(0'W, [any, list])