1:- module(lsp_utils, [called_at/3,
    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                      usemod_filespec_position/4,
    9                      seek_to_line/2,
   10                      linechar_offset/3,
   11                      url_path/2,
   12                      unlimited//1
   13                     ]).

   22:- use_module(library(apply_macros)).   23:- use_module(library(apply), [maplist/3, exclude/3]).   24:- use_module(library(dcg/basics), [blanks//0]).   25:- use_module(library(prolog_xref)).   26:- use_module(library(prolog_source), [read_source_term_at_location/3]).   27:- use_module(library(help)). % help_text/2 if new, help_html/3 & help_objects/3 if old
   28:- use_module(library(lynx/html_text), [html_text/1]).   29:- use_module(library(solution_sequences), [distinct/2]).   30:- use_module(library(lists), [append/3, member/2, selectchk/4]).   31:- use_module(library(sgml), [load_html/3]).   32:- use_module(library(yall)).   33
   34:- include('_lsp_path_add.pl').   35
   36:- use_module(lsp(lsp_reading_source), [ file_lines_start_end/2,
   37                                         read_term_positions/2,
   38                                         read_term_positions/4,
   39                                         find_in_term_with_positions/5,
   40                                         position_to_match/3,
   41                                         file_offset_line_position/4 ]).   42
   43:- if(current_predicate(xref_called/5)).

 called_at(+Path:atom, +Clause:term, -Locations:list) is det

Find the callers and locations of the goal Clause, starting from the file Path. Locations will be a list of all the callers and locations that the Clause is called from as LSP-formatted dicts.

   48called_at(Path, Clause, Locations) :-
   49    setof(L, Path^Clause^Locs^(
   50                 called_at_(Path, Clause, Locs),
   51                 member(L, Locs)
   52             ),
   53          Locations), !.
   54called_at(Path, Clause, Locations) :-
   55    name_callable(Clause, Callable),
   56    xref_source(Path),
   57    xref_called(Path, Callable, _By, _, CallerLine),
   58    % we couldn't find the definition, but we know it's in that form, so give that at least
   59    succ(CallerLine0, CallerLine),
   60    Locations = [_{range: _{start: _{line: CallerLine0, character: 0},
   61                            end: _{line: CallerLine, character: 0}}}].
   62
   63called_at_(Path, Clause, Locations) :-
   64    name_callable(Clause, Callable),
   65    xref_source(Path),
   66    xref_called(Path, Callable, _By, _, CallerLine),
   67    file_lines_start_end(Path, LineCharRange),
   68    file_offset_line_position(LineCharRange, Offset, CallerLine, 0),
   69    read_term_positions(Path, Offset, Offset, TermInfos),
   70    Clause = FuncName/Arity,
   71    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Matches, []),
   72    maplist(position_to_match(LineCharRange), Matches, Locations).
   73called_at_(Path, Clause, Locations) :-
   74    xref_source(Path),
   75    Clause = FuncName/Arity,
   76    DcgArity is Arity + 2,
   77    DcgClause = FuncName/DcgArity,
   78    name_callable(DcgClause, DcgCallable),
   79    xref_defined(Path, DcgCallable, dcg),
   80    name_callable(DcgClause, DcgCallable),
   81    xref_called(Path, DcgCallable, _By, _, CallerLine),
   82    file_lines_start_end(Path, LineCharRange),
   83    file_offset_line_position(LineCharRange, Offset, CallerLine, 0),
   84    read_term_positions(Path, Offset, Offset, TermInfos),
   85    find_occurences_of_callable(Path, FuncName, DcgArity, TermInfos, Matches, Tail0),
   86    % also look for original arity in a dcg context
   87    % TODO: modify this to check that it's inside a DCG if it has this
   88    % arity...but not in braces?
   89    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Tail0, []),
   90    maplist(position_to_match(LineCharRange), Matches, Locations).
   91:- else.   92called_at(Path, Callable, By, Ref) :-
   93    xref_called(Path, Callable, By),
   94    xref_defined(Path, By, Ref).
   95:- endif.   96
   97find_occurences_of_callable(_, _, _, [], Tail, Tail).
   98find_occurences_of_callable(Path, FuncName, Arity, [TermInfo|TermInfos], Matches, Tail) :-
   99    FindState = in_meta(false),
  100    find_in_term_with_positions(term_matches_callable(FindState, Path, FuncName, Arity),
  101                                TermInfo.term, TermInfo.subterm, Matches, Tail0),
  102    find_occurences_of_callable(Path, FuncName, Arity, TermInfos, Tail0, Tail).
  103
  104term_matches_callable(FindState, Path, FuncName, Arity, Term, Position) :-
  105    arg(1, Position, Start),
  106    arg(2, Position, End),
  107    ( arg(1, FindState, in_meta(_, MStart, MEnd)),
  108      once( Start > MEnd ; End < MStart )
  109    -> nb_setarg(1, FindState, false)
  110    ; true ),
  111    term_matches_callable_(FindState, Path, FuncName, Arity, Term, Position).
  112
  113term_matches_callable_(_, _, FuncName, Arity, Term, _) :-
  114    nonvar(Term), Term = FuncName/Arity.
  115term_matches_callable_(_, _, FuncName, Arity, Term, _) :-
  116    nonvar(Term),
  117    functor(T, FuncName, Arity),
  118    Term = T, !.
  119term_matches_callable_(State, _, FuncName, Arity, Term, _) :-
  120    nonvar(Term),
  121    % TODO check the argument
  122    arg(1, State, in_meta(N, _, _)),
  123    MArity is Arity - N,
  124    functor(T, FuncName, MArity),
  125    Term = T, !.
  126term_matches_callable_(State, Path, _, _, Term, Position) :-
  127    nonvar(Term), compound(Term),
  128    compound_name_arity(Term, ThisName, ThisArity),
  129    name_callable(ThisName/ThisArity, Callable),
  130    xref_meta(Path, Callable, Called),
  131    member(E, Called), nonvar(E), E = _+N, integer(N),
  132    arg(1, Position, Start),
  133    arg(2, Position, End),
  134    nb_setarg(1, State, in_meta(N, Start, End)),
  135    fail.

 url_path(?FileUrl:atom, ?Path:atom) is det

Convert between file:// url and path

  140url_path(Url, Path) :-
  141    current_prolog_flag(windows, true),
  142    % on windows, in neovim at least, textDocument URI looks like
  143    % "file:///C:/foo/bar/baz.pl"; we need to strip off another
  144    % leading slash to get a valid path
  145    atom_concat('file:///', Path, Url), !.
  146url_path(Url, Path) :-
  147    atom_concat('file://', Path, Url).
  148
  149defined_at(Path, Name/Arity, Location) :-
  150    name_callable(Name/Arity, Callable),
  151    xref_source(Path),
  152    xref_defined(Path, Callable, Ref),
  153    url_path(Doc, Path),
  154    relative_ref_location(Doc, Callable, Ref, Location).
  155defined_at(Path, Name/Arity, Location) :-
  156    % maybe it's a DCG?
  157    DcgArity is Arity + 2,
  158    name_callable(Name/DcgArity, Callable),
  159    xref_source(Path),
  160    xref_defined(Path, Callable, Ref),
  161    url_path(Doc, Path),
  162    relative_ref_location(Doc, Callable, Ref, Location).
  163
  164collapse_adjacent([X|Rst], [X|CRst]) :-
  165    collapse_adjacent(X, Rst, CRst).
  166collapse_adjacent(X, [Y|Rst], CRst) :-
  167    succ(X, Y), !,
  168    collapse_adjacent(Y, Rst, CRst).
  169collapse_adjacent(_, [X|Rst], [X|CRst]) :- !,
  170    collapse_adjacent(X, Rst, CRst).
  171collapse_adjacent(_, [], []).

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

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

  177name_callable(Name/0, Name) :- atom(Name), !.
  178name_callable(Name/Arity, Callable) :-
  179    length(FakeArgs, Arity),
  180    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.

  186relative_ref_location(Here, _, position(Line0, Char1),
  187                      _{uri: Here, range: _{start: _{line: Line0, character: Char1},
  188                                            end: _{line: Line1, character: 0}}}) :-
  189    !, succ(Line0, Line1).
  190relative_ref_location(Here, _, local(Line1),
  191                      _{uri: Here, range: _{start: _{line: Line0, character: 1},
  192                                            end: _{line: NextLine, character: 0}}}) :-
  193    !, succ(Line0, Line1), succ(Line1, NextLine).
  194relative_ref_location(_, Goal, imported(Path), Location) :-
  195    url_path(ThereUri, Path),
  196    xref_source(Path),
  197    xref_defined(Path, Goal, Loc),
  198    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.

  204help_at_position(Path, Line1, Char0, S) :-
  205    clause_in_file_at_position(Clause, Path, line_char(Line1, Char0)),
  206    predicate_help(Path, Clause, S0),
  207    maybe_move_path(Path, S0, S1),
  208    format_help(S1, S).

 maybe_move_path(+Path:string, +Help0:string, -Help:string) is det

If Help0 starts with Path (as it would if it is the help for a locally defined predicate), Help is the text of Help0 but with Path moved to the end. This gives better hover-help for local predicates (since, in Emacs at least, it just shows the first line in the message area on hover).

  217maybe_move_path(Path, Help0, Help) :-
  218    string_concat(Path, "\n\n", Path1),
  219    string_concat(Path1, Help1, Help0), !,
  220    format(string(Help), "~w~n~n~w", [Help1, Path]).
  221maybe_move_path(_, Help, Help).
  222
  223blank_string(S) :-
  224    string_codes(S, Cs),
  225    phrase(blanks, Cs, []).

 format_help(+Help0, -Help1) is det

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

  230format_help(HelpFull, Help) :-
  231    split_string(HelpFull, "\n", " ", Lines0),
  232    exclude([Line]>>string_concat("Availability: ", _, Line),
  233            Lines0, Lines1),
  234    exclude(blank_string, Lines1, Lines2),
  235    Lines2 = [HelpShort|_],
  236    split_string(HelpFull, "\n", " ", HelpLines),
  237    selectchk(HelpShort, HelpLines, "", HelpLines0),
  238    append([HelpShort], HelpLines0, HelpLines1),
  239    atomic_list_concat(HelpLines1, "\n", Help).
  240
  241:- if(current_predicate(help_text/2)).  242predicate_help(_, Pred, Help) :- help_text(Pred, Help), !.
  243:- else.  244predicate_help(_, Pred, Help) :-
  245    nonvar(Pred),
  246    prolog_help:help_objects(Pred, exact, Matches), !,
  247    catch(prolog_help:help_html(Matches, exact-exact, HtmlDoc), _, fail),
  248    setup_call_cleanup(open_string(HtmlDoc, In),
  249                       load_html(stream(In), Dom, []),
  250                       close(In)),
  251    with_output_to(string(Help), html_text(Dom)).
  252:- endif.  253predicate_help(HerePath, Pred, Help) :-
  254    xref_source(HerePath),
  255    name_callable(Pred, Callable),
  256    xref_defined(HerePath, Callable, Loc),
  257    location_path(HerePath, Loc, Path),
  258    once(xref_comment(Path, Callable, Summary, Comment)),
  259    pldoc_process:parse_comment(Comment, Path:0, Parsed),
  260    memberchk(mode(Signature, Mode), Parsed),
  261    memberchk(predicate(_, Summary, _), Parsed),
  262    format(string(Help), "  ~w is ~w.~n~n~w", [Signature, Mode, Summary]).
  263/*
  264predicate_help(_, Pred/_Arity, Help) :-
  265    help_objects(Pred, dwim, Matches), !,
  266    catch(help_html(Matches, dwim-Pred, HtmlDoc), _, fail),
  267    setup_call_cleanup(open_string(HtmlDoc, In),
  268                       load_html(stream(In), Dom, []),
  269                       close(In)),
  270    with_output_to(string(Help), html_text(Dom)).
  271*/
  272
  273location_path(HerePath, local(_), HerePath).
  274location_path(_, imported(Path), Path).
  275
  276linechar_offset(Stream, line_char(Line1, Char0), Offset) :-
  277    seek(Stream, 0, bof, _),
  278    seek_to_line(Stream, Line1),
  279    seek(Stream, Char0, current, Offset).
  280
  281seek_to_line(Stream, N) :-
  282    N > 1, !,
  283    skip(Stream, 0'\n),
  284    NN is N - 1,
  285    seek_to_line(Stream, NN).
  286seek_to_line(_, _).
  287
  288clause_variable_positions(Path, Line, Variables) :-
  289    file_lines_start_end(Path, LineCharRange),
  290    read_term_positions(Path, TermsWithPositions),
  291    % find the top-level term that the offset falls within
  292    file_offset_line_position(LineCharRange, Offset, Line, 0),
  293    member(TermInfo, TermsWithPositions),
  294    SubTermPoses = TermInfo.subterm,
  295    arg(1, SubTermPoses, TermFrom),
  296    arg(2, SubTermPoses, TermTo),
  297    between(TermFrom, TermTo, Offset), !,
  298    find_in_term_with_positions(
  299        [X, _]>>( \+ \+ ( X = '$var'(Name), ground(Name) ) ),
  300        TermInfo.term,
  301        TermInfo.subterm,
  302        VariablesPositions, []
  303    ),
  304    findall(
  305        VarName-Locations,
  306        group_by(
  307            VarName,
  308            Location,
  309            ( member(found_at('$var'(VarName), Location0-_), VariablesPositions),
  310              file_offset_line_position(LineCharRange, Location0, L1, C),
  311              succ(L0, L1),
  312              Location = position(L0, C)
  313            ),
  314            Locations
  315        ),
  316        Variables).
  317
  318usemod_filespec_position(Path, Line, FileSpec, Position) :-
  319    file_lines_start_end(Path, LineCharRange),
  320    read_term_positions(Path, TermsWithPositions),
  321    % find the top-level term that the offset falls within
  322    file_offset_line_position(LineCharRange, Offset, Line, 0),
  323    member(TermInfo, TermsWithPositions),
  324    SubTermPoses = TermInfo.subterm,
  325    arg(1, SubTermPoses, TermFrom),
  326    arg(2, SubTermPoses, TermTo),
  327    between(TermFrom, TermTo, Offset), !,
  328    find_in_term_with_positions(
  329        {FileSpec}/[Term, _]>>once(matches_use_module(FileSpec, Term)),
  330        TermInfo.term,
  331        TermInfo.subterm,
  332        Positions,
  333        [] ),
  334    member(
  335        found_at(_Term,
  336            term_position(_, _, _, _, [ % :- ...
  337                term_position(_, _, _, _, [ % use_module(...)
  338                    SpecPos | _Rest])])),
  339        Positions
  340    ),
  341    termpos_start_end(SpecPos, Start, End),
  342    file_offset_line_position(LineCharRange, Start, StartLine1, StartCol),
  343    file_offset_line_position(LineCharRange, End, EndLine1, EndCol),
  344    succ(StartLine, StartLine1),
  345    succ(EndLine, EndLine1),
  346    Position = _{start: _{line: StartLine, character: StartCol},
  347                 end:   _{line: EndLine,   character: EndCol  } }.
  348
  349matches_use_module(FileSpec, ( :- use_module(FileSpec) )).
  350matches_use_module(FileSpec, ( :- use_module(FileSpec, _) )).
  351
  352termpos_start_end(From-To, From, To) :- !. % Primitive types (atoms, numbers, variables)
  353termpos_start_end(Term, From, To) :-
  354    arg(1, Term, From),
  355    arg(2, Term, To).
  356
  357clause_in_file_at_position(Clause, Path, Position) :-
  358    xref_source(Path),
  359    findall(Op, xref_op(Path, Op), Ops),
  360    setup_call_cleanup(
  361        open(Path, read, Stream, [ newline(posix) ]),
  362        clause_at_position(Stream, Ops, Clause, Position),
  363        close(Stream)
  364    ).
  365
  366clause_at_position(Stream, Ops, Clause, Start) :-
  367    linechar_offset(Stream, Start, Offset), !,
  368    clause_at_position(Stream, Ops, Clause, Start, Offset).
  369clause_at_position(Stream, Ops, Clause, line_char(Line1, Char), Here) :-
  370    read_source_term_at_location(Stream, Terms, [line(Line1),
  371                                                 subterm_positions(SubPos),
  372                                                 operators(Ops),
  373                                                 error(Error)]),
  374    extract_clause_at_position(Stream, Ops, Terms, line_char(Line1, Char), Here,
  375                               SubPos, Error, Clause).
  376
  377extract_clause_at_position(Stream, Ops, _, line_char(Line1, Char), Here, _,
  378                           Error, Clause) :-
  379    nonvar(Error), !, Line1 > 1,
  380    LineBack is Line1 - 1,
  381    clause_at_position(Stream, Ops, Clause, line_char(LineBack, Char), Here).
  382extract_clause_at_position(_, _, Terms, _, Here, SubPos, _, Clause) :-
  383    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)=.

  389find_clause(Term, Offset, F-T, Clause) :-
  390    between(F, T, Offset),
  391    ground(Term), Clause = Term/0.
  392find_clause(Term, Offset, term_position(_, _, FF, FT, _), Name/Arity) :-
  393    between(FF, FT, Offset),
  394    functor(Term, Name, Arity).
  395find_clause(Term, Offset, term_position(F, T, _, _, SubPoses), Clause) :-
  396    between(F, T, Offset),
  397    Term =.. [_|SubTerms],
  398    find_containing_term(Offset, SubTerms, SubPoses, SubTerm, SubPos),
  399    find_clause(SubTerm, Offset, SubPos, Clause).
  400find_clause(Term, Offset, parentheses_term_position(F, T, SubPoses), Clause) :-
  401    between(F, T, Offset),
  402    find_clause(Term, Offset, SubPoses, Clause).
  403find_clause({SubTerm}, Offset, brace_term_position(F, T, SubPos), Clause) :-
  404    between(F, T, Offset),
  405    find_clause(SubTerm, Offset, SubPos, Clause).
  406
  407find_containing_term(Offset, [Term|_], [F-T|_], Term, F-T) :-
  408    between(F, T, Offset).
  409find_containing_term(Offset, [Term|_], [P|_], Term, P) :-
  410    P = term_position(F, T, _, _, _),
  411    between(F, T, Offset), !.
  412find_containing_term(Offset, [Term|_], [PP|_], Term, P) :-
  413    PP = parentheses_term_position(F, T, P),
  414    between(F, T, Offset), !.
  415find_containing_term(Offset, [BTerm|_], [BP|_], Term, P) :-
  416    BP = brace_term_position(F, T, P),
  417    {Term} = BTerm,
  418    between(F, T, Offset).
  419find_containing_term(Offset, [Terms|_], [LP|_], Term, P) :-
  420    LP = list_position(_F, _T, Ps, _),
  421    find_containing_term(Offset, Terms, Ps, Term, P).
  422find_containing_term(Offset, [Dict|_], [DP|_], Term, P) :-
  423    DP = dict_position(_, _, _, _, Ps),
  424    member(key_value_position(_F, _T, _SepF, _SepT, Key, _KeyPos, ValuePos),
  425           Ps),
  426    get_dict(Key, Dict, Value),
  427    find_containing_term(Offset, [Value], [ValuePos], Term, P).
  428find_containing_term(Offset, [_|Ts], [_|Ps], T, P) :-
  429    find_containing_term(Offset, Ts, Ps, T, P).
  430
  431:- meta_predicate unlimited(//, *, *).

 unlimited(:Nonterminal)// is semidet

Tries to parse Nonterminal an unlimited number of times. If the provided nonterminal ever fails, unlimited fails too. This rule can never actually succeed (i.e. yield true), although it could be considered to succeed "at infinity." Nonterminal is likely to be a DCG rule which performs side effects as it parses.

  440unlimited(Nonterminal) -->
  441    call(Nonterminal),
  442    unlimited(Nonterminal)