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