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