[m-rev.] for review: XML documentation of DU types pass

[Julien Fischer]

On Tue, 31 Oct 2006, Peter Ross wrote:

> Estimated hours taken: 24
> Branches: main
>
> Generate an XML representation of the du types in the current module.
> Notably we associate with each type, data constructor and data field
> a comment, describing that part of the declaration.
> The current strategy associates the comment starting on the same line
> as the type declaration, and if there is none then the comment directly
> above.  At a later date, this strategy needs to be made more flexible.

It isn't clear from this description what the overall point of this
change is, e.g. automatically generating documentation from comments,
or at least being able to generate such documentation from the XML
representation.

> This required two main changes to the compiler.
> Change one was to associate with a term.variable the context
> of that variable.
> Then the constructor and constructor_arg types had to have their
> context recorded.
>
> compiler/xml_documentation.m:
> 	Add the pass which generates an XML documentation
> 	of the du types in the current module.

I suggest:

 	Add a pass that generates XML documentation for the du
 	types in the current module.

> compiler/handle_options.m:
> compiler/mercury_compile.m:
> compiler/options.m:
> 	Call the xml_documentation phase and stop afterwards.

You will also need to update the user's guide.


>
> library/term.m:
> 	Add the term.context to term.variables.
> 	Remove the backwards mode of var_list_to_term_list as it
> 	no longer works.
> 	Make the predicate version of term_list_to_var_list
> 	semidet as we can no longer use the backwards version
> 	var_list_to_term_list.

You will also need to update samples/interpreter.m.

>
> library/parser.m:
> 	Fill in the term.context of term.variables while parsing.
>
> compiler/prog_data.m:
> 	Add the context to the constructor and constructor_arg types.
>
> compiler/prog_io.m:
> 	Fill in the context fields in the constructor and constructor_arg
> 	types.
>
> compiler/add_clause.m:
> compiler/prog_io.m:
> compiler/prog_io_typeclass.m:
> compiler/typecheck.m:
> 	Call the correct version of term_list_to_var_list,
> 	to deal with the fact that we removed the reverse
> 	mode of var_list_to_term_list.
>
> compiler/add_clause.m:
> compiler/det_util.m:
> compiler/fact_table.m:
> compiler/hlds_out.m:
> compiler/inst_graph.m:
> compiler/intermod.m:
> compiler/make_hlds_passes.m:
> compiler/mercury_to_mercury.m:
> compiler/prog_ctgc.m:
> compiler/prog_io.m:
> compiler/prog_io_dcg.m:
> compiler/prog_io_goal.m:
> compiler/prog_io_pragma.m:
> compiler/prog_io_typeclass.m:
> compiler/prog_io_util.m:
> compiler/prog_io_util.m:
> compiler/prog_util.m:
> compiler/state_var.m:
> compiler/superhomogeneous.m:
> compiler/switch_detection.m:
> compiler/typecheck_errors.m:
> library/term_io.m:
> library/varset.m:
> 	Handle the context in the term.variable structure.
>
> compiler/add_type.m:
> compiler/check_typeclass.m:
> compiler/equiv_type.m:
> compiler/hhf.m:
> compiler/hlds_out.m:
> compiler/inst_check.m:
> compiler/make_tags.m:
> compiler/mercury_to_mercury.m:
> compiler/ml_type_gen.m:
> compiler/ml_unify_gen.m:
> compiler/mode_util.m:
> compiler/module_qual.m:
> compiler/post_typecheck.m:
> compiler/prog_io.m:
> compiler/prog_mode.m:
> compiler/prog_type.m:
> compiler/recompilation.check.m:
> compiler/recompilation.usage.m:
> compiler/special_pred.m:
> compiler/term_constr_build.m:
> compiler/term_norm.m:
> compiler/type_ctor_info.m:
> compiler/type_util.m:
> compiler/typecheck.m:
> compiler/unify_proc.m:
> compiler/untupling.m:
> compiler/unused_imports.m:
> 	Handle the context field in the constructor and constructor_arg
> 	types.
>
> compiler/check_hlds.m:
> 	Add the xml_documentation module.

The new module also needs to be mentioned in
compiler/notes/compiler_design.html.

...

> Index: compiler/add_clause.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/add_clause.m,v
> retrieving revision 1.36
> diff -u -r1.36 add_clause.m
> --- compiler/add_clause.m	2 Oct 2006 05:21:07 -0000	1.36
> +++ compiler/add_clause.m	31 Oct 2006 04:52:45 -0000
> @@ -132,7 +132,7 @@
>             (
>                 GoalType = goal_type_promise(_)
>             ->
> -                term.term_list_to_var_list(Args, HeadVars),
> +                HeadVars = term.term_list_to_var_list(Args),
>                 preds_add_implicit_for_assertion(HeadVars, !.ModuleInfo,
>                     ModuleName, PredName, Arity, Status, Context, PredOrFunc,
>                     PredId, !PredicateTable),
> @@ -868,11 +868,11 @@
>         NumAdded, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !Specs) :-
>     % It is an error for the left or right hand side of a
>     % unification to be !X (it may be !.X or !:X, however).
> -    ( A0 = functor(atom("!"), [variable(StateVarA)], _) ->
> +    ( A0 = functor(atom("!"), [variable(StateVarA, _)], _) ->
>         report_svar_unify_error(Context, !.VarSet, StateVarA, !Specs),
>         Goal = true_goal,
>         NumAdded = 0
> -    ; B0 = functor(atom("!"), [variable(StateVarB)], _) ->
> +    ; B0 = functor(atom("!"), [variable(StateVarB, _)], _) ->
>         report_svar_unify_error(Context, !.VarSet, StateVarB, !Specs),
>         Goal = true_goal,
>         NumAdded = 0
> @@ -896,8 +896,8 @@
>     MutableHLDS = trace_mutable_var_hlds(MutableName, StateVarName),
>     GetPredName = unqualified("get_" ++ MutableName),
>     SetPredName = unqualified("set_" ++ MutableName),
> -    SetVar = functor(atom("!:"), [variable(StateVar)], Context),
> -    UseVar = functor(atom("!."), [variable(StateVar)], Context),
> +    SetVar = functor(atom("!:"), [variable(StateVar, context_init)], Context),
> +    UseVar = functor(atom("!."), [variable(StateVar, context_init)], Context),

These variables should take their context from the surrounding context
(which should be the context of the trace goal decl).

>     GetPurity = purity_semipure,
>     SetPurity = purity_impure,
>     GetGoal = call_expr(GetPredName, [SetVar], GetPurity) - Context,
> @@ -910,8 +910,8 @@
>     Builtin = mercury_private_builtin_module,
>     GetPredName = qualified(Builtin, "trace_get_io_state"),
>     SetPredName = qualified(Builtin, "trace_set_io_state"),
> -    SetVar = functor(atom("!:"), [variable(StateVar)], Context),
> -    UseVar = functor(atom("!."), [variable(StateVar)], Context),
> +    SetVar = functor(atom("!:"), [variable(StateVar, context_init)], Context),
> +    UseVar = functor(atom("!."), [variable(StateVar, context_init)], Context),

Likewise.

...

> Index: compiler/make_hlds_passes.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
> retrieving revision 1.58
> diff -u -r1.58 make_hlds_passes.m
> --- compiler/make_hlds_passes.m	13 Oct 2006 04:52:20 -0000	1.58
> +++ compiler/make_hlds_passes.m	31 Oct 2006 04:52:45 -0000
> @@ -1586,7 +1586,7 @@
>     % Construct the semipure get predicate.
>     %
>     UnsafeGetPredName = mutable_unsafe_get_pred_sym_name(ModuleName, Name),
> -    UnsafeGetCallArgs = [variable(X)],
> +    UnsafeGetCallArgs = [variable(X, context_init)],
>     CallUnsafeGet = call_expr(UnsafeGetPredName, UnsafeGetCallArgs,
>         purity_semipure) - Context,

For the mutable source-to-source transformation the "correct" context
to attach to each variable is the context of the original mutable
declaration, e.g. Context in the above code.

...

> Index: compiler/options.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
> retrieving revision 1.532
> diff -u -r1.532 options.m
> --- compiler/options.m	5 Oct 2006 04:59:21 -0000	1.532
> +++ compiler/options.m	31 Oct 2006 04:52:46 -0000
> @@ -164,6 +164,7 @@
>     ;       make_optimization_interface
>     ;       make_transitive_opt_interface
>     ;       make_analysis_registry
> +    ;       make_xml_documentation
>     ;       generate_source_file_mapping
>     ;       generate_dependency_file
>     ;       generate_dependencies
> @@ -934,6 +935,7 @@
>     make_optimization_interface         -   bool(no),
>     make_transitive_opt_interface       -   bool(no),
>     make_analysis_registry              -   bool(no),
> +    make_xml_documentation              -   bool(no),
>     convert_to_mercury                  -   bool(no),
>     typecheck_only                      -   bool(no),
>     errorcheck_only                     -   bool(no),
> @@ -1556,6 +1558,7 @@
> short_option('v', verbose).
> short_option('V', very_verbose).
> short_option('w', inhibit_warnings).
> +short_option('x', make_xml_documentation).
> short_option('?', help).
>
> % warning options
> @@ -1657,6 +1660,7 @@
>         make_transitive_opt_interface).
> long_option("make-trans-opt",       make_transitive_opt_interface).
> long_option("make-analysis-registry",   make_analysis_registry).
> +long_option("make-xml-documentation",   make_xml_documentation).

I suggest also adding `--make-xml-doc' as a synonym.

> long_option("convert-to-mercury",   convert_to_mercury).
> long_option("convert-to-Mercury",   convert_to_mercury).
> long_option("pretty-print",         convert_to_mercury).
> @@ -3048,6 +3052,10 @@
>         "--make-transitive-optimization-interface",
>         "\tOutput transitive optimization information",
>         "\tinto the `<module>.trans_opt' file.",
> +        "\tThis option should only be used by mmake.",
> +        "-x,--make-xml-documentation",
> +        "\tOutput XML documentation of the module",
> +        "\tinto the `<module>.xml' file.",
>         "\tThis option should only be used by mmake.",
>         "-P, --convert-to-mercury",
>         "\tConvert to Mercury. Output to file `<module>.ugly'",


> @@ -135,8 +134,9 @@
>             % as the DCG output var from this goal, and append the DCG argument
>             % pair to the non-terminal's argument list.
>             new_dcg_var(!VarSet, !Counter, Var),
> -            Args = Args0 ++ [term.variable(!.Var), term.variable(Var)],
> -            Goal = call_expr(SymName, Args, purity_pure) - Context,
> +            Args = Args0 ++
> +                [term.variable(!.Var, Ctxt), term.variable(Var, Ctxt)],
> +            Goal = call_expr(SymName, Args, purity_pure) - Ctxt,
>             MaybeGoal = ok1(Goal),
>             !:Var = Var

Changing the name of the context from Context to Ctxt, here
and in a few other spots, is not helpful IMO as the former is used
almost everywhere else.

...

> Index: library/term.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/term.m,v
> retrieving revision 1.124
> diff -u -r1.124 term.m
> --- library/term.m	23 Oct 2006 00:33:01 -0000	1.124
> +++ library/term.m	31 Oct 2006 04:52:47 -0000
> @@ -36,7 +36,8 @@
>                 term.context
>             )
>     ;       variable(
> -                var(T)
> +                var(T),
> +                term.context
>             ).
>
> :- type const
> @@ -399,15 +400,16 @@
>     % Abort (call error/1) if the list contains any non-variables.
>     %
> :- func term_list_to_var_list(list(term(T))) = list(var(T)).
> -:- pred term_list_to_var_list(list(term(T))::in, list(var(T))::out) is det.
> +
> +    % Convert a list of terms which are all vars into a list of vars.
> +    %
> +:- pred term_list_to_var_list(list(term(T))::in, list(var(T))::out) is semidet.
>
>     % Convert a list of terms which are all vars into a list of vars
>     % (or vice versa).
>     %
> :- func var_list_to_term_list(list(var(T))) = list(term(T)).
> -:- pred var_list_to_term_list(list(var(T)), list(term(T))).
> -:- mode var_list_to_term_list(in, out) is det.
> -:- mode var_list_to_term_list(out, in) is semidet.
> +:- pred var_list_to_term_list(list(var(T))::in, list(term(T))::out) is det.

The changes to the interface of this module need to be mentioned in the
NEWS file.

...

> New File: compiler/xml_documentation.m
> ===================================================================
> %-----------------------------------------------------------------------------%
> % vim: ft=mercury ts=4 sw=4 et
> %-----------------------------------------------------------------------------%
> % Copyright (C) 2006 The University of Melbourne.
> % This file may only be copied under the terms of the GNU General
> % Public License - see the file COPYING in the Mercury distribution.
> %-----------------------------------------------------------------------------%
> %
> % Module: xml_documentation.m
> % Main authors: petdr.
> %
> % This module outputs an XML representation of a module,
> % which can then be transformed by a stylesheet into some other
> % documentation format.
> %
> %-----------------------------------------------------------------------------%
>
> :- module check_hlds.xml_documentation.
>
> :- interface.
>
> :- import_module hlds.
> :- import_module hlds.hlds_module.
>
> :- import_module io.
>
>    %
>    % Output a representation of the module in XML which can be used
>    % to document the module.
>    %
> :- pred xml_documentation(module_info::in, io::di, io::uo) is det.
>

...

>    % Record all the locations of comments in a file.
>    %
> :- type comments
>    --->    comments(
>                    % For each line record what is on the line.
>                line_types  :: map(int, line_type)
>            ).
>
> :- type line_type
>                % A line containing only whitespace.
>    --->    blank
>
>                % A line containing just a comment.
>    ;       comment(string)
>
>                % A line which contains both a comment and code.
>    ;       code_and_comment(string)
>
>                % A line containing code.
>    ;       code
>    .
>
> %-----------------------------------------------------------------------------%
>
> xml_documentation(ModuleInfo, !IO) :-
>    module_info_get_name(ModuleInfo, ModuleName),
>    module_name_to_file_name(ModuleName, ".xml", no, FileName, !IO),
>
>    lookup_module_source_file(ModuleName, SrcFileName, !IO),
>    io.open_input(SrcFileName, SrcResult, !IO),
>    ( SrcResult = ok(SrcStream),
>        build_comments(SrcStream, comments(map.init), Comments, !IO),
>
>        io.open_output(FileName, OpenResult, !IO),
>        ( OpenResult = ok(Stream),
>            ModuleInfoXmlDoc = module_info_xml_doc(Comments, ModuleInfo),
>            write_xml_doc_to_stream(Stream, ModuleInfoXmlDoc, !IO)
>        ; OpenResult = error(Err),
>            unable_to_open_file(FileName, Err, !IO)
>        )
>    ; SrcResult = error(SrcErr),
>        unable_to_open_file(SrcFileName, SrcErr, !IO)
>    ).

The switches there should be formatted thus:


 	(
 	    SrcResult = ok(SrcStream),
 	    build_comments(...
 	;
             SrcResult = error(...),
             unable_to_open_file(...)
         )



> :- pred unable_to_open_file(string::in, io.error::in, io::di, io::uo) is det.
>
> unable_to_open_file(FileName, IOErr, !IO) :-
>    io.stderr_stream(StdErr, !IO),
>    io.write_string(StdErr, "Unable to open file: '", !IO),
>    io.write_string(StdErr, FileName, !IO),
>    io.write_string(StdErr, "' because\n", !IO),
>    io.write_string(StdErr, io.error_message(IOErr), !IO),
>    io.nl(StdErr, !IO),
>
>    io.set_exit_status(1).

This crops up enough in the compiler that it's worth putting this
predicate in error_util.m instead (we should eventually convert all
the similar spots in mercury_compile.m and elsewhere to use it as well.)

...

>    % Given the input_stream build the comments datastructure which
>    % represents this stream.
>    %
> :- pred build_comments(io.input_stream::in, comments::in, comments::out,
>    io::di, io::uo) is det.
>
> build_comments(S, comments(!.C), comments(!:C), !IO) :-
>    io.get_line_number(S, LineNumber, !IO),
>    io.read_line(S, LineResult, !IO),
>    ( LineResult = ok(Line),
>        svmap.set(LineNumber, line_type(Line), !C),
>        build_comments(S, comments(!.C), comments(!:C), !IO)
>    ; LineResult = eof,
>        true
>    ; LineResult = error(_),
>        true
>    ).

Ignoring I/O errors here isn't right - at least mark this spot
with an XXX comment.

>
>    %
>    % Given a list of character representing one line

s/character/characters/

>    % return the type of the line.
>    %
>    % Note this predicate is pretty stupid at the moment.
>    % It only recognizes lines which contains % comments.
>    % It also is confused by % characters in strings, etc. etc.
>    %
> :- func line_type(list(character)) = line_type.
>
> line_type(Line) = LineType :-
>    list.takewhile(char.is_whitespace, Line, _WhiteSpace, Rest),
>    list.takewhile(is_not_comment_char, Rest, Decl, Comment),
>    ( Rest = [] ->
>        LineType = blank
>    ; Comment = [_|_] ->

s/[_|_]/[_ | _]/

>        ( Decl = [] ->
>            LineType = comment(string.from_char_list(Comment))
>        ;
>            LineType = code_and_comment(string.from_char_list(Comment))
>        )

That can be turned into a switch.

>    ;
>        LineType = code
>    ).
>
> :- pred is_not_comment_char(char::in) is semidet.
>
> is_not_comment_char(C) :-
>    C \= '%'.
>
> %-----------------------------------------------------------------------------%
> %-----------------------------------------------------------------------------%
>
> % Comment selection strategies
>
>    %
>    % Get the XML representation of the comment associated
>    % with the given prog_context.
>    %
> :- func comment(comments, prog_context) = xml.
>
> comment(Comments, Context) =
>    elem("comment", [], [cdata(get_comment(Comments, Context))]).
>
>    %
>    % Get the comment string associated with the given prog_context.
>    %
> :- func get_comment(comments, prog_context) = string.
>
> get_comment(Comments, context(_, Line)) =
>        %
>        % XXX at a later date this hard-coded strategy should
>        % be made more flexible.  What I imagine is that the
>        % user would pass a string saying in what order
>        % they wish to search for comments.
>        %
>    ( comment_on_current_line(Comments, Line, C) ->
>        C
>    ; comment_directly_above(Comments, Line, C) ->
>        C
>    ;
>        ""
>    ).
>
> %-----------------------------------------------------------------------------%
>
>    %
>    % Succeeds if the current line has a comment.
>    % The comment is extended with all the lines following
>    % the current line which just contain a comment.
>    %
> :- pred comment_on_current_line(comments::in, int::in, string::out) is semidet.
>
> comment_on_current_line(Comments, Line, Comment) :-
>    map.search(Comments ^ line_types, Line, code_and_comment(Comment0)),
>    RestComment = get_comment_forwards(Comments, Line + 1),
>    Comment = Comment0 ++ RestComment.
>
>    %
>    % Succeeds if the comment is directly above the current line.
>    % The comment above ends when we find a line above the current
>    % line which doesn't just contain a comment.
>    %
> :- pred comment_directly_above(comments::in, int::in, string::out) is semidet.
>
> comment_directly_above(Comments, Line, Comment) :-
>    map.search(Comments ^ line_types, Line - 1, comment(_)),
>    Comment = get_comment_backwards(Comments, Line - 1).
>
>    %
>    % Return the string which represents the comment starting at the given
>    % line.  The comment ends when a line which is not a plain comment line
>    % is found.
>    %
> :- func get_comment_forwards(comments, int) = string.
>
> get_comment_forwards(Comments, Line) = Comment :-
>    LineType = map.lookup(Comments ^ line_types, Line),
>    ( LineType = comment(CurrentComment),
>        CommentBelow = get_comment_backwards(Comments, Line + 1),
>        Comment = CurrentComment ++ CommentBelow
>    ; ( LineType = blank ; LineType = code ; LineType = code_and_comment(_) ),
>        Comment = ""
>    ).
>
>    %
>    % Return the string which represents the comment ending at the given line.
>    % The comment extends backwards until the the line above the given
>    % line is not a comment only line.
>    %
> :- func get_comment_backwards(comments, int) = string.
>
> get_comment_backwards(Comments, Line) = Comment :-
>    LineType = map.lookup(Comments ^ line_types, Line),
>    ( LineType = comment(CurrentComment),
>        CommentAbove = get_comment_backwards(Comments, Line - 1),
>        Comment = CommentAbove ++ CurrentComment
>    ; ( LineType = blank ; LineType = code ; LineType = code_and_comment(_) ),
>        Comment = ""
>    ).

Reformat thus:

 	(
 	    LineType = comment(CurrentComment),
             CommentAbove = get_comment_backwards(Comments, Line - 1),
             Comment = CommentAbove ++ CurrentComment
         ;
              ( LineType = blank
              ; LineType = code
              ; LineType = code_and_comment(_)
              ),
              Comment = ""
         ).

Likewise for get_comment_forwards.

That looks okay otherwise.

Julien.
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------