View source with raw 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
  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).