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)).
  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    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              ]).
 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).
 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(++).                     % 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).
 483
 484
 485%!  modes_to_predicate_indicators(+Modes:list, -PI:list) is det.
 486%
 487%   Create a list of predicate indicators represented by Modes. Each
 488%   predicate indicator is  of  the   form  atom/integer  for normal
 489%   predicates or atom//integer for DCG rules.
 490%
 491%   @param Modes    Mode-list as produced by process_modes/5
 492%   @param PI       List of Name/Arity or Name//Arity without duplicates
 493
 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).
 518
 519%!  compile_clause(:Term, +FilePos) is det.
 520%
 521%   Add a clause to the  compiled   program.  Unlike  assert/1, this
 522%   associates the clause with the   given source-location, makes it
 523%   static code and removes the  clause   if  the  file is reloaded.
 524%   Finally,  as  we  create  clauses   one-by-one,  we  define  our
 525%   predicates as discontiguous.
 526%
 527%   @param Term     Clause-term
 528%   @param FilePos  Term of the form File:Line, where File is a
 529%                   canonical filename.
 530
 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] ].