chr_messages.pl

   1 /*  $Id$
   2
   3     Part of CHR (Constraint Handling Rules)
   4
   5     Author:        Jan Wielemaker and Tom Schrijvers
   6     E-mail:        Tom.Schrijvers@cs.kuleuven.be
   7     WWW:           http://www.swi-prolog.org
   8     Copyright (C): 2003-2004, K.U. Leuven
   9
  10     This program is free software; you can redistribute it and/or
  11     modify it under the terms of the GNU General Public License
  12     as published by the Free Software Foundation; either version 2
  13     of the License, or (at your option) any later version.
  14
  15     This program is distributed in the hope that it will be useful,
  16     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18     GNU General Public License for more details.
  19
  20     You should have received a copy of the GNU Lesser General Public
  21     License along with this library; if not, write to the Free Software
  22     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  23
  24     As a special exception, if you link this library with other files,
  25     compiled with a Free Software compiler, to produce an executable, this
  26     library does not by itself cause the resulting executable to be covered
  27     by the GNU General Public License. This exception does not however
  28     invalidate any other reasons why the executable file might be covered by
  29     the GNU General Public License.
  30 */
  31
  32 :- module(chr_messages,
  33           [ chr_message/3               % +CHR Message, Out, Rest
  34           ]).
  35 :- use_module(chr(chr_runtime)).
  36
  37 :- discontiguous
  38         chr_message/3.
  39
  40 %       compiler messages
  41
  42 chr_message(compilation_failed(From)) -->
  43         [ 'CHR Failed to compile ~w'-[From] ].
  44
  45 %       debug messages
  46
  47 chr_message(prompt) -->
  48         [ at_same_line, ' ? ', flush ].
  49 chr_message(command(Command)) -->
  50         [ at_same_line, '[~w]'-[Command] ].
  51 chr_message(invalid_command) -->
  52         [ nl, 'CHR: Not a valid debug option.  Use ? for help.' ].
  53 chr_message(debug_options) -->
  54         { bagof(Ls-Cmd,
  55                 bagof(L, 'chr debug command'(L, Cmd), Ls),
  56                 Lines)
  57         },
  58         [ 'CHR Debugger commands:', nl, nl ],
  59         debug_commands(Lines),
  60         [ nl ].
  61
  62 debug_commands([]) -->
  63         [].
  64 debug_commands([Ls-Cmd|T]) -->
  65         [ '\t' ], chars(Ls), [ '~t~28|~w'-[Cmd], nl ],
  66         debug_commands(T).
  67
  68 chars([C]) --> !,
  69         char(C).
  70 chars([C|T]) -->
  71         char(C), [', '],
  72         chars(T).
  73
  74 char(' ') --> !, ['<space>'].
  75 char('\r') --> !, ['<cr>'].
  76 char(end_of_file) --> !, ['EOF'].
  77 char(C) --> [C].
  78
  79
  80 chr_message(ancestors(History, Depth)) -->
  81         [ 'CHR Ancestors:', nl ],
  82         ancestors(History, Depth).
  83
  84 ancestors([], _) -->
  85         [].
  86 ancestors([Event|Events], Depth) -->
  87         [ '\t' ], event(Event, Depth), [ nl ],
  88         { NDepth is Depth - 1
  89         },
  90         ancestors(Events, NDepth).
  91
  92
  93 %       debugging ports
  94
  95 chr_message(event(Port, Depth)) -->
  96         [ 'CHR: ' ],
  97         event(Port, Depth),
  98         [ flush ].                      % do not emit a newline
  99
 100 event(Port, Depth) -->
 101         depth(Depth),
 102         port(Port).
 103 event(apply(H1,H2,G,B), Depth) -->
 104         depth(Depth),
 105         [ 'Apply: ' ],
 106         rule(H1,H2,G,B).
 107 event(try(H1,H2,G,B), Depth) -->
 108         depth(Depth),
 109         [ 'Try: ' ],
 110         rule(H1,H2,G,B).
 111 event(insert(#(_,Susp)), Depth) -->
 112         depth(Depth),
 113         [ 'Insert: ' ],
 114         head(Susp).
 115
 116 port(call(Susp)) -->
 117         [ 'Call: ' ],
 118         head(Susp).
 119 port(wake(Susp)) -->
 120         [ 'Wake: ' ],
 121         head(Susp).
 122 port(exit(Susp)) -->
 123         [ 'Exit: ' ],
 124         head(Susp).
 125 port(fail(Susp)) -->
 126         [ 'Fail: ' ],
 127         head(Susp).
 128 port(redo(Susp)) -->
 129         [ 'Redo: ' ],
 130         head(Susp).
 131 port(remove(Susp)) -->
 132         [ 'Remove: ' ],
 133         head(Susp).
 134
 135
 136 depth(Depth) -->
 137         [ '~t(~D)~10| '-[Depth] ].
 138
 139 head(Susp) -->
 140         { Susp =.. [_,ID,_,_,_,_|GoalArgs], Goal =.. GoalArgs
 141         },
 142         [ '~w # <~w>'-[Goal, ID] ].
 143
 144 heads([H]) --> !,
 145         head(H).
 146 heads([H|T]) -->
 147         head(H),
 148         [ ', ' ],
 149         heads(T).
 150
 151
 152 %       rule(H1, H2, G, B)
 153 %
 154 %       Produce text for the CHR rule "H1 \ H2 [<=]=> G | B"
 155
 156 rule(H1, H2, G, B) -->
 157         rule_head(H1, H2),
 158         rule_body(G, B).
 159
 160 rule_head([], H2) --> !,
 161         heads(H2),
 162         [ ' ==> ' ].
 163 rule_head(H1, []) --> !,
 164         heads(H1),
 165         [ ' <=> ' ].
 166 rule_head(H1, H2) -->
 167         heads(H2), [ ' \\ ' ], heads(H1), [' <=> '].
 168
 169
 170 rule_body(true, B) --> !,
 171         [ '~w.'-[B] ].
 172 rule_body(G, B) -->
 173         [ '~w | ~w.'-[G, B] ].