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)).   51
   52/** <module> Analyse PlDoc mode declarations
   53
   54This  module  analyzes  the  formal  part  of  the  documentation  of  a
   55predicate. The formal  part  is  processed   by  read_term/3  using  the
   56operator declarations in this module.
   57*/
   58
   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                 *******************************/
   74
   75%!  process_modes(+Lines:lines, +Module, +FilePos,
   76%!                -Modes:list, -Args:list(atom),
   77%!                -RestLines:lines) is det.
   78%
   79%   Process the formal header lines  (upto   the  first blank line),
   80%   returning the remaining lines and  the   names  of the arguments
   81%   used in the various header lines.
   82%
   83%   @arg FilePos  Term File:Line with the position of comment
   84%   @arg Modes    List if mode(Head, Bindings) terms
   85%   @arg Args     List of argument-names appearing in modes
   86
   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).
   92
   93%!  mode_lines(+Lines, -ModeText:codes, ?ModeTail:codes, -Lines) is det.
   94%
   95%   Extract the formal header. For  %%/%!   comments  these  are all
   96%   lines starting with %%/%!. For /**   comments,  first skip empty
   97%   lines and then  take  all  lines   upto  the  first  blank line.
   98%   Skipping empty lines allows for comments using this style:
   99%
  100%     ==
  101%     /**
  102%      * predicate(+arg1:type1, ?arg2:type2) is det
  103%      ...
  104%     ==
  105
  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).
  137
  138
  139%!  modes(+Text:codes, +Module, +FilePos, -ModeDecls) is det.
  140%
  141%   Read mode declaration. This consists of a number of Prolog terms
  142%   which may or may not be closed by  a Prolog full-stop.
  143%
  144%   @arg Text             Input text as list of codes.
  145%   @arg Module           Module the comment comes from
  146%   @arg ModeDecls        List of mode(Term, Bindings)
  147
  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(_, _, []).
  169
  170%!  mode_syntax_error(+ErrorTerm) is det.
  171%
  172%   Print syntax errors in  mode   declarations.  Currently, this is
  173%   suppressed unless the flag =pldoc_errors= is specified.
  174
  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              ]).
  225
  226
  227%!  prepare_module_operators is det.
  228%
  229%   Import operators from current source module.
  230
  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)).
  249
  250
  251%!  public_operators(+Module, -List:list(op(Pri,Assoc,Name))) is det.
  252%
  253%   List is the list of operators exported from Module through its
  254%   module header.
  255
  256public_operators(Module, List) :-
  257    module_property(Module, exported_operators(List)),
  258    !.
  259public_operators(_, []).
  260
  261
  262%!  extract_varnames(+Bindings, -VarNames, ?VarTail) is det.
  263%
  264%   Extract the variables names.
  265%
  266%   @arg Bindings         Nested list of Name=Var
  267%   @arg VarNames         List of variable names
  268%   @arg VarTail          Tail of VarNames
  269
  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).
  279
  280%!  compile_mode(+Mode, -Compiled) is det.
  281%
  282%   Compile  a  PlDoc  mode  declararion   into  a  term  mode(Head,
  283%   Determinism).
  284%
  285%   @arg Mode       List if mode-terms.  See process_modes/6.
  286
  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) :- !.
  353
  354
  355%!  mode(:Head, ?Det) is nondet.
  356%
  357%   True if there is a mode-declaration for Head with Det.
  358%
  359%   @arg  Head    Callable term.  Arguments are a mode-indicator
  360%                   followed by a type.
  361%   @arg  Det     One of =unknown=, =det=, =semidet=, or =nondet=.
  362
  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).
  381
  382
  383%!  is_mode(@Head) is semidet.
  384%
  385%   True if Head is a valid mode-term.
  386
  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).
  461
  462%!  mode_indicator(?Ind:atom) is nondet.
  463%
  464%   Our defined argument-mode indicators
  465
  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).
  485
  486
  487%!  modes_to_predicate_indicators(+Modes:list, -PI:list) is det.
  488%
  489%   Create a list of predicate indicators represented by Modes. Each
  490%   predicate indicator is  of  the   form  atom/integer  for normal
  491%   predicates or atom//integer for DCG rules.
  492%
  493%   @arg Modes    Mode-list as produced by process_modes/5
  494%   @arg PI       List of Name/Arity or Name//Arity without duplicates
  495
  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).
  520
  521%!  compile_clause(:Term, +FilePos) is det.
  522%
  523%   Add a clause to the  compiled   program.  Unlike  assert/1, this
  524%   associates the clause with the   given source-location, makes it
  525%   static code and removes the  clause   if  the  file is reloaded.
  526%   Finally,  as  we  create  clauses   one-by-one,  we  define  our
  527%   predicates as discontiguous.
  528%
  529%   @arg Term     Clause-term
  530%   @arg FilePos  Term of the form File:Line, where File is a
  531%                 canonical filename.
  532
  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] ]