1/*  Part of CHR (Constraint Handling Rules)
    2
    3    Author:        Jan Wielemaker and Tom Schrijvers
    4    E-mail:        Tom.Schrijvers@cs.kuleuven.be
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2004-2011, K.U. Leuven
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(chr_messages,
   36	  [ chr_message/3		% +CHR Message, Out, Rest
   37	  ]).   38:- use_module(chr(chr_runtime)).   39
   40:- discontiguous
   41	chr_message/3.   42
   43%	compiler messages
   44
   45chr_message(compilation_failed(From)) -->
   46	[ 'CHR Failed to compile ~w'-[From] ].
   47
   48%	debug messages
   49
   50chr_message(prompt) -->
   51	[ at_same_line, ' ? ', flush ].
   52chr_message(command(Command)) -->
   53	[ at_same_line, '[~w]'-[Command] ].
   54chr_message(invalid_command) -->
   55	[ nl, 'CHR: Not a valid debug option.  Use ? for help.' ].
   56chr_message(debug_options) -->
   57	{ bagof(Ls-Cmd,
   58		bagof(L, 'chr debug command'(L, Cmd), Ls),
   59		Lines)
   60	},
   61	[ 'CHR Debugger commands:', nl, nl ],
   62	debug_commands(Lines),
   63	[ nl ].
   64
   65debug_commands([]) -->
   66	[].
   67debug_commands([Ls-Cmd|T]) -->
   68	[ '\t' ], chars(Ls), [ '~t~28|~w'-[Cmd], nl ],
   69	debug_commands(T).
   70	
   71chars([C]) --> !,
   72	char(C).
   73chars([C|T]) -->
   74	char(C), [', '],
   75	chars(T).
   76
   77char(' ') --> !, ['<space>'].
   78char('\r') --> !, ['<cr>'].
   79char(end_of_file) --> !, ['EOF'].
   80char(C) --> [C].
   81
   82
   83chr_message(ancestors(History, Depth)) -->
   84	[ 'CHR Ancestors:', nl ],
   85	ancestors(History, Depth).
   86
   87ancestors([], _) -->
   88	[].
   89ancestors([Event|Events], Depth) -->
   90	[ '\t' ], event(Event, Depth), [ nl ],
   91	{ NDepth is Depth - 1
   92	},
   93	ancestors(Events, NDepth).
   94
   95
   96%	debugging ports
   97
   98chr_message(event(Port, Depth)) -->
   99	[ 'CHR: ' ],
  100	event(Port, Depth),
  101	[ flush ].			% do not emit a newline
  102
  103event(Port, Depth) -->
  104	depth(Depth),
  105	port(Port).
  106event(apply(H1,H2,G,B), Depth) -->
  107	depth(Depth),
  108	[ 'Apply: ' ],
  109	rule(H1,H2,G,B).
  110event(try(H1,H2,G,B), Depth) -->
  111	depth(Depth),
  112	[ 'Try: ' ],
  113	rule(H1,H2,G,B).
  114event(insert(#(_,Susp)), Depth) -->
  115	depth(Depth),
  116	[ 'Insert: ' ],
  117	head(Susp).
  118
  119port(call(Susp)) -->
  120	[ 'Call: ' ],
  121	head(Susp).
  122port(wake(Susp)) -->
  123	[ 'Wake: ' ],
  124	head(Susp).
  125port(exit(Susp)) -->
  126	[ 'Exit: ' ],
  127	head(Susp).
  128port(fail(Susp)) -->
  129	[ 'Fail: ' ],
  130	head(Susp).
  131port(redo(Susp)) -->
  132	[ 'Redo: ' ],
  133	head(Susp).
  134port(remove(Susp)) -->
  135	[ 'Remove: ' ],
  136	head(Susp).
  137
  138
  139depth(Depth) -->
  140	[ '~t(~D)~10| '-[Depth] ].
  141
  142head(Susp) -->
  143	{ Susp =.. [_,ID,_,_,_,_|GoalArgs], Goal =.. GoalArgs
  144	},
  145	[ '~w # <~w>'-[Goal, ID] ].
  146
  147heads([H]) --> !,
  148	head(H).
  149heads([H|T]) -->
  150	head(H),
  151	[ ', ' ],
  152	heads(T).
  153
  154
  155%	rule(H1, H2, G, B)
  156%	
  157%	Produce text for the CHR rule "H1 \ H2 [<=]=> G | B"
  158
  159rule(H1, H2, G, B) -->
  160	rule_head(H1, H2),
  161	rule_body(G, B).
  162
  163rule_head([], H2) --> !,
  164	heads(H2),
  165	[ ' ==> ' ].
  166rule_head(H1, []) --> !,
  167	heads(H1),
  168	[ ' <=> ' ].
  169rule_head(H1, H2) -->
  170	heads(H2), [ ' \\ ' ], heads(H1), [' <=> '].
  171
  172
  173rule_body(true, B) --> !,
  174	[ '~w.'-[B] ].
  175rule_body(G, B) -->
  176	[ '~w | ~w.'-[G, B] ]