1:- module(lsp_utils, [called_at/4,
    2                      defined_at/3,
    3                      name_callable/2,
    4                      relative_ref_location/4,
    5                      help_at_position/4,
    6                      clause_in_file_at_position/3,
    7                      clause_variable_positions/3,
    8                      seek_to_line/2,
    9                      linechar_offset/3
   10                     ]).

   19:- use_module(library(apply_macros)).   20:- use_module(library(apply), [maplist/3, exclude/3]).   21:- use_module(library(prolog_xref)).   22:- use_module(library(prolog_source), [read_source_term_at_location/3]).   23:- use_module(library(help), [help_html/3, help_objects/3]).   24:- use_module(library(lynx/html_text), [html_text/1]).   25:- use_module(library(solution_sequences), [distinct/2]).   26:- use_module(library(lists), [append/3, member/2, selectchk/4]).   27:- use_module(library(sgml), [load_html/3]).   28
   29:- if(current_predicate(xref_called/5)).

 called_at(+Path:atom, +Clause:term, -By:term, -Location:term) is nondet

Find the callers and locations of the goal Clause, starting from the file Path. Location will be bound to all the callers and locations that the Clause is called from like Caller-Location.

See also

- find_subclause/4

   36called_at(Path, Clause, By, Location) :-
   37    name_callable(Clause, Callable),
   38    xref_source(Path),
   39    xref_called(Path, Callable, By, _, CallerLine),
   40    setup_call_cleanup(
   41        open(Path, read, Stream, []),
   42        ( find_subclause(Stream, Clause, CallerLine, Locations),
   43          member(Location, Locations),
   44          Location \= position(_, 0) ),
   45        close(Stream)
   46    ).
   47called_at(Path, Name/Arity, By, Location) :-
   48    DcgArity is Arity + 2,
   49    name_callable(Name/DcgArity, Callable),
   50    xref_source(Path),
   51    xref_called(Path, Callable, By, _, CallerLine),
   52    setup_call_cleanup(
   53        open(Path, read, Stream, []),
   54        ( find_subclause(Stream, Name/Arity, CallerLine, Locations),
   55          member(Location, Locations),
   56          Location \= position(_, 0) ),
   57        close(Stream)
   58    ).
   59:- else.   60called_at(Path, Callable, By, Ref) :-
   61    xref_called(Path, Callable, By),
   62    xref_defined(Path, By, Ref).
   63:- endif.   64
   65defined_at(Path, Name/Arity, Location) :-
   66    name_callable(Name/Arity, Callable),
   67    xref_source(Path),
   68    xref_defined(Path, Callable, Ref),
   69    atom_concat('file://', Path, Doc),
   70    relative_ref_location(Doc, Callable, Ref, Location).
   71defined_at(Path, Name/Arity, Location) :-
   72    % maybe it's a DCG?
   73    DcgArity is Arity + 2,
   74    name_callable(Name/DcgArity, Callable),
   75    xref_source(Path),
   76    xref_defined(Path, Callable, Ref),
   77    atom_concat('file://', Path, Doc),
   78    relative_ref_location(Doc, Callable, Ref, Location).
   79
   80
   81find_subclause(Stream, Subclause, CallerLine, Locations) :-
   82    read_source_term_at_location(Stream, Term, [line(CallerLine),
   83                                                subterm_positions(Poses)]),
   84    findall(Offset, distinct(Offset, find_clause(Term, Offset, Poses, Subclause)),
   85            Offsets),
   86    collapse_adjacent(Offsets, StartOffsets),
   87    maplist(offset_line_char(Stream), StartOffsets, Locations).
   88
   89offset_line_char(Stream, Offset, position(Line, Char)) :-
   90    % seek(Stream, 0, bof, _),
   91    % for some reason, seek/4 isn't zeroing stream line position
   92    set_stream_position(Stream, '$stream_position'(0,0,0,0)),
   93    setup_call_cleanup(
   94        open_null_stream(NullStream),
   95        copy_stream_data(Stream, NullStream, Offset),
   96        close(NullStream)
   97    ),
   98    stream_property(Stream, position(Pos)),
   99    stream_position_data(line_count, Pos, Line),
  100    stream_position_data(line_position, Pos, Char).
  101
  102collapse_adjacent([X|Rst], [X|CRst]) :-
  103    collapse_adjacent(X, Rst, CRst).
  104collapse_adjacent(X, [Y|Rst], CRst) :-
  105    succ(X, Y), !,
  106    collapse_adjacent(Y, Rst, CRst).
  107collapse_adjacent(_, [X|Rst], [X|CRst]) :- !,
  108    collapse_adjacent(X, Rst, CRst).
  109collapse_adjacent(_, [], []).

 name_callable(?Name:functor, ?Callable:term) is det

True when, if Name = Func/Arity, Callable = Func(_, _, ...) with Arity args.

  115name_callable(Name/0, Name) :- atom(Name), !.
  116name_callable(Name/Arity, Callable) :-
  117    length(FakeArgs, Arity),
  118    Callable =.. [Name|FakeArgs], !.

 relative_ref_location(+Path:atom, +Goal:term, +Position:position(int,int), -Location:dict) is semidet

Given Goal found in Path and position Position (from called_at/3), Location is a dictionary suitable for sending as an LSP response indicating the position in a file of Goal.

  124relative_ref_location(Here, _, position(Line0, Char1),
  125                      _{uri: Here, range: _{start: _{line: Line0, character: Char1},
  126                                            end: _{line: Line1, character: 0}}}) :-
  127    !, succ(Line0, Line1).
  128relative_ref_location(Here, _, local(Line1),
  129                      _{uri: Here, range: _{start: _{line: Line0, character: 1},
  130                                            end: _{line: NextLine, character: 0}}}) :-
  131    !, succ(Line0, Line1), succ(Line1, NextLine).
  132relative_ref_location(_, Goal, imported(Path), Location) :-
  133    atom_concat('file://', Path, ThereUri),
  134    xref_source(Path),
  135    xref_defined(Path, Goal, Loc),
  136    relative_ref_location(ThereUri, Goal, Loc, Location).

 help_at_position(+Path:atom, +Line:integer, +Char:integer, -Help:string) is det

Help is the documentation for the term under the cursor at line Line, character Char in the file Path.

  142help_at_position(Path, Line1, Char0, S) :-
  143    clause_in_file_at_position(Clause, Path, line_char(Line1, Char0)),
  144    predicate_help(Path, Clause, S0),
  145    format_help(S0, S).

 format_help(+Help0, -Help1) is det

Reformat help string, so the first line is the signature of the predicate.

  150format_help(HelpFull, Help) :-
  151    split_string(HelpFull, "\n", " ", Lines0),
  152    exclude([Line]>>string_concat("Availability: ", _, Line),
  153            Lines0, Lines1),
  154    exclude([""]>>true, Lines1, Lines2),
  155    Lines2 = [HelpShort|_],
  156    split_string(HelpFull, "\n", "", HelpLines),
  157    selectchk(HelpShort, HelpLines, "", HelpLines0),
  158    append([HelpShort], HelpLines0, HelpLines1),
  159    atomic_list_concat(HelpLines1, "\n", Help).
  160
  161predicate_help(_, Pred, Help) :-
  162    nonvar(Pred),
  163    help_objects(Pred, exact, Matches), !,
  164    catch(help_html(Matches, exact-exact, HtmlDoc), _, fail),
  165    setup_call_cleanup(open_string(HtmlDoc, In),
  166                       load_html(stream(In), Dom, []),
  167                       close(In)),
  168    with_output_to(string(Help), html_text(Dom)).
  169predicate_help(HerePath, Pred, Help) :-
  170    xref_source(HerePath),
  171    name_callable(Pred, Callable),
  172    xref_defined(HerePath, Callable, Loc),
  173    location_path(HerePath, Loc, Path),
  174    once(xref_comment(Path, Callable, Summary, Comment)),
  175    pldoc_process:parse_comment(Comment, Path:0, Parsed),
  176    memberchk(mode(Signature, Mode), Parsed),
  177    memberchk(predicate(_, Summary, _), Parsed),
  178    format(string(Help), "  ~w is ~w.~n~n~w", [Signature, Mode, Summary]).
  179predicate_help(_, Pred/_Arity, Help) :-
  180    help_objects(Pred, dwim, Matches), !,
  181    catch(help_html(Matches, dwim-Pred, HtmlDoc), _, fail),
  182    setup_call_cleanup(open_string(HtmlDoc, In),
  183                       load_html(stream(In), Dom, []),
  184                       close(In)),
  185    with_output_to(string(Help), html_text(Dom)).
  186
  187location_path(HerePath, local(_), HerePath).
  188location_path(_, imported(Path), Path).
  189
  190linechar_offset(Stream, line_char(Line1, Char0), Offset) :-
  191    seek(Stream, 0, bof, _),
  192    seek_to_line(Stream, Line1),
  193    seek(Stream, Char0, current, Offset).
  194
  195seek_to_line(Stream, N) :-
  196    N > 1, !,
  197    skip(Stream, 0'\n),
  198    NN is N - 1,
  199    seek_to_line(Stream, NN).
  200seek_to_line(_, _).
  201
  202clause_variable_positions(Path, Line, Variables) :-
  203    xref_source(Path),
  204    findall(Op, xref_op(Path, Op), Ops),
  205    setup_call_cleanup(
  206        open(Path, read, Stream, []),
  207        ( read_source_term_at_location(
  208              Stream, Term,
  209              [line(Line),
  210               subterm_positions(SubPos),
  211               variable_names(VarNames),
  212               operators(Ops),
  213               error(Error)]),
  214          ( var(Error)
  215          -> bagof(
  216              VarName-Locations,
  217              Offsets^ColOffsets^Var^Offset^(
  218                  member(VarName=Var, VarNames),
  219                  bagof(Offset, find_var(Term, Offset, SubPos, Var), Offsets),
  220                  collapse_adjacent(Offsets, ColOffsets),
  221                  maplist(offset_line_char(Stream), ColOffsets, Locations)
  222              ),
  223              Variables)
  224          ; ( debug(server, "Error reading term: ~w", [Error]),
  225              Variables = [] )
  226          )
  227        ),
  228        close(Stream)
  229    ).
  230
  231clause_in_file_at_position(Clause, Path, Position) :-
  232    xref_source(Path),
  233    findall(Op, xref_op(Path, Op), Ops),
  234    setup_call_cleanup(
  235        open(Path, read, Stream, []),
  236        clause_at_position(Stream, Ops, Clause, Position),
  237        close(Stream)
  238    ).
  239
  240clause_at_position(Stream, Ops, Clause, Start) :-
  241    linechar_offset(Stream, Start, Offset), !,
  242    clause_at_position(Stream, Ops, Clause, Start, Offset).
  243clause_at_position(Stream, Ops, Clause, line_char(Line1, Char), Here) :-
  244    read_source_term_at_location(Stream, Terms, [line(Line1),
  245                                                 subterm_positions(SubPos),
  246                                                 operators(Ops),
  247                                                 error(Error)]),
  248    extract_clause_at_position(Stream, Ops, Terms, line_char(Line1, Char), Here,
  249                               SubPos, Error, Clause).
  250
  251extract_clause_at_position(Stream, Ops, _, line_char(Line1, Char), Here, _,
  252                           Error, Clause) :-
  253    nonvar(Error), !, Line1 > 1,
  254    LineBack is Line1 - 1,
  255    clause_at_position(Stream, Ops, Clause, line_char(LineBack, Char), Here).
  256extract_clause_at_position(_, _, Terms, _, Here, SubPos, _, Clause) :-
  257    once(find_clause(Terms, Here, SubPos, Clause)).

 find_clause(+Term:term, ?Offset:int, +Position:position, ?Subclause) is nondet

True when Subclause is a subclause of Term at offset Offset and Position is the term positions for Term as given by read_term/3 with =subterm_positions(Position)=.

  263find_clause(Term, Offset, F-T, Clause) :-
  264    between(F, T, Offset),
  265    ground(Term), Clause = Term/0.
  266find_clause(Term, Offset, term_position(_, _, FF, FT, _), Name/Arity) :-
  267    between(FF, FT, Offset),
  268    functor(Term, Name, Arity).
  269find_clause(Term, Offset, term_position(F, T, _, _, SubPoses), Clause) :-
  270    between(F, T, Offset),
  271    Term =.. [_|SubTerms],
  272    find_containing_term(Offset, SubTerms, SubPoses, SubTerm, SubPos),
  273    find_clause(SubTerm, Offset, SubPos, Clause).
  274find_clause(Term, Offset, parentheses_term_position(F, T, SubPoses), Clause) :-
  275    between(F, T, Offset),
  276    find_clause(Term, Offset, SubPoses, Clause).
  277find_clause({SubTerm}, Offset, brace_term_position(F, T, SubPos), Clause) :-
  278    between(F, T, Offset),
  279    find_clause(SubTerm, Offset, SubPos, Clause).
  280
  281find_containing_term(Offset, [Term|_], [F-T|_], Term, F-T) :-
  282    between(F, T, Offset).
  283find_containing_term(Offset, [Term|_], [P|_], Term, P) :-
  284    P = term_position(F, T, _, _, _),
  285    between(F, T, Offset), !.
  286find_containing_term(Offset, [Term|_], [PP|_], Term, P) :-
  287    PP = parentheses_term_position(F, T, P),
  288    between(F, T, Offset), !.
  289find_containing_term(Offset, [BTerm|_], [BP|_], Term, P) :-
  290    BP = brace_term_position(F, T, P),
  291    {Term} = BTerm,
  292    between(F, T, Offset).
  293find_containing_term(Offset, [Terms|_], [LP|_], Term, P) :-
  294    LP = list_position(_F, _T, Ps, _),
  295    find_containing_term(Offset, Terms, Ps, Term, P).
  296find_containing_term(Offset, [Dict|_], [DP|_], Term, P) :-
  297    DP = dict_position(_, _, _, _, Ps),
  298    member(key_value_position(_F, _T, _SepF, _SepT, Key, _KeyPos, ValuePos),
  299          Ps),
  300    get_dict(Key, Dict, Value),
  301    find_containing_term(Offset, [Value], [ValuePos], Term, P).
  302find_containing_term(Offset, [_|Ts], [_|Ps], T, P) :-
  303    find_containing_term(Offset, Ts, Ps, T, P).
  304
  305find_var(Term, Offset, Loc, Var), Var == Term =>
  306    Loc = F-T, between(F, T, Offset).
  307find_var(Term, Offset, term_position(F, T, _, _, SubPoses), Var) =>
  308    between(F, T, Offset),
  309    % using compound_name_arguments/3 instead of =.. to handle
  310    % zero-arg terms properly
  311    compound_name_arguments(Term, _, SubTerms),
  312    find_containing_term(Offset, SubTerms, SubPoses, SubTerm, SubPos),
  313    find_var(SubTerm, Offset, SubPos, Var).
  314find_var(Term, Offset, parentheses_term_position(F, T, SubPoses), Var) =>
  315    between(F, T, Offset),
  316    find_var(Term, Offset, SubPoses, Var).
  317find_var({SubTerm}, Offset, brace_term_position(F, T, SubPos), Var) =>
  318    between(F, T, Offset),
  319    find_var(SubTerm, Offset, SubPos, Var).
  320find_var(Term, Offset, SubPos, Var), Term \== Var => fail