stop using submodule
This commit is contained in:
Vítor Santos Costa
177
packages/chr/chr_messages.pl
Normal file
177
packages/chr/chr_messages.pl
Normal file
@@ -0,0 +1,177 @@
|
||||
/* $Id$
|
||||
|
||||
Part of CHR (Constraint Handling Rules)
|
||||
|
||||
Author: Jan Wielemaker and Tom Schrijvers
|
||||
E-mail: Tom.Schrijvers@cs.kuleuven.be
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 2003-2004, K.U. Leuven
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
as published by the Free Software Foundation; either version 2
|
||||
of the License, or (at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
As a special exception, if you link this library with other files,
|
||||
compiled with a Free Software compiler, to produce an executable, this
|
||||
library does not by itself cause the resulting executable to be covered
|
||||
by the GNU General Public License. This exception does not however
|
||||
invalidate any other reasons why the executable file might be covered by
|
||||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
%% @addtogroup CHR_in_YAP_Programs
|
||||
%
|
||||
% CHR controlling the compiler
|
||||
%
|
||||
:- module(chr_messages,
|
||||
[ chr_message/3 % +CHR Message, Out, Rest
|
||||
]).
|
||||
:- use_module(chr(chr_runtime)).
|
||||
|
||||
:- discontiguous
|
||||
chr_message/3.
|
||||
|
||||
% compiler messages
|
||||
|
||||
chr_message(compilation_failed(From)) -->
|
||||
[ 'CHR Failed to compile ~w'-[From] ].
|
||||
|
||||
% debug messages
|
||||
|
||||
chr_message(prompt) -->
|
||||
[ at_same_line, ' ? ', flush_output ].
|
||||
chr_message(command(Command)) -->
|
||||
[ at_same_line, '[~w]'-[Command] ].
|
||||
chr_message(invalid_command) -->
|
||||
[ nl, 'CHR: Not a valid debug option. Use ? for help.' ].
|
||||
chr_message(debug_options) -->
|
||||
{ bagof(Ls-Cmd,
|
||||
bagof(L, 'chr debug command'(L, Cmd), Ls),
|
||||
Lines)
|
||||
},
|
||||
[ 'CHR Debugger commands:', nl, nl ],
|
||||
debug_commands(Lines),
|
||||
[ nl ].
|
||||
|
||||
debug_commands([]) -->
|
||||
[].
|
||||
debug_commands([Ls-Cmd|T]) -->
|
||||
[ '\t' ], chars(Ls), [ '~t~28|~w'-[Cmd], nl ],
|
||||
debug_commands(T).
|
||||
|
||||
chars([C]) --> !,
|
||||
char(C).
|
||||
chars([C|T]) -->
|
||||
char(C), [', '],
|
||||
chars(T).
|
||||
|
||||
char(' ') --> !, ['<space>'].
|
||||
char('\r') --> !, ['<cr>'].
|
||||
char(end_of_file) --> !, ['EOF'].
|
||||
char(C) --> [C].
|
||||
|
||||
|
||||
chr_message(ancestors(History, Depth)) -->
|
||||
[ 'CHR Ancestors:', nl ],
|
||||
ancestors(History, Depth).
|
||||
|
||||
ancestors([], _) -->
|
||||
[].
|
||||
ancestors([Event|Events], Depth) -->
|
||||
[ '\t' ], event(Event, Depth), [ nl ],
|
||||
{ NDepth is Depth - 1
|
||||
},
|
||||
ancestors(Events, NDepth).
|
||||
|
||||
|
||||
% debugging ports
|
||||
|
||||
chr_message(event(Port, Depth)) -->
|
||||
[ 'CHR: ' ],
|
||||
event(Port, Depth),
|
||||
[ flush_output ]. % do not emit a newline
|
||||
|
||||
event(Port, Depth) -->
|
||||
depth(Depth),
|
||||
port(Port).
|
||||
event(apply(H1,H2,G,B), Depth) -->
|
||||
depth(Depth),
|
||||
[ 'Apply: ' ],
|
||||
rule(H1,H2,G,B).
|
||||
event(try(H1,H2,G,B), Depth) -->
|
||||
depth(Depth),
|
||||
[ 'Try: ' ],
|
||||
rule(H1,H2,G,B).
|
||||
event(insert(#(_,Susp)), Depth) -->
|
||||
depth(Depth),
|
||||
[ 'Insert: ' ],
|
||||
head(Susp).
|
||||
|
||||
port(call(Susp)) -->
|
||||
[ 'Call: ' ],
|
||||
head(Susp).
|
||||
port(wake(Susp)) -->
|
||||
[ 'Wake: ' ],
|
||||
head(Susp).
|
||||
port(exit(Susp)) -->
|
||||
[ 'Exit: ' ],
|
||||
head(Susp).
|
||||
port(fail(Susp)) -->
|
||||
[ 'Fail: ' ],
|
||||
head(Susp).
|
||||
port(redo(Susp)) -->
|
||||
[ 'Redo: ' ],
|
||||
head(Susp).
|
||||
port(remove(Susp)) -->
|
||||
[ 'Remove: ' ],
|
||||
head(Susp).
|
||||
|
||||
|
||||
depth(Depth) -->
|
||||
[ '~t(~D)~10| '-[Depth] ].
|
||||
|
||||
head(Susp) -->
|
||||
{ Susp =.. [_,ID,_,_,_,_|GoalArgs], Goal =.. GoalArgs
|
||||
},
|
||||
[ '~w # <~w>'-[Goal, ID] ].
|
||||
|
||||
heads([H]) --> !,
|
||||
head(H).
|
||||
heads([H|T]) -->
|
||||
head(H),
|
||||
[ ', ' ],
|
||||
heads(T).
|
||||
|
||||
|
||||
% rule(H1, H2, G, B)
|
||||
%
|
||||
% Produce text for the CHR rule "H1 \ H2 [<=]=> G | B"
|
||||
|
||||
rule(H1, H2, G, B) -->
|
||||
rule_head(H1, H2),
|
||||
rule_body(G, B).
|
||||
|
||||
rule_head([], H2) --> !,
|
||||
heads(H2),
|
||||
[ ' ==> ' ].
|
||||
rule_head(H1, []) --> !,
|
||||
heads(H1),
|
||||
[ ' <=> ' ].
|
||||
rule_head(H1, H2) -->
|
||||
heads(H2), [ ' \\ ' ], heads(H1), [' <=> '].
|
||||
|
||||
|
||||
rule_body(true, B) --> !,
|
||||
[ '~w.'-[B] ].
|
||||
rule_body(G, B) -->
|
||||
[ '~w | ~w.'-[G, B] ].
|
||||
Reference in New Issue
Block a user