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

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

 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

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

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

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

 mode_syntax_error(+ErrorTerm) is det

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

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

 prepare_module_operators is det

Import operators from current source module.

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

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

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

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

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

 is_mode(@Head) is semidet

True if Head is a valid mode-term.

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

 mode_indicator(?Ind:atom) is nondet

Our defined argument-mode indicators

  467mode_indicator(+).                      % Instantiated to type
  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).

 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

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

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