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    prolog:message_action/2,
  305    chr:debug_event/2,
  306    chr:debug_interact/3.  307
  308prolog:message_action(trace_mode(OnOff), _) :-
  309    (   OnOff == on
  310    ->  chr_trace
  311    ;   chr_notrace
  312    ).
  313
  314:- public
  315    debug_event/2,
  316    debug_interact/3.  317
  318%!  debug_event(+State, +Event)
  319%
  320%   Hook into the CHR debugger.  At this moment we will discard CHR
  321%   events if we are in a Prolog `skip' and we ignore the
  322
  323debug_event(_State, _Event) :-
  324    tracing,                        % are we tracing?
  325    prolog_skip_level(Skip, Skip),
  326    Skip \== very_deep,
  327    prolog_current_frame(Me),
  328    prolog_frame_attribute(Me, level, Level),
  329    Level > Skip,
  330    !.
  331
  332%!  debug_interact(+Event, +Depth, -Command)
  333%
  334%   Hook into the CHR debugger to display Event and ask for the next
  335%   command to execute. This  definition   causes  the normal Prolog
  336%   debugger to be used for the standard ports.
  337
  338debug_interact(Event, _Depth, creep) :-
  339    prolog_event(Event),
  340    tracing,
  341    !.
  342
  343prolog_event(call(_)).
  344prolog_event(exit(_)).
  345prolog_event(fail(_)).
  346
  347%!  debug_ask_continue(-Command) is semidet.
  348%
  349%   Hook to ask for a CHR debug   continuation. Must bind Command to
  350%   one of =creep=, =skip=, =ancestors=, =nodebug=, =abort=, =fail=,
  351%   =break=, =help= or =exit=.
  352
  353
  354                 /*******************************
  355                 *            MESSAGES          *
  356                 *******************************/
  357
  358:- multifile
  359    prolog:message/3.  360
  361prolog:message(chr(CHR)) -->
  362    chr_message(CHR).
  363
  364:- multifile
  365    check:trivial_fail_goal/1.  366
  367check:trivial_fail_goal(_:Goal) :-
  368    functor(Goal, Name, _),
  369    sub_atom(Name, 0, _, _, '$chr_store_constants_').
  370
  371                 /*******************************
  372                 *       TOPLEVEL PRINTING      *
  373                 *******************************/
  374
  375:- create_prolog_flag(chr_toplevel_show_store, true, []).  376
  377:- residual_goals(chr_residuals).  378
  379%!  chr_residuals// is det.
  380%
  381%   Find the CHR constraints from the   store.  These are accessible
  382%   through the nondet predicate   current_chr_constraint/1. Doing a
  383%   findall/4 however would loose the  bindings. We therefore rolled
  384%   findallv/4,  which  exploits  non-backtrackable  assignment  and
  385%   realises a copy of the template  without disturbing the bindings
  386%   using this strangely looking construct.   Note that the bindings
  387%   created by the unifications are in New,  which is newer then the
  388%   latest choicepoint and therefore the bindings are not trailed.
  389%
  390%     ==
  391%     duplicate_term(Templ, New),
  392%     New = Templ
  393%     ==
  394
  395chr_residuals(Residuals, Tail) :-
  396    chr_current_prolog_flag(chr_toplevel_show_store,true),
  397    nb_current(chr_global, _),
  398    !,
  399    Goal = _:_,
  400    findallv(Goal, current_chr_constraint(Goal), Residuals, Tail).
  401chr_residuals(Residuals, Residuals).
  402
  403:- meta_predicate
  404    findallv(?, 0, ?, ?).  405
  406findallv(Templ, Goal, List, Tail) :-
  407    List2 = [x|_],
  408    State = state(List2),
  409    (   call(Goal),
  410        arg(1, State, L),
  411        duplicate_term(Templ, New),
  412        New = Templ,
  413        Cons = [New|_],
  414        nb_linkarg(2, L, Cons),
  415        nb_linkarg(1, State, Cons),
  416        fail
  417    ;   List2 = [x|List],
  418        arg(1, State, Last),
  419        arg(2, Last, Tail)
  420    ).
  421
  422
  423                 /*******************************
  424                 *         MUST BE LAST!        *
  425                 *******************************/
  426
  427%!  in_chr_context is semidet.
  428%
  429%   True if we are expanding into  a   context  where  the chr module is
  430%   loaded.
  431
  432in_chr_context :-
  433    prolog_load_context(module, M),
  434    (   current_op(1180, xfx, M:(==>))
  435    ->  true
  436    ;   module_property(chr, exports(PIs)),
  437        member(PI, PIs),
  438        pi_head(PI, Head),
  439        predicate_property(M:Head, imported_from(chr))
  440    ->  true
  441    ).
  442
  443:- multifile system:term_expansion/2.  444:- dynamic   system:term_expansion/2.  445
  446system:term_expansion(In, Out) :-
  447    \+ current_prolog_flag(xref, true),
  448    in_chr_context,
  449    chr_expand(In, Out).
  450
  451%% SWI end
  452
  453%% SICStus begin
  454%
  455% :- dynamic
  456%       current_toplevel_show_store/1,
  457%       current_generate_debug_info/1,
  458%       current_optimize/1.
  459%
  460% current_toplevel_show_store(on).
  461%
  462% current_generate_debug_info(false).
  463%
  464% current_optimize(off).
  465%
  466% chr_current_prolog_flag(generate_debug_info, X) :-
  467%       chr_flag(generate_debug_info, X, X).
  468% chr_current_prolog_flag(optimize, X) :-
  469%       chr_flag(optimize, X, X).
  470%
  471% chr_flag(Flag, Old, New) :-
  472%       Goal = chr_flag(Flag,Old,New),
  473%       g must_be(Flag, oneof([toplevel_show_store,generate_debug_info,optimize]), Goal, 1),
  474%       chr_flag(Flag, Old, New, Goal).
  475%
  476% chr_flag(toplevel_show_store, Old, New, Goal) :-
  477%       clause(current_toplevel_show_store(Old), true, Ref),
  478%       (   New==Old -> true
  479%       ;   must_be(New, oneof([on,off]), Goal, 3),
  480%           erase(Ref),
  481%           assertz(current_toplevel_show_store(New))
  482%       ).
  483% chr_flag(generate_debug_info, Old, New, Goal) :-
  484%       clause(current_generate_debug_info(Old), true, Ref),
  485%       (   New==Old -> true
  486%       ;   must_be(New, oneof([false,true]), Goal, 3),
  487%           erase(Ref),
  488%           assertz(current_generate_debug_info(New))
  489%       ).
  490% chr_flag(optimize, Old, New, Goal) :-
  491%       clause(current_optimize(Old), true, Ref),
  492%       (   New==Old -> true
  493%       ;   must_be(New, oneof([full,off]), Goal, 3),
  494%           erase(Ref),
  495%           assertz(current_optimize(New))
  496%       ).
  497%
  498%
  499% all_stores_goal(Goal, CVAs) :-
  500%       chr_flag(toplevel_show_store, on, on), !,
  501%       findall(C-CVAs, find_chr_constraint(C), Pairs),
  502%       andify(Pairs, Goal, CVAs).
  503% all_stores_goal(true, _).
  504%
  505% andify([], true, _).
  506% andify([X-Vs|L], Conj, Vs) :- andify(L, X, Conj, Vs).
  507%
  508% andify([], X, X, _).
  509% andify([Y-Vs|L], X, (X,Conj), Vs) :- andify(L, Y, Conj, Vs).
  510%
  511% :- multifile user:term_expansion/6.
  512%
  513% user:term_expansion(In, _, Ids, Out, [], [chr|Ids]) :-
  514%       nonvar(In),
  515%       nonmember(chr, Ids),
  516%       chr_expand(In, Out), !.
  517%
  518%% SICStus end
  519
  520%%% for SSS %%%
  521
  522add_pragma_to_chr_rule((Name @ Rule), Pragma, Result) :-
  523    !,
  524    add_pragma_to_chr_rule(Rule,Pragma,NRule),
  525    Result = (Name @ NRule).
  526add_pragma_to_chr_rule((Rule pragma Pragmas), Pragma, Result) :-
  527    !,
  528    Result = (Rule pragma (Pragma,Pragmas)).
  529add_pragma_to_chr_rule((Head ==> Body), Pragma, Result) :-
  530    !,
  531    Result = (Head ==> Body pragma Pragma).
  532add_pragma_to_chr_rule((Head <=> Body), Pragma, Result) :-
  533    !,
  534    Result = (Head <=> Body pragma Pragma).
  535add_pragma_to_chr_rule(Term,_,Term).
  536
  537
  538                 /*******************************
  539                 *        SANDBOX SUPPORT       *
  540                 *******************************/
  541
  542:- multifile
  543    sandbox:safe_primitive/1.  544
  545% CHR uses a lot of global variables. We   don't  really mind as long as
  546% the user does not mess around  with   global  variable that may have a
  547% predefined meaning.
  548
  549sandbox:safe_primitive(system:b_setval(V, _)) :-
  550    chr_var(V).
  551sandbox:safe_primitive(system:nb_linkval(V, _)) :-
  552    chr_var(V).
  553sandbox:safe_primitive(chr:debug_event(_,_)).
  554sandbox:safe_primitive(chr:debug_interact(_,_,_)).
  555
  556chr_var(Name) :- sub_atom(Name, 0, _, _, '$chr').
  557chr_var(Name) :- sub_atom(Name, 0, _, _, 'chr').
  558
  559
  560                 /*******************************
  561                 *     SYNTAX HIGHLIGHTING      *
  562                 *******************************/
  563
  564:- multifile
  565    prolog_colour:term_colours/2,
  566    prolog_colour:goal_colours/2.  567
  568%!  term_colours(+Term, -Colours)
  569%
  570%   Colourisation of a toplevel term as read from the file.
  571
  572term_colours((_Name @ Rule), delimiter - [ identifier, RuleColours ]) :-
  573    !,
  574    term_colours(Rule, RuleColours).
  575term_colours((Rule pragma _Pragma), delimiter - [RuleColours,pragma]) :-
  576    !,
  577    term_colours(Rule, RuleColours).
  578term_colours((Head <=> Body), delimiter - [ HeadColours, BodyColours ]) :-
  579    !,
  580    chr_head(Head, HeadColours),
  581    chr_body(Body, BodyColours).
  582term_colours((Head ==> Body), delimiter - [ HeadColours, BodyColours ]) :-
  583    !,
  584    chr_head(Head, HeadColours),
  585    chr_body(Body, BodyColours).
  586
  587chr_head(_C#_Id, delimiter - [ head, identifier ]) :- !.
  588chr_head((A \ B), delimiter - [ AC, BC ]) :-
  589    !,
  590    chr_head(A, AC),
  591    chr_head(B, BC).
  592chr_head((A, B), functor - [ AC, BC ]) :-
  593    !,
  594    chr_head(A, AC),
  595    chr_head(B, BC).
  596chr_head(_, head).
  597
  598chr_body((Guard|Goal), delimiter - [ GuardColour, GoalColour ]) :-
  599    !,
  600    chr_body(Guard, GuardColour),
  601    chr_body(Goal, GoalColour).
  602chr_body(_, body).
  603
  604
  605%!  goal_colours(+Goal, -Colours)
  606%
  607%   Colouring of special goals.
  608
  609goal_colours(constraints(Decls), deprecated-[DeclColours]) :-
  610    chr_constraint_colours(Decls, DeclColours).
  611goal_colours(chr_constraint(Decls), built_in-[DeclColours]) :-
  612    chr_constraint_colours(Decls, DeclColours).
  613goal_colours(chr_type(TypeDecl), built_in-[DeclColours]) :-
  614    chr_type_decl_colours(TypeDecl, DeclColours).
  615goal_colours(chr_option(Option,Value), built_in-[OpC,ValC]) :-
  616    chr_option_colours(Option, Value, OpC, ValC).
  617
  618chr_constraint_colours(Var, instantiation_error(Var)) :-
  619    var(Var),
  620    !.
  621chr_constraint_colours((H,T), classify-[HeadColours,BodyColours]) :-
  622    !,
  623    chr_constraint_colours(H, HeadColours),
  624    chr_constraint_colours(T, BodyColours).
  625chr_constraint_colours(PI, Colours) :-
  626    pi_to_term(PI, Goal),
  627    !,
  628    Colours = predicate_indicator-[ goal(constraint(0), Goal),
  629                                    arity
  630                                  ].
  631chr_constraint_colours(Goal, Colours) :-
  632    atom(Goal),
  633    !,
  634    Colours = goal(constraint(0), Goal).
  635chr_constraint_colours(Goal, Colours) :-
  636    compound(Goal),
  637    !,
  638    compound_name_arguments(Goal, _Name, Args),
  639    maplist(chr_argspec, Args, ArgColours),
  640    Colours = goal(constraint(0), Goal)-ArgColours.
  641
  642chr_argspec(Term, mode(Mode)-[chr_type(Type)]) :-
  643    compound(Term),
  644    compound_name_arguments(Term, Mode, [Type]),
  645    chr_mode(Mode).
  646
  647chr_mode(+).
  648chr_mode(?).
  649chr_mode(-).
  650
  651pi_to_term(Name/Arity, Term) :-
  652    atom(Name), integer(Arity), Arity >= 0,
  653    !,
  654    functor(Term, Name, Arity).
  655
  656chr_type_decl_colours((Type ---> Def), built_in-[chr_type(Type), DefColours]) :-
  657    chr_type_colours(Def, DefColours).
  658chr_type_decl_colours((Type == Alias), built_in-[chr_type(Type), chr_type(Alias)]).
  659
  660chr_type_colours(Var, classify) :-
  661    var(Var),
  662    !.
  663chr_type_colours((A;B), control-[CA,CB]) :-
  664    !,
  665    chr_type_colours(A, CA),
  666    chr_type_colours(B, CB).
  667chr_type_colours(T, chr_type(T)).
  668
  669chr_option_colours(Option, Value, identifier, ValCol) :-
  670    chr_option_range(Option, Values),
  671    !,
  672    (   nonvar(Value),
  673        memberchk(Value, Values)
  674    ->  ValCol = classify
  675    ;   ValCol = error
  676    ).
  677chr_option_colours(_, _, error, classify).
  678
  679chr_option_range(check_guard_bindings, [on,off]).
  680chr_option_range(optimize, [off, full]).
  681chr_option_range(debug, [on, off]).
  682
  683prolog_colour:term_colours(Term, Colours) :-
  684    term_colours(Term, Colours).
  685prolog_colour:goal_colours(Term, Colours) :-
  686    goal_colours(Term, Colours)