/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (c) 2006-2018, University of Amsterdam VU University Amsterdam CWI, Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(pldoc_modes, [ process_modes/6, % +Lines, +M, +FP, -Modes, -Av, -RLines compile_mode/2, % +PlDocMode, +ModeTerm mode/2, % ?:Head, -Det is_mode/1, % @Mode mode_indicator/1, % ?Atom modes_to_predicate_indicators/2, % +Modes, -PIs compile_clause/2 % +Term, +File:Line ]). :- use_module(library(lists)). :- use_module(library(apply)). :- use_module(library(operators)). :- use_module(library(error)). /** Analyse PlDoc mode declarations This module analyzes the formal part of the documentation of a predicate. The formal part is processed by read_term/3 using the operator declarations in this module. @author Jan Wielemaker @license GPL */ :- op(750, xf, ...). % Repeated argument: Arg... :- op(650, fx, +). % allow +Arg :- op(650, fx, -). % allow -Arg :- op(650, fx, ++). % allow ++Arg :- op(650, fx, --). % allow --Arg :- op(650, fx, ?). % allow ?Arg :- op(650, fx, :). % allow :Arg :- op(650, fx, @). % allow @Arg :- op(650, fx, !). % allow !Arg :- op(200, xf, //). % allow for Head// is det. /******************************* * MODES * *******************************/ %! 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. % % @param FilePos Term File:Line with the position of comment % @param Modes List if mode(Head, Bindings) terms % @param Args List of argument-names appearing in modes process_modes(Lines, Module, FilePos, ModeDecls, Vars, RestLines) :- mode_lines(Lines, ModeText, [], RestLines), modes(ModeText, Module, FilePos, ModeDecls), extract_varnames(ModeDecls, Vars0, []), 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 % ... % == mode_lines(Lines0, ModeText, ModeTail, Lines) :- percent_mode_line(Lines0, C, ModeText, ModeTail0, Lines1), !, percent_mode_lines(Lines1, C, ModeTail0, ModeTail, Lines). mode_lines(Lines0, ModeText, ModeTail, Lines) :- empty_lines(Lines0, Lines1), non_empty_lines(Lines1, ModeText, ModeTail, Lines). percent_mode_line([1-[C|L]|Lines], C, ModeText, ModeTail, Lines) :- percent_mode_char(C), append(L, [10|ModeTail], ModeText). percent_mode_char(0'%). percent_mode_char(0'!). percent_mode_lines(Lines0, C, ModeText, ModeTail, Lines) :- percent_mode_line(Lines0, C, ModeText, ModeTail1, Lines1), !, percent_mode_lines(Lines1, C, ModeTail1, ModeTail, Lines). percent_mode_lines(Lines, _, Mode, Mode, Lines). empty_lines([_-[]|Lines0], Lines) :- !, empty_lines(Lines0, Lines). empty_lines(Lines, Lines). non_empty_lines([], ModeTail, ModeTail, []). non_empty_lines([_-[]|Lines], ModeTail, ModeTail, Lines) :- !. non_empty_lines([_-L|Lines0], ModeText, ModeTail, Lines) :- append(L, [10|ModeTail0], ModeText), 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. % % @param Text Input text as list of codes. % @param Module Module the comment comes from % @param ModeDecls List of mode(Term, Bindings) modes(Text, Module, FilePos, Decls) :- prepare_module_operators(Module), modes(Text, FilePos, Decls). modes(Text, FilePos, Decls) :- catch(read_mode_terms(Text, FilePos, '', Decls), E, true), ( var(E) -> ! ; E = error(syntax_error(end_of_file), _) -> fail ; !, mode_syntax_error(E), Decls = [] ). modes(Text, FilePos, Decls) :- catch(read_mode_terms(Text, FilePos, ' . ', Decls), E, true), ( var(E) -> ! ; mode_syntax_error(E), fail ). modes(_, _, []). %! mode_syntax_error(+ErrorTerm) is det. % % Print syntax errors in mode declarations. Currently, this is % suppressed unless the flag =pldoc_errors= is specified. mode_syntax_error(E) :- current_prolog_flag(pldoc_errors, true), !, print_message(warning, E). mode_syntax_error(_). read_mode_terms(Text, File:Line, End, Terms) :- format(string(S), '~s~w', [Text, End]), setup_call_cleanup( open_string(S, In), read_modes(In, File, Line, Terms), close(In)). read_modes(In, File, Line, Terms) :- ( atom(File) % can be PceEmacs buffer -> set_stream(In, file_name(File)) ; true ), stream_property(In, position(Pos0)), set_line(Pos0, Line, Pos), set_stream_position(In, Pos), read_modes(In, Terms). set_line('$stream_position'(CharC, _, LinePos, ByteC), Line, '$stream_position'(CharC, Line, LinePos, ByteC)). read_modes(In, Terms) :- read_mode_term(In, Term0), read_modes(Term0, In, Terms). read_modes(mode(end_of_file,[]), _, []) :- !. read_modes(T0, In, [T0|Rest]) :- T0 = mode(Mode, _), is_mode(Mode), !, read_mode_term(In, T1), read_modes(T1, In, Rest). read_modes(mode(Mode, Bindings), In, Modes) :- maplist(call, Bindings), print_message(warning, pldoc(invalid_mode(Mode))), read_mode_term(In, T1), read_modes(T1, In, Modes). read_mode_term(In, mode(Term, Bindings)) :- read_term(In, Term, [ variable_names(Bindings), module(pldoc_modes) ]). %! prepare_module_operators is det. % % Import operators from current source module. :- dynamic prepared_module/2. prepare_module_operators(Module) :- ( prepared_module(Module, _) -> true ; unprepare_module_operators, public_operators(Module, Ops), ( Ops \== [] -> push_operators(Ops, Undo), asserta(prepared_module(Module, Undo)) ; true ) ). unprepare_module_operators :- forall(retract(prepared_module(_, Undo)), 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. public_operators(Module, List) :- module_property(Module, exported_operators(List)), !. public_operators(_, []). %! extract_varnames(+Bindings, -VarNames, ?VarTail) is det. % % Extract the variables names. % % @param Bindings Nested list of Name=Var % @param VarNames List of variable names % @param VarTail Tail of VarNames extract_varnames([], VN, VN) :- !. extract_varnames([H|T], VN0, VN) :- !, extract_varnames(H, VN0, VN1), extract_varnames(T, VN1, VN). extract_varnames(mode(_, Bindings), VN0, VN) :- !, extract_varnames(Bindings, VN0, VN). extract_varnames(Name=_, [Name|VN], VN). %! compile_mode(+Mode, -Compiled) is det. % % Compile a PlDoc mode declararion into a term mode(Head, % Determinism). % % @param Mode List if mode-terms. See process_modes/6. compile_mode(mode(Mode, _Bindings), Compiled) :- compile_mode2(Mode, Compiled). compile_mode2(Var, _) :- var(Var), !, throw(error(instantiation_error, context(_, 'PlDoc: Mode declaration expected'))). compile_mode2(Head0 is Det, mode(Head, Det)) :- !, dcg_expand(Head0, Head). compile_mode2(Head0, mode(Head, unknown)) :- dcg_expand(Head0, Head). dcg_expand(M:Head0, M:Head) :- atom(M), !, dcg_expand(Head0, Head). dcg_expand(//(Head0), Head) :- !, Head0 =.. [Name|List0], maplist(remove_argname, List0, List1), append(List1, [?list, ?list], List2), Head =.. [Name|List2]. dcg_expand(Head0, Head) :- remove_argnames(Head0, Head). remove_argnames(Var, _) :- var(Var), !, instantiation_error(Var). remove_argnames(M:Head0, M:Head) :- !, must_be(atom, M), remove_argnames(Head0, Head). remove_argnames(Head0, Head) :- functor(Head0, Name, Arity), functor(Head, Name, Arity), remove_argnames(0, Arity, Head0, Head). remove_argnames(Arity, Arity, _, _) :- !. remove_argnames(I0, Arity, H0, H) :- I is I0 + 1, arg(I, H0, A0), remove_argname(A0, A), arg(I, H, A), remove_argnames(I, Arity, H0, H). remove_argname(T, ?(any)) :- var(T), !. remove_argname(...(T0), ...(T)) :- !, remove_argname(T0, T). remove_argname(A0, A) :- mode_ind(A0, M, A1), !, remove_aname(A1, A2), mode_ind(A, M, A2). remove_argname(A0, ?A) :- remove_aname(A0, A). remove_aname(Var, any) :- var(Var), !. remove_aname(_:Type, Type) :- !. %! mode(:Head, ?Det) is nondet. % % True if there is a mode-declaration for Head with Det. % % @param Head Callable term. Arguments are a mode-indicator % followed by a type. % @param Det One of =unknown=, =det=, =semidet=, or =nondet=. :- module_transparent mode/2. mode(Head, Det) :- var(Head), !, current_module(M), '$c_current_predicate'(_, M:'$mode'(_,_)), M:'$mode'(H,Det), qualify(M,H,Head). mode(M:Head, Det) :- current_module(M), '$c_current_predicate'(_, M:'$mode'(_,_)), M:'$mode'(Head,Det). qualify(system, H, H) :- !. qualify(user, H, H) :- !. qualify(M, H, M:H). %! is_mode(@Head) is semidet. % % True if Head is a valid mode-term. is_mode(Var) :- var(Var), !, fail. is_mode(Head is Det) :- !, is_det(Det), is_head(Head). is_mode(Head) :- is_head(Head). is_det(Var) :- var(Var), !, fail. is_det(failure). is_det(det). is_det(semidet). is_det(nondet). is_det(multi). is_det(undefined). is_head(Var) :- var(Var), !, fail. is_head(//(Head)) :- !, is_mhead(Head). is_head(M:(//(Head))) :- !, atom(M), is_phead(Head). is_head(Head) :- is_mhead(Head). is_mhead(M:Head) :- !, atom(M), is_phead(Head). is_mhead(Head) :- is_phead(Head). is_phead(Head) :- callable(Head), functor(Head, _Name, Arity), is_head_args(0, Arity, Head). is_head_args(A, A, _) :- !. is_head_args(I0, Arity, Head) :- I is I0 + 1, arg(I, Head, Arg), is_head_arg(Arg), is_head_args(I, Arity, Head). is_head_arg(Arg) :- var(Arg), !. is_head_arg(...(Arg)) :- !, is_head_arg_nva(Arg). is_head_arg(Arg) :- is_head_arg_nva(Arg). is_head_arg_nva(Arg) :- var(Arg), !. is_head_arg_nva(Arg) :- Arg =.. [Ind,Arg1], mode_indicator(Ind), is_head_arg(Arg1). is_head_arg_nva(Arg:Type) :- var(Arg), is_type(Type). is_type(Type) :- var(Type), !. % allow polypmorphic types. is_type(Type) :- callable(Type). %! mode_indicator(?Ind:atom) is nondet. % % Our defined argument-mode indicators mode_indicator(+). % Instantiated to type mode_indicator(-). % Output argument mode_indicator(++). % Ground mode_indicator(--). % Must be unbound mode_indicator(?). % Partially instantiated to type mode_indicator(:). % Meta-argument (implies +) mode_indicator(@). % Not instantiated by pred mode_indicator(!). % Mutable term mode_ind(+(X), +, X). mode_ind(-(X), -, X). mode_ind(++(X), ++, X). mode_ind(--(X), --, X). mode_ind(?(X), ?, X). mode_ind(:(X), :, X). mode_ind(@(X), @, X). mode_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. % % @param Modes Mode-list as produced by process_modes/5 % @param PI List of Name/Arity or Name//Arity without duplicates modes_to_predicate_indicators(Modes, PIs) :- modes_to_predicate_indicators2(Modes, PIs0), list_to_set(PIs0, PIs). modes_to_predicate_indicators2([], []). modes_to_predicate_indicators2([mode(H,_B)|T0], [PI|T]) :- mode_to_pi(H, PI), modes_to_predicate_indicators2(T0, T). mode_to_pi(Head is _Det, PI) :- !, head_to_pi(Head, PI). mode_to_pi(Head, PI) :- head_to_pi(Head, PI). head_to_pi(M:Head, M:PI) :- atom(M), !, head_to_pi(Head, PI). head_to_pi(//(Head), Name//Arity) :- !, functor(Head, Name, Arity). head_to_pi(Head, Name/Arity) :- 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. % % @param Term Clause-term % @param FilePos Term of the form File:Line, where File is a % canonical filename. compile_clause(Term, File:Line) :- '$set_source_module'(SM, SM), strip_module(SM:Term, M, Plain), clause_head(Plain, Head), functor(Head, Name, Arity), multifile(M:(Name/Arity)), ( M == SM -> Clause = Term ; Clause = M:Term ), '$store_clause'('$source_location'(File, Line):Clause, File). clause_head((Head :- _Body), Head) :- !. clause_head(Head, Head). /******************************* * MESSAGES * *******************************/ :- multifile prolog:message//1. prolog:message(pldoc(invalid_mode(Mode))) --> [ 'Invalid mode declaration in PlDoc comment: ~q'-[Mode] ].