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-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(pldoc_modes,
   37          [ process_modes/6,            % +Lines, +M, +FP, -Modes, -Av, -RLines
   38            compile_mode/2,             % +PlDocMode, +ModeTerm
   39            mode/2,                     % ?:Head, -Det
   40            is_mode/1,                  % @Mode
   41            mode_indicator/1,           % ?Atom
   42            modes_to_predicate_indicators/2, % +Modes, -PIs
   43            compile_clause/2            % +Term, +File:Line
   44          ]).   45:- use_module(library(lists)).   46:- use_module(library(apply)).   47:- use_module(library(memfile)).   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    new_memory_file(MemFile),
  185    open_memory_file(MemFile, write, Out),
  186    format(Out, '~s~w', [Text, End]),
  187    close(Out),
  188    open_memory_file(MemFile, read, In),
  189    (   atom(File)                  % can be PceEmacs buffer
  190    ->  set_stream(In, file_name(File))
  191    ;   true
  192    ),
  193    stream_property(In, position(Pos0)),
  194    set_line(Pos0, Line, Pos),
  195    set_stream_position(In, Pos),
  196    call_cleanup(read_modes(In, Terms),
  197                 (   close(In),
  198                     free_memory_file(MemFile))).
  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).
  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(++).                     % Ground
  469mode_indicator(--).                     % Must be unbound
  470mode_indicator(?).                      % Partially instantiated to type
  471mode_indicator(:).                      % Meta-argument (implies +)
  472mode_indicator(@).                      % Not instantiated by pred
  473mode_indicator(!).                      % Mutable term
  474
  475mode_ind(+(X), +, X).
  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).

 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

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

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