/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@vu.nl
WWW: http://www.swi-prolog.org/projects/xpce/
Copyright (c) 2011-2021, University of Amsterdam
VU University Amsterdam
CWI, Amsterdam
SWI-Prolog Solutions b.v.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
*/
:- module(prolog_colour,
[ prolog_colourise_stream/3, % +Stream, +SourceID, :ColourItem
prolog_colourise_stream/4, % +Stream, +SourceID, :ColourItem, +Opts
prolog_colourise_term/4, % +Stream, +SourceID, :ColourItem, +Opts
prolog_colourise_query/3, % +String, +SourceID, :ColourItem
syntax_colour/2, % +Class, -Attributes
syntax_message//1 % +Class
]).
:- use_module(library(record),[(record)/1, op(_,_,record)]).
:- autoload(library(apply),[maplist/3]).
:- autoload(library(debug),[debug/3]).
:- autoload(library(error),[is_of_type/2]).
:- autoload(library(lists),[member/2,append/3]).
:- autoload(library(operators),
[push_operators/1,pop_operators/0,push_op/3]).
:- autoload(library(option),[option/3]).
:- autoload(library(predicate_options),
[current_option_arg/2,current_predicate_options/3]).
:- autoload(library(prolog_clause),[predicate_name/2]).
:- autoload(library(prolog_source),
[ load_quasi_quotation_syntax/2,
read_source_term_at_location/3,
prolog_canonical_source/2
]).
:- autoload(library(prolog_xref),
[ xref_option/2,
xref_public_list/3,
xref_op/2,
xref_prolog_flag/4,
xref_module/2,
xref_meta/3,
xref_source_file/4,
xref_defined/3,
xref_called/3,
xref_defined_class/3,
xref_exported/2,
xref_hook/1
]).
:- meta_predicate
prolog_colourise_stream(+, +, 3),
prolog_colourise_stream(+, +, 3, +),
prolog_colourise_query(+, +, 3),
prolog_colourise_term(+, +, 3, +).
:- predicate_options(prolog_colourise_term/4, 4,
[ subterm_positions(-any)
]).
:- predicate_options(prolog_colourise_stream/4, 4,
[ operators(list(any))
]).
/** <module> Prolog syntax colouring support.
This module defines reusable code to colourise Prolog source.
@tbd: The one-term version
*/
:- multifile
style/2, % +ColourClass, -Attributes
message//1, % +ColourClass
term_colours/2, % +SourceTerm, -ColourSpec
goal_colours/2, % +Goal, -ColourSpec
goal_colours/3, % +Goal, +Class, -ColourSpec
directive_colours/2, % +Goal, -ColourSpec
goal_classification/2, % +Goal, -Class
vararg_goal_classification/3. % +Name, +Arity, -Class
:- record
colour_state(source_id_list,
module,
stream,
closure,
singletons).
colour_state_source_id(State, SourceID) :-
colour_state_source_id_list(State, SourceIDList),
member(SourceID, SourceIDList).
%! prolog_colourise_stream(+Stream, +SourceID, :ColourItem) is det.
%! prolog_colourise_stream(+Stream, +SourceID, :ColourItem, +Opts) is det.
%
% Determine colour fragments for the data on Stream. SourceID is
% the canonical identifier of the input as known to the
% cross-referencer, i.e., as created using xref_source(SourceID).
%
% ColourItem is a closure that is called for each identified
% fragment with three additional arguments:
%
% * The syntactical category
% * Start position (character offset) of the fragment
% * Length of the fragment (in characters).
%
% Options
%
% - operators(+Ops)
% Provide an initial list of additional operators.
prolog_colourise_stream(Fd, SourceId, ColourItem) :-
prolog_colourise_stream(Fd, SourceId, ColourItem, []).
prolog_colourise_stream(Fd, SourceId, ColourItem, Options) :-
to_list(SourceId, SourceIdList),
make_colour_state([ source_id_list(SourceIdList),
stream(Fd),
closure(ColourItem)
],
TB),
option(operators(Ops), Options, []),
setup_call_cleanup(
save_settings(TB, Ops, State),
colourise_stream(Fd, TB),
restore_settings(State)).
to_list(List, List) :-
is_list(List),
!.
to_list(One, [One]).
colourise_stream(Fd, TB) :-
( peek_char(Fd, #) % skip #! script line
-> skip(Fd, 10)
; true
),
repeat,
colour_state_module(TB, SM),
character_count(Fd, Start),
catch(read_term(Fd, Term,
[ subterm_positions(TermPos),
singletons(Singletons0),
module(SM),
comments(Comments)
]),
E,
read_error(E, TB, Start, Fd)),
fix_operators(Term, SM, TB),
warnable_singletons(Singletons0, Singletons),
colour_state_singletons(TB, Singletons),
( colourise_term(Term, TB, TermPos, Comments)
-> true
; arg(1, TermPos, From),
print_message(warning,
format('Failed to colourise ~p at index ~d~n',
[Term, From]))
),
Term == end_of_file,
!.
save_settings(TB, Ops, state(Style, Flags, OSM, Xref)) :-
( source_module(TB, SM)
-> true
; SM = prolog_colour_ops
),
set_xref(Xref, true),
'$set_source_module'(OSM, SM),
colour_state_module(TB, SM),
maplist(qualify_op(SM), Ops, QOps),
push_operators(QOps),
syntax_flags(Flags),
'$style_check'(Style, Style).
qualify_op(M, op(P,T,N), op(P,T,M:N)) :-
atom(N), !.
qualify_op(M, op(P,T,L), op(P,T,QL)) :-
is_list(L), !,
maplist(qualify_op_name(M), L, QL).
qualify_op(_, Op, Op).
qualify_op_name(M, N, M:N) :-
atom(N),
!.
qualify_op_name(_, N, N).
restore_settings(state(Style, Flags, OSM, Xref)) :-
restore_syntax_flags(Flags),
'$style_check'(_, Style),
pop_operators,
'$set_source_module'(OSM),
set_xref(_, Xref).
set_xref(Old, New) :-
current_prolog_flag(xref, Old),
!,
set_prolog_flag(xref, New).
set_xref(false, New) :-
set_prolog_flag(xref, New).
syntax_flags(Pairs) :-
findall(set_prolog_flag(Flag, Value),
syntax_flag(Flag, Value),
Pairs).
syntax_flag(Flag, Value) :-
syntax_flag(Flag),
current_prolog_flag(Flag, Value).
restore_syntax_flags([]).
restore_syntax_flags([set_prolog_flag(Flag, Value)|T]) :-
set_prolog_flag(Flag, Value),
restore_syntax_flags(T).
%! source_module(+State, -Module) is semidet.
%
% True when Module is the module context into which the file is
% loaded. This is the module of the file if File is a module file,
% or the load context of File if File is not included or the
% module context of the file into which the file was included.
source_module(TB, Module) :-
colour_state_source_id_list(TB, []),
!,
colour_state_module(TB, Module).
source_module(TB, Module) :-
colour_state_source_id(TB, SourceId),
xref_option(SourceId, module(Module)),
!.
source_module(TB, Module) :-
( colour_state_source_id(TB, File),
atom(File)
; colour_state_stream(TB, Fd),
is_stream(Fd),
stream_property(Fd, file_name(File))
),
module_context(File, [], Module).
module_context(File, _, Module) :-
source_file_property(File, module(Module)),
!.
module_context(File, Seen, Module) :-
source_file_property(File, included_in(File2, _Line)),
\+ memberchk(File, Seen),
!,
module_context(File2, [File|Seen], Module).
module_context(File, _, Module) :-
source_file_property(File, load_context(Module, _, _)).
%! read_error(+Error, +TB, +Start, +Stream) is failure.
%
% If this is a syntax error, create a syntax-error fragment.
read_error(Error, TB, Start, EndSpec) :-
( syntax_error(Error, Id, CharNo)
-> message_to_string(error(syntax_error(Id), _), Msg),
( integer(EndSpec)
-> End = EndSpec
; character_count(EndSpec, End)
),
show_syntax_error(TB, CharNo:Msg, Start-End),
fail
; throw(Error)
).
syntax_error(error(syntax_error(Id), stream(_S, _Line, _LinePos, CharNo)),
Id, CharNo).
syntax_error(error(syntax_error(Id), file(_S, _Line, _LinePos, CharNo)),
Id, CharNo).
syntax_error(error(syntax_error(Id), string(_Text, CharNo)),
Id, CharNo).
%! warnable_singletons(+Singletons, -Warn) is det.
%
% Warn is the subset of the singletons that we warn about.
warnable_singletons([], []).
warnable_singletons([H|T0], List) :-
H = (Name=_Var),
( '$is_named_var'(Name)
-> List = [H|T]
; List = T
),
warnable_singletons(T0, T).
%! colour_item(+Class, +TB, +Pos) is det.
colour_item(Class, TB, Pos) :-
arg(1, Pos, Start),
arg(2, Pos, End),
Len is End - Start,
colour_state_closure(TB, Closure),
call(Closure, Class, Start, Len).
%! safe_push_op(+Prec, +Type, :Name, +State)
%
% Define operators into the default source module and register
% them to be undone by pop_operators/0.
safe_push_op(P, T, N0, State) :-
colour_state_module(State, CM),
strip_module(CM:N0, M, N),
( is_list(N),
N \== [] % define list as operator
-> acyclic_term(N),
forall(member(Name, N),
safe_push_op(P, T, M:Name, State))
; push_op(P, T, M:N)
),
debug(colour, ':- ~w.', [op(P,T,M:N)]).
%! fix_operators(+Term, +Module, +State) is det.
%
% Fix flags that affect the syntax, such as operators and some
% style checking options. Src is the canonical source as required
% by the cross-referencer.
fix_operators((:- Directive), M, Src) :-
ground(Directive),
catch(process_directive(Directive, M, Src), _, true),
!.
fix_operators(_, _, _).
:- multifile
prolog:xref_update_syntax/2.
process_directive(Directive, M, _Src) :-
prolog:xref_update_syntax(Directive, M),
!.
process_directive(style_check(X), _, _) :-
!,
style_check(X).
process_directive(set_prolog_flag(Flag, Value), M, _) :-
syntax_flag(Flag),
!,
set_prolog_flag(M:Flag, Value).
process_directive(M:op(P,T,N), _, Src) :-
!,
process_directive(op(P,T,N), M, Src).
process_directive(op(P,T,N), M, Src) :-
!,
safe_push_op(P, T, M:N, Src).
process_directive(module(_Name, Export), M, Src) :-
!,
forall(member(op(P,A,N), Export),
safe_push_op(P,A,M:N, Src)).
process_directive(use_module(Spec), _, Src) :-
!,
catch(process_use_module1(Spec, Src), _, true).
process_directive(use_module(Spec, Imports), _, Src) :-
!,
catch(process_use_module2(Spec, Imports, Src), _, true).
process_directive(Directive, _, Src) :-
prolog_source:expand((:-Directive), Src, _).
syntax_flag(character_escapes).
syntax_flag(var_prefix).
syntax_flag(allow_variable_name_as_functor).
syntax_flag(allow_dot_in_atom).
%! process_use_module1(+Imports, +Src)
%
% Get the exported operators from the referenced files.
process_use_module1([], _) :- !.
process_use_module1([H|T], Src) :-
!,
process_use_module1(H, Src),
process_use_module1(T, Src).
process_use_module1(File, Src) :-
( xref_public_list(File, Src,
[ exports(Exports),
silent(true),
path(Path)
])
-> forall(member(op(P,T,N), Exports),
safe_push_op(P,T,N,Src)),
colour_state_module(Src, SM),
( member(Syntax/4, Exports),
load_quasi_quotation_syntax(SM:Path, Syntax),
fail
; true
)
; true
).
process_use_module2(File, Imports, Src) :-
( xref_public_list(File, Src,
[ exports(Exports),
silent(true),
path(Path)
])
-> forall(( member(op(P,T,N), Exports),
member(op(P,T,N), Imports)),
safe_push_op(P,T,N,Src)),
colour_state_module(Src, SM),
( member(Syntax/4, Exports),
member(Syntax/4, Imports),
load_quasi_quotation_syntax(SM:Path, Syntax),
fail
; true
)
; true
).
%! prolog_colourise_query(+Query:string, +SourceId, :ColourItem)
%
% Colourise a query, to be executed in the context of SourceId.
%
% @arg SourceId Execute Query in the context of
% the cross-referenced environment SourceID.
prolog_colourise_query(QueryString, SourceID, ColourItem) :-
query_colour_state(SourceID, ColourItem, TB),
setup_call_cleanup(
save_settings(TB, [], State),
colourise_query(QueryString, TB),
restore_settings(State)).
query_colour_state(module(Module), ColourItem, TB) :-
!,
make_colour_state([ source_id_list([]),
module(Module),
closure(ColourItem)
],
TB).
query_colour_state(SourceID, ColourItem, TB) :-
to_list(SourceID, SourceIDList),
make_colour_state([ source_id_list(SourceIDList),
closure(ColourItem)
],
TB).
colourise_query(QueryString, TB) :-
colour_state_module(TB, SM),
string_length(QueryString, End),
( catch(term_string(Query, QueryString,
[ subterm_positions(TermPos),
singletons(Singletons0),
module(SM),
comments(Comments)
]),
E,
read_error(E, TB, 0, End))
-> warnable_singletons(Singletons0, Singletons),
colour_state_singletons(TB, Singletons),
colourise_comments(Comments, TB),
( Query == end_of_file
-> true
; colourise_body(Query, TB, TermPos)
)
; true % only a syntax error
).
%! prolog_colourise_term(+Stream, +SourceID, :ColourItem, +Options)
%
% Colourise the next term on Stream. Unlike
% prolog_colourise_stream/3, this predicate assumes it is reading
% a single term rather than the entire stream. This implies that
% it cannot adjust syntax according to directives that precede it.
%
% Options:
%
% * subterm_positions(-TermPos)
% Return complete term-layout. If an error is read, this is a
% term error_position(StartClause, EndClause, ErrorPos)
prolog_colourise_term(Stream, SourceId, ColourItem, Options) :-
to_list(SourceId, SourceIdList),
make_colour_state([ source_id_list(SourceIdList),
stream(Stream),
closure(ColourItem)
],
TB),
option(subterm_positions(TermPos), Options, _),
findall(Op, xref_op(SourceId, Op), Ops),
debug(colour, 'Ops from ~p: ~p', [SourceId, Ops]),
findall(Opt, xref_flag_option(SourceId, Opt), Opts),
character_count(Stream, Start),
( source_module(TB, Module)
-> true
; Module = prolog_colour_ops
),
read_source_term_at_location(
Stream, Term,
[ module(Module),
operators(Ops),
error(Error),
subterm_positions(TermPos),
singletons(Singletons0),
comments(Comments)
| Opts
]),
( var(Error)
-> warnable_singletons(Singletons0, Singletons),
colour_state_singletons(TB, Singletons),
colour_item(range, TB, TermPos), % Call to allow clearing
colourise_term(Term, TB, TermPos, Comments)
; character_count(Stream, End),
TermPos = error_position(Start, End, Pos),
colour_item(range, TB, TermPos),
show_syntax_error(TB, Error, Start-End),
Error = Pos:_Message
).
xref_flag_option(TB, var_prefix(Bool)) :-
xref_prolog_flag(TB, var_prefix, Bool, _Line).
show_syntax_error(TB, Pos:Message, Range) :-
integer(Pos),
!,
End is Pos + 1,
colour_item(syntax_error(Message, Range), TB, Pos-End).
show_syntax_error(TB, _:Message, Range) :-
colour_item(syntax_error(Message, Range), TB, Range).
singleton(Var, TB) :-
colour_state_singletons(TB, Singletons),
member_var(Var, Singletons).
member_var(V, [_=V2|_]) :-
V == V2,
!.
member_var(V, [_|T]) :-
member_var(V, T).
%! colourise_term(+Term, +TB, +Termpos, +Comments)
%
% Colourise the next Term.
%
% @bug The colour spec is closed with =fullstop=, but the
% position information does not include the full stop
% location, so all we can do is assume it is behind the
% term.
colourise_term(Term, TB, TermPos, Comments) :-
colourise_comments(Comments, TB),
( Term == end_of_file
-> true
; colourise_term(Term, TB, TermPos),
colourise_fullstop(TB, TermPos)
).
colourise_fullstop(TB, TermPos) :-
arg(2, TermPos, EndTerm),
Start is EndTerm,
End is Start+1,
colour_item(fullstop, TB, Start-End).
colourise_comments(-, _).
colourise_comments([], _).
colourise_comments([H|T], TB) :-
colourise_comment(H, TB),
colourise_comments(T, TB).
colourise_comment((-)-_, _) :- !.
colourise_comment(Pos-Comment, TB) :-
comment_style(Comment, Style),
stream_position_data(char_count, Pos, Start),
string_length(Comment, Len),
End is Start + Len + 1,
colour_item(comment(Style), TB, Start-End).
comment_style(Comment, structured) :- % Starts %%, %! or /**
structured_comment_start(Start),
sub_string(Comment, 0, Len, _, Start),
Next is Len+1,
string_code(Next, Comment, NextCode),
code_type(NextCode, space),
!.
comment_style(Comment, line) :- % Starts %
sub_string(Comment, 0, _, _, '%'),
!.
comment_style(_, block). % Starts /*
%! structured_comment_start(-Start)
%
% Copied from library(pldoc/doc_process). Unfortunate, but we do
% not want to force loading pldoc.
structured_comment_start('%%').
structured_comment_start('%!').
structured_comment_start('/**').
%! colourise_term(+Term, +TB, +Pos)
%
% Colorise a file toplevel term.
colourise_term(Var, TB, Start-End) :-
var(Var),
!,
colour_item(instantiation_error, TB, Start-End).
colourise_term(_, _, Pos) :-
var(Pos),
!.
colourise_term(Term, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_term(Term, TB, Pos).
colourise_term(Term, TB, Pos) :-
term_colours(Term, FuncSpec-ArgSpecs),
!,
Pos = term_position(F,T,FF,FT,ArgPos),
colour_item(term, TB, F-T), % TBD: Allow specifying by term_colours/2?
specified_item(FuncSpec, Term, TB, FF-FT),
specified_items(ArgSpecs, Term, TB, ArgPos).
colourise_term((Pre=>Body), TB,
term_position(F,T,FF,FT,[PP,BP])) :-
nonvar(Pre),
Pre = (Head,Cond),
PP = term_position(_HF,_HT,_HFF,_HFT,[HP,CP]),
!,
colour_item(clause, TB, F-T),
colour_item(neck(=>), TB, FF-FT),
colourise_clause_head(Head, TB, HP),
colour_item(rule_condition, TB, CP),
colourise_body(Cond, Head, TB, CP),
colourise_body(Body, Head, TB, BP).
colourise_term(Term, TB,
term_position(F,T,FF,FT,[HP,BP])) :-
neck(Term, Head, Body, Neck),
!,
colour_item(clause, TB, F-T),
colour_item(neck(Neck), TB, FF-FT),
colourise_clause_head(Head, TB, HP),
colourise_body(Body, Head, TB, BP).
colourise_term(((Head,RHC) --> Body), TB,
term_position(F,T,FF,FT,
[ term_position(_,_,_,_,[HP,RHCP]),
BP
])) :-
!,
colour_item(grammar_rule, TB, F-T),
colour_item(dcg_right_hand_ctx, TB, RHCP),
colourise_term_arg(RHC, TB, RHCP),
colour_item(neck(-->), TB, FF-FT),
colourise_extended_head(Head, 2, TB, HP),
colourise_dcg(Body, Head, TB, BP).
colourise_term((Head --> Body), TB, % TBD: expansion!
term_position(F,T,FF,FT,[HP,BP])) :-
!,
colour_item(grammar_rule, TB, F-T),
colour_item(neck(-->), TB, FF-FT),
colourise_extended_head(Head, 2, TB, HP),
colourise_dcg(Body, Head, TB, BP).
colourise_term(:->(Head, Body), TB,
term_position(F,T,FF,FT,[HP,BP])) :-
!,
colour_item(method, TB, F-T),
colour_item(neck(:->), TB, FF-FT),
colour_method_head(send(Head), TB, HP),
colourise_method_body(Body, TB, BP).
colourise_term(:<-(Head, Body), TB,
term_position(F,T,FF,FT,[HP,BP])) :-
!,
colour_item(method, TB, F-T),
colour_item(neck(:<-), TB, FF-FT),
colour_method_head(get(Head), TB, HP),
colourise_method_body(Body, TB, BP).
colourise_term((:- Directive), TB, Pos) :-
!,
colour_item(directive, TB, Pos),
Pos = term_position(_F,_T,FF,FT,[ArgPos]),
colour_item(neck(directive), TB, FF-FT),
colourise_directive(Directive, TB, ArgPos).
colourise_term((?- Directive), TB, Pos) :-
!,
colourise_term((:- Directive), TB, Pos).
colourise_term(end_of_file, _, _) :- !.
colourise_term(Fact, TB, Pos) :-
!,
colour_item(clause, TB, Pos),
colourise_clause_head(Fact, TB, Pos).
neck((Head :- Body), Head, Body, :-).
neck((Head => Body), Head, Body, =>).
neck(?=>(Head, Body), Head, Body, ?=>).
%! colourise_extended_head(+Head, +ExtraArgs, +TB, +Pos) is det.
%
% Colourise a clause-head that is extended by term_expansion,
% getting ExtraArgs more arguments (e.g., DCGs add two more
% arguments.
colourise_extended_head(Head, N, TB, Pos) :-
extend(Head, N, TheHead),
colourise_clause_head(TheHead, TB, Pos).
extend(M:Head, N, M:ExtHead) :-
nonvar(Head),
!,
extend(Head, N, ExtHead).
extend(Head, N, ExtHead) :-
compound(Head),
!,
compound_name_arguments(Head, Name, Args),
length(Extra, N),
append(Args, Extra, NArgs),
compound_name_arguments(ExtHead, Name, NArgs).
extend(Head, N, ExtHead) :-
atom(Head),
!,
length(Extra, N),
compound_name_arguments(ExtHead, Head, Extra).
extend(Head, _, Head).
colourise_clause_head(_, _, Pos) :-
var(Pos),
!.
colourise_clause_head(Head, TB, parentheses_term_position(PO,PC,Pos)) :-
colour_item(parentheses, TB, PO-PC),
colourise_clause_head(Head, TB, Pos).
colourise_clause_head(M:Head, TB, QHeadPos) :-
QHeadPos = term_position(_,_,QF,QT,[MPos,HeadPos]),
head_colours(M:Head, meta-[_, ClassSpec-ArgSpecs]),
!,
colourise_module(M, TB, MPos),
colour_item(functor, TB, QF-QT),
functor_position(HeadPos, FPos, ArgPos),
( ClassSpec == classify
-> classify_head(TB, Head, Class)
; Class = ClassSpec
),
colour_item(head_term(Class, Head), TB, QHeadPos),
colour_item(head(Class, Head), TB, FPos),
specified_items(ArgSpecs, Head, TB, ArgPos).
colourise_clause_head(Head, TB, Pos) :-
head_colours(Head, ClassSpec-ArgSpecs),
!,
functor_position(Pos, FPos, ArgPos),
( ClassSpec == classify
-> classify_head(TB, Head, Class)
; Class = ClassSpec
),
colour_item(head_term(Class, Head), TB, Pos),
colour_item(head(Class, Head), TB, FPos),
specified_items(ArgSpecs, Head, TB, ArgPos).
colourise_clause_head(:=(Eval, Ret), TB,
term_position(_,_,AF,AT,
[ term_position(_,_,SF,ST,
[ SelfPos,
FuncPos
]),
RetPos
])) :-
Eval =.. [.,M,Func],
FuncPos = term_position(_,_,FF,FT,_),
!,
colourise_term_arg(M, TB, SelfPos),
colour_item(func_dot, TB, SF-ST), % .
colour_item(dict_function(Func), TB, FF-FT),
colourise_term_args(Func, TB, FuncPos),
colour_item(dict_return_op, TB, AF-AT), % :=
colourise_term_arg(Ret, TB, RetPos).
colourise_clause_head(Head, TB, Pos) :-
functor_position(Pos, FPos, _),
classify_head(TB, Head, Class),
colour_item(head_term(Class, Head), TB, Pos),
colour_item(head(Class, Head), TB, FPos),
colourise_term_args(Head, TB, Pos).
%! colourise_extern_head(+Head, +Module, +TB, +Pos)
%
% Colourise the head specified as Module:Head. Normally used for
% adding clauses to multifile predicates in other modules.
colourise_extern_head(Head, M, TB, Pos) :-
functor_position(Pos, FPos, _),
colour_item(head(extern(M), Head), TB, FPos),
colourise_term_args(Head, TB, Pos).
colour_method_head(SGHead, TB, Pos) :-
arg(1, SGHead, Head),
functor_name(SGHead, SG),
functor_position(Pos, FPos, _),
colour_item(method(SG), TB, FPos),
colourise_term_args(Head, TB, Pos).
%! functor_position(+Term, -FunctorPos, -ArgPosList)
%
% Get the position of a functor and its argument. Unfortunately
% this goes wrong for lists, who have two `functor-positions'.
functor_position(term_position(_,_,FF,FT,ArgPos), FF-FT, ArgPos) :- !.
functor_position(list_position(F,_T,Elms,none), F-FT, Elms) :-
!,
FT is F + 1.
functor_position(dict_position(_,_,FF,FT,KVPos), FF-FT, KVPos) :- !.
functor_position(brace_term_position(F,T,Arg), F-T, [Arg]) :- !.
functor_position(Pos, Pos, []).
colourise_module(Term, TB, Pos) :-
( var(Term)
; atom(Term)
),
!,
colour_item(module(Term), TB, Pos).
colourise_module(_, TB, Pos) :-
colour_item(type_error(module), TB, Pos).
%! colourise_directive(+Body, +TB, +Pos)
%
% Colourise the body of a directive.
colourise_directive(_,_,Pos) :-
var(Pos),
!.
colourise_directive(Dir, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_directive(Dir, TB, Pos).
colourise_directive((A,B), TB, term_position(_,_,_,_,[PA,PB])) :-
!,
colourise_directive(A, TB, PA),
colourise_directive(B, TB, PB).
colourise_directive(Body, TB, Pos) :-
nonvar(Body),
directive_colours(Body, ClassSpec-ArgSpecs), % specified
!,
functor_position(Pos, FPos, ArgPos),
( ClassSpec == classify
-> goal_classification(TB, Body, [], Class)
; Class = ClassSpec
),
colour_item(goal(Class, Body), TB, FPos),
specified_items(ArgSpecs, Body, TB, ArgPos).
colourise_directive(Body, TB, Pos) :-
colourise_body(Body, TB, Pos).
% colourise_body(+Body, +TB, +Pos)
%
% Breaks down to colourise_goal/3.
colourise_body(Body, TB, Pos) :-
colourise_body(Body, [], TB, Pos).
colourise_body(Body, Origin, TB, Pos) :-
colour_item(body, TB, Pos),
colourise_goals(Body, Origin, TB, Pos).
%! colourise_method_body(+MethodBody, +TB, +Pos)
%
% Colourise the optional "comment":: as pce(comment) and proceed
% with the body.
%
% @tbd Get this handled by a hook.
colourise_method_body(_, _, Pos) :-
var(Pos),
!.
colourise_method_body(Body, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_method_body(Body, TB, Pos).
colourise_method_body(::(_Comment,Body), TB,
term_position(_F,_T,_FF,_FT,[CP,BP])) :-
!,
colour_item(comment(string), TB, CP),
colourise_body(Body, TB, BP).
colourise_method_body(Body, TB, Pos) :- % deal with pri(::) < 1000
Body =.. [F,A,B],
control_op(F),
!,
Pos = term_position(_F,_T,FF,FT,
[ AP,
BP
]),
colour_item(control, TB, FF-FT),
colourise_method_body(A, TB, AP),
colourise_body(B, TB, BP).
colourise_method_body(Body, TB, Pos) :-
colourise_body(Body, TB, Pos).
control_op(',').
control_op((;)).
control_op((->)).
control_op((*->)).
%! colourise_goals(+Body, +Origin, +TB, +Pos)
%
% Colourise the goals in a body.
colourise_goals(_, _, _, Pos) :-
var(Pos),
!.
colourise_goals(Body, Origin, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_goals(Body, Origin, TB, Pos).
colourise_goals(Body, Origin, TB, term_position(_,_,FF,FT,ArgPos)) :-
body_compiled(Body),
!,
colour_item(control, TB, FF-FT),
colourise_subgoals(ArgPos, 1, Body, Origin, TB).
colourise_goals(Goal, Origin, TB, Pos) :-
colourise_goal(Goal, Origin, TB, Pos).
colourise_subgoals([], _, _, _, _).
colourise_subgoals([Pos|T], N, Body, Origin, TB) :-
arg(N, Body, Arg),
colourise_goals(Arg, Origin, TB, Pos),
NN is N + 1,
colourise_subgoals(T, NN, Body, Origin, TB).
%! colourise_dcg(+Body, +Head, +TB, +Pos)
%
% Breaks down to colourise_dcg_goal/3.
colourise_dcg(Body, Head, TB, Pos) :-
colour_item(dcg, TB, Pos),
( dcg_extend(Head, Origin)
-> true
; Origin = Head
),
colourise_dcg_goals(Body, Origin, TB, Pos).
colourise_dcg_goals(Var, _, TB, Pos) :-
var(Var),
!,
colour_item(goal(meta,Var), TB, Pos).
colourise_dcg_goals(_, _, _, Pos) :-
var(Pos),
!.
colourise_dcg_goals(Body, Origin, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_dcg_goals(Body, Origin, TB, Pos).
colourise_dcg_goals({Body}, Origin, TB, brace_term_position(F,T,Arg)) :-
!,
colour_item(dcg(plain), TB, F-T),
colourise_goals(Body, Origin, TB, Arg).
colourise_dcg_goals([], _, TB, Pos) :-
!,
colour_item(dcg(terminal), TB, Pos).
colourise_dcg_goals(List, _, TB, list_position(F,T,Elms,Tail)) :-
List = [_|_],
!,
colour_item(dcg(terminal), TB, F-T),
colourise_list_args(Elms, Tail, List, TB, classify).
colourise_dcg_goals(_, _, TB, string_position(F,T)) :-
integer(F),
!,
colour_item(dcg(string), TB, F-T).
colourise_dcg_goals(Body, Origin, TB, term_position(_,_,FF,FT,ArgPos)) :-
dcg_body_compiled(Body), % control structures
!,
colour_item(control, TB, FF-FT),
colourise_dcg_subgoals(ArgPos, 1, Body, Origin, TB).
colourise_dcg_goals(Goal, Origin, TB, Pos) :-
colourise_dcg_goal(Goal, Origin, TB, Pos).
colourise_dcg_subgoals([], _, _, _, _).
colourise_dcg_subgoals([Pos|T], N, Body, Origin, TB) :-
arg(N, Body, Arg),
colourise_dcg_goals(Arg, Origin, TB, Pos),
NN is N + 1,
colourise_dcg_subgoals(T, NN, Body, Origin, TB).
dcg_extend(Term, _) :-
var(Term), !, fail.
dcg_extend(M:Term, M:Goal) :-
dcg_extend(Term, Goal).
dcg_extend(Term, Goal) :-
compound(Term),
!,
compound_name_arguments(Term, Name, Args),
append(Args, [_,_], NArgs),
compound_name_arguments(Goal, Name, NArgs).
dcg_extend(Term, Goal) :-
atom(Term),
!,
compound_name_arguments(Goal, Term, [_,_]).
dcg_body_compiled(G) :-
body_compiled(G),
!.
dcg_body_compiled((_|_)).
% colourise_dcg_goal(+Goal, +Origin, +TB, +Pos).
colourise_dcg_goal(!, Origin, TB, TermPos) :-
!,
colourise_goal(!, Origin, TB, TermPos).
colourise_dcg_goal(Goal, Origin, TB, TermPos) :-
dcg_extend(Goal, TheGoal),
!,
colourise_goal(TheGoal, Origin, TB, TermPos).
colourise_dcg_goal(Goal, _, TB, Pos) :-
colourise_term_args(Goal, TB, Pos).
%! colourise_goal(+Goal, +Origin, +TB, +Pos)
%
% Colourise access to a single goal.
%
% @tbd Quasi Quotations are coloured as a general term argument.
% Possibly we should do something with the goal information it
% refers to, in particular if this goal is not defined.
% Deal with list as goal (consult)
colourise_goal(_,_,_,Pos) :-
var(Pos),
!.
colourise_goal(Goal, Origin, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_goal(Goal, Origin, TB, Pos).
colourise_goal(Goal, _, TB, Pos) :-
Pos = list_position(F,T,Elms,TailPos),
Goal = [_|_],
!,
FT is F + 1,
AT is T - 1,
colour_item(goal_term(built_in, Goal), TB, Pos),
colour_item(goal(built_in, Goal), TB, F-FT),
colour_item(goal(built_in, Goal), TB, AT-T),
colourise_file_list(Goal, TB, Elms, TailPos, any).
colourise_goal(Goal, Origin, TB, Pos) :-
Pos = list_position(F,T,Elms,Tail),
callable(Goal),
Goal =.. [_,GH,GT|_],
!,
goal_classification(TB, Goal, Origin, Class),
FT is F + 1,
AT is T - 1,
colour_item(goal_term(Class, Goal), TB, Pos),
colour_item(goal(Class, Goal), TB, F-FT),
colour_item(goal(Class, Goal), TB, AT-T),
colourise_list_args(Elms, Tail, [GH|GT], TB, classify).
colourise_goal(Goal, _Origin, TB, Pos) :-
Pos = quasi_quotation_position(_F,_T,_QQType,_QQTypePos,_CPos),
!,
colourise_term_arg(Goal, TB, Pos).
colourise_goal(Goal, Origin, TB, Pos) :-
strip_module(Goal, _, PGoal),
nonvar(PGoal),
( goal_classification(TB, Goal, Origin, ClassInferred),
call_goal_colours(Goal, ClassInferred, ClassSpec-ArgSpecs)
-> true
; call_goal_colours(Goal, ClassSpec-ArgSpecs)
),
!, % specified
functor_position(Pos, FPos, ArgPos),
( ClassSpec == classify
-> goal_classification(TB, Goal, Origin, Class)
; Class = ClassSpec
),
colour_item(goal_term(Class, Goal), TB, Pos),
colour_item(goal(Class, Goal), TB, FPos),
colour_dict_braces(TB, Pos),
specified_items(ArgSpecs, Goal, TB, ArgPos).
colourise_goal(Module:Goal, _Origin, TB, QGoalPos) :-
QGoalPos = term_position(_,_,QF,QT,[PM,PG]),
!,
colourise_module(Module, TB, PM),
colour_item(functor, TB, QF-QT),
( PG = term_position(_,_,FF,FT,_)
-> FP = FF-FT
; FP = PG
),
( callable(Goal)
-> qualified_goal_classification(Module:Goal, TB, Class),
colour_item(goal_term(Class, Goal), TB, QGoalPos),
colour_item(goal(Class, Goal), TB, FP),
colourise_goal_args(Goal, Module, TB, PG)
; var(Goal)
-> colourise_term_arg(Goal, TB, PG)
; colour_item(type_error(callable), TB, PG)
).
colourise_goal(Op, _Origin, TB, Pos) :-
nonvar(Op),
Op = op(_,_,_),
!,
colourise_op_declaration(Op, TB, Pos).
colourise_goal(Goal, Origin, TB, Pos) :-
goal_classification(TB, Goal, Origin, Class),
( Pos = term_position(_,_,FF,FT,_ArgPos)
-> FPos = FF-FT
; FPos = Pos
),
colour_item(goal_term(Class, Goal), TB, Pos),
colour_item(goal(Class, Goal), TB, FPos),
colourise_goal_args(Goal, TB, Pos).
% make sure to emit a fragment for the braces of tag{k:v, ...} or
% {...} that is mapped to something else.
colour_dict_braces(TB, dict_position(_F,T,_TF,TT,_KVPos)) :-
!,
BStart is TT+1,
colour_item(dict_content, TB, BStart-T).
colour_dict_braces(TB, brace_term_position(F,T,_Arg)) :-
!,
colour_item(brace_term, TB, F-T).
colour_dict_braces(_, _).
%! colourise_goal_args(+Goal, +TB, +Pos)
%
% Colourise the arguments to a goal. This predicate deals with
% meta- and database-access predicates.
colourise_goal_args(Goal, TB, Pos) :-
colourization_module(TB, Module),
colourise_goal_args(Goal, Module, TB, Pos).
colourization_module(TB, Module) :-
( colour_state_source_id(TB, SourceId),
xref_module(SourceId, Module)
-> true
; Module = user
).
colourise_goal_args(Goal, M, TB, term_position(_,_,_,_,ArgPos)) :-
!,
( meta_args(Goal, TB, MetaArgs)
-> colourise_meta_args(1, Goal, M, MetaArgs, TB, ArgPos)
; colourise_goal_args(1, Goal, M, TB, ArgPos)
).
colourise_goal_args(Goal, M, TB, brace_term_position(_,_,ArgPos)) :-
!,
( meta_args(Goal, TB, MetaArgs)
-> colourise_meta_args(1, Goal, M, MetaArgs, TB, [ArgPos])
; colourise_goal_args(1, Goal, M, TB, [ArgPos])
).
colourise_goal_args(_, _, _, _). % no arguments
colourise_goal_args(_, _, _, _, []) :- !.
colourise_goal_args(N, Goal, Module, TB, [P0|PT]) :-
colourise_option_arg(Goal, Module, N, TB, P0),
!,
NN is N + 1,
colourise_goal_args(NN, Goal, Module, TB, PT).
colourise_goal_args(N, Goal, Module, TB, [P0|PT]) :-
arg(N, Goal, Arg),
colourise_term_arg(Arg, TB, P0),
NN is N + 1,
colourise_goal_args(NN, Goal, Module, TB, PT).
colourise_meta_args(_, _, _, _, _, []) :- !.
colourise_meta_args(N, Goal, Module, MetaArgs, TB, [P0|PT]) :-
colourise_option_arg(Goal, Module, N, TB, P0),
!,
NN is N + 1,
colourise_meta_args(NN, Goal, Module, MetaArgs, TB, PT).
colourise_meta_args(N, Goal, Module, MetaArgs, TB, [P0|PT]) :-
arg(N, Goal, Arg),
arg(N, MetaArgs, MetaSpec),
colourise_meta_arg(MetaSpec, Arg, TB, P0),
NN is N + 1,
colourise_meta_args(NN, Goal, Module, MetaArgs, TB, PT).
colourise_meta_arg(MetaSpec, Arg, TB, Pos) :-
nonvar(Arg),
expand_meta(MetaSpec, Arg, Expanded),
!,
colourise_goal(Expanded, [], TB, Pos). % TBD: recursion
colourise_meta_arg(MetaSpec, Arg, TB, Pos) :-
nonvar(Arg),
MetaSpec == //,
!,
colourise_dcg_goals(Arg, //, TB, Pos).
colourise_meta_arg(_, Arg, TB, Pos) :-
colourise_term_arg(Arg, TB, Pos).
%! meta_args(+Goal, +TB, -ArgSpec) is semidet.
%
% Return a copy of Goal, where each meta-argument is an integer
% representing the number of extra arguments or the atom // for
% indicating a DCG body. The non-meta arguments are unbound
% variables.
%
% E.g. meta_args(maplist(foo,x,y), X) --> X = maplist(2,_,_)
%
% NOTE: this could be cached if performance becomes an issue.
meta_args(Goal, TB, VarGoal) :-
colour_state_source_id(TB, SourceId),
xref_meta(SourceId, Goal, _),
!,
compound_name_arity(Goal, Name, Arity),
compound_name_arity(VarGoal, Name, Arity),
xref_meta(SourceId, VarGoal, MetaArgs),
instantiate_meta(MetaArgs).
instantiate_meta([]).
instantiate_meta([H|T]) :-
( var(H)
-> H = 0
; H = V+N
-> V = N
; H = //(V)
-> V = (//)
),
instantiate_meta(T).
%! expand_meta(+MetaSpec, +Goal, -Expanded) is semidet.
%
% Add extra arguments to the goal if the meta-specifier is an
% integer (see above).
expand_meta(MetaSpec, Goal, Goal) :-
MetaSpec == 0.
expand_meta(MetaSpec, M:Goal, M:Expanded) :-
atom(M),
!,
expand_meta(MetaSpec, Goal, Expanded).
expand_meta(MetaSpec, Goal, Expanded) :-
integer(MetaSpec),
MetaSpec > 0,
( atom(Goal)
-> functor(Expanded, Goal, MetaSpec)
; compound(Goal)
-> compound_name_arguments(Goal, Name, Args0),
length(Extra, MetaSpec),
append(Args0, Extra, Args),
compound_name_arguments(Expanded, Name, Args)
).
%! colourise_setof(+Term, +TB, +Pos)
%
% Colourise the 2nd argument of setof/bagof
colourise_setof(Var^G, TB, term_position(_,_,FF,FT,[VP,GP])) :-
!,
colourise_term_arg(Var, TB, VP),
colour_item(ext_quant, TB, FF-FT),
colourise_setof(G, TB, GP).
colourise_setof(Term, TB, Pos) :-
colourise_goal(Term, [], TB, Pos).
% colourise_db(+Arg, +TB, +Pos)
%
% Colourise database modification calls (assert/1, retract/1 and
% friends.
colourise_db((Head:-_Body), TB, term_position(_,_,_,_,[HP,_])) :-
!,
colourise_db(Head, TB, HP).
colourise_db(Module:Head, TB, term_position(_,_,QF,QT,[MP,HP])) :-
!,
colourise_module(Module, TB, MP),
colour_item(functor, TB, QF-QT),
( atom(Module),
colour_state_source_id(TB, SourceId),
xref_module(SourceId, Module)
-> colourise_db(Head, TB, HP)
; colourise_db(Head, TB, HP)
).
colourise_db(Head, TB, Pos) :-
colourise_goal(Head, '<db-change>', TB, Pos).
%! colourise_option_args(+Goal, +Module, +Arg:integer,
%! +TB, +ArgPos) is semidet.
%
% Colourise predicate options for the Arg-th argument of
% Module:Goal
colourise_option_arg(Goal, Module, Arg, TB, ArgPos) :-
goal_name_arity(Goal, Name, Arity),
current_option_arg(Module:Name/Arity, Arg),
current_predicate_options(Module:Name/Arity, Arg, OptionDecl),
debug(emacs, 'Colouring option-arg ~w of ~p',
[Arg, Module:Name/Arity]),
arg(Arg, Goal, Options),
colourise_option(Options, Module, Goal, Arg, OptionDecl, TB, ArgPos).
colourise_option(Options0, Module, Goal, Arg, OptionDecl, TB, Pos0) :-
strip_option_module_qualifier(Goal, Module, Arg, TB,
Options0, Pos0, Options, Pos),
( Pos = list_position(F, T, ElmPos, TailPos)
-> colour_item(list, TB, F-T),
colourise_option_list(Options, OptionDecl, TB, ElmPos, TailPos)
; ( var(Options)
; Options == []
)
-> colourise_term_arg(Options, TB, Pos)
; colour_item(type_error(list), TB, Pos)
).
strip_option_module_qualifier(Goal, Module, Arg, TB,
M:Options, term_position(_,_,_,_,[MP,Pos]),
Options, Pos) :-
predicate_property(Module:Goal, meta_predicate(Head)),
arg(Arg, Head, :),
!,
colourise_module(M, TB, MP).
strip_option_module_qualifier(_, _, _, _,
Options, Pos, Options, Pos).
colourise_option_list(_, _, _, [], none) :- !.
colourise_option_list(Tail, _, TB, [], TailPos) :-
!,
colourise_term_arg(Tail, TB, TailPos).
colourise_option_list([H|T], OptionDecl, TB, [HPos|TPos], TailPos) :-
colourise_option(H, OptionDecl, TB, HPos),
colourise_option_list(T, OptionDecl, TB, TPos, TailPos).
colourise_option(Opt, _, TB, Pos) :-
var(Opt),
!,
colourise_term_arg(Opt, TB, Pos).
colourise_option(Opt, OptionDecl, TB, term_position(_,_,FF,FT,ValPosList)) :-
!,
generalise_term(Opt, GenOpt),
( memberchk(GenOpt, OptionDecl)
-> colour_item(option_name, TB, FF-FT),
Opt =.. [Name|Values],
GenOpt =.. [Name|Types],
colour_option_values(Values, Types, TB, ValPosList)
; colour_item(no_option_name, TB, FF-FT),
colourise_term_args(ValPosList, 1, Opt, TB)
).
colourise_option(_, _, TB, Pos) :-
colour_item(type_error(option), TB, Pos).
colour_option_values([], [], _, _).
colour_option_values([V0|TV], [T0|TT], TB, [P0|TP]) :-
( ( var(V0)
; is_of_type(T0, V0)
; T0 = list(_),
member(E, V0),
var(E)
; functor(V0, '.', 2),
V0 \= [_|_]
)
-> colourise_term_arg(V0, TB, P0)
; callable(V0),
( T0 = callable
-> N = 0
; T0 = (callable+N)
)
-> colourise_meta_arg(N, V0, TB, P0)
; colour_item(type_error(T0), TB, P0)
),
colour_option_values(TV, TT, TB, TP).
%! colourise_files(+Arg, +TB, +Pos, +Why)
%
% Colourise the argument list of one of the file-loading predicates.
%
% @param Why is one of =any= or =imported=
colourise_files(List, TB, list_position(F,T,Elms,TailPos), Why) :-
!,
colour_item(list, TB, F-T),
colourise_file_list(List, TB, Elms, TailPos, Why).
colourise_files(M:Spec, TB, term_position(_,_,_,_,[MP,SP]), Why) :-
!,
colourise_module(M, TB, MP),
colourise_files(Spec, TB, SP, Why).
colourise_files(Var, TB, P, _) :-
var(Var),
!,
colour_item(var, TB, P).
colourise_files(Spec0, TB, Pos, Why) :-
strip_module(Spec0, _, Spec),
( colour_state_source_id(TB, Source),
prolog_canonical_source(Source, SourceId),
catch(xref_source_file(Spec, Path, SourceId, [silent(true)]),
_, fail)
-> ( Why = imported,
\+ resolves_anything(TB, Path),
exports_something(TB, Path)
-> colour_item(file_no_depend(Path), TB, Pos)
; colour_item(file(Path), TB, Pos)
)
; colour_item(nofile, TB, Pos)
).
%! colourise_file_list(+Files, +TB, +ElmPos, +TailPos, +Why)
colourise_file_list([], _, [], none, _).
colourise_file_list(Last, TB, [], TailPos, _Why) :-
( var(Last)
-> colourise_term(Last, TB, TailPos)
; colour_item(type_error(list), TB, TailPos)
).
colourise_file_list([H|T], TB, [PH|PT], TailPos, Why) :-
colourise_files(H, TB, PH, Why),
colourise_file_list(T, TB, PT, TailPos, Why).
resolves_anything(TB, Path) :-
colour_state_source_id(TB, SourceId),
xref_defined(SourceId, Head, imported(Path)),
xref_called(SourceId, Head, _),
!.
exports_something(TB, Path) :-
colour_state_source_id(TB, SourceId),
xref_defined(SourceId, _, imported(Path)),
!.
%! colourise_directory(+Arg, +TB, +Pos)
%
% Colourise argument that should be an existing directory.
colourise_directory(Spec, TB, Pos) :-
( colour_state_source_id(TB, SourceId),
catch(xref_source_file(Spec, Path, SourceId,
[ file_type(directory),
silent(true)
]),
_, fail)
-> colour_item(directory(Path), TB, Pos)
; colour_item(nofile, TB, Pos)
).
%! colourise_langoptions(+Term, +TB, +Pos) is det.
%
% Colourise the 3th argument of module/3
colourise_langoptions([], _, _) :- !.
colourise_langoptions([H|T], TB, list_position(PF,PT,[HP|TP],_)) :-
!,
colour_item(list, TB, PF-PT),
colourise_langoptions(H, TB, HP),
colourise_langoptions(T, TB, TP).
colourise_langoptions(Spec, TB, Pos) :-
colourise_files(library(dialect/Spec), TB, Pos, imported).
%! colourise_class(ClassName, TB, Pos)
%
% Colourise an XPCE class.
colourise_class(ClassName, TB, Pos) :-
colour_state_source_id(TB, SourceId),
classify_class(SourceId, ClassName, Classification),
colour_item(class(Classification, ClassName), TB, Pos).
%! classify_class(+SourceId, +ClassName, -Classification)
%
% Classify an XPCE class. As long as this code is in this module
% rather than using hooks, we do not want to load xpce unless it
% is already loaded.
classify_class(SourceId, Name, Class) :-
xref_defined_class(SourceId, Name, Class),
!.
classify_class(_SourceId, Name, Class) :-
current_predicate(pce:send_class/3),
( current_predicate(classify_class/2)
-> true
; use_module(library(pce_meta), [classify_class/2])
),
member(G, [classify_class(Name, Class)]),
call(G).
%! colourise_term_args(+Term, +TB, +Pos)
%
% colourise head/body principal terms.
colourise_term_args(Term, TB,
term_position(_,_,_,_,ArgPos)) :-
!,
colourise_term_args(ArgPos, 1, Term, TB).
colourise_term_args(_, _, _).
colourise_term_args([], _, _, _).
colourise_term_args([Pos|T], N, Term, TB) :-
arg(N, Term, Arg),
colourise_term_arg(Arg, TB, Pos),
NN is N + 1,
colourise_term_args(T, NN, Term, TB).
colourise_term_arg(_, _, Pos) :-
var(Pos),
!.
colourise_term_arg(Arg, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_term_arg(Arg, TB, Pos).
colourise_term_arg(Var, TB, Pos) :- % variable
var(Var), Pos = _-_,
!,
( singleton(Var, TB)
-> colour_item(singleton, TB, Pos)
; colour_item(var, TB, Pos)
).
colourise_term_arg(List, TB, list_position(F, T, Elms, Tail)) :-
!,
colour_item(list, TB, F-T),
colourise_list_args(Elms, Tail, List, TB, classify). % list
colourise_term_arg(String, TB, string_position(F, T)) :- % string
!,
( string(String)
-> colour_item(string, TB, F-T)
; String = [H|_]
-> ( integer(H)
-> colour_item(codes, TB, F-T)
; colour_item(chars, TB, F-T)
)
; String == []
-> colour_item(codes, TB, F-T)
).
colourise_term_arg(_, TB,
quasi_quotation_position(F,T,QQType,QQTypePos,CPos)) :-
!,
colourise_qq_type(QQType, TB, QQTypePos),
functor_name(QQType, Type),
colour_item(qq_content(Type), TB, CPos),
arg(1, CPos, SE),
SS is SE-2,
FE is F+2,
TS is T-2,
colour_item(qq(open), TB, F-FE),
colour_item(qq(sep), TB, SS-SE),
colour_item(qq(close), TB, TS-T).
colourise_term_arg({Term}, TB, brace_term_position(F,T,Arg)) :-
!,
colour_item(brace_term, TB, F-T),
colourise_term_arg(Term, TB, Arg).
colourise_term_arg(Map, TB, dict_position(F,T,TF,TT,KVPos)) :-
!,
is_dict(Map, Tag),
colour_item(dict, TB, F-T),
TagPos = TF-TT,
( var(Tag)
-> ( singleton(Tag, TB)
-> colour_item(singleton, TB, TagPos)
; colour_item(var, TB, TagPos)
)
; colour_item(dict_tag, TB, TagPos)
),
BStart is TT+1,
colour_item(dict_content, TB, BStart-T),
colourise_dict_kv(Map, TB, KVPos).
colourise_term_arg([](List,Term), TB, % [] as operator
term_position(_,_,0,0,[ListPos,ArgPos])) :-
!,
colourise_term_arg(List, TB, ListPos),
colourise_term_arg(Term, TB, ArgPos).
colourise_term_arg(Compound, TB, Pos) :- % compound
compound(Compound),
!,
( Pos = term_position(_F,_T,FF,FT,_ArgPos)
-> colour_item(functor, TB, FF-FT) % TBD: Infix/Postfix?
; true % TBD: When is this
),
colourise_term_args(Compound, TB, Pos).
colourise_term_arg(EmptyList, TB, Pos) :-
EmptyList == [],
!,
colour_item(empty_list, TB, Pos).
colourise_term_arg(Atom, TB, Pos) :-
atom(Atom),
!,
colour_item(atom, TB, Pos).
colourise_term_arg(Integer, TB, Pos) :-
integer(Integer),
!,
colour_item(int, TB, Pos).
colourise_term_arg(Rational, TB, Pos) :-
rational(Rational),
!,
colour_item(rational(Rational), TB, Pos).
colourise_term_arg(Float, TB, Pos) :-
float(Float),
!,
colour_item(float, TB, Pos).
colourise_term_arg(_Arg, _TB, _Pos) :-
true.
colourise_list_args([HP|TP], Tail, [H|T], TB, How) :-
specified_item(How, H, TB, HP),
colourise_list_args(TP, Tail, T, TB, How).
colourise_list_args([], none, _, _, _) :- !.
colourise_list_args([], TP, T, TB, How) :-
specified_item(How, T, TB, TP).
%! colourise_qq_type(+QQType, +TB, +QQTypePos)
%
% Colouring the type part of a quasi quoted term
colourise_qq_type(QQType, TB, QQTypePos) :-
functor_position(QQTypePos, FPos, _),
colour_item(qq_type, TB, FPos),
colourise_term_args(QQType, TB, QQTypePos).
qq_position(quasi_quotation_position(_,_,_,_,_)).
%! colourise_dict_kv(+Dict, +TB, +KVPosList)
%
% Colourise the name-value pairs in the dict
colourise_dict_kv(_, _, []) :- !.
colourise_dict_kv(Dict, TB, [key_value_position(_F,_T,SF,ST,K,KP,VP)|KV]) :-
colour_item(dict_key, TB, KP),
colour_item(dict_sep, TB, SF-ST),
get_dict(K, Dict, V),
colourise_term_arg(V, TB, VP),
colourise_dict_kv(Dict, TB, KV).
%! colourise_exports(+List, +TB, +Pos)
%
% Colourise the module export-list (or any other list holding
% terms of the form Name/Arity referring to predicates).
colourise_exports([], TB, Pos) :- !,
colourise_term_arg([], TB, Pos).
colourise_exports(List, TB, list_position(F,T,ElmPos,Tail)) :-
!,
colour_item(list, TB, F-T),
( Tail == none
-> true
; colour_item(type_error(list), TB, Tail)
),
colourise_exports2(List, TB, ElmPos).
colourise_exports(_, TB, Pos) :-
colour_item(type_error(list), TB, Pos).
colourise_exports2([G0|GT], TB, [P0|PT]) :-
!,
colourise_declaration(G0, export, TB, P0),
colourise_exports2(GT, TB, PT).
colourise_exports2(_, _, _).
%! colourise_imports(+List, +File, +TB, +Pos)
%
% Colourise import list from use_module/2, importing from File.
colourise_imports(List, File, TB, Pos) :-
( colour_state_source_id(TB, SourceId),
ground(File),
catch(xref_public_list(File, SourceId,
[ path(Path),
public(Public),
silent(true)
] ), _, fail)
-> true
; Public = [],
Path = (-)
),
colourise_imports(List, Path, Public, TB, Pos).
colourise_imports([], _, _, TB, Pos) :-
!,
colour_item(empty_list, TB, Pos).
colourise_imports(List, File, Public, TB, list_position(F,T,ElmPos,Tail)) :-
!,
colour_item(list, TB, F-T),
( Tail == none
-> true
; colour_item(type_error(list), TB, Tail)
),
colourise_imports2(List, File, Public, TB, ElmPos).
colourise_imports(except(Except), File, Public, TB,
term_position(_,_,FF,FT,[LP])) :-
!,
colour_item(keyword(except), TB, FF-FT),
colourise_imports(Except, File, Public, TB, LP).
colourise_imports(_, _, _, TB, Pos) :-
colour_item(type_error(list), TB, Pos).
colourise_imports2([G0|GT], File, Public, TB, [P0|PT]) :-
!,
colourise_import(G0, File, TB, P0),
colourise_imports2(GT, File, Public, TB, PT).
colourise_imports2(_, _, _, _, _).
colourise_import(PI as Name, File, TB, term_position(_,_,FF,FT,[PP,NP])) :-
pi_to_term(PI, Goal),
!,
colour_item(goal(imported(File), Goal), TB, PP),
rename_goal(Goal, Name, NewGoal),
goal_classification(TB, NewGoal, [], Class),
colour_item(goal(Class, NewGoal), TB, NP),
colour_item(keyword(as), TB, FF-FT).
colourise_import(PI, File, TB, Pos) :-
pi_to_term(PI, Goal),
colour_state_source_id(TB, SourceID),
( \+ xref_defined(SourceID, Goal, imported(File))
-> colour_item(undefined_import, TB, Pos)
; \+ xref_called(SourceID, Goal, _)
-> colour_item(unused_import, TB, Pos)
),
!.
colourise_import(PI, _, TB, Pos) :-
colourise_declaration(PI, import, TB, Pos).
%! colourise_declaration(+Decl, ?Which, +TB, +Pos) is det.
%
% Colourise declaration sequences as used by module/2, dynamic/1,
% etc.
colourise_declaration(PI, _, TB, term_position(F,T,FF,FT,[NamePos,ArityPos])) :-
pi_to_term(PI, Goal),
!,
goal_classification(TB, Goal, [], Class),
colour_item(predicate_indicator(Class, Goal), TB, F-T),
colour_item(goal(Class, Goal), TB, NamePos),
colour_item(predicate_indicator, TB, FF-FT),
colour_item(arity, TB, ArityPos).
colourise_declaration(Module:PI, _, TB,
term_position(_,_,QF,QT,[PM,PG])) :-
atom(Module), pi_to_term(PI, Goal),
!,
colourise_module(M, TB, PM),
colour_item(functor, TB, QF-QT),
colour_item(predicate_indicator(extern(M), Goal), TB, PG),
PG = term_position(_,_,FF,FT,[NamePos,ArityPos]),
colour_item(goal(extern(M), Goal), TB, NamePos),
colour_item(predicate_indicator, TB, FF-FT),
colour_item(arity, TB, ArityPos).
colourise_declaration(Module:PI, _, TB,
term_position(_,_,QF,QT,[PM,PG])) :-
atom(Module), nonvar(PI), PI = Name/Arity,
!, % partial predicate indicators
colourise_module(Module, TB, PM),
colour_item(functor, TB, QF-QT),
( (var(Name) ; atom(Name)),
(var(Arity) ; integer(Arity), Arity >= 0)
-> colourise_term_arg(PI, TB, PG)
; colour_item(type_error(predicate_indicator), TB, PG)
).
colourise_declaration(op(N,T,P), Which, TB, Pos) :-
( Which == export
; Which == import
),
!,
colour_item(exported_operator, TB, Pos),
colourise_op_declaration(op(N,T,P), TB, Pos).
colourise_declaration(Module:Goal, table, TB,
term_position(_,_,QF,QT,
[PM,term_position(_F,_T,FF,FT,ArgPos)])) :-
atom(Module), callable(Goal),
!,
colourise_module(Module, TB, PM),
colour_item(functor, TB, QF-QT),
goal_classification(TB, Module:Goal, [], Class),
compound_name_arguments(Goal, _, Args),
colour_item(goal(Class, Goal), TB, FF-FT),
colourise_table_modes(Args, TB, ArgPos).
colourise_declaration(Goal, table, TB, term_position(_F,_T,FF,FT,ArgPos)) :-
callable(Goal),
!,
compound_name_arguments(Goal, _, Args),
goal_classification(TB, Goal, [], Class),
colour_item(goal(Class, Goal), TB, FF-FT),
colourise_table_modes(Args, TB, ArgPos).
colourise_declaration(Goal, table, TB, Pos) :-
atom(Goal),
!,
goal_classification(TB, Goal, [], Class),
colour_item(goal(Class, Goal), TB, Pos).
colourise_declaration(Partial, _Which, TB, Pos) :-
compatible_with_pi(Partial),
!,
colourise_term_arg(Partial, TB, Pos).
colourise_declaration(_, Which, TB, Pos) :-
colour_item(type_error(declaration(Which)), TB, Pos).
compatible_with_pi(Term) :-
var(Term),
!.
compatible_with_pi(Name/Arity) :-
!,
var_or_atom(Name),
var_or_nonneg(Arity).
compatible_with_pi(Name//Arity) :-
!,
var_or_atom(Name),
var_or_nonneg(Arity).
compatible_with_pi(M:T) :-
var_or_atom(M),
compatible_with_pi(T).
var_or_atom(X) :- var(X), !.
var_or_atom(X) :- atom(X).
var_or_nonneg(X) :- var(X), !.
var_or_nonneg(X) :- integer(X), X >= 0, !.
pi_to_term(Name/Arity, Term) :-
(atom(Name)->true;Name==[]), integer(Arity), Arity >= 0,
!,
functor(Term, Name, Arity).
pi_to_term(Name//Arity0, Term) :-
atom(Name), integer(Arity0), Arity0 >= 0,
!,
Arity is Arity0 + 2,
functor(Term, Name, Arity).
colourise_meta_declarations((Head,Tail), Extra, TB,
term_position(_,_,_,_,[PH,PT])) :-
!,
colourise_meta_declaration(Head, Extra, TB, PH),
colourise_meta_declarations(Tail, Extra, TB, PT).
colourise_meta_declarations(Last, Extra, TB, Pos) :-
colourise_meta_declaration(Last, Extra, TB, Pos).
colourise_meta_declaration(M:Head, Extra, TB,
term_position(_,_,QF,QT,
[ MP,
term_position(_,_,FF,FT,ArgPos)
])) :-
compound(Head),
!,
colourise_module(M, TB, MP),
colour_item(functor, TB, QF-QT),
colour_item(goal(extern(M),Head), TB, FF-FT),
compound_name_arguments(Head, _, Args),
colourise_meta_decls(Args, Extra, TB, ArgPos).
colourise_meta_declaration(Head, Extra, TB, term_position(_,_,FF,FT,ArgPos)) :-
compound(Head),
!,
goal_classification(TB, Head, [], Class),
colour_item(goal(Class, Head), TB, FF-FT),
compound_name_arguments(Head, _, Args),
colourise_meta_decls(Args, Extra, TB, ArgPos).
colourise_meta_declaration([H|T], Extra, TB, list_position(LF,LT,[HP],TP)) :-
!,
colour_item(list, TB, LF-LT),
colourise_meta_decls([H,T], Extra, TB, [HP,TP]).
colourise_meta_declaration(_, _, TB, Pos) :-
!,
colour_item(type_error(compound), TB, Pos).
colourise_meta_decls([], _, _, []).
colourise_meta_decls([Arg|ArgT], Extra, TB, [PosH|PosT]) :-
colourise_meta_decl(Arg, Extra, TB, PosH),
colourise_meta_decls(ArgT, Extra, TB, PosT).
colourise_meta_decl(Arg, Extra, TB, Pos) :-
nonvar(Arg),
( valid_meta_decl(Arg)
-> true
; memberchk(Arg, Extra)
),
colour_item(meta(Arg), TB, Pos).
colourise_meta_decl(_, _, TB, Pos) :-
colour_item(error, TB, Pos).
valid_meta_decl(:).
valid_meta_decl(*).
valid_meta_decl(//).
valid_meta_decl(^).
valid_meta_decl(?).
valid_meta_decl(+).
valid_meta_decl(-).
valid_meta_decl(I) :- integer(I), between(0,9,I).
%! colourise_declarations(+Term, +Which, +TB, +Pos)
%
% Colourise specification for dynamic/1, table/1, etc. Includes
% processing options such as ``:- dynamic p/1 as incremental.``.
colourise_declarations(List, Which, TB, list_position(F,T,Elms,none)) :-
!,
colour_item(list, TB, F-T),
colourise_list_declarations(List, Which, TB, Elms).
colourise_declarations(Term, Which, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_declarations(Term, Which, TB, Pos).
colourise_declarations((Head,Tail), Which, TB,
term_position(_,_,_,_,[PH,PT])) :-
!,
colourise_declarations(Head, Which, TB, PH),
colourise_declarations(Tail, Which, TB, PT).
colourise_declarations(as(Spec, Options), Which, TB,
term_position(_,_,FF,FT,[PH,PT])) :-
!,
colour_item(keyword(as), TB, FF-FT),
colourise_declarations(Spec, Which, TB, PH),
colourise_decl_options(Options, Which, TB, PT).
colourise_declarations(PI, Which, TB, Pos) :-
colourise_declaration(PI, Which, TB, Pos).
colourise_list_declarations([], _, _, []).
colourise_list_declarations([H|T], Which, TB, [HP|TP]) :-
colourise_declaration(H, Which, TB, HP),
colourise_list_declarations(T, Which, TB, TP).
colourise_table_modes([], _, _).
colourise_table_modes([H|T], TB, [PH|PT]) :-
colourise_table_mode(H, TB, PH),
colourise_table_modes(T, TB, PT).
colourise_table_mode(H, TB, Pos) :-
table_mode(H, Mode),
!,
colour_item(table_mode(Mode), TB, Pos).
colourise_table_mode(lattice(Spec), TB, term_position(_F,_T,FF,FT,[ArgPos])) :-
!,
colour_item(table_mode(lattice), TB, FF-FT),
table_moded_call(Spec, 3, TB, ArgPos).
colourise_table_mode(po(Spec), TB, term_position(_F,_T,FF,FT,[ArgPos])) :-
!,
colour_item(table_mode(po), TB, FF-FT),
table_moded_call(Spec, 2, TB, ArgPos).
colourise_table_mode(_, TB, Pos) :-
colour_item(type_error(table_mode), TB, Pos).
table_mode(Var, index) :-
var(Var),
!.
table_mode(+, index).
table_mode(index, index).
table_mode(-, first).
table_mode(first, first).
table_mode(last, last).
table_mode(min, min).
table_mode(max, max).
table_mode(sum, sum).
table_moded_call(Atom, Arity, TB, Pos) :-
atom(Atom),
functor(Head, Atom, Arity),
goal_classification(TB, Head, [], Class),
colour_item(goal(Class, Head), TB, Pos).
table_moded_call(Atom/Arity, Arity, TB,
term_position(_,_,FF,FT,[NP,AP])) :-
atom(Atom),
!,
functor(Head, Atom, Arity),
goal_classification(TB, Head, [], Class),
colour_item(goal(Class, Head), TB, NP),
colour_item(predicate_indicator, TB, FF-FT),
colour_item(arity, TB, AP).
table_moded_call(Head, Arity, TB, Pos) :-
Pos = term_position(_,_,FF,FT,_),
compound(Head),
!,
compound_name_arity(Head, _Name, Arity),
goal_classification(TB, Head, [], Class),
colour_item(goal(Class, Head), TB, FF-FT),
colourise_term_args(Head, TB, Pos).
table_moded_call(_, _, TB, Pos) :-
colour_item(type_error(predicate_name_or_indicator), TB, Pos).
colourise_decl_options(Options, Which, TB,
parentheses_term_position(_,_,Pos)) :-
!,
colourise_decl_options(Options, Which, TB, Pos).
colourise_decl_options((Head,Tail), Which, TB,
term_position(_,_,_,_,[PH,PT])) :-
!,
colourise_decl_options(Head, Which, TB, PH),
colourise_decl_options(Tail, Which, TB, PT).
colourise_decl_options(Option, Which, TB, Pos) :-
ground(Option),
valid_decl_option(Option, Which),
!,
functor(Option, Name, _),
( Pos = term_position(_,_,FF,FT,[ArgPos])
-> colour_item(decl_option(Name), TB, FF-FT),
( arg(1, Option, Value),
nonneg_or_false(Value)
-> colourise_term_arg(Value, TB, ArgPos)
; colour_item(type_error(decl_option_value(Which)), TB, ArgPos)
)
; colour_item(decl_option(Name), TB, Pos)
).
colourise_decl_options(_, Which, TB, Pos) :-
colour_item(type_error(decl_option(Which)), TB, Pos).
valid_decl_option(subsumptive, table).
valid_decl_option(variant, table).
valid_decl_option(incremental, table).
valid_decl_option(monotonic, table).
valid_decl_option(opaque, table).
valid_decl_option(lazy, table).
valid_decl_option(monotonic, dynamic).
valid_decl_option(incremental, dynamic).
valid_decl_option(abstract(_), dynamic).
valid_decl_option(opaque, dynamic).
valid_decl_option(shared, table).
valid_decl_option(private, table).
valid_decl_option(subgoal_abstract(_), table).
valid_decl_option(answer_abstract(_), table).
valid_decl_option(max_answers(_), table).
valid_decl_option(shared, dynamic).
valid_decl_option(private, dynamic).
valid_decl_option(local, dynamic).
valid_decl_option(multifile, _).
valid_decl_option(discontiguous, _).
valid_decl_option(volatile, _).
nonneg_or_false(Value) :-
var(Value),
!.
nonneg_or_false(Value) :-
integer(Value), Value >= 0,
!.
nonneg_or_false(off).
nonneg_or_false(false).
%! colourise_op_declaration(Op, TB, Pos) is det.
colourise_op_declaration(op(P,T,N), TB, term_position(_,_,FF,FT,[PP,TP,NP])) :-
colour_item(goal(built_in, op(N,T,P)), TB, FF-FT),
colour_op_priority(P, TB, PP),
colour_op_type(T, TB, TP),
colour_op_name(N, TB, NP).
colour_op_name(_, _, Pos) :-
var(Pos),
!.
colour_op_name(Name, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colour_op_name(Name, TB, Pos).
colour_op_name(Name, TB, Pos) :-
var(Name),
!,
colour_item(var, TB, Pos).
colour_op_name(Name, TB, Pos) :-
(atom(Name) ; Name == []),
!,
colour_item(identifier, TB, Pos).
colour_op_name(Module:Name, TB, term_position(_F,_T,QF,QT,[MP,NP])) :-
!,
colourise_module(Module, TB, MP),
colour_item(functor, TB, QF-QT),
colour_op_name(Name, TB, NP).
colour_op_name(List, TB, list_position(F,T,Elems,none)) :-
!,
colour_item(list, TB, F-T),
colour_op_names(List, TB, Elems).
colour_op_name(_, TB, Pos) :-
colour_item(error, TB, Pos).
colour_op_names([], _, []).
colour_op_names([H|T], TB, [HP|TP]) :-
colour_op_name(H, TB, HP),
colour_op_names(T, TB, TP).
colour_op_type(Type, TB, Pos) :-
var(Type),
!,
colour_item(var, TB, Pos).
colour_op_type(Type, TB, Pos) :-
op_type(Type),
!,
colour_item(op_type(Type), TB, Pos).
colour_op_type(_, TB, Pos) :-
colour_item(error, TB, Pos).
colour_op_priority(Priority, TB, Pos) :-
var(Priority), colour_item(var, TB, Pos).
colour_op_priority(Priority, TB, Pos) :-
integer(Priority),
between(0, 1200, Priority),
!,
colour_item(int, TB, Pos).
colour_op_priority(_, TB, Pos) :-
colour_item(error, TB, Pos).
op_type(fx).
op_type(fy).
op_type(xf).
op_type(yf).
op_type(xfy).
op_type(xfx).
op_type(yfx).
%! colourise_prolog_flag_name(+Name, +TB, +Pos)
%
% Colourise the name of a Prolog flag
colourise_prolog_flag_name(_, _, Pos) :-
var(Pos),
!.
colourise_prolog_flag_name(Name, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
colourise_prolog_flag_name(Name, TB, Pos).
colourise_prolog_flag_name(Name, TB, Pos) :-
atom(Name),
!,
( current_prolog_flag(Name, _)
-> colour_item(flag_name(Name), TB, Pos)
; colour_item(no_flag_name(Name), TB, Pos)
).
colourise_prolog_flag_name(Name, TB, Pos) :-
colourise_term(Name, TB, Pos).
/*******************************
* CONFIGURATION *
*******************************/
% body_compiled(+Term)
%
% Succeeds if term is a construct handled by the compiler.
body_compiled((_,_)).
body_compiled((_->_)).
body_compiled((_*->_)).
body_compiled((_;_)).
body_compiled(\+_).
%! goal_classification(+TB, +Goal, +Origin, -Class)
%
% Classify Goal appearing in TB and called from a clause with head
% Origin. For directives, Origin is [].
goal_classification(_, QGoal, _, Class) :-
strip_module(QGoal, _, Goal),
( var(Goal)
-> !, Class = meta
; \+ callable(Goal)
-> !, Class = not_callable
).
goal_classification(_, Goal, Origin, recursion) :-
callable(Origin),
generalise_term(Goal, Origin),
!.
goal_classification(TB, Goal, _, How) :-
colour_state_source_id(TB, SourceId),
xref_defined(SourceId, Goal, How),
How \= public(_),
!.
goal_classification(TB, Goal, _, Class) :-
( colour_state_source_id(TB, SourceId),
xref_module(SourceId, Module)
-> true
; Module = user
),
call_goal_classification(Goal, Module, Class),
!.
goal_classification(TB, Goal, _, How) :-
colour_state_module(TB, Module),
atom(Module),
Module \== prolog_colour_ops,
predicate_property(Module:Goal, imported_from(From)),
!,
How = imported(From).
goal_classification(_TB, _Goal, _, undefined).
%! goal_classification(+Goal, +Module, -Class)
%
% Multifile hookable classification for non-local goals.
call_goal_classification(Goal, Module, Class) :-
catch(global_goal_classification(Goal, Module, Class), _,
Class = type_error(callable)).
global_goal_classification(Goal, _, built_in) :-
built_in_predicate(Goal),
!.
global_goal_classification(Goal, _, autoload(From)) :- % SWI-Prolog
predicate_property(Goal, autoload(From)).
global_goal_classification(Goal, Module, Class) :- % SWI-Prolog
strip_module(Goal, _, PGoal),
current_predicate(_, user:PGoal),
!,
( Module == user
-> Class = global(GClass, Location),
global_location(user:Goal, Location),
global_class(user:Goal, GClass)
; Class = global
).
global_goal_classification(Goal, _, Class) :-
compound(Goal),
compound_name_arity(Goal, Name, Arity),
vararg_goal_classification(Name, Arity, Class).
global_location(Goal, File:Line) :-
predicate_property(Goal, file(File)),
predicate_property(Goal, line_count(Line)),
!.
global_location(_, -).
global_class(Goal, dynamic) :- predicate_property(Goal, dynamic), !.
global_class(Goal, multifile) :- predicate_property(Goal, multifile), !.
global_class(Goal, tabled) :- predicate_property(Goal, tabled), !.
global_class(_, static).
%! vararg_goal_classification(+Name, +Arity, -Class) is semidet.
%
% Multifile hookable classification for _vararg_ predicates.
vararg_goal_classification(call, Arity, built_in) :-
Arity >= 1.
vararg_goal_classification(send_super, Arity, expanded) :- % XPCE (TBD)
Arity >= 2.
vararg_goal_classification(get_super, Arity, expanded) :- % XPCE (TBD)
Arity >= 3.
%! qualified_goal_classification(:Goal, +TB, -Class)
%
% Classify an explicitly qualified goal.
qualified_goal_classification(Goal, TB, Class) :-
goal_classification(TB, Goal, [], Class),
Class \== undefined,
!.
qualified_goal_classification(Module:Goal, _, extern(Module, How)) :-
predicate_property(Module:Goal, visible),
!,
( ( predicate_property(Module:Goal, public)
; predicate_property(Module:Goal, exported)
)
-> How = (public)
; How = (private)
).
qualified_goal_classification(Module:_, _, extern(Module, unknown)).
%! classify_head(+TB, +Head, -Class)
%
% Classify a clause head
classify_head(TB, Goal, exported) :-
colour_state_source_id(TB, SourceId),
xref_exported(SourceId, Goal),
!.
classify_head(_TB, Goal, hook) :-
xref_hook(Goal),
!.
classify_head(TB, Goal, hook) :-
colour_state_source_id(TB, SourceId),
xref_module(SourceId, M),
xref_hook(M:Goal),
!.
classify_head(TB, Goal, Class) :-
built_in_predicate(Goal),
( system_module(TB)
-> ( predicate_property(system:Goal, iso)
-> Class = def_iso
; goal_name(Goal, Name),
\+ sub_atom(Name, 0, _, _, $)
-> Class = def_swi
)
; ( predicate_property(system:Goal, iso)
-> Class = iso
; Class = built_in
)
).
classify_head(TB, Goal, unreferenced) :-
colour_state_source_id(TB, SourceId),
\+ (xref_called(SourceId, Goal, By), By \= Goal),
!.
classify_head(TB, Goal, How) :-
colour_state_source_id(TB, SourceId),
( xref_defined(SourceId, Goal, imported(From))
-> How = imported(From)
; xref_defined(SourceId, Goal, How)
),
!.
classify_head(_TB, _Goal, undefined).
built_in_predicate(Goal) :-
predicate_property(system:Goal, built_in),
!.
built_in_predicate(module(_, _)). % reserved expanded constructs
built_in_predicate(module(_, _, _)).
built_in_predicate(if(_)).
built_in_predicate(elif(_)).
built_in_predicate(else).
built_in_predicate(endif).
goal_name(_:G, Name) :- nonvar(G), !, goal_name(G, Name).
goal_name(G, Name) :- callable(G), functor_name(G, Name).
system_module(TB) :-
colour_state_source_id(TB, SourceId),
xref_module(SourceId, M),
module_property(M, class(system)).
generalise_term(Specific, General) :-
( compound(Specific)
-> compound_name_arity(Specific, Name, Arity),
compound_name_arity(General0, Name, Arity),
General = General0
; General = Specific
).
rename_goal(Goal0, Name, Goal) :-
( compound(Goal0)
-> compound_name_arity(Goal0, _, Arity),
compound_name_arity(Goal, Name, Arity)
; Goal = Name
).
functor_name(Term, Name) :-
( compound(Term)
-> compound_name_arity(Term, Name, _)
; atom(Term)
-> Name = Term
).
goal_name_arity(Goal, Name, Arity) :-
( compound(Goal)
-> compound_name_arity(Goal, Name, Arity)
; atom(Goal)
-> Name = Goal, Arity = 0
).
call_goal_colours(Term, Colours) :-
goal_colours(Term, Colours),
!.
call_goal_colours(Term, Colours) :-
def_goal_colours(Term, Colours).
call_goal_colours(Term, Class, Colours) :-
goal_colours(Term, Class, Colours),
!.
%call_goal_colours(Term, Class, Colours) :-
% def_goal_colours(Term, Class, Colours).
% Specify colours for individual goals.
def_goal_colours(module(_,_), built_in-[identifier,exports]).
def_goal_colours(module(_,_,_), built_in-[identifier,exports,langoptions]).
def_goal_colours(use_module(_), built_in-[imported_file]).
def_goal_colours(use_module(File,_), built_in-[file,imports(File)]).
def_goal_colours(autoload(_), built_in-[imported_file]).
def_goal_colours(autoload(File,_), built_in-[file,imports(File)]).
def_goal_colours(reexport(_), built_in-[file]).
def_goal_colours(reexport(File,_), built_in-[file,imports(File)]).
def_goal_colours(dynamic(_), built_in-[declarations(dynamic)]).
def_goal_colours(thread_local(_), built_in-[declarations(thread_local)]).
def_goal_colours(module_transparent(_), built_in-[declarations(module_transparent)]).
def_goal_colours(discontiguous(_), built_in-[declarations(discontiguous)]).
def_goal_colours(multifile(_), built_in-[declarations(multifile)]).
def_goal_colours(volatile(_), built_in-[declarations(volatile)]).
def_goal_colours(public(_), built_in-[declarations(public)]).
def_goal_colours(det(_), built_in-[declarations(det)]).
def_goal_colours(table(_), built_in-[declarations(table)]).
def_goal_colours(meta_predicate(_), built_in-[meta_declarations]).
def_goal_colours(consult(_), built_in-[file]).
def_goal_colours(include(_), built_in-[file]).
def_goal_colours(ensure_loaded(_), built_in-[file]).
def_goal_colours(load_files(_), built_in-[file]).
def_goal_colours(load_files(_,_), built_in-[file,options]).
def_goal_colours(setof(_,_,_), built_in-[classify,setof,classify]).
def_goal_colours(bagof(_,_,_), built_in-[classify,setof,classify]).
def_goal_colours(predicate_options(_,_,_), built_in-[predicate,classify,classify]).
% Database access
def_goal_colours(assert(_), built_in-[db]).
def_goal_colours(asserta(_), built_in-[db]).
def_goal_colours(assertz(_), built_in-[db]).
def_goal_colours(assert(_,_), built_in-[db,classify]).
def_goal_colours(asserta(_,_), built_in-[db,classify]).
def_goal_colours(assertz(_,_), built_in-[db,classify]).
def_goal_colours(retract(_), built_in-[db]).
def_goal_colours(retractall(_), built_in-[db]).
def_goal_colours(clause(_,_), built_in-[db,classify]).
def_goal_colours(clause(_,_,_), built_in-[db,classify,classify]).
% misc
def_goal_colours(set_prolog_flag(_,_), built_in-[prolog_flag_name,classify]).
def_goal_colours(current_prolog_flag(_,_), built_in-[prolog_flag_name,classify]).
% XPCE stuff
def_goal_colours(pce_autoload(_,_), classify-[classify,file]).
def_goal_colours(pce_image_directory(_), classify-[directory]).
def_goal_colours(new(_, _), built_in-[classify,pce_new]).
def_goal_colours(send_list(_,_,_), built_in-pce_arg_list).
def_goal_colours(send(_,_), built_in-[pce_arg,pce_selector]).
def_goal_colours(get(_,_,_), built_in-[pce_arg,pce_selector,pce_arg]).
def_goal_colours(send_super(_,_), built_in-[pce_arg,pce_selector]).
def_goal_colours(get_super(_,_), built_in-[pce_arg,pce_selector,pce_arg]).
def_goal_colours(get_chain(_,_,_), built_in-[pce_arg,pce_selector,pce_arg]).
def_goal_colours(Pce, built_in-pce_arg) :-
compound(Pce),
functor_name(Pce, Functor),
pce_functor(Functor).
pce_functor(send).
pce_functor(get).
pce_functor(send_super).
pce_functor(get_super).
/*******************************
* SPECIFIC HEADS *
*******************************/
head_colours(file_search_path(_,_), hook-[identifier,classify]).
head_colours(library_directory(_), hook-[file]).
head_colours(resource(_,_), hook-[identifier,file]).
head_colours(resource(_,_,_), hook-[identifier,file,classify]).
head_colours(Var, _) :-
var(Var),
!,
fail.
head_colours(M:H, Colours) :-
M == user,
head_colours(H, HC),
HC = hook - _,
!,
Colours = meta-[module(user), HC ].
head_colours(M:H, Colours) :-
atom(M), callable(H),
xref_hook(M:H),
!,
Colours = meta-[module(M), hook-classify ].
head_colours(M:_, meta-[module(M),extern(M)]).
/*******************************
* STYLES *
*******************************/
%! def_style(+Pattern, -Style)
%
% Define the style used for the given pattern. Definitions here
% can be overruled by defining rules for
% emacs_prolog_colours:style/2
def_style(goal(built_in,_), [colour(blue)]).
def_style(goal(imported(_),_), [colour(blue)]).
def_style(goal(autoload(_),_), [colour(navy_blue)]).
def_style(goal(global,_), [colour(navy_blue)]).
def_style(goal(global(dynamic,_),_), [colour(magenta)]).
def_style(goal(global(_,_),_), [colour(navy_blue)]).
def_style(goal(undefined,_), [colour(red)]).
def_style(goal(thread_local(_),_), [colour(magenta), underline(true)]).
def_style(goal(dynamic(_),_), [colour(magenta)]).
def_style(goal(multifile(_),_), [colour(navy_blue)]).
def_style(goal(expanded,_), [colour(blue), underline(true)]).
def_style(goal(extern(_),_), [colour(blue), underline(true)]).
def_style(goal(extern(_,private),_), [colour(red)]).
def_style(goal(extern(_,public),_), [colour(blue)]).
def_style(goal(recursion,_), [underline(true)]).
def_style(goal(meta,_), [colour(red4)]).
def_style(goal(foreign(_),_), [colour(darkturquoise)]).
def_style(goal(local(_),_), []).
def_style(goal(constraint(_),_), [colour(darkcyan)]).
def_style(goal(not_callable,_), [background(orange)]).
def_style(option_name, [colour('#3434ba')]).
def_style(no_option_name, [colour(red)]).
def_style(neck(_), [bold(true)]).
def_style(head(exported,_), [colour(blue), bold(true)]).
def_style(head(public(_),_), [colour('#016300'), bold(true)]).
def_style(head(extern(_),_), [colour(blue), bold(true)]).
def_style(head(dynamic,_), [colour(magenta), bold(true)]).
def_style(head(multifile,_), [colour(navy_blue), bold(true)]).
def_style(head(unreferenced,_), [colour(red), bold(true)]).
def_style(head(hook,_), [colour(blue), underline(true)]).
def_style(head(meta,_), []).
def_style(head(constraint(_),_), [colour(darkcyan), bold(true)]).
def_style(head(imported(_),_), [colour(darkgoldenrod4), bold(true)]).
def_style(head(built_in,_), [background(orange), bold(true)]).
def_style(head(iso,_), [background(orange), bold(true)]).
def_style(head(def_iso,_), [colour(blue), bold(true)]).
def_style(head(def_swi,_), [colour(blue), bold(true)]).
def_style(head(_,_), [bold(true)]).
def_style(rule_condition, [background('#d4ffe3')]).
def_style(module(_), [colour(dark_slate_blue)]).
def_style(comment(_), [colour(dark_green)]).
def_style(directive, [background(grey90)]).
def_style(method(_), [bold(true)]).
def_style(var, [colour(red4)]).
def_style(singleton, [bold(true), colour(red4)]).
def_style(unbound, [colour(red), bold(true)]).
def_style(quoted_atom, [colour(navy_blue)]).
def_style(string, [colour(navy_blue)]).
def_style(rational(_), [colour(steel_blue)]).
def_style(codes, [colour(navy_blue)]).
def_style(chars, [colour(navy_blue)]).
def_style(nofile, [colour(red)]).
def_style(file(_), [colour(blue), underline(true)]).
def_style(file_no_depend(_), [colour(blue), underline(true), background(pink)]).
def_style(directory(_), [colour(blue)]).
def_style(class(built_in,_), [colour(blue), underline(true)]).
def_style(class(library(_),_), [colour(navy_blue), underline(true)]).
def_style(class(local(_,_,_),_), [underline(true)]).
def_style(class(user(_),_), [underline(true)]).
def_style(class(user,_), [underline(true)]).
def_style(class(undefined,_), [colour(red), underline(true)]).
def_style(prolog_data, [colour(blue), underline(true)]).
def_style(flag_name(_), [colour(blue)]).
def_style(no_flag_name(_), [colour(red)]).
def_style(unused_import, [colour(blue), background(pink)]).
def_style(undefined_import, [colour(red)]).
def_style(constraint(_), [colour(darkcyan)]).
def_style(keyword(_), [colour(blue)]).
def_style(identifier, [bold(true)]).
def_style(delimiter, [bold(true)]).
def_style(expanded, [colour(blue), underline(true)]).
def_style(hook(_), [colour(blue), underline(true)]).
def_style(op_type(_), [colour(blue)]).
def_style(qq_type, [bold(true)]).
def_style(qq(_), [colour(blue), bold(true)]).
def_style(qq_content(_), [colour(red4)]).
def_style(dict_tag, [bold(true)]).
def_style(dict_key, [bold(true)]).
def_style(dict_function(_), [colour(navy_blue)]).
def_style(dict_return_op, [colour(blue)]).
def_style(hook, [colour(blue), underline(true)]).
def_style(dcg_right_hand_ctx, [background('#d4ffe3')]).
def_style(error, [background(orange)]).
def_style(type_error(_), [background(orange)]).
def_style(syntax_error(_,_), [background(orange)]).
def_style(instantiation_error, [background(orange)]).
def_style(decl_option(_), [bold(true)]).
def_style(table_mode(_), [bold(true)]).
%! syntax_colour(?Class, ?Attributes) is nondet.
%
% True when a range classified Class must be coloured using
% Attributes. Attributes is a list of:
%
% * colour(ColourName)
% * background(ColourName)
% * bold(Boolean)
% * underline(Boolean)
%
% Attributes may be the empty list. This is used for cases where
% -for example- a menu is associated with the fragment. If
% syntax_colour/2 fails, no fragment is created for the region.
syntax_colour(Class, Attributes) :-
( style(Class, Attributes) % user hook
; def_style(Class, Attributes) % system default
).
%! term_colours(+Term, -FunctorColour, -ArgColours)
%
% Define colourisation for specific terms.
term_colours((?- Directive), Colours) :-
term_colours((:- Directive), Colours).
term_colours((prolog:Head --> _),
neck(-->) - [ expanded - [ module(prolog),
hook(message) - [ identifier
]
],
dcg_body(prolog:Head)
]) :-
prolog_message_hook(Head).
prolog_message_hook(message(_)).
prolog_message_hook(deprecated(_)).
prolog_message_hook(error_message(_)).
prolog_message_hook(message_context(_)).
prolog_message_hook(message_location(_)).
% XPCE rules
term_colours(variable(_, _, _, _),
expanded - [ identifier,
classify,
classify,
comment(string)
]).
term_colours(variable(_, _, _),
expanded - [ identifier,
classify,
atom
]).
term_colours(handle(_, _, _),
expanded - [ classify,
classify,
classify
]).
term_colours(handle(_, _, _, _),
expanded - [ classify,
classify,
classify,
classify
]).
term_colours(class_variable(_,_,_,_),
expanded - [ identifier,
pce(type),
pce(default),
comment(string)
]).
term_colours(class_variable(_,_,_),
expanded - [ identifier,
pce(type),
pce(default)
]).
term_colours(delegate_to(_),
expanded - [ classify
]).
term_colours((:- encoding(_)),
expanded - [ expanded - [ classify
]
]).
term_colours((:- pce_begin_class(_, _, _)),
expanded - [ expanded - [ identifier,
pce_new,
comment(string)
]
]).
term_colours((:- pce_begin_class(_, _)),
expanded - [ expanded - [ identifier,
pce_new
]
]).
term_colours((:- pce_extend_class(_)),
expanded - [ expanded - [ identifier
]
]).
term_colours((:- pce_end_class),
expanded - [ expanded
]).
term_colours((:- pce_end_class(_)),
expanded - [ expanded - [ identifier
]
]).
term_colours((:- use_class_template(_)),
expanded - [ expanded - [ pce_new
]
]).
term_colours((:- emacs_begin_mode(_,_,_,_,_)),
expanded - [ expanded - [ identifier,
classify,
classify,
classify,
classify
]
]).
term_colours((:- emacs_extend_mode(_,_)),
expanded - [ expanded - [ identifier,
classify
]
]).
term_colours((:- pce_group(_)),
expanded - [ expanded - [ identifier
]
]).
term_colours((:- pce_global(_, new(_))),
expanded - [ expanded - [ identifier,
pce_arg
]
]).
term_colours((:- emacs_end_mode),
expanded - [ expanded
]).
term_colours(pce_ifhostproperty(_,_),
expanded - [ classify,
classify
]).
term_colours((_,_),
error - [ classify,
classify
]).
%! specified_item(+Specified, +Term, +TB, +TermPosition) is det.
%
% Colourise an item that is explicitly classified by the user using
% term_colours/2 or goal_colours/2.
specified_item(_Class, _Term, _TB, Pos) :-
var(Pos),
!.
specified_item(Class, Term, TB, parentheses_term_position(PO,PC,Pos)) :-
!,
colour_item(parentheses, TB, PO-PC),
specified_item(Class, Term, TB, Pos).
specified_item(_, Var, TB, Pos) :-
( var(Var)
; qq_position(Pos)
),
!,
colourise_term_arg(Var, TB, Pos).
% generic classification
specified_item(classify, Term, TB, Pos) :-
!,
colourise_term_arg(Term, TB, Pos).
% classify as head
specified_item(head, Term, TB, Pos) :-
!,
colourise_clause_head(Term, TB, Pos).
% expanded head (DCG=2, ...)
specified_item(head(+N), Term, TB, Pos) :-
!,
colourise_extended_head(Term, N, TB, Pos).
% M:Head
specified_item(extern(M), Term, TB, Pos) :-
!,
colourise_extern_head(Term, M, TB, Pos).
% classify as body
specified_item(body, Term, TB, Pos) :-
!,
colourise_body(Term, TB, Pos).
specified_item(body(Goal), _Term0, TB, Pos) :-
!,
colourise_body(Goal, TB, Pos).
specified_item(dcg_body(Head), Term, TB, Pos) :-
!,
colourise_dcg(Term, Head, TB, Pos).
specified_item(setof, Term, TB, Pos) :-
!,
colourise_setof(Term, TB, Pos).
specified_item(meta(MetaSpec), Term, TB, Pos) :-
!,
colourise_meta_arg(MetaSpec, Term, TB, Pos).
% DCG goal in body
specified_item(dcg, Term, TB, Pos) :-
!,
colourise_dcg(Term, [], TB, Pos).
% assert/retract arguments
specified_item(db, Term, TB, Pos) :-
!,
colourise_db(Term, TB, Pos).
% error(Error)
specified_item(error(Error), _Term, TB, Pos) :-
colour_item(Error, TB, Pos).
% files
specified_item(file(Path), _Term, TB, Pos) :-
!,
colour_item(file(Path), TB, Pos).
specified_item(file, Term, TB, Pos) :-
!,
colourise_files(Term, TB, Pos, any).
specified_item(imported_file, Term, TB, Pos) :-
!,
colourise_files(Term, TB, Pos, imported).
specified_item(langoptions, Term, TB, Pos) :-
!,
colourise_langoptions(Term, TB, Pos).
% directory
specified_item(directory, Term, TB, Pos) :-
!,
colourise_directory(Term, TB, Pos).
% [Name/Arity, ...]
specified_item(exports, Term, TB, Pos) :-
!,
colourise_exports(Term, TB, Pos).
% [Name/Arity, ...]
specified_item(imports(File), Term, TB, Pos) :-
!,
colourise_imports(Term, File, TB, Pos).
% Name/Arity
specified_item(import(File), Term, TB, Pos) :-
!,
colourise_import(Term, File, TB, Pos).
% Name/Arity, ...
specified_item(predicates, Term, TB, Pos) :-
!,
colourise_declarations(Term, predicate_indicator, TB, Pos).
% Name/Arity
specified_item(predicate, Term, TB, Pos) :-
!,
colourise_declaration(Term, predicate_indicator, TB, Pos).
% head(Arg, ...)
specified_item(meta_declarations, Term, TB, Pos) :-
!,
colourise_meta_declarations(Term, [], TB, Pos).
specified_item(meta_declarations(Extra), Term, TB, Pos) :-
!,
colourise_meta_declarations(Term, Extra, TB, Pos).
specified_item(declarations(Which), Term, TB, Pos) :-
!,
colourise_declarations(Term, Which, TB, Pos).
% set_prolog_flag(Name, _)
specified_item(prolog_flag_name, Term, TB, Pos) :-
!,
colourise_prolog_flag_name(Term, TB, Pos).
% XPCE new argument
specified_item(pce_new, Term, TB, Pos) :-
!,
( atom(Term)
-> colourise_class(Term, TB, Pos)
; compound(Term)
-> functor_name(Term, Class),
Pos = term_position(_,_,FF, FT, ArgPos),
colourise_class(Class, TB, FF-FT),
specified_items(pce_arg, Term, TB, ArgPos)
; colourise_term_arg(Term, TB, Pos)
).
% Generic XPCE arguments
specified_item(pce_arg, new(X), TB,
term_position(_,_,_,_,[ArgPos])) :-
!,
specified_item(pce_new, X, TB, ArgPos).
specified_item(pce_arg, new(X, T), TB,
term_position(_,_,_,_,[P1, P2])) :-
!,
colourise_term_arg(X, TB, P1),
specified_item(pce_new, T, TB, P2).
specified_item(pce_arg, @(Ref), TB, Pos) :-
!,
colourise_term_arg(@(Ref), TB, Pos).
specified_item(pce_arg, prolog(Term), TB,
term_position(_,_,FF,FT,[ArgPos])) :-
!,
colour_item(prolog_data, TB, FF-FT),
colourise_term_arg(Term, TB, ArgPos).
specified_item(pce_arg, Term, TB, Pos) :-
compound(Term),
Term \= [_|_],
\+ is_dict(Term),
!,
specified_item(pce_new, Term, TB, Pos).
specified_item(pce_arg, Term, TB, Pos) :-
!,
colourise_term_arg(Term, TB, Pos).
% List of XPCE arguments
specified_item(pce_arg_list, List, TB, list_position(F,T,Elms,Tail)) :-
!,
colour_item(list, TB, F-T),
colourise_list_args(Elms, Tail, List, TB, pce_arg).
specified_item(pce_arg_list, Term, TB, Pos) :-
!,
specified_item(pce_arg, Term, TB, Pos).
% XPCE selector
specified_item(pce_selector, Term, TB,
term_position(_,_,_,_,ArgPos)) :-
!,
specified_items(pce_arg, Term, TB, ArgPos).
specified_item(pce_selector, Term, TB, Pos) :-
colourise_term_arg(Term, TB, Pos).
% Nested specification
specified_item(FuncSpec-ArgSpecs, Term, TB,
term_position(_,_,FF,FT,ArgPos)) :-
!,
specified_item(FuncSpec, Term, TB, FF-FT),
specified_items(ArgSpecs, Term, TB, ArgPos).
% Nested for {...}
specified_item(FuncSpec-[ArgSpec], {Term}, TB,
brace_term_position(F,T,ArgPos)) :-
!,
specified_item(FuncSpec, {Term}, TB, F-T),
specified_item(ArgSpec, Term, TB, ArgPos).
% Specified
specified_item(FuncSpec-ElmSpec, List, TB,
list_position(F,T,ElmPos,TailPos)) :-
!,
colour_item(FuncSpec, TB, F-T),
specified_list(ElmSpec, List, TB, ElmPos, TailPos).
specified_item(Class, _, TB, Pos) :-
colour_item(Class, TB, Pos).
%! specified_items(+Spec, +Term, +TB, +PosList)
specified_items(Specs, Term, TB, PosList) :-
is_dict(Term),
!,
specified_dict_kv(PosList, Term, TB, Specs).
specified_items(Specs, Term, TB, PosList) :-
is_list(Specs),
!,
specified_arglist(Specs, 1, Term, TB, PosList).
specified_items(Spec, Term, TB, PosList) :-
specified_argspec(PosList, Spec, 1, Term, TB).
specified_arglist([], _, _, _, _).
specified_arglist(_, _, _, _, []) :- !. % Excess specification args
specified_arglist([S0|ST], N, T, TB, [P0|PT]) :-
( S0 == options,
colourization_module(TB, Module),
colourise_option_arg(T, Module, N, TB, P0)
-> true
; arg(N, T, Term),
specified_item(S0, Term, TB, P0)
),
NN is N + 1,
specified_arglist(ST, NN, T, TB, PT).
specified_argspec([], _, _, _, _).
specified_argspec([P0|PT], Spec, N, T, TB) :-
arg(N, T, Term),
specified_item(Spec, Term, TB, P0),
NN is N + 1,
specified_argspec(PT, Spec, NN, T, TB).
% specified_list(+Spec, +List, +TB, +PosList, TailPos)
specified_list([], [], _, [], _).
specified_list([HS|TS], [H|T], TB, [HP|TP], TailPos) :-
!,
specified_item(HS, H, TB, HP),
specified_list(TS, T, TB, TP, TailPos).
specified_list(Spec, [H|T], TB, [HP|TP], TailPos) :-
specified_item(Spec, H, TB, HP),
specified_list(Spec, T, TB, TP, TailPos).
specified_list(_, _, _, [], none) :- !.
specified_list(Spec, Tail, TB, [], TailPos) :-
specified_item(Spec, Tail, TB, TailPos).
%! specified_dict_kv(+PosList, +Term, +TB, +Specs)
%
% @arg Specs is a list of dict_kv(+Key, +KeySpec, +ArgSpec)
specified_dict_kv([], _, _, _).
specified_dict_kv([key_value_position(_F,_T,SF,ST,K,KP,VP)|Pos],
Dict, TB, Specs) :-
specified_dict_kv1(K, Specs, KeySpec, ValueSpec),
colour_item(KeySpec, TB, KP),
colour_item(dict_sep, TB, SF-ST),
get_dict(K, Dict, V),
specified_item(ValueSpec, V, TB, VP),
specified_dict_kv(Pos, Dict, TB, Specs).
specified_dict_kv1(Key, Specs, KeySpec, ValueSpec) :-
Specs = [_|_],
memberchk(dict_kv(Key, KeySpec, ValueSpec), Specs),
!.
specified_dict_kv1(Key, dict_kv(Key2, KeySpec, ValueSpec), KeySpec, ValueSpec) :-
\+ Key \= Key2,
!. % do not bind Key2
specified_dict_kv1(_, _, dict_key, classify).
/*******************************
* DESCRIPTIONS *
*******************************/
syntax_message(Class) -->
message(Class),
!.
syntax_message(qq(_)) -->
[ 'Quasi quote delimiter' ].
syntax_message(qq_type) -->
[ 'Quasi quote type term' ].
syntax_message(qq_content(Type)) -->
[ 'Quasi quote content (~w syntax)'-[Type] ].
syntax_message(goal(Class, Goal)) -->
!,
goal_message(Class, Goal).
syntax_message(class(Type, Class)) -->
!,
xpce_class_message(Type, Class).
syntax_message(dict_return_op) -->
!,
[ ':= separates function from return value' ].
syntax_message(dict_function) -->
!,
[ 'Function on a dict' ].
syntax_message(ext_quant) -->
!,
[ 'Existential quantification operator' ].
syntax_message(hook(message)) -->
[ 'Rule for print_message/2' ].
syntax_message(module(Module)) -->
( { current_module(Module) }
-> ( { module_property(Module, file(File)) }
-> [ 'Module ~w defined in ~w'-[Module,File] ]
; [ 'Module ~w'-[Module] ]
)
; [ 'Module ~w (not loaded)'-[Module] ]
).
syntax_message(decl_option(incremental)) -->
[ 'Keep affected tables consistent' ].
syntax_message(decl_option(abstract)) -->
[ 'Add abstracted goal to table dependency graph' ].
syntax_message(decl_option(volatile)) -->
[ 'Do not include predicate in a saved program' ].
syntax_message(decl_option(multifile)) -->
[ 'Clauses are spread over multiple files' ].
syntax_message(decl_option(discontiguous)) -->
[ 'Clauses are not contiguous' ].
syntax_message(decl_option(private)) -->
[ 'Tables or clauses are private to a thread' ].
syntax_message(decl_option(local)) -->
[ 'Tables or clauses are private to a thread' ].
syntax_message(decl_option(shared)) -->
[ 'Tables or clauses are shared between threads' ].
syntax_message(decl_option(_Opt)) -->
[ 'Predicate property' ].
syntax_message(rational(Value)) -->
[ 'Rational number ~w'-[Value] ].
syntax_message(rule_condition) -->
[ 'Guard' ].
syntax_message(neck(=>)) -->
[ 'Rule' ].
syntax_message(neck(-->)) -->
[ 'Grammar rule' ].
goal_message(meta, _) -->
[ 'Meta call' ].
goal_message(not_callable, _) -->
[ 'Goal is not callable (type error)' ].
goal_message(expanded, _) -->
[ 'Expanded goal' ].
goal_message(Class, Goal) -->
{ predicate_name(Goal, PI) },
[ 'Call to ~q'-PI ],
goal_class(Class).
goal_class(recursion) -->
[ ' (recursive call)' ].
goal_class(undefined) -->
[ ' (undefined)' ].
goal_class(global) -->
[ ' (Auto-imported from module user)' ].
goal_class(global(Class, File:Line)) -->
[ ' (~w in user module from ~w:~w)'-[Class, File, Line] ].
goal_class(global(Class, source_location(File,Line))) -->
[ ' (~w in user module from ~w:~w)'-[Class, File, Line] ].
goal_class(global(Class, -)) -->
[ ' (~w in user module)'-[Class] ].
goal_class(imported(From)) -->
[ ' (imported from ~q)'-[From] ].
goal_class(extern(_, private)) -->
[ ' (WARNING: private predicate)' ].
goal_class(extern(_, public)) -->
[ ' (public predicate)' ].
goal_class(extern(_)) -->
[ ' (cross-module call)' ].
goal_class(Class) -->
[ ' (~p)'-[Class] ].
xpce_class_message(Type, Class) -->
[ 'XPCE ~w class ~q'-[Type, Class] ].