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)).

   62:- op(750, xf, ...).                    % Repeated argument: 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(650, fx, @).                      % allow @Arg
   70:- op(650, fx, !).                      % allow !Arg
   71:- op(200, xf, //).                     % allow for Head// is det.
   72
   73                 /*******************************
   74                 *             MODES            *
   75                 *******************************/

 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

   89process_modes(Lines, Module, FilePos, ModeDecls, Vars, RestLines) :-
   90    mode_lines(Lines, ModeText, [], RestLines),
   91    modes(ModeText, Module, FilePos, ModeDecls),
   92    extract_varnames(ModeDecls, Vars0, []),
   93    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
 ...

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

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

 mode_syntax_error(+ErrorTerm) is det

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

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

 prepare_module_operators is det

Import operators from current source module.

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

  258public_operators(Module, List) :-
  259    module_property(Module, exported_operators(List)),
  260    !.
  261public_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

  272extract_varnames([], VN, VN) :- !.
  273extract_varnames([H|T], VN0, VN) :-
  274    !,
  275    extract_varnames(H, VN0, VN1),
  276    extract_varnames(T, VN1, VN).
  277extract_varnames(mode(_, Bindings), VN0, VN) :-
  278    !,
  279    extract_varnames(Bindings, VN0, VN).
  280extract_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.

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

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

 is_mode(@Head) is semidet

True if Head is a valid mode-term.

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

 mode_indicator(?Ind:atom) is nondet

Our defined argument-mode indicators

  468mode_indicator(+).                      % Instantiated to type
  469mode_indicator(-).                      % Output argument
  470mode_indicator(++).                     % Ground
  471mode_indicator(--).                     % Must be unbound
  472mode_indicator(?).                      % Partially instantiated to type
  473mode_indicator(:).                      % Meta-argument (implies +)
  474mode_indicator(@).                      % Not instantiated by pred
  475mode_indicator(!).                      % Mutable term
  476
  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] ]