1:- module(plammar_util, [
    2    warning/1,
    3    warning/2,
    4    list_open/2,
    5    list_close/1,
    6    yes/1,
    7    no/1,
    8    otherwise/0,
    9    spec_class/2,
   10    set_option/3,
   11    integer_number/3,
   12    use_msg/3,
   13    use_msg/4
   14  ]).   15
   16:- use_module(library(lists), [append/3]).   17:- use_module(library(option), [merge_options/3]).   18
   19warning(Format, Arguments) :-
   20  print_message(warning, format(Format, Arguments)).
   21warning(Msg) :-
   22  warning(Msg, []).
   23
   24list_open(List, Open_List) :-
   25  append(List, _, Open_List).
   26
   27list_close([]).
   28list_close([_|Xs]) :-
   29  ( var(Xs) -> Xs = []
   30  ; list_close(Xs) ).
   31
   32yes(yes).
   33yes(true).
   34yes(y).
   35yes(ok).
   36
   37no(no).
   38no(false).
   39no(n).
   40
   41otherwise.
   42
   43spec_class( fx, prefix).
   44spec_class( fy, prefix).
   45spec_class(xfx, infix).
   46spec_class(xfy, infix).
   47spec_class(yfx, infix).
   48spec_class(xf , postfix).
   49spec_class(yf , postfix).
   50
   51set_option(New_Option, Old, New) :-
   52  merge_options([New_Option], Old, New).
   53
   54character_code_integer('a', 7).
   55character_code_integer('b', 8).
   56character_code_integer('c', 99).
   57character_code_integer('e', 27).
   58character_code_integer('f', 12).
   59character_code_integer('n', 10).
   60character_code_integer('r', 13).
   61character_code_integer('s', 32).
   62character_code_integer('t', 9).
   63character_code_integer('v', 11).
   64
   65integer_number(_Atom, integer_constant(Chars), Integer) :-
   66  chars2dec(Chars, 10, 0, Integer).
   67
   68integer_number(_Atom, character_code_constant(['0', single_quote_char('\''), single_quoted_character(non_quote_char( control_escape_sequence([backslash_char('\\'), symbolic_control_char(Symbolic_Control_Char)])))]), Integer) :-
   69  Symbolic_Control_Char =.. [_Type, Char],
   70  character_code_integer(Char, Integer).
   71
   72integer_number(Atom, character_code_constant(_), Integer) :-
   73  atom_concat('0\'', Char, Atom),
   74  atom_codes(Char, Codes),
   75  Codes = [Integer].
   76
   77integer_number(_Atom, binary_constant([binary_constant_indicator(['0','b'])|Chars]), Integer) :-
   78  chars2dec(Chars, 2, 0, Integer).
   79
   80integer_number(_Atom, octal_constant([octal_constant_indicator(['0','o'])|Chars]), Integer) :-
   81  chars2dec(Chars, 8, 0, Integer).
   82
   83integer_number(_Atom, hexadecimal_constant([hexadecimal_constant_indicator(['0','x'])|Chars]), Integer) :-
   84  chars2dec(Chars, 16, 0, Integer).
   85
   86chars2dec([], _, N, N).
   87chars2dec([space_char(' ')|Chars], Base, Acc, N) :-
   88  !,
   89  chars2dec(Chars, Base, Acc, N).
   90chars2dec([underscore_char('_')|Chars], Base, Acc, N) :-
   91  !,
   92  chars2dec(Chars, Base, Acc, N).
   93chars2dec([PT|Chars], Base, Acc, N) :-
   94  PT =.. [_Type, Char],
   95  code_type(Char, xdigit(Digit)),
   96  Acc1 is Acc*Base + Digit,
   97  chars2dec(Chars, Base, Acc1, N).
   98
   99use_msg(Found, Expected, Msg) :-
  100  format(atom(Msg), 'Use "~w" instead of "~w".', [Expected, Found]).
  101
  102use_msg(Found, Expected, Msg, Why) :-
  103  format(atom(Msg), 'Use "~w" instead of "~w" ~w.', [Expected, Found, Why])