View source with formatted comments or as raw
    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:- use_module(library(dialect), [expects_dialect/1]).   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,Source),
  178	prolog_load_context(source,File),
  179	prolog_load_context(term_position,Pos),
  180	stream_position_data(line_count,Pos,SourceLocation),
  181	add_pragma_to_chr_rule(Term,source_location(File:SourceLocation),NTerm),
  182	assert(chr_term(Source, SourceLocation, NTerm)).
  183chr_expand(Term, []) :-
  184	Term = (:- chr_preprocessor Preprocessor), !,
  185	prolog_load_context(source,File),
  186	assert(chr_pp(File, Preprocessor)).
  187chr_expand(end_of_file, FinalProgram) :-
  188	extra_declarations(FinalProgram,Program),
  189	prolog_load_context(source,File),
  190	findall(T, retract(chr_term(File,_Line,T)), CHR0),
  191	CHR0 \== [],
  192	prolog_load_context(module, Module),
  193	add_debug_decl(CHR0, CHR1),
  194	add_optimise_decl(CHR1, CHR2),
  195	call_preprocess(CHR2, CHR3),
  196	CHR4 = [ (:- module(Module, [])) | CHR3 ],
  197	findall(P, retract(chr_pp(File, P)), Preprocessors),
  198	( Preprocessors = [] ->
  199		CHR4 = CHR
  200	; Preprocessors = [Preprocessor] ->
  201		chr_compiler_errors:chr_info(preprocessor,'\tPreprocessing with ~w.\n',[Preprocessor]),
  202		call_chr_preprocessor(Preprocessor,CHR4,CHR)
  203	;
  204		chr_compiler_errors:print_chr_error(error(syntax(Preprocessors),'Too many preprocessors! Only one is allowed!\n',[])),
  205		fail
  206	),
  207	catch(call_chr_translate(File,
  208			   [ (:- module(Module, []))
  209			   | CHR
  210			   ],
  211			   Program0),
  212		chr_error(Error),
  213		(	chr_compiler_errors:print_chr_error(Error),
  214			fail
  215		)
  216	),
  217	delete_header(Program0, Program).
  218
  219
  220delete_header([(:- module(_,_))|T0], T) :- !,
  221	delete_header(T0, T).
  222delete_header(L, L).
  223
  224add_debug_decl(CHR, CHR) :-
  225	member(option(Name, _), CHR), Name == debug, !.
  226add_debug_decl(CHR, CHR) :-
  227	member((:- chr_option(Name, _)), CHR), Name == debug, !.
  228add_debug_decl(CHR, [(:- chr_option(debug, Debug))|CHR]) :-
  229	(   chr_current_prolog_flag(generate_debug_info, true)
  230	->  Debug = on
  231	;   Debug = off
  232	).
  233
  234%% SWI begin
  235chr_current_prolog_flag(Flag,Val) :- current_prolog_flag(Flag,Val).
  236%% SWI end
  237
  238add_optimise_decl(CHR, CHR) :-
  239	\+(\+(memberchk((:- chr_option(optimize, _)), CHR))), !.
  240add_optimise_decl(CHR, [(:- chr_option(optimize, full))|CHR]) :-
  241	chr_current_prolog_flag(optimize, full), !.
  242add_optimise_decl(CHR, CHR).
  243
  244%%	call_preprocess(+CHR0, -CHR) is det.
  245%
  246%	Call user chr:preprocess(CHR0, CHR).
  247
  248call_preprocess(CHR0, CHR) :-
  249	preprocess(CHR0, CHR), !.
  250call_preprocess(CHR, CHR).
  251
  252%	call_chr_translate(+File, +In, -Out)
  253%
  254%	The entire chr_translate/2 translation may fail, in which case we'd
  255%	better issue a warning  rather  than   simply  ignoring  the CHR
  256%	declarations.
  257
  258call_chr_translate(File, In, _Out) :-
  259	( chr_translate_line_info(In, File, Out0) ->
  260	    nb_setval(chr_translated_program,Out0),
  261	    fail
  262	).
  263call_chr_translate(_, _In, Out) :-
  264	nb_current(chr_translated_program,Out), !,
  265	nb_delete(chr_translated_program).
  266
  267call_chr_translate(File, _, []) :-
  268	print_message(error, chr(compilation_failed(File))).
  269
  270call_chr_preprocessor(Preprocessor,CHR,_NCHR) :-
  271	( call(Preprocessor,CHR,CHR0) ->
  272		nb_setval(chr_preprocessed_program,CHR0),
  273		fail
  274	).
  275call_chr_preprocessor(_,_,NCHR)	:-
  276	nb_current(chr_preprocessed_program,NCHR), !,
  277	nb_delete(chr_preprocessed_program).
  278call_chr_preprocessor(Preprocessor,_,_) :-
  279	chr_compiler_errors:print_chr_error(error(preprocessor,'Preprocessor `~w\' failed!\n',[Preprocessor])).
  280
  281%% SWI begin
  282
  283		 /*******************************
  284		 *      SYNCHRONISE TRACER	*
  285		 *******************************/
  286
  287:- multifile
  288	user:message_hook/3,
  289	chr:debug_event/2,
  290	chr:debug_interact/3.  291:- dynamic
  292	user:message_hook/3.  293
  294user:message_hook(trace_mode(OnOff), _, _) :-
  295	(   OnOff == on
  296	->  chr_trace
  297	;   chr_notrace
  298	),
  299	fail.				% backtrack to other handlers
  300
  301:- public
  302	debug_event/2,
  303	debug_interact/3.  304
  305%%	debug_event(+State, +Event)
  306%
  307%	Hook into the CHR debugger.  At this moment we will discard CHR
  308%	events if we are in a Prolog `skip' and we ignore the
  309
  310debug_event(_State, _Event) :-
  311	tracing,			% are we tracing?
  312	prolog_skip_level(Skip, Skip),
  313	Skip \== very_deep,
  314	prolog_current_frame(Me),
  315	prolog_frame_attribute(Me, level, Level),
  316	Level > Skip, !.
  317
  318%%	debug_interact(+Event, +Depth, -Command)
  319%
  320%	Hook into the CHR debugger to display Event and ask for the next
  321%	command to execute. This  definition   causes  the normal Prolog
  322%	debugger to be used for the standard ports.
  323
  324debug_interact(Event, _Depth, creep) :-
  325	prolog_event(Event),
  326	tracing, !.
  327
  328prolog_event(call(_)).
  329prolog_event(exit(_)).
  330prolog_event(fail(_)).
  331
  332%%	debug_ask_continue(-Command) is semidet.
  333%
  334%	Hook to ask for a CHR debug   continuation. Must bind Command to
  335%	one of =creep=, =skip=, =ancestors=, =nodebug=, =abort=, =fail=,
  336%	=break=, =help= or =exit=.
  337
  338
  339		 /*******************************
  340		 *	      MESSAGES		*
  341		 *******************************/
  342
  343:- multifile
  344	prolog:message/3.  345
  346prolog:message(chr(CHR)) -->
  347	chr_message(CHR).
  348
  349:- multifile
  350        check:trivial_fail_goal/1.  351
  352check:trivial_fail_goal(_:Goal) :-
  353        functor(Goal, Name, _),
  354        sub_atom(Name, 0, _, _, '$chr_store_constants_').
  355
  356		 /*******************************
  357		 *	 TOPLEVEL PRINTING	*
  358		 *******************************/
  359
  360:- create_prolog_flag(chr_toplevel_show_store, true, []).  361
  362:- residual_goals(chr_residuals).  363
  364%%	chr_residuals// is det.
  365%
  366%	Find the CHR constraints from the   store.  These are accessible
  367%	through the nondet predicate   current_chr_constraint/1. Doing a
  368%	findall/4 however would loose the  bindings. We therefore rolled
  369%	findallv/4,  which  exploits  non-backtrackable  assignment  and
  370%	realises a copy of the template  without disturbing the bindings
  371%	using this strangely looking construct.   Note that the bindings
  372%	created by the unifications are in New,  which is newer then the
  373%	latest choicepoint and therefore the bindings are not trailed.
  374%
  375%	  ==
  376%	  duplicate_term(Templ, New),
  377%	  New = Templ
  378%	  ==
  379
  380chr_residuals(Residuals, Tail) :-
  381	chr_current_prolog_flag(chr_toplevel_show_store,true),
  382	nb_current(chr_global, _), !,
  383	Goal = _:_,
  384	findallv(Goal, current_chr_constraint(Goal), Residuals, Tail).
  385chr_residuals(Residuals, Residuals).
  386
  387:- meta_predicate
  388	findallv(?, 0, ?, ?).  389
  390findallv(Templ, Goal, List, Tail) :-
  391	List2 = [x|_],
  392	State = state(List2),
  393	(   call(Goal),
  394	    arg(1, State, L),
  395	    duplicate_term(Templ, New),
  396	    New = Templ,
  397	    Cons = [New|_],
  398	    nb_linkarg(2, L, Cons),
  399	    nb_linkarg(1, State, Cons),
  400	    fail
  401	;   List2 = [x|List],
  402	    arg(1, State, Last),
  403	    arg(2, Last, Tail)
  404	).
  405
  406
  407		 /*******************************
  408		 *	   MUST BE LAST!	*
  409		 *******************************/
  410
  411:- multifile system:term_expansion/2.  412:- dynamic   system:term_expansion/2.  413
  414system:term_expansion(In, Out) :-
  415	\+ current_prolog_flag(xref, true),
  416	chr_expand(In, Out).
  417%% SWI end
  418
  419%% SICStus begin
  420%
  421% :- dynamic
  422%	current_toplevel_show_store/1,
  423%	current_generate_debug_info/1,
  424%	current_optimize/1.
  425%
  426% current_toplevel_show_store(on).
  427%
  428% current_generate_debug_info(false).
  429%
  430% current_optimize(off).
  431%
  432% chr_current_prolog_flag(generate_debug_info, X) :-
  433%	chr_flag(generate_debug_info, X, X).
  434% chr_current_prolog_flag(optimize, X) :-
  435%	chr_flag(optimize, X, X).
  436%
  437% chr_flag(Flag, Old, New) :-
  438%	Goal = chr_flag(Flag,Old,New),
  439%	g must_be(Flag, oneof([toplevel_show_store,generate_debug_info,optimize]), Goal, 1),
  440%	chr_flag(Flag, Old, New, Goal).
  441%
  442% chr_flag(toplevel_show_store, Old, New, Goal) :-
  443%	clause(current_toplevel_show_store(Old), true, Ref),
  444%	(   New==Old -> true
  445%	;   must_be(New, oneof([on,off]), Goal, 3),
  446%	    erase(Ref),
  447%	    assertz(current_toplevel_show_store(New))
  448%	).
  449% chr_flag(generate_debug_info, Old, New, Goal) :-
  450%	clause(current_generate_debug_info(Old), true, Ref),
  451%	(   New==Old -> true
  452%	;   must_be(New, oneof([false,true]), Goal, 3),
  453%	    erase(Ref),
  454%	    assertz(current_generate_debug_info(New))
  455%	).
  456% chr_flag(optimize, Old, New, Goal) :-
  457%	clause(current_optimize(Old), true, Ref),
  458%	(   New==Old -> true
  459%	;   must_be(New, oneof([full,off]), Goal, 3),
  460%	    erase(Ref),
  461%	    assertz(current_optimize(New))
  462%	).
  463%
  464%
  465% all_stores_goal(Goal, CVAs) :-
  466%	chr_flag(toplevel_show_store, on, on), !,
  467%	findall(C-CVAs, find_chr_constraint(C), Pairs),
  468%	andify(Pairs, Goal, CVAs).
  469% all_stores_goal(true, _).
  470%
  471% andify([], true, _).
  472% andify([X-Vs|L], Conj, Vs) :- andify(L, X, Conj, Vs).
  473%
  474% andify([], X, X, _).
  475% andify([Y-Vs|L], X, (X,Conj), Vs) :- andify(L, Y, Conj, Vs).
  476%
  477% :- multifile user:term_expansion/6.
  478%
  479% user:term_expansion(In, _, Ids, Out, [], [chr|Ids]) :-
  480%	nonvar(In),
  481%	nonmember(chr, Ids),
  482%	chr_expand(In, Out), !.
  483%
  484%% SICStus end
  485
  486%%% for SSS %%%
  487
  488add_pragma_to_chr_rule((Name @ Rule), Pragma, Result) :- !,
  489	add_pragma_to_chr_rule(Rule,Pragma,NRule),
  490	Result = (Name @ NRule).
  491add_pragma_to_chr_rule((Rule pragma Pragmas), Pragma, Result) :- !,
  492	Result = (Rule pragma (Pragma,Pragmas)).
  493add_pragma_to_chr_rule((Head ==> Body), Pragma, Result) :- !,
  494	Result = (Head ==> Body pragma Pragma).
  495add_pragma_to_chr_rule((Head <=> Body), Pragma, Result) :- !,
  496	Result = (Head <=> Body pragma Pragma).
  497add_pragma_to_chr_rule(Term,_,Term).
  498
  499
  500		 /*******************************
  501		 *	  SANDBOX SUPPORT	*
  502		 *******************************/
  503
  504:- multifile
  505	sandbox:safe_primitive/1.  506
  507% CHR uses a lot of global variables. We   don't  really mind as long as
  508% the user does not mess around  with   global  variable that may have a
  509% predefined meaning.
  510
  511sandbox:safe_primitive(system:b_setval(V, _)) :-
  512	chr_var(V).
  513sandbox:safe_primitive(system:nb_linkval(V, _)) :-
  514	chr_var(V).
  515sandbox:safe_primitive(chr:debug_event(_,_)).
  516sandbox:safe_primitive(chr:debug_interact(_,_,_)).
  517
  518chr_var(Name) :- sub_atom(Name, 0, _, _, '$chr').
  519chr_var(Name) :- sub_atom(Name, 0, _, _, 'chr').
  520
  521
  522		 /*******************************
  523		 *     SYNTAX HIGHLIGHTING	*
  524		 *******************************/
  525
  526:- multifile
  527	prolog_colour:term_colours/2,
  528	prolog_colour:goal_colours/2.  529
  530%%	term_colours(+Term, -Colours)
  531%
  532%	Colourisation of a toplevel term as read from the file.
  533
  534term_colours((_Name @ Rule), delimiter - [ identifier, RuleColours ]) :- !,
  535	term_colours(Rule, RuleColours).
  536term_colours((Rule pragma _Pragma), delimiter - [RuleColours,pragma]) :- !,
  537	term_colours(Rule, RuleColours).
  538term_colours((Head <=> Body), delimiter - [ HeadColours, BodyColours ]) :- !,
  539	chr_head(Head, HeadColours),
  540	chr_body(Body, BodyColours).
  541term_colours((Head ==> Body), delimiter - [ HeadColours, BodyColours ]) :- !,
  542	chr_head(Head, HeadColours),
  543	chr_body(Body, BodyColours).
  544
  545chr_head(_C#_Id, delimiter - [ head, identifier ]) :- !.
  546chr_head((A \ B), delimiter - [ AC, BC ]) :- !,
  547	chr_head(A, AC),
  548	chr_head(B, BC).
  549chr_head((A, B), functor - [ AC, BC ]) :- !,
  550	chr_head(A, AC),
  551	chr_head(B, BC).
  552chr_head(_, head).
  553
  554chr_body((Guard|Goal), delimiter - [ GuardColour, GoalColour ]) :- !,
  555	chr_body(Guard, GuardColour),
  556	chr_body(Goal, GoalColour).
  557chr_body(_, body).
  558
  559
  560%%	goal_colours(+Goal, -Colours)
  561%
  562%	Colouring of special goals.
  563
  564goal_colours(constraints(Decls), deprecated-[DeclColours]) :-
  565	chr_constraint_colours(Decls, DeclColours).
  566goal_colours(chr_constraint(Decls), built_in-[DeclColours]) :-
  567	chr_constraint_colours(Decls, DeclColours).
  568goal_colours(chr_type(TypeDecl), built_in-[DeclColours]) :-
  569	chr_type_decl_colours(TypeDecl, DeclColours).
  570goal_colours(chr_option(Option,Value), built_in-[OpC,ValC]) :-
  571	chr_option_colours(Option, Value, OpC, ValC).
  572
  573chr_constraint_colours(Var, instantiation_error(Var)) :-
  574	var(Var), !.
  575chr_constraint_colours((H,T), classify-[HeadColours,BodyColours]) :- !,
  576	chr_constraint_colours(H, HeadColours),
  577	chr_constraint_colours(T, BodyColours).
  578chr_constraint_colours(PI, Colours) :-
  579	pi_to_term(PI, Goal), !,
  580	Colours = predicate_indicator-[ goal(constraint(0), Goal),
  581					arity
  582				      ].
  583chr_constraint_colours(Goal, Colours) :-
  584	atom(Goal), !,
  585	Colours = goal(constraint(0), Goal).
  586chr_constraint_colours(Goal, Colours) :-
  587	compound(Goal), !,
  588	compound_name_arguments(Goal, _Name, Args),
  589	maplist(chr_argspec, Args, ArgColours),
  590	Colours = goal(constraint(0), Goal)-ArgColours.
  591
  592chr_argspec(Term, mode(Mode)-[chr_type(Type)]) :-
  593	compound(Term),
  594	compound_name_arguments(Term, Mode, [Type]),
  595	chr_mode(Mode).
  596
  597chr_mode(+).
  598chr_mode(?).
  599chr_mode(-).
  600
  601pi_to_term(Name/Arity, Term) :-
  602	atom(Name), integer(Arity), Arity >= 0, !,
  603	functor(Term, Name, Arity).
  604
  605chr_type_decl_colours((Type ---> Def), built_in-[chr_type(Type), DefColours]) :-
  606	chr_type_colours(Def, DefColours).
  607chr_type_decl_colours((Type == Alias), built_in-[chr_type(Type), chr_type(Alias)]).
  608
  609chr_type_colours(Var, classify) :-
  610	var(Var), !.
  611chr_type_colours((A;B), control-[CA,CB]) :- !,
  612	chr_type_colours(A, CA),
  613	chr_type_colours(B, CB).
  614chr_type_colours(T, chr_type(T)).
  615
  616chr_option_colours(Option, Value, identifier, ValCol) :-
  617	chr_option_range(Option, Values), !,
  618	(   nonvar(Value),
  619	    memberchk(Value, Values)
  620	->  ValCol = classify
  621	;   ValCol = error
  622	).
  623chr_option_colours(_, _, error, classify).
  624
  625chr_option_range(check_guard_bindings, [on,off]).
  626chr_option_range(optimize, [off, full]).
  627chr_option_range(debug, [on, off]).
  628
  629prolog_colour:term_colours(Term, Colours) :-
  630	term_colours(Term, Colours).
  631prolog_colour:goal_colours(Term, Colours) :-
  632	goal_colours(Term, Colours)