1:- module(lsp_highlights, [ highlights_at_position/3 ]).    2
    3:- include('_lsp_path_add.pl').    4
    5:- use_module(library(apply), [maplist/2]).    6:- use_module(library(apply_macros)).    7:- use_module(library(yall)).    8
    9:- use_module(lsp(lsp_reading_source)).   10
   11highlights_at_position(Path, Position, Highlights) :-
   12    highlights_at_position(Path, Position, _, Highlights).
   13
   14highlights_at_position(Path, line_char(Line1, Char0), Leaf, Highlights) :-
   15    file_lines_start_end(Path, LineCharRange),
   16    read_term_positions(Path, TermsWithPositions),
   17    % find the top-level term that the offset falls within
   18    file_offset_line_position(LineCharRange, Offset, Line1, Char0),
   19    % find the specific sub-term containing the point
   20    member(TermInfo, TermsWithPositions),
   21    SubTermPoses = TermInfo.subterm,
   22    arg(1, SubTermPoses, TermFrom),
   23    arg(2, SubTermPoses, TermTo),
   24    between(TermFrom, TermTo, Offset), !,
   25    subterm_leaf_position(TermInfo.term, Offset, SubTermPoses, Leaf),
   26    ( Leaf = '$var'(_)
   27      % if it's a variable, only look inside the containing term
   28    -> find_occurrences_of_var(Leaf, TermInfo, Matches)
   29    % if it's the functor of a term, find all occurrences in the file
   30    ; functor(Leaf, FuncName, Arity),
   31      find_occurrences_of_func(FuncName, Arity, TermsWithPositions, Matches)
   32    ),
   33    maplist(position_to_match(LineCharRange), Matches, Highlights).
   34
   35find_occurrences_of_func(FuncName, Arity, TermInfos, Matches) :-
   36    find_occurrences_of_func(FuncName, Arity, TermInfos, Matches, []).
   37find_occurrences_of_func(_, _, [], Tail, Tail).
   38find_occurrences_of_func(FuncName, Arity, [TermInfo|Rest], Matches, Tail) :-
   39    find_in_term_with_positions({FuncName, Arity}/[X, _]>>( nonvar(X),
   40                                                            functor(X, FuncName, Arity) ),
   41                                TermInfo.term, TermInfo.subterm, Matches, Tail0),
   42    find_occurrences_of_func(FuncName, Arity, Rest, Tail0, Tail).
   43
   44find_occurrences_of_var(Var, TermInfo, Matches) :-
   45    Var = '$var'(Name), ground(Name), % wrapped term; otherwise it's anonymous & matches nothing
   46    Term = TermInfo.term,
   47    Poses = TermInfo.subterm,
   48    find_in_term_with_positions({Var}/[X, _]>>( ground(X), X = Var ), Term, Poses,
   49                                Matches, [])