1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2006-2025, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(pldoc_modes,
   39          [ process_modes/6,            % +Lines, +M, +FP, -Modes, -Av, -RLines
   40            compile_mode/2,             % +PlDocMode, +ModeTerm
   41            (mode)/2,                   % ?:Head, -Det
   42            is_mode/1,                  % @Mode
   43            mode_indicator/1,           % ?Atom
   44            modes_to_predicate_indicators/2, % +Modes, -PIs
   45            compile_clause/2            % +Term, +File:Line
   46          ]).   47:- use_module(library(lists)).   48:- use_module(library(apply)).   49:- use_module(library(operators)).   50:- use_module(library(error)).

   59:- op(750, xf, ...).                    % Repeated argument: Arg...
   60:- op(650, fx, +).                      % allow +Arg
   61:- op(650, fx, -).                      % allow -Arg
   62:- op(650, fx, =).                      % allow =Arg
   63:- op(650, fx, ++).                     % allow ++Arg
   64:- op(650, fx, --).                     % allow --Arg
   65:- op(650, fx, ?).                      % allow ?Arg
   66:- op(650, fx, :).                      % allow :Arg
   67:- op(650, fx, @).                      % allow @Arg
   68:- op(650, fx, !).                      % allow !Arg
   69:- op(200, xf, //).                     % allow for Head// is det.
   70
   71                 /*******************************
   72                 *             MODES            *
   73                 *******************************/

 process_modes(+Lines:lines, +Module, +FilePos, -Modes:list, -Args:list(atom), -RestLines:lines) is det

Process the formal header lines (upto the first blank line), returning the remaining lines and the names of the arguments used in the various header lines.

Arguments:

FilePos	- Term File:Line with the position of comment
Modes	- List if mode(Head, Bindings) terms
Args	- List of argument-names appearing in modes

   87process_modes(Lines, Module, FilePos, ModeDecls, Vars, RestLines) :-
   88    mode_lines(Lines, ModeText, [], RestLines),
   89    modes(ModeText, Module, FilePos, ModeDecls),
   90    extract_varnames(ModeDecls, Vars0, []),
   91    sort(Vars0, Vars).

 mode_lines(+Lines, -ModeText:codes, ?ModeTail:codes, -Lines) is det

Extract the formal header. For %%/%! comments these are all lines starting with %%/%!. For /** comments, first skip empty lines and then take all lines upto the first blank line. Skipping empty lines allows for comments using this style:

/**
 * predicate(+arg1:type1, ?arg2:type2) is det
 ...

  106mode_lines(Lines0, ModeText, ModeTail, Lines) :-
  107    percent_mode_line(Lines0, C, ModeText, ModeTail0, Lines1),
  108    !,
  109    percent_mode_lines(Lines1, C, ModeTail0, ModeTail, Lines).
  110mode_lines(Lines0, ModeText, ModeTail, Lines) :-
  111    empty_lines(Lines0, Lines1),
  112    non_empty_lines(Lines1, ModeText, ModeTail, Lines).
  113
  114percent_mode_line([1-[C|L]|Lines], C, ModeText, ModeTail, Lines) :-
  115    percent_mode_char(C),
  116    append(L, [10|ModeTail], ModeText).
  117
  118percent_mode_char(0'%).
  119percent_mode_char(0'!).
  120
  121percent_mode_lines(Lines0, C, ModeText, ModeTail, Lines) :-
  122    percent_mode_line(Lines0, C, ModeText, ModeTail1, Lines1),
  123    !,
  124    percent_mode_lines(Lines1, C, ModeTail1, ModeTail, Lines).
  125percent_mode_lines(Lines, _, Mode, Mode, Lines).
  126
  127empty_lines([_-[]|Lines0], Lines) :-
  128    !,
  129    empty_lines(Lines0, Lines).
  130empty_lines(Lines, Lines).
  131
  132non_empty_lines([], ModeTail, ModeTail, []).
  133non_empty_lines([_-[]|Lines], ModeTail, ModeTail, Lines) :- !.
  134non_empty_lines([_-L|Lines0], ModeText, ModeTail, Lines) :-
  135    append(L, [10|ModeTail0], ModeText),
  136    non_empty_lines(Lines0, ModeTail0, ModeTail, Lines).

 modes(+Text:codes, +Module, +FilePos, -ModeDecls) is det

Read mode declaration. This consists of a number of Prolog terms which may or may not be closed by a Prolog full-stop.

Arguments:

Text	- Input text as list of codes.
Module	- Module the comment comes from
ModeDecls	- List of mode(Term, Bindings)

  148modes(Text, Module, FilePos, Decls) :-
  149    prepare_module_operators(Module),
  150    modes(Text, FilePos, Decls).
  151
  152modes(Text, FilePos, Decls) :-
  153    catch(read_mode_terms(Text, FilePos, '', Decls), E, true),
  154    (   var(E)
  155    ->  !
  156    ;   E = error(syntax_error(end_of_file), _)
  157    ->  fail
  158    ;   !, mode_syntax_error(E),
  159        Decls = []
  160    ).
  161modes(Text, FilePos, Decls) :-
  162    catch(read_mode_terms(Text, FilePos, ' . ', Decls), E, true),
  163    (   var(E)
  164    ->  !
  165    ;   mode_syntax_error(E),
  166        fail
  167    ).
  168modes(_, _, []).

 mode_syntax_error(+ErrorTerm) is det

Print syntax errors in mode declarations. Currently, this is suppressed unless the flag pldoc_errors is specified.

  175mode_syntax_error(E) :-
  176    current_prolog_flag(pldoc_errors, true),
  177    !,
  178    print_message(warning, E).
  179mode_syntax_error(_).
  180
  181
  182read_mode_terms(Text, File:Line, End, Terms) :-
  183    format(string(S), '~s~w', [Text, End]),
  184    setup_call_cleanup(
  185        open_string(S, In),
  186        read_modes(In, File, Line, Terms),
  187        close(In)).
  188
  189read_modes(In, File, Line, Terms) :-
  190    (   atom(File)                  % can be PceEmacs buffer
  191    ->  set_stream(In, file_name(File))
  192    ;   true
  193    ),
  194    stream_property(In, position(Pos0)),
  195    set_line(Pos0, Line, Pos),
  196    set_stream_position(In, Pos),
  197    read_modes(In, Terms).
  198
  199set_line('$stream_position'(CharC, _, LinePos, ByteC),
  200         Line,
  201         '$stream_position'(CharC, Line, LinePos, ByteC)).
  202
  203read_modes(In, Terms) :-
  204    read_mode_term(In, Term0),
  205    read_modes(Term0, In, Terms).
  206
  207read_modes(mode(end_of_file,[]), _, []) :- !.
  208read_modes(T0, In, [T0|Rest]) :-
  209    T0 = mode(Mode, _),
  210    is_mode(Mode),
  211    !,
  212    read_mode_term(In, T1),
  213    read_modes(T1, In, Rest).
  214read_modes(mode(Mode, Bindings), In, Modes) :-
  215    maplist(call, Bindings),
  216    print_message(warning, pldoc(invalid_mode(Mode))),
  217    read_mode_term(In, T1),
  218    read_modes(T1, In, Modes).
  219
  220read_mode_term(In, mode(Term, Bindings)) :-
  221    read_term(In, Term,
  222              [ variable_names(Bindings),
  223                module(pldoc_modes)
  224              ]).

 prepare_module_operators is det

Import operators from current source module.

  231:- dynamic
  232    prepared_module/2.  233
  234prepare_module_operators(Module) :-
  235    (   prepared_module(Module, _)
  236    ->  true
  237    ;   unprepare_module_operators,
  238        public_operators(Module, Ops),
  239        (   Ops \== []
  240        ->  push_operators(Ops, Undo),
  241            asserta(prepared_module(Module, Undo))
  242        ;   true
  243        )
  244    ).
  245
  246unprepare_module_operators :-
  247    forall(retract(prepared_module(_, Undo)),
  248           pop_operators(Undo)).

 public_operators(+Module, -List:list(op(Pri,Assoc,Name))) is det

List is the list of operators exported from Module through its module header.

  256public_operators(Module, List) :-
  257    module_property(Module, exported_operators(List)),
  258    !.
  259public_operators(_, []).

 extract_varnames(+Bindings, -VarNames, ?VarTail) is det

Extract the variables names.

Arguments:

Bindings	- Nested list of Name=Var
VarNames	- List of variable names
VarTail	- Tail of VarNames

  270extract_varnames([], VN, VN) :- !.
  271extract_varnames([H|T], VN0, VN) :-
  272    !,
  273    extract_varnames(H, VN0, VN1),
  274    extract_varnames(T, VN1, VN).
  275extract_varnames(mode(_, Bindings), VN0, VN) :-
  276    !,
  277    extract_varnames(Bindings, VN0, VN).
  278extract_varnames(Name=_, [Name|VN], VN).

 compile_mode(+Mode, -Compiled) is det

Compile a PlDoc mode declararion into a term mode(Head, Determinism).

Arguments:

Mode	- List if mode-terms. See process_modes/6.

  287compile_mode(mode(Mode, _Bindings), Compiled) :-
  288    compile_mode2(Mode, Compiled).
  289
  290compile_mode2(Var, _) :-
  291    var(Var),
  292    !,
  293    throw(error(instantiation_error,
  294                context(_, 'PlDoc: Mode declaration expected'))).
  295compile_mode2(Head0 is Det, mode(Head, Det)) :-
  296    !,
  297    dcg_expand(Head0, Head).
  298compile_mode2(Head0, mode(Head, unknown)) :-
  299    dcg_expand(Head0, Head).
  300
  301dcg_expand(M:Head0, M:Head) :-
  302    atom(M),
  303    !,
  304    dcg_expand(Head0, Head).
  305dcg_expand(//(Head0), Head) :-
  306    !,
  307    Head0 =.. [Name|List0],
  308    maplist(remove_argname, List0, List1),
  309    append(List1, [?list, ?list], List2),
  310    Head =.. [Name|List2].
  311dcg_expand(Head0, Head) :-
  312    remove_argnames(Head0, Head).
  313
  314remove_argnames(Var, _) :-
  315    var(Var),
  316    !,
  317    instantiation_error(Var).
  318remove_argnames(M:Head0, M:Head) :-
  319    !,
  320    must_be(atom, M),
  321    remove_argnames(Head0, Head).
  322remove_argnames(Head0, Head) :-
  323    functor(Head0, Name, Arity),
  324    functor(Head, Name, Arity),
  325    remove_argnames(0, Arity, Head0, Head).
  326
  327remove_argnames(Arity, Arity, _, _) :- !.
  328remove_argnames(I0, Arity, H0, H) :-
  329    I is I0 + 1,
  330    arg(I, H0, A0),
  331    remove_argname(A0, A),
  332    arg(I, H, A),
  333    remove_argnames(I, Arity, H0, H).
  334
  335remove_argname(T, ?(any)) :-
  336    var(T),
  337    !.
  338remove_argname(...(T0), ...(T)) :-
  339    !,
  340    remove_argname(T0, T).
  341remove_argname(A0, A) :-
  342    mode_ind(A0, M, A1),
  343    !,
  344    remove_aname(A1, A2),
  345    mode_ind(A, M, A2).
  346remove_argname(A0, ?A) :-
  347    remove_aname(A0, A).
  348
  349remove_aname(Var, any) :-
  350    var(Var),
  351    !.
  352remove_aname(_:Type, Type) :- !.

 mode(:Head, ?Det) is nondet

True if there is a mode-declaration for Head with Det.

Arguments:

Head	- Callable term. Arguments are a mode-indicator followed by a type.
Det	- One of unknown, det, semidet, or nondet.

  363:- module_transparent
  364    (mode)/2.  365
  366mode(Head, Det) :-
  367    var(Head),
  368    !,
  369    current_module(M),
  370    '$c_current_predicate'(_, M:'$mode'(_,_)),
  371    M:'$mode'(H,Det),
  372    qualify(M,H,Head).
  373mode(M:Head, Det) :-
  374    current_module(M),
  375    '$c_current_predicate'(_, M:'$mode'(_,_)),
  376    M:'$mode'(Head,Det).
  377
  378qualify(system, H, H) :- !.
  379qualify(user,   H, H) :- !.
  380qualify(M,      H, M:H).

 is_mode(@Head) is semidet

True if Head is a valid mode-term.

  387is_mode(Var) :-
  388    var(Var), !, fail.
  389is_mode(Head is Det) :-
  390    !,
  391    is_det(Det),
  392    is_head(Head).
  393is_mode(Head) :-
  394    is_head(Head).
  395
  396is_det(Var) :-
  397    var(Var), !, fail.
  398is_det(failure).
  399is_det(det).
  400is_det(semidet).
  401is_det(nondet).
  402is_det(multi).
  403is_det(undefined).
  404
  405is_head(Var) :-
  406    var(Var), !, fail.
  407is_head(//(Head)) :-
  408    !,
  409    is_mhead(Head).
  410is_head(M:(//(Head))) :-
  411    !,
  412    atom(M),
  413    is_phead(Head).
  414is_head(Head) :-
  415    is_mhead(Head).
  416
  417is_mhead(M:Head) :-
  418    !,
  419    atom(M),
  420    is_phead(Head).
  421is_mhead(Head) :-
  422    is_phead(Head).
  423
  424is_phead(Head) :-
  425    callable(Head),
  426    functor(Head, _Name, Arity),
  427    is_head_args(0, Arity, Head).
  428
  429is_head_args(A, A, _) :- !.
  430is_head_args(I0, Arity, Head) :-
  431    I is I0 + 1,
  432    arg(I, Head, Arg),
  433    is_head_arg(Arg),
  434    is_head_args(I, Arity, Head).
  435
  436is_head_arg(Arg) :-
  437    var(Arg),
  438    !.
  439is_head_arg(...(Arg)) :-
  440    !,
  441    is_head_arg_nva(Arg).
  442is_head_arg(Arg) :-
  443    is_head_arg_nva(Arg).
  444
  445is_head_arg_nva(Arg) :-
  446    var(Arg),
  447    !.
  448is_head_arg_nva(Arg) :-
  449    Arg =.. [Ind,Arg1],
  450    mode_indicator(Ind),
  451    is_head_arg(Arg1).
  452is_head_arg_nva(Arg:Type) :-
  453    var(Arg),
  454    is_type(Type).
  455
  456is_type(Type) :-
  457    var(Type),
  458    !.                   % allow polypmorphic types.
  459is_type(Type) :-
  460    callable(Type).

 mode_indicator(?Ind:atom) is nondet

Our defined argument-mode indicators

  466mode_indicator(+).                      % Instantiated to type
  467mode_indicator(-).                      % Output argument
  468mode_indicator(=).                      % Output argument
  469mode_indicator(++).                     % Ground
  470mode_indicator(--).                     % Must be unbound
  471mode_indicator(?).                      % Partially instantiated to type
  472mode_indicator(:).                      % Meta-argument (implies +)
  473mode_indicator(@).                      % Not instantiated by pred
  474mode_indicator(!).                      % Mutable term
  475
  476mode_ind(+(X), +, X).
  477mode_ind(-(X), -, X).
  478mode_ind(=(X), =, X).
  479mode_ind(++(X), ++, X).
  480mode_ind(--(X), --, X).
  481mode_ind(?(X), ?, X).
  482mode_ind(:(X), :, X).
  483mode_ind(@(X), @, X).
  484mode_ind(!(X), !, X).

 modes_to_predicate_indicators(+Modes:list, -PI:list) is det

Create a list of predicate indicators represented by Modes. Each predicate indicator is of the form atom/integer for normal predicates or atom//integer for DCG rules.

Arguments:

Modes	- Mode-list as produced by process_modes/5
PI	- List of Name/Arity or Name//Arity without duplicates

  496modes_to_predicate_indicators(Modes, PIs) :-
  497    modes_to_predicate_indicators2(Modes, PIs0),
  498    list_to_set(PIs0, PIs).
  499
  500modes_to_predicate_indicators2([], []).
  501modes_to_predicate_indicators2([mode(H,_B)|T0], [PI|T]) :-
  502    mode_to_pi(H, PI),
  503    modes_to_predicate_indicators2(T0, T).
  504
  505mode_to_pi(Head is _Det, PI) :-
  506    !,
  507    head_to_pi(Head, PI).
  508mode_to_pi(Head, PI) :-
  509    head_to_pi(Head, PI).
  510
  511head_to_pi(M:Head, M:PI) :-
  512    atom(M),
  513    !,
  514    head_to_pi(Head, PI).
  515head_to_pi(//(Head), Name//Arity) :-
  516    !,
  517    functor(Head, Name, Arity).
  518head_to_pi(Head, Name/Arity) :-
  519    functor(Head, Name, Arity).

 compile_clause(:Term, +FilePos) is det

Add a clause to the compiled program. Unlike assert/1, this associates the clause with the given source-location, makes it static code and removes the clause if the file is reloaded. Finally, as we create clauses one-by-one, we define our predicates as discontiguous.

Arguments:

Term	- Clause-term
FilePos	- Term of the form File:Line, where File is a canonical filename.

  533compile_clause(Term, File:Line) :-
  534    '$set_source_module'(SM, SM),
  535    strip_module(SM:Term, M, Plain),
  536    clause_head(Plain, Head),
  537    functor(Head, Name, Arity),
  538    multifile(M:(Name/Arity)),
  539    (   M == SM
  540    ->  Clause = Term
  541    ;   Clause = M:Term
  542    ),
  543    '$store_clause'('$source_location'(File, Line):Clause, File).
  544
  545clause_head((Head :- _Body), Head) :- !.
  546clause_head(Head, Head).
  547
  548
  549                 /*******************************
  550                 *             MESSAGES         *
  551                 *******************************/
  552
  553:- multifile
  554    prolog:message//1.  555
  556prolog:message(pldoc(invalid_mode(Mode))) -->
  557    [ 'Invalid mode declaration in PlDoc comment: ~q'-[Mode] ]