1/*  Part of CHR (Constraint Handling Rules)
    2
    3    Author:        Tom Schrijvers and Jan Wielemaker
    4    E-mail:        Tom.Schrijvers@cs.kuleuven.be
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2004-2015, 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%% SWI begin
   36:- module(chr,
   37	  [ op(1180, xfx, ==>),
   38	    op(1180, xfx, <=>),
   39	    op(1150, fx, constraints),
   40	    op(1150, fx, chr_constraint),
   41	    op(1150, fx, chr_preprocessor),
   42	    op(1150, fx, handler),
   43	    op(1150, fx, rules),
   44	    op(1100, xfx, \),
   45	    op(1200, xfx, @),
   46	    op(1190, xfx, pragma),
   47	    op( 500, yfx, #),
   48	    op(1150, fx, chr_type),
   49	    op(1150, fx, chr_declaration),
   50	    op(1130, xfx, --->),
   51	    op(1150, fx, (?)),
   52	    chr_show_store/1,		% +Module
   53	    find_chr_constraint/1,	% +Pattern
   54	    chr_trace/0,
   55	    chr_notrace/0,
   56	    chr_leash/1			% +Ports
   57	  ]).   58
   59:- expects_dialect(swi).   60
   61:- set_prolog_flag(generate_debug_info, false).   62
   63:- multifile
   64	debug_ask_continue/1,
   65	preprocess/2.   66
   67:- multifile user:file_search_path/2.   68:- dynamic   user:file_search_path/2.   69:- dynamic   chr_translated_program/1.   70
   71user:file_search_path(chr, library(chr)).
   72
   73:- load_files([ chr(chr_translate),
   74		chr(chr_runtime),
   75		chr(chr_messages),
   76		chr(chr_hashtable_store),
   77		chr(chr_compiler_errors)
   78	      ],
   79	      [ if(not_loaded),
   80		silent(true)
   81	      ]).   82
   83:- use_module(library(lists), [member/2]).   84%% SWI end
   85
   86%% SICStus begin
   87%% :- module(chr,[
   88%%	chr_trace/0,
   89%%	chr_notrace/0,
   90%%	chr_leash/0,
   91%%	chr_flag/3,
   92%%	chr_show_store/1
   93%%	]).
   94%%
   95%% :- op(1180, xfx, ==>),
   96%%	op(1180, xfx, <=>),
   97%%	op(1150, fx, constraints),
   98%%	op(1150, fx, handler),
   99%%	op(1150, fx, rules),
  100%%	op(1100, xfx, \),
  101%%	op(1200, xfx, @),
  102%%	op(1190, xfx, pragma),
  103%%	op( 500, yfx, #),
  104%%	op(1150, fx, chr_type),
  105%%	op(1130, xfx, --->),
  106%%	op(1150, fx, (?)).
  107%%
  108%% :- multifile user:file_search_path/2.
  109%% :- dynamic   chr_translated_program/1.
  110%%
  111%% user:file_search_path(chr, library(chr)).
  112%%
  113%%
  114%% :- use_module('chr/chr_translate').
  115%% :- use_module('chr/chr_runtime').
  116%% :- use_module('chr/chr_hashtable_store').
  117%% :- use_module('chr/hprolog').
  118%% SICStus end
  119
  120:- multifile chr:'$chr_module'/1.  121
  122:- dynamic chr_term/3.		% File, Term
  123
  124:- dynamic chr_pp/2.		% File, Term
  125
  126%	chr_expandable(+Term)
  127%
  128%	Succeeds if Term is a  rule  that   must  be  handled by the CHR
  129%	compiler. Ideally CHR definitions should be between
  130%
  131%		:- constraints ...
  132%		...
  133%		:- end_constraints.
  134%
  135%	As they are not we have to   use  some heuristics. We assume any
  136%	file is a CHR after we've seen :- constraints ...
  137
  138chr_expandable((:- constraints _)).
  139chr_expandable((constraints _)).
  140chr_expandable((:- chr_constraint _)).
  141chr_expandable((:- chr_type _)).
  142chr_expandable((chr_type _)).
  143chr_expandable((:- chr_declaration _)).
  144chr_expandable(option(_, _)).
  145chr_expandable((:- chr_option(_, _))).
  146chr_expandable((handler _)).
  147chr_expandable((rules _)).
  148chr_expandable((_ <=> _)).
  149chr_expandable((_ @ _)).
  150chr_expandable((_ ==> _)).
  151chr_expandable((_ pragma _)).
  152
  153%	chr_expand(+Term, -Expansion)
  154%
  155%	Extract CHR declarations and rules from the file and run the
  156%	CHR compiler when reaching end-of-file.
  157
  158%% SWI begin
  159extra_declarations([ (:- use_module(chr(chr_runtime))),
  160		     (:- style_check(-discontiguous)),
  161		     (:- style_check(-singleton)),
  162		     (:- style_check(-no_effect)),
  163		     (:- set_prolog_flag(generate_debug_info, false))
  164		   | Tail
  165		   ], Tail).
  166%% SWI end
  167
  168%% SICStus begin
  169%% extra_declarations([(:-use_module(chr(chr_runtime)))
  170%%		     , (:- use_module(chr(hprolog),[term_variables/2,term_variables/3]))
  171%%		     , (:-use_module(chr(hpattvars)))
  172%%		     | Tail], Tail).
  173%% SICStus end
  174
  175chr_expand(Term, []) :-
  176	chr_expandable(Term), !,
  177	prolog_load_context(source,File),
  178	prolog_load_context(term_position,Pos),
  179	stream_position_data(line_count,Pos,LineNumber),
  180	add_pragma_to_chr_rule(Term,line_number(LineNumber),NTerm),
  181	assert(chr_term(File, LineNumber, NTerm)).
  182chr_expand(Term, []) :-
  183	Term = (:- chr_preprocessor Preprocessor), !,
  184	prolog_load_context(source,File),
  185	assert(chr_pp(File, Preprocessor)).
  186chr_expand(end_of_file, FinalProgram) :-
  187	extra_declarations(FinalProgram,Program),
  188	prolog_load_context(source,File),
  189	findall(T, retract(chr_term(File,_Line,T)), CHR0),
  190	CHR0 \== [],
  191	prolog_load_context(module, Module),
  192	add_debug_decl(CHR0, CHR1),
  193	add_optimise_decl(CHR1, CHR2),
  194	call_preprocess(CHR2, CHR3),
  195	CHR4 = [ (:- module(Module, [])) | CHR3 ],
  196	findall(P, retract(chr_pp(File, P)), Preprocessors),
  197	( Preprocessors = [] ->
  198		CHR4 = CHR
  199	; Preprocessors = [Preprocessor] ->
  200		chr_compiler_errors:chr_info(preprocessor,'\tPreprocessing with ~w.\n',[Preprocessor]),
  201		call_chr_preprocessor(Preprocessor,CHR4,CHR)
  202	;
  203		chr_compiler_errors:print_chr_error(error(syntax(Preprocessors),'Too many preprocessors! Only one is allowed!\n',[])),
  204		fail
  205	),
  206	catch(call_chr_translate(File,
  207			   [ (:- module(Module, []))
  208			   | CHR
  209			   ],
  210			   Program0),
  211		chr_error(Error),
  212		(	chr_compiler_errors:print_chr_error(Error),
  213			fail
  214		)
  215	),
  216	delete_header(Program0, Program).
  217
  218
  219delete_header([(:- module(_,_))|T0], T) :- !,
  220	delete_header(T0, T).
  221delete_header(L, L).
  222
  223add_debug_decl(CHR, CHR) :-
  224	member(option(Name, _), CHR), Name == debug, !.
  225add_debug_decl(CHR, CHR) :-
  226	member((:- chr_option(Name, _)), CHR), Name == debug, !.
  227add_debug_decl(CHR, [(:- chr_option(debug, Debug))|CHR]) :-
  228	(   chr_current_prolog_flag(generate_debug_info, true)
  229	->  Debug = on
  230	;   Debug = off
  231	).
  232
  233%% SWI begin
  234chr_current_prolog_flag(Flag,Val) :- current_prolog_flag(Flag,Val).
  235%% SWI end
  236
  237add_optimise_decl(CHR, CHR) :-
  238	\+(\+(memberchk((:- chr_option(optimize, _)), CHR))), !.
  239add_optimise_decl(CHR, [(:- chr_option(optimize, full))|CHR]) :-
  240	chr_current_prolog_flag(optimize, full), !.
  241add_optimise_decl(CHR, CHR).
  242
  243%%	call_preprocess(+CHR0, -CHR) is det.
  244%
  245%	Call user chr:preprocess(CHR0, CHR).
  246
  247call_preprocess(CHR0, CHR) :-
  248	preprocess(CHR0, CHR), !.
  249call_preprocess(CHR, CHR).
  250
  251%	call_chr_translate(+File, +In, -Out)
  252%
  253%	The entire chr_translate/2 translation may fail, in which case we'd
  254%	better issue a warning  rather  than   simply  ignoring  the CHR
  255%	declarations.
  256
  257call_chr_translate(File, In, _Out) :-
  258	( chr_translate_line_info(In, File, Out0) ->
  259	    nb_setval(chr_translated_program,Out0),
  260	    fail
  261	).
  262call_chr_translate(_, _In, Out) :-
  263	nb_current(chr_translated_program,Out), !,
  264	nb_delete(chr_translated_program).
  265
  266call_chr_translate(File, _, []) :-
  267	print_message(error, chr(compilation_failed(File))).
  268
  269call_chr_preprocessor(Preprocessor,CHR,_NCHR) :-
  270	( call(Preprocessor,CHR,CHR0) ->
  271		nb_setval(chr_preprocessed_program,CHR0),
  272		fail
  273	).
  274call_chr_preprocessor(_,_,NCHR)	:-
  275	nb_current(chr_preprocessed_program,NCHR), !,
  276	nb_delete(chr_preprocessed_program).
  277call_chr_preprocessor(Preprocessor,_,_) :-
  278	chr_compiler_errors:print_chr_error(error(preprocessor,'Preprocessor `~w\' failed!\n',[Preprocessor])).
  279
  280%% SWI begin
  281
  282		 /*******************************
  283		 *      SYNCHRONISE TRACER	*
  284		 *******************************/
  285
  286:- multifile
  287	user:message_hook/3,
  288	chr:debug_event/2,
  289	chr:debug_interact/3.  290:- dynamic
  291	user:message_hook/3.  292
  293user:message_hook(trace_mode(OnOff), _, _) :-
  294	(   OnOff == on
  295	->  chr_trace
  296	;   chr_notrace
  297	),
  298	fail.				% backtrack to other handlers
  299
  300:- public
  301	debug_event/2,
  302	debug_interact/3.  303
  304%%	debug_event(+State, +Event)
  305%
  306%	Hook into the CHR debugger.  At this moment we will discard CHR
  307%	events if we are in a Prolog `skip' and we ignore the
  308
  309debug_event(_State, _Event) :-
  310	tracing,			% are we tracing?
  311	prolog_skip_level(Skip, Skip),
  312	Skip \== very_deep,
  313	prolog_current_frame(Me),
  314	prolog_frame_attribute(Me, level, Level),
  315	Level > Skip, !.
  316
  317%%	debug_interact(+Event, +Depth, -Command)
  318%
  319%	Hook into the CHR debugger to display Event and ask for the next
  320%	command to execute. This  definition   causes  the normal Prolog
  321%	debugger to be used for the standard ports.
  322
  323debug_interact(Event, _Depth, creep) :-
  324	prolog_event(Event),
  325	tracing, !.
  326
  327prolog_event(call(_)).
  328prolog_event(exit(_)).
  329prolog_event(fail(_)).
  330
  331%%	debug_ask_continue(-Command) is semidet.
  332%
  333%	Hook to ask for a CHR debug   continuation. Must bind Command to
  334%	one of =creep=, =skip=, =ancestors=, =nodebug=, =abort=, =fail=,
  335%	=break=, =help= or =exit=.
  336
  337
  338		 /*******************************
  339		 *	      MESSAGES		*
  340		 *******************************/
  341
  342:- multifile
  343	prolog:message/3.  344
  345prolog:message(chr(CHR)) -->
  346	chr_message(CHR).
  347
  348:- multifile
  349        check:trivial_fail_goal/1.  350
  351check:trivial_fail_goal(_:Goal) :-
  352        functor(Goal, Name, _),
  353        sub_atom(Name, 0, _, _, '$chr_store_constants_').
  354
  355		 /*******************************
  356		 *	 TOPLEVEL PRINTING	*
  357		 *******************************/
  358
  359:- create_prolog_flag(chr_toplevel_show_store, true, []).  360
  361:- residual_goals(chr_residuals).  362
  363%%	chr_residuals// is det.
  364%
  365%	Find the CHR constraints from the   store.  These are accessible
  366%	through the nondet predicate   current_chr_constraint/1. Doing a
  367%	findall/4 however would loose the  bindings. We therefore rolled
  368%	findallv/4,  which  exploits  non-backtrackable  assignment  and
  369%	realises a copy of the template  without disturbing the bindings
  370%	using this strangely looking construct.   Note that the bindings
  371%	created by the unifications are in New,  which is newer then the
  372%	latest choicepoint and therefore the bindings are not trailed.
  373%
  374%	  ==
  375%	  duplicate_term(Templ, New),
  376%	  New = Templ
  377%	  ==
  378
  379chr_residuals(Residuals, Tail) :-
  380	chr_current_prolog_flag(chr_toplevel_show_store,true),
  381	nb_current(chr_global, _), !,
  382	Goal = _:_,
  383	findallv(Goal, current_chr_constraint(Goal), Residuals, Tail).
  384chr_residuals(Residuals, Residuals).
  385
  386:- meta_predicate
  387	findallv(?, 0, ?, ?).  388
  389findallv(Templ, Goal, List, Tail) :-
  390	List2 = [x|_],
  391	State = state(List2),
  392	(   call(Goal),
  393	    arg(1, State, L),
  394	    duplicate_term(Templ, New),
  395	    New = Templ,
  396	    Cons = [New|_],
  397	    nb_linkarg(2, L, Cons),
  398	    nb_linkarg(1, State, Cons),
  399	    fail
  400	;   List2 = [x|List],
  401	    arg(1, State, Last),
  402	    arg(2, Last, Tail)
  403	).
  404
  405
  406		 /*******************************
  407		 *	   MUST BE LAST!	*
  408		 *******************************/
  409
  410:- multifile system:term_expansion/2.  411:- dynamic   system:term_expansion/2.  412
  413system:term_expansion(In, Out) :-
  414	\+ current_prolog_flag(xref, true),
  415	chr_expand(In, Out).
  416%% SWI end
  417
  418%% SICStus begin
  419%
  420% :- dynamic
  421%	current_toplevel_show_store/1,
  422%	current_generate_debug_info/1,
  423%	current_optimize/1.
  424%
  425% current_toplevel_show_store(on).
  426%
  427% current_generate_debug_info(false).
  428%
  429% current_optimize(off).
  430%
  431% chr_current_prolog_flag(generate_debug_info, X) :-
  432%	chr_flag(generate_debug_info, X, X).
  433% chr_current_prolog_flag(optimize, X) :-
  434%	chr_flag(optimize, X, X).
  435%
  436% chr_flag(Flag, Old, New) :-
  437%	Goal = chr_flag(Flag,Old,New),
  438%	g must_be(Flag, oneof([toplevel_show_store,generate_debug_info,optimize]), Goal, 1),
  439%	chr_flag(Flag, Old, New, Goal).
  440%
  441% chr_flag(toplevel_show_store, Old, New, Goal) :-
  442%	clause(current_toplevel_show_store(Old), true, Ref),
  443%	(   New==Old -> true
  444%	;   must_be(New, oneof([on,off]), Goal, 3),
  445%	    erase(Ref),
  446%	    assertz(current_toplevel_show_store(New))
  447%	).
  448% chr_flag(generate_debug_info, Old, New, Goal) :-
  449%	clause(current_generate_debug_info(Old), true, Ref),
  450%	(   New==Old -> true
  451%	;   must_be(New, oneof([false,true]), Goal, 3),
  452%	    erase(Ref),
  453%	    assertz(current_generate_debug_info(New))
  454%	).
  455% chr_flag(optimize, Old, New, Goal) :-
  456%	clause(current_optimize(Old), true, Ref),
  457%	(   New==Old -> true
  458%	;   must_be(New, oneof([full,off]), Goal, 3),
  459%	    erase(Ref),
  460%	    assertz(current_optimize(New))
  461%	).
  462%
  463%
  464% all_stores_goal(Goal, CVAs) :-
  465%	chr_flag(toplevel_show_store, on, on), !,
  466%	findall(C-CVAs, find_chr_constraint(C), Pairs),
  467%	andify(Pairs, Goal, CVAs).
  468% all_stores_goal(true, _).
  469%
  470% andify([], true, _).
  471% andify([X-Vs|L], Conj, Vs) :- andify(L, X, Conj, Vs).
  472%
  473% andify([], X, X, _).
  474% andify([Y-Vs|L], X, (X,Conj), Vs) :- andify(L, Y, Conj, Vs).
  475%
  476% :- multifile user:term_expansion/6.
  477%
  478% user:term_expansion(In, _, Ids, Out, [], [chr|Ids]) :-
  479%	nonvar(In),
  480%	nonmember(chr, Ids),
  481%	chr_expand(In, Out), !.
  482%
  483%% SICStus end
  484
  485%%% for SSS %%%
  486
  487add_pragma_to_chr_rule((Name @ Rule), Pragma, Result) :- !,
  488	add_pragma_to_chr_rule(Rule,Pragma,NRule),
  489	Result = (Name @ NRule).
  490add_pragma_to_chr_rule((Rule pragma Pragmas), Pragma, Result) :- !,
  491	Result = (Rule pragma (Pragma,Pragmas)).
  492add_pragma_to_chr_rule((Head ==> Body), Pragma, Result) :- !,
  493	Result = (Head ==> Body pragma Pragma).
  494add_pragma_to_chr_rule((Head <=> Body), Pragma, Result) :- !,
  495	Result = (Head <=> Body pragma Pragma).
  496add_pragma_to_chr_rule(Term,_,Term).
  497
  498
  499		 /*******************************
  500		 *	  SANDBOX SUPPORT	*
  501		 *******************************/
  502
  503:- multifile
  504	sandbox:safe_primitive/1.  505
  506% CHR uses a lot of global variables. We   don't  really mind as long as
  507% the user does not mess around  with   global  variable that may have a
  508% predefined meaning.
  509
  510sandbox:safe_primitive(system:b_setval(V, _)) :-
  511	chr_var(V).
  512sandbox:safe_primitive(system:nb_linkval(V, _)) :-
  513	chr_var(V).
  514sandbox:safe_primitive(chr:debug_event(_,_)).
  515sandbox:safe_primitive(chr:debug_interact(_,_,_)).
  516
  517chr_var(Name) :- sub_atom(Name, 0, _, _, '$chr').
  518chr_var(Name) :- sub_atom(Name, 0, _, _, 'chr').
  519
  520
  521		 /*******************************
  522		 *     SYNTAX HIGHLIGHTING	*
  523		 *******************************/
  524
  525:- multifile
  526	prolog_colour:term_colours/2,
  527	prolog_colour:goal_colours/2.  528
  529%%	term_colours(+Term, -Colours)
  530%
  531%	Colourisation of a toplevel term as read from the file.
  532
  533term_colours((_Name @ Rule), delimiter - [ identifier, RuleColours ]) :- !,
  534	term_colours(Rule, RuleColours).
  535term_colours((Rule pragma _Pragma), delimiter - [RuleColours,pragma]) :- !,
  536	term_colours(Rule, RuleColours).
  537term_colours((Head <=> Body), delimiter - [ HeadColours, BodyColours ]) :- !,
  538	chr_head(Head, HeadColours),
  539	chr_body(Body, BodyColours).
  540term_colours((Head ==> Body), delimiter - [ HeadColours, BodyColours ]) :- !,
  541	chr_head(Head, HeadColours),
  542	chr_body(Body, BodyColours).
  543
  544chr_head(_C#_Id, delimiter - [ head, identifier ]) :- !.
  545chr_head((A \ B), delimiter - [ AC, BC ]) :- !,
  546	chr_head(A, AC),
  547	chr_head(B, BC).
  548chr_head((A, B), functor - [ AC, BC ]) :- !,
  549	chr_head(A, AC),
  550	chr_head(B, BC).
  551chr_head(_, head).
  552
  553chr_body((Guard|Goal), delimiter - [ GuardColour, GoalColour ]) :- !,
  554	chr_body(Guard, GuardColour),
  555	chr_body(Goal, GoalColour).
  556chr_body(_, body).
  557
  558
  559%%	goal_colours(+Goal, -Colours)
  560%
  561%	Colouring of special goals.
  562
  563goal_colours(constraints(Decls), deprecated-[DeclColours]) :-
  564	chr_constraint_colours(Decls, DeclColours).
  565goal_colours(chr_constraint(Decls), built_in-[DeclColours]) :-
  566	chr_constraint_colours(Decls, DeclColours).
  567goal_colours(chr_type(TypeDecl), built_in-[DeclColours]) :-
  568	chr_type_decl_colours(TypeDecl, DeclColours).
  569goal_colours(chr_option(Option,Value), built_in-[OpC,ValC]) :-
  570	chr_option_colours(Option, Value, OpC, ValC).
  571
  572chr_constraint_colours(Var, instantiation_error(Var)) :-
  573	var(Var), !.
  574chr_constraint_colours((H,T), classify-[HeadColours,BodyColours]) :- !,
  575	chr_constraint_colours(H, HeadColours),
  576	chr_constraint_colours(T, BodyColours).
  577chr_constraint_colours(PI, Colours) :-
  578	pi_to_term(PI, Goal), !,
  579	Colours = predicate_indicator-[ goal(constraint(0), Goal),
  580					arity
  581				      ].
  582chr_constraint_colours(Goal, Colours) :-
  583	atom(Goal), !,
  584	Colours = goal(constraint(0), Goal).
  585chr_constraint_colours(Goal, Colours) :-
  586	compound(Goal), !,
  587	compound_name_arguments(Goal, _Name, Args),
  588	maplist(chr_argspec, Args, ArgColours),
  589	Colours = goal(constraint(0), Goal)-ArgColours.
  590
  591chr_argspec(Term, mode(Mode)-[chr_type(Type)]) :-
  592	compound(Term),
  593	compound_name_arguments(Term, Mode, [Type]),
  594	chr_mode(Mode).
  595
  596chr_mode(+).
  597chr_mode(?).
  598chr_mode(-).
  599
  600pi_to_term(Name/Arity, Term) :-
  601	atom(Name), integer(Arity), Arity >= 0, !,
  602	functor(Term, Name, Arity).
  603
  604chr_type_decl_colours((Type ---> Def), built_in-[chr_type(Type), DefColours]) :-
  605	chr_type_colours(Def, DefColours).
  606chr_type_decl_colours((Type == Alias), built_in-[chr_type(Type), chr_type(Alias)]).
  607
  608chr_type_colours(Var, classify) :-
  609	var(Var), !.
  610chr_type_colours((A;B), control-[CA,CB]) :- !,
  611	chr_type_colours(A, CA),
  612	chr_type_colours(B, CB).
  613chr_type_colours(T, chr_type(T)).
  614
  615chr_option_colours(Option, Value, identifier, ValCol) :-
  616	chr_option_range(Option, Values), !,
  617	(   nonvar(Value),
  618	    memberchk(Value, Values)
  619	->  ValCol = classify
  620	;   ValCol = error
  621	).
  622chr_option_colours(_, _, error, classify).
  623
  624chr_option_range(check_guard_bindings, [on,off]).
  625chr_option_range(optimize, [off, full]).
  626chr_option_range(debug, [on, off]).
  627
  628prolog_colour:term_colours(Term, Colours) :-
  629	term_colours(Term, Colours).
  630prolog_colour:goal_colours(Term, Colours) :-
  631	goal_colours(Term, Colours)