[m-dev.] for review: Added a new format "newpretty" to the browser.
Mark Anthony BROWN
dougl at cs.mu.OZ.AU
Mon Mar 5 03:34:33 AEDT 2001
Hi,
Here is the first round of review comments. After you have addressed these,
please post a relative diff of the changes, including a log message for just
the second part of the project.
Cheers,
Mark.
--
First, a couple of general comments about the design.
- The design seems to be OK for single functor types, but if there
is more than one functor they will all use the same argument list,
which is not the right thing to do, I think. Maybe it would be
better to have the user specify a functor rather than a type (or
let them specify both)? This would only require minor changes to
the code below.
- It would be nice to have commands which add or remove a single
argument from the list of arguments that are displayed, rather
than having to specify the whole set each time.
Sarvamanan THURAIRATNAM writes:
> Estimated hours taken : 200
>
> For Fergus or Mark to Review.
>
> Added a new pretty printing format to the term browser. This new format
> helps put a limit on the size of the term printed during debugging.
> This limit is specified by setting the number of lines you want the term
> to be printed on and the width of these lines. Also you could specify which
> arguments should be printed for terms that are of certain types. Refer to
> sized_pretty.m for Examples.
>
> browser/sized_pretty.m:
> New file that does what's described above.
>
> browser/browse.m:
> browser/browser_info.m:
> browser/mdb.m:
> browser/parse.m:
> trace/mercury_trace_browse.c:
> trace/mercury_trace_browse.h:
> trace/mercury_trace_internal.c:
> Modified to accommodate the new format.
>
> tests/debugger/browse_pretty.inp:
> tests/debugger/browser_test.inp:
> Included test cases for the new pretty printing format.
>
> tests/debugger/browse_pretty.exp:
> tests/debugger/browser_test.exp:
> Changed the expected output.
>
> This is the second part of my project. This is the part that allows the user
> to specify for certain types which arguments should be printed. The Relative
> diff is included below. The full diff will be sent in the next mail.
>
> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
> %%%%%%%% Relative Diff %%%%%%%%
> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
>
> --- Review/mercury/browser/browse.m Tue Jan 23 14:43:47 2001
> +++ Database/mercury/browser/browse.m Wed Feb 7 15:15:02 2001
> @@ -275,6 +275,17 @@
> write_path(Debugger, Info0 ^ dirs),
> nl_debugger(Debugger),
> { Info = Info0 }
> + ; { Command = add_to_database(String, List) } ->
> + { State0 = Info0 ^ state },
> + { browser_info__get_database(State0, Database) },
> + { sized_pretty__adding_to_database(String, List, Database,
> + NewDatabase) },
> + { browser_info__set_database(State0, NewDatabase, State) },
It is our convention to use names like Database0 and Database, rather than
Database and NewDatabase.
> + { Info = Info0 ^ state := State }
> + ; { Command = clear_database } ->
> + { State0 = Info0 ^ state },
> + { browser_info__set_database(State0, [], State) },
> + { Info = Info0 ^ state := State }
> ;
> write_string_debugger(Debugger,
> "command not yet implemented\n"),
> @@ -350,7 +361,8 @@
> portray_verbose(Debugger, SubUniv, Params)
> ;
> { Format = pretty },
> - portray_pretty(Debugger, SubUniv, Params)
> + { browser_info__get_database(Info ^ state, Database) },
> + portray_pretty(Debugger, SubUniv, Params, Database)
> )
> ;
> write_string_debugger(Debugger, "error: no such subterm")
> @@ -406,12 +418,13 @@
> write_string_debugger(Debugger, Str).
>
>
> -:- pred portray_pretty(debugger, univ, format_params, io__state, io__state).
> -:- mode portray_pretty(in, in, in, di, uo) is det.
> +:- pred portray_pretty(debugger, univ, format_params, database, io__state,
> + io__state).
> +:- mode portray_pretty(in, in, in, in, di, uo) is det.
>
> -portray_pretty(Debugger, Univ, Params) -->
> +portray_pretty(Debugger, Univ, Params, Database) -->
> { sized_pretty__univ_to_string_line(Univ, Params ^ width,
> - Params ^ lines, Str) },
> + Params ^ lines, Database, Str) },
> write_string_debugger(Debugger, Str).
>
> % The maximum estimated size for which we use `io__write'.
> --- Review/mercury/browser/browser_info.m Tue Feb 6 12:14:44 2001
> +++ Database/mercury/browser/browser_info.m Tue Feb 20 18:14:11 2001
> @@ -14,6 +14,7 @@
>
> :- interface.
> :- import_module bool, list, std_util.
> +:- import_module mdb__sized_pretty.
>
> % The non-persistent browser information. A new one of these is
> % created every time the browser is called, based on the contents
> @@ -96,6 +97,16 @@
> portray_format, format_params).
> :- mode browser_info__get_format_params(in, in, in, out) is det.
>
> + % given the persistent state, retrieves the database.
s/given/Given/
and also below.
> +:- pred browser_info__get_database(browser_persistent_state, database).
> +:- mode browser_info__get_database(in, out) is det.
> +
> + % given the persistent state and a database this predicate gives back
> + % a new persistent state that has the new database stored in it.
> +:- pred browser_info__set_database(browser_persistent_state, database,
> + browser_persistent_state).
> +:- mode browser_info__set_database(in, in, out) is det.
> +
> %---------------------------------------------------------------------------%
>
> % An abstract data type that holds persistent browser settings.
> @@ -179,6 +190,15 @@
> %
> browser_info__set_param(P, B, A, no, no, no, no, format(Format)).
>
> +:- pragma export(browser_info__get_database(in, out),
> + "ML_BROWSE_get_database").
> +browser_info__get_database(State, State ^ type_information).
> +
> +:- pragma export(browser_info__set_database(in, in, out),
> + "ML_BROWSE_set_database").
> +browser_info__set_database(State0, Database, State) :-
> + State = State0 ^ type_information := Database.
> +
> %---------------------------------------------------------------------------%
>
> browser_info__init(Term, MaybeFormat, State, Info) :-
> @@ -209,7 +229,8 @@
> ---> browser_persistent_state(
> print_params :: caller_params,
> browse_params :: caller_params,
> - print_all_params :: caller_params
> + print_all_params :: caller_params,
> + type_information :: database
> ).
>
> :- type caller_params
> @@ -240,7 +261,7 @@
> % term will be shown.
> %
> browser_info__init_persistent_state(State) :-
> - State = browser_persistent_state(Print, Browse, PrintAll),
> + State = browser_persistent_state(Print, Browse, PrintAll, []),
> caller_type_print_defaults(Print),
> caller_type_browse_defaults(Browse),
> caller_type_print_all_defaults(PrintAll).
> @@ -287,7 +308,8 @@
> BParams),
> maybe_set_param(A, F, Pr, V, NPr, Setting, State0 ^ print_all_params,
> AParams),
> - State = browser_persistent_state(PParams, BParams, AParams).
> + State = browser_persistent_state(PParams, BParams, AParams,
> + State0 ^ type_information).
>
> :- pred default_all_yes(bool, bool, bool, bool, bool, bool).
> :- mode default_all_yes(in, in, in, out, out, out) is det.
> --- Review/mercury/browser/parse.m Wed Jan 17 10:45:06 2001
> +++ Database/mercury/browser/parse.m Wed Feb 21 11:34:24 2001
> @@ -80,6 +80,8 @@
> ; print
> ; display
> ; write
> + ; add_to_database(string, list(int))
> + ; clear_database
> ; unknown
> .
>
> @@ -167,7 +169,7 @@
> ; char__is_digit(C) ->
> dig_to_int(C, N),
> lexer_num(N, Cs, Toks)
> - ; char__is_alpha_or_underscore(C) ->
> + ; is_alpha_or_underscore_or_colon(C) ->
> lexer_name(C, Cs, Toks)
> ; char__is_whitespace(C) ->
> lexer(Cs, Toks)
> @@ -218,11 +220,22 @@
> :- pred lexer_name(char, list(char), list(token)).
> :- mode lexer_name(in, in, out) is det.
> lexer_name(C, Cs, Toks) :-
> - list__takewhile(char__is_alpha_or_underscore, Cs, Letters, Rest),
> + list__takewhile(is_alpha_or_underscore_or_colon, Cs, Letters, Rest),
> string__from_char_list([C | Letters], Name),
> lexer(Rest, Toks2),
> Toks = [name(Name) | Toks2].
> -
> +
> +
> + % True iff the character is a letter or an underscore or a colon.
> +:- pred is_alpha_or_underscore_or_colon(char).
> +:- mode is_alpha_or_underscore_or_colon(in) is semidet.
> +is_alpha_or_underscore_or_colon(Char) :-
> + ( Char = (':') ->
> + true
> + ;
> + char__is_alpha_or_underscore(Char)
> + ).
> +
>
> :- pred parse(list(token), command).
> :- mode parse(in, out) is semidet.
> @@ -271,6 +284,13 @@
> ; (Tok = name("print") ; Tok = name("p")) ->
> Toks = [],
> Comm = print
> + ; Tok = name("add_to_database") ->
> + Toks = [name(Typename) | Rest],
> + parse_ints(Rest, List),
> + Comm = add_to_database(Typename, List)
> + ; Tok = name("clear_database") ->
> + Toks = [],
> + Comm = clear_database
> ;
> Tok = (<),
> Toks = [num(Depth)],
> @@ -345,6 +365,13 @@
> ).
>
>
> +:- pred parse_ints(list(token), list(int)).
> +:- mode parse_ints(in, out) is semidet.
> +parse_ints([], []).
> +parse_ints([num(Head) | Toks], List) :-
> + List = [Head | Rest],
> + parse_ints(Toks, Rest).
> +
> %---------------------------------------------------------------------------%
>
> :- pred show_command(command, io__state, io__state).
> @@ -381,6 +408,15 @@
> io__write_string("write\n").
> show_command(unknown) -->
> io__write_string("unknown\n").
> +show_command(add_to_database(String, List)) -->
> + io__write_string("add_to_database "),
> + io__write_string(String),
> + io__write_string(" "),
> + io__write(List),
> + nl.
> +
> +show_command(clear_database) -->
> + io__write_string("clear_database\n").
>
> :- pred show_path(path, io__state, io__state).
> :- mode show_path(in, di, uo) is det.
> --- Review/mercury/browser/sized_pretty.m Tue Feb 20 17:56:59 2001
> +++ Database/mercury/browser/sized_pretty.m Wed Feb 21 11:56:35 2001
> @@ -16,11 +16,13 @@
> % ---------------------------
> %
> % Call univ_to_string_line with the follwing variables:
> -% univ_to_string_line(Univ, LineWidth, Lines, String)
> +% univ_to_string_line(Univ, LineWidth, Lines, Database, String)
> % where Univ : is the Term (in univ type) you want to convert
> % LineWidth : is the length of the lines
> % Lines : is the number of lines you want the term to be
> % printed on
> +% Database : A database that has information about types
> +% specified by the user.
> % String : output string
> %
> % EXAMPLES
> @@ -118,6 +120,11 @@
> % big(big(big/3, "Level 2", small), "Level 1", big(big/3, "Level 2", small))
> %
> %------------------------------------------------------------------------------%
> +% Width = 75, Lines(s) = 1, Database = ["test:big" - [1, 2]]
> +%
> +% big(big(big(small, "Level 3", ), "Level 2", ), "Level 1", )
> +%
> +%------------------------------------------------------------------------------%
> % Width = 20, Line(s) = 10
> %
> % big(
> @@ -161,18 +168,36 @@
>
> :- interface.
>
> -:- import_module std_util, int, string.
> +:- import_module std_util, int, string, list.
> +
> + % The idea of using a database is to be able specify that for
> + % a term of specific type only print the arguments specified by
> + % the user.
> +:- type database == list(entry). % A database that stores information
> + % about types.
> +
> +:- type entry
> + ---> entry(
> + string, % specifies the type. If it's a user
> + % defined type then "<modulename>:type"
> + list(int) % specifies the arguments to print
> + ).
A few things about this new code:
- It would be better if the module exported an abstract type (i.e. one
that is named in the interface but defined in the implementation).
- The database type represents a mapping from type names to lists
of argument positions, so why not use the map module from the
standard library? That is, make the type equivalent to
map(string, list(int)).
- I don't think that "database" is a very good name for this type,
because it doesn't give any information about what the type does.
A better name might be something like visible_args_database.
Likewise some other things should be changed along the same lines,
such as function names, debugger commands, etc.
>
> % This may throw an exception or cause a runtime abort if the term
> % in question has user-defined equality.
> % The Limit is number of lines.
> -:- pred univ_to_string_line(univ::in, int::in, int::in, string::out) is det.
> +:- pred univ_to_string_line(univ::in, int::in, int::in, database::in,
> + string::out) is det.
> +
> + % adding information about a type to the database.
> +:- pred adding_to_database(string::in, list(int)::in, database::in,
> + database::out) is det.
>
> %------------------------------------------------------------------------------%
>
> :- implementation.
>
> -:- import_module list, require, assoc_list, pprint, bool.
> +:- import_module require, assoc_list, pprint, bool.
>
> :- type no_measure_params ---> no_measure_params.
> :- type measure_params
> @@ -222,16 +247,18 @@
> % the partial limit that each of the argument should be
> % given. It's arguments in order are term, measure parameter(s),
> % limit, arity, a flag (once the limit for the subterms
> - % is determined the subterms are flagged with this limit), size
> - % of the Functor, partial limit, adjusted limit, adjusted
> - % measure parameter(s).
> + % is determined the subterms are flagged with this limit), a
> + % list that specifies which aruments to print (if a list is not
> + % provided we print all the arguments), size of the Functor,
> + % partial limit, adjusted limit, adjusted measure parameter(s).
> % Also a term is not deconstructed unless it has enough space
> % to print functor and the functors of it's arguments.
> % If the bool is `yes', we check that there is enough space to
> % print the functor and the functors of its arguments before
> % deconstructing the term.
> pred measured_split(univ::in, MeasureParams::in, T::in, int::in,
> - bool::in, T::out, maybe(T)::out, T::out, MeasureParams::out) is det
> + bool::in, maybe(list(int)) ::in, T::out, maybe(T)::out, T::out,
> + MeasureParams::out) is det
>
> ].
>
> @@ -244,7 +271,7 @@
> % Head Term is going to be printed on a single line then it should be
> % given a limit of character_count(LineWidth - 1) instead of
> % character_count(LineWidth - 3).
> -univ_to_string_line(Univ, LineWidth, Lines, String) :-
> +univ_to_string_line(Univ, LineWidth, Lines, Database, String) :-
> Params = measure_params(LineWidth),
> deconstruct(univ_value(Univ), _, Arity, _),
> ( Arity \= 0,
> @@ -256,7 +283,7 @@
> ;
> Limit = line_count(Lines)
> ),
> - annotate_with_size(Univ, Params, Limit, AnnotTerm),
> + annotate_with_size(Univ, Params, Limit, Database, AnnotTerm),
> Doc = to_doc_sized(AnnotTerm),
> String = pprint__to_string(LineWidth, Doc).
>
> @@ -267,31 +294,32 @@
> % further.
> % In The Second pass the space is evenly distributed between
> % the terms and therefore the subterms are deconstructed evenly.
> -:- pred annotate_with_size(univ::in, MeasureParams::in, T::in,
> +:- pred annotate_with_size(univ::in, MeasureParams::in, T::in, database::in,
> size_annotated_term(T)::out) is det
> <= measure_with_params(T, MeasureParams).
>
> -annotate_with_size(Univ, Params, Limit, Size2) :-
> - first_pass(Univ, Params, Limit, Size1),
> - second_pass(Size1, Params, Limit, Size2).
> +annotate_with_size(Univ, Params, Limit, Database, Size2) :-
> + first_pass(Univ, Params, Limit, Database, Size1),
> + second_pass(Size1, Params, Limit, Database, Size2).
>
> %------------------------------------------------------------------------------%
>
> -:- pred first_pass(univ::in, MeasureParams::in, T::in,
> +:- pred first_pass(univ::in, MeasureParams::in, T::in, database::in,
> size_annotated_term(T)::out) is det
> <= measure_with_params(T, MeasureParams).
>
> -first_pass(Univ, Params, Limit, Size) :-
> - deconstruct(univ_value(Univ), Functor, Arity, Args),
> - measured_split(Univ, Params, Limit, Arity, yes, FunctorSize,
> - Flag, NewLimit, NewParams),
> - flag_with(Args, Flag, FlaggedUnivArgs),
> +first_pass(Univ, Params, Limit, Database, Size) :-
> + deconstruct(univ_value(Univ), Functor, Arity, Args),
> + MaybeList = search_database(Database, type_name(univ_type(Univ))),
> + measured_split(Univ, Params, Limit, Arity, yes, MaybeList,
> + FunctorSize, Flag, NewLimit, NewParams),
> + flag_with(Args, Flag, MaybeList, 1, FlaggedUnivArgs),
> ( (Arity \= 0, Flag = no) ->
> Exact0 = no
> ;
> Exact0 = yes
> ),
> - annotate_args_with_size(FlaggedUnivArgs, NewParams, NewLimit,
> + annotate_args_with_size(FlaggedUnivArgs, NewParams, Database, NewLimit,
> FunctorSize, SoFar, Exact0, Exact, MaybeArgSizes),
> (
> Exact = no,
> @@ -305,12 +333,12 @@
> %------------------------------------------------------------------------------%
> % annotating the arguments.
> :- pred annotate_args_with_size(assoc_list(maybe(T), univ)::in,
> - MeasureParams::in, T::in, T::in, T::out, bool::in, bool::out,
> - size_annotated_args(T)::out) is det <= measure_with_params(T,
> - MeasureParams).
> + MeasureParams::in, database::in, T::in, T::in, T::out, bool::in,
> + bool::out, size_annotated_args(T)::out) is det <=
> + measure_with_params(T, MeasureParams).
IMHO, it would be easier to read if you put the "<=" on the same line as
the measure_with_params constraint. The same applies below.
>
> -annotate_args_with_size([], _, _, SoFar, SoFar, Exact, Exact, []).
> -annotate_args_with_size([Flag - Arg | FlaggedArgs], Params, Limit,
> +annotate_args_with_size([], _, _, _, SoFar, SoFar, Exact, Exact, []).
> +annotate_args_with_size([Flag - Arg | FlaggedArgs], Params, Database, Limit,
> SoFar0, SoFar, Exact0, Exact,
> [MaybeFlaggedSize | MaybeFlaggedSizes]) :-
> (
> @@ -321,7 +349,7 @@
> AppliedArgLimit = max_measure(ArgLimit,
> subtract_measures(Limit, SoFar0, Params))
> ),
> - first_pass(Arg, Params, AppliedArgLimit, Size),
> + first_pass(Arg, Params, AppliedArgLimit, Database, Size),
> MaybeFlaggedSize = yes(ArgLimit - Size),
> extract_size_from_annotation(Size) = ArgSize,
> SoFar1 = add_measures(SoFar0, ArgSize, Params),
> @@ -343,8 +371,8 @@
> ;
> Exact2 = Exact1
> ),
> - annotate_args_with_size(FlaggedArgs, Params, Limit, SoFar1, SoFar,
> - Exact2, Exact, MaybeFlaggedSizes).
> + annotate_args_with_size(FlaggedArgs, Params, Database, Limit, SoFar1,
> + SoFar, Exact2, Exact, MaybeFlaggedSizes).
>
> %------------------------------------------------------------------------------%
> % Annotates the arguments with zero limit.
> @@ -385,11 +413,14 @@
> % the other terms which could take up more than their share.
> % If a term can be fully printed within the given space,
> % ("exact" type) then the Term is not altered.
> + % Also the database is searched for the type of the term and if
> + % found the "list specifying the arguments to be printed" is passed
> + % to measured_split/10.
> :- pred second_pass(size_annotated_term(T)::in, MeasureParams::in, T::in,
> - size_annotated_term(T)::out) is det
> + database::in, size_annotated_term(T)::out) is det
> <= measure_with_params(T, MeasureParams).
>
> -second_pass(OldSizeTerm, Params, Limit, NewSizeTerm) :-
> +second_pass(OldSizeTerm, Params, Limit, Database, NewSizeTerm) :-
> (
> OldSizeTerm = exact(_Univ, _Size, _, _Arity, _MaybeArgs),
> NewSizeTerm = OldSizeTerm
> @@ -398,21 +429,24 @@
> NewSizeTerm = OldSizeTerm
> ;
> OldSizeTerm = at_least(Univ, _Size, deconstructed(Functor,
> - Arity,MaybeArgs)),
> - measured_split(Univ, Params, Limit, Arity, yes, FSize, Flag,
> - NewLimit, NewParams),
> + Arity, MaybeArgs)),
> + MaybeList = search_database(Database,
> + type_name(univ_type(Univ))),
> + measured_split(Univ, Params, Limit, Arity, yes, MaybeList,
> + FSize, Flag, NewLimit, NewParams),
> ( if Flag = yes(X) then
> ArgLimit = X,
> - check_args(NewParams, MaybeArgs, ArgLimit, Passed,
> + check_args(NewParams, MaybeArgs, ArgLimit, Passed,
> FSize, Used),
> LeftOver = add_measures(subtract_measures(NewLimit,
> Used, Params), FSize, Params),
> measured_split(Univ, Params, LeftOver, Arity - Passed,
> - no, _, Flag2, _, _),
> + no, MaybeList, _, Flag2, _, _),
> ( if Flag2 = yes(Y) then
> SplitLimit = Y,
> process_args(NewParams, MaybeArgs, ArgLimit,
> - SplitLimit, NewArgs, NewSize0),
> + SplitLimit, Database, NewArgs,
> + NewSize0),
> NewSize = add_measures(FSize, NewSize0,
> NewParams),
> Result0 = list__map(check_if_exact, NewArgs),
> @@ -473,11 +507,11 @@
> % represented would be annoted again with a new limit
> % (SplitLimit). The rest of the terms are left alone.
> :- pred process_args(MeasureParams::in, size_annotated_args(T)::in, T::in,
> - T::in, size_annotated_args(T)::out, T::out) is det <=
> + T::in, database::in, size_annotated_args(T)::out, T::out) is det <=
> measure_with_params(T, MeasureParams).
>
> -process_args(_, [], _, _, [], zero_measure).
> -process_args(Params, [HeadArg | Rest], ArgLimit, SplitLimit,
> +process_args(_, [], _, _, _, [], zero_measure).
> +process_args(Params, [HeadArg | Rest], ArgLimit, SplitLimit, Database,
> [NewHeadArg | NewRest], SizeOut) :-
> ( if HeadArg = yes(X) then
> X = _ - STerm,
> @@ -494,7 +528,8 @@
> NewHeadArg = HeadArg
> ;
> NewHeadArg = yes(pair(SplitLimit, NewSTerm)),
> - annotate_with_size(Univ, Params, SplitLimit, NewSTerm)
> + annotate_with_size(Univ, Params, SplitLimit, Database,
> + NewSTerm)
> )
> else
> NewHeadArg = no
> @@ -505,7 +540,8 @@
> ;
> SizeOut = RestSize
> ),
> - process_args(Params, Rest, ArgLimit, SplitLimit, NewRest, RestSize).
> + process_args(Params, Rest, ArgLimit, SplitLimit, Database,
> + NewRest, RestSize).
>
> %------------------------------------------------------------------------------%
> % checking if an size-annotated arg is an exact type (fully represented)
> @@ -563,11 +599,79 @@
> %------------------------------------------------------------------------------%
> % A predicate that creates an associated list of Univ and their
> % individual Limit
> -:- pred flag_with(list(univ)::in, maybe(T)::in, assoc_list(maybe(T), univ)::out)
> - is det.
> -flag_with([], _, []).
> -flag_with([Arg | Args], Flag, [Flag - Arg | FlaggedArgs]) :-
> - flag_with(Args, Flag, FlaggedArgs).
> +:- pred flag_with(list(univ)::in, maybe(T)::in, maybe(list(int))::in, int::in,
> + assoc_list(maybe(T), univ)::out) is det.
> +
> +flag_with([], _, _, _, []).
> +flag_with([Arg | Args], Flag, no, Index, [Flag - Arg | FlaggedArgs]) :-
> + flag_with(Args, Flag, no, Index + 1, FlaggedArgs).
> +
> +flag_with([Arg | Args], Flag, yes(List), Index, [Head | FlaggedArgs]) :-
> + ( list__member(Index, List) ->
> + Head = Flag - Arg
> + ;
> + Head = no - Arg
> + ),
> + flag_with(Args, Flag, yes(List), Index + 1, FlaggedArgs).
> +
> +%------------------------------------------------------------------------------%
> +
> +:- pragma export(sized_pretty__adding_to_database(in, in, in, out),
> + "SIZED_PRETTY_adding_to_database").
That name should be prefixed by "ML_", as is done earlier. The same applies
below.
> +
> +adding_to_database(String, Arguments, [], DataBase) :-
> + list__remove_dups(Arguments, NoDups),
> + DataBase = [entry(String, NoDups)].
> +
> + % if the type is already there modify it. Otherwise add the new
> + % entry to the end
> +adding_to_database(String, Arguments, [Head | Rest], DataBase) :-
> + ( Head = entry(String, _) ->
> + list__remove_dups(Arguments, NoDups),
> + DataBase = [entry(String, NoDups) | Rest]
> + ;
> + DataBase = [Head | DataBase0],
> + adding_to_database(String, Arguments, Rest, DataBase0)
> + ).
> +
> +%------------------------------------------------------------------------------%
> + % converts a database to a string that is equivalent to the commands
> + % that would be needed to create the database from the "mdb> prompt".
> +:- pragma export(sized_pretty__database_to_string(in, out),
> + "SIZED_PRETTY_database_to_string").
> +
> +:- pred database_to_string(database::in, string::out) is det.
I think it would be better to export a predicate which takes an
io__output_stream and a database, and prints the required commands to the
stream. This would mean you can avoid creating a potentially large string.
If you want to know how to pass an io__output_stream from C to Mercury,
take a look at how ML_BROWSE_browse is called in mercury_trace_browse.c.
> +
> +database_to_string([], "").
> +
> +database_to_string([entry(Type, NumList) | Rest], StringOut) :-
> + list__map(string__int_to_string, NumList, StringList),
> + string__append("add_to_database ", Type, StringTemp),
> + string__append(StringTemp, " ", StringTemp2),
> + string__append(StringTemp2, string_list_to_string(StringList), String),
> + database_to_string(Rest, StringRest),
> + string__append(String, "\n", StringTemp3),
> + string__append(StringTemp3, StringRest, StringOut).
> +
> +:- func string_list_to_string(list(string)) = string.
> +
> +string_list_to_string([]) = "".
> +
> +string_list_to_string([Head | Rest]) = String :-
> + string__append(Head, " ", StringTemp),
> + string__append(StringTemp, string_list_to_string(Rest), String).
> +%------------------------------------------------------------------------------%
> + % searching the database for the type.
> +:- func search_database(database, string) = maybe(list(int)).
> +
> +search_database([], _) = no.
> +
> +search_database([entry(String, Arguments) | Rest], KeyString) = Result :-
> + ( String = KeyString ->
> + Result = yes(Arguments)
> + ;
> + Result = search_database(Rest, KeyString)
> + ).
>
> %------------------------------------------------------------------------------%
> % functor_count is a representation where the size of a term
> @@ -602,18 +706,24 @@
> zero_functor_count = functor_count(0).
>
> :- pred functor_count_split(univ::in, no_measure_params::in, functor_count::in,
> - int::in, bool::in, functor_count::out, maybe(functor_count)::out,
> - functor_count::out, no_measure_params::out) is det.
> + int::in, bool::in, maybe(list(int))::in, functor_count::out,
> + maybe(functor_count)::out, functor_count::out, no_measure_params::out)
> + is det.
>
> -functor_count_split(_, Params, functor_count(Limit), Arity, _, functor_count(1),
> - Flag, functor_count(Limit), Params) :-
> - ( Arity = 0 ->
> +functor_count_split(_, Params, functor_count(Limit), Arity, _, MaybeList,
> + functor_count(1), Flag, functor_count(Limit), Params) :-
> + ( MaybeList = yes(List) ->
> + NewArity = list__length(list__filter(>=(Arity), List))
> + ;
> + NewArity = Arity
> + ),
The above piece of code is duplicated in each of the typeclass instances,
so it would be better if it was a separate predicate.
> + ( NewArity = 0 ->
> Flag = no
> ;
> - ( Limit =< (Arity + 1) ->
> + ( Limit =< (NewArity + 1) ->
> Flag = no
> ;
> - RoundUp = (Limit + Arity - 1) // Arity,
> + RoundUp = (Limit + NewArity - 1) // NewArity,
> Flag = yes(functor_count(RoundUp))
> )
> ).
> @@ -627,7 +737,7 @@
> :- instance measure_with_params(functor_count, no_measure_params) where [
> func(add_measures/3) is add_functor_count,
> func(subtract_measures/3) is subtract_functor_count,
> - pred(measured_split/9) is functor_count_split
> + pred(measured_split/10) is functor_count_split
> ].
>
>
> @@ -663,25 +773,30 @@
> zero_char_count = char_count(0).
>
> :- pred char_count_split(univ::in, no_measure_params::in, char_count::in,
> - int::in, bool::in, char_count::out, maybe(char_count)::out,
> - char_count::out, no_measure_params::out) is det.
> + int::in, bool::in, maybe(list(int))::in, char_count::out,
> + maybe(char_count)::out, char_count::out, no_measure_params::out) is det.
>
> -char_count_split(Univ, Params, char_count(Limit), Arity, Check,
> +char_count_split(Univ, Params, char_count(Limit), Arity, Check, MaybeList,
> char_count(FunctorSize), Flag, char_count(Limit), Params) :-
> deconstruct(univ_value(Univ), Functor, _, Args),
> + ( MaybeList = yes(List) ->
> + NewArity = list__length(list__filter(>=(Arity), List))
> + ;
> + NewArity = Arity
> + ),
> ( Check = yes ->
> - get_arg_length(Args, TotalLength, _)
> + get_arg_length(Args, MaybeList, 1, TotalLength, _)
> ;
> TotalLength = 0
> ),
> FunctorSize = string__length(Functor) + 2*(Arity),
> - ( Arity = 0 ->
> + ( NewArity = 0 ->
> Flag = no
> ;
> ( Limit =< (FunctorSize + TotalLength) ->
> Flag = no
> ;
> - RoundUp = (Limit + Arity - FunctorSize) // Arity,
> + RoundUp = (Limit + NewArity - FunctorSize) // NewArity,
> Flag = yes(char_count(RoundUp))
> )
> ).
> @@ -695,7 +810,7 @@
> :- instance measure_with_params(char_count, no_measure_params) where [
> func(add_measures/3) is add_char_count,
> func(subtract_measures/3) is subtract_char_count,
> - pred(measured_split/9) is char_count_split
> + pred(measured_split/10) is char_count_split
> ].
>
> %------------------------------------------------------------------------------%
> @@ -809,24 +924,30 @@
> % We assume that all arguments have to be on separate lines, or
> % the whole term should be printed on a single line.
> :- pred size_count_split(univ::in, measure_params::in, size_count::in,
> - int::in, bool::in, size_count::out, maybe(size_count)::out,
> - size_count::out, measure_params::out) is det.
> + int::in, bool::in, maybe(list(int))::in, size_count::out,
> + maybe(size_count)::out, size_count::out, measure_params::out) is det.
>
> -size_count_split(Univ, Params, Limit, Arity, Check, FunctorSize,
> +size_count_split(Univ, Params, Limit, Arity, Check, MaybeList, FunctorSize,
> Flag, NewLimit, NewParams) :-
> % LineWidth is length of the line in which the functor is printed.
> Params = measure_params(LineWidth),
> deconstruct(univ_value(Univ), Functor, ActualArity, Args),
> FSize = string__length(Functor) + 2 * (ActualArity),
> + ( MaybeList = yes(List) ->
> + NewArity = list__length(list__filter(>=(Arity), List))
> + ;
> + NewArity = Arity
> + ),
> + NotPrinted = ActualArity - NewArity,
> ( Check = yes ->
> - get_arg_length(Args, TotalLength, MaxArgLength),
> + get_arg_length(Args, MaybeList, 1, TotalLength, MaxArgLength),
> int__max(MaxArgLength, (string__length(Functor) + 1), MaxLength)
> ;
> TotalLength = 0,
> MaxLength = 0
> ),
> (
> - Arity = 0
> + NewArity = 0
> ->
> Flag = no,
> FunctorSize = character_count(FSize),
> @@ -837,14 +958,14 @@
> Limit = line_count(LineLimit),
> % we need one line for the functor and atleast
> % one line for each argument
> - LineLimit >= (Arity + 1),
> + LineLimit >= (NewArity + 1 + NotPrinted),
I think it would be clearer to write this as "LineLimit >= (ActualArity + 1)".
> % linewidth is decreased by two characters to account
> % for indentation
> (LineWidth - 2) >= MaxLength
> ->
> - Line = (LineLimit - 1) // Arity,
> + Line = (LineLimit - 1 - NotPrinted) // NewArity,
> Flag = yes(line_count(Line)),
> - FunctorSize = line_count(1),
> + FunctorSize = line_count(1 + NotPrinted),
> NewLimit = Limit,
> NewParams = measure_params(LineWidth - 2)
> ;
> @@ -855,8 +976,9 @@
> % newline at the end of it (Hence the "- 3").
> LineWidth - 3 >= (FSize + TotalLength)
> ->
> - % "Arity - 1" is for rounding up.
> - Char = (LineWidth - 3 - FSize + Arity - 1) // Arity ,
> + % "Arity - 1" is for rounding up.
> + Char = (LineWidth - 3 - FSize + NewArity - 1) //
> + NewArity ,
> Flag = yes(character_count(Char)),
> FunctorSize = character_count(FSize),
> NewLimit = character_count(LineWidth - 3),
> @@ -865,7 +987,7 @@
> Limit = character_count(CharLimit),
> CharLimit >= (FSize + TotalLength)
> ->
> - Char = (CharLimit - FSize + Arity - 1) // Arity,
> + Char = (CharLimit - FSize + NewArity - 1)// NewArity,
> Flag = yes(character_count(Char)),
> FunctorSize = character_count(FSize),
> NewLimit = Limit,
> @@ -890,33 +1012,42 @@
> :- instance measure_with_params(size_count, measure_params) where [
> func(add_measures/3) is add_size_count,
> func(subtract_measures/3) is subtract_size_count,
> - pred(measured_split/9) is size_count_split
> + pred(measured_split/10) is size_count_split
> ].
>
> %------------------------------------------------------------------------------%
> % This predicate determines how many characters it will take
> % to print the functors of the arguments. Also determines the
> % length of biggest functor.
> -:- pred get_arg_length(list(univ)::in, int::out, int::out) is det.
> +:- pred get_arg_length(list(univ)::in, maybe(list(int))::in, int::in, int::out,
> + int::out) is det.
>
> -get_arg_length([], 0, 0).
> -get_arg_length([HeadUniv | Rest], TotalLength, MaxLength) :-
> +get_arg_length([], _, _, 0, 0).
> +get_arg_length([HeadUniv | Rest], MaybeList, Index, TotalLength, MaxLength) :-
> deconstruct(univ_value(HeadUniv), Functor, Arity, _),
> + (
> + MaybeList = yes(List),
> + not list__member(Index, List)
> + ->
> + Length = 0
> + ;
> + ( Arity = 0 ->
> + Length = string__length(Functor)
> + ;
> + % 2 is added because if a term has arguments then the
> + % shortest way to print it is "functor/Arity"
> + % Assuming Arity is a single digit
> + Length = string__length(Functor) + 2
> + )
> + ),
> ( Rest = [] ->
> Correction = 2
> ;
> Correction = 3
> ),
> - ( Arity = 0 ->
> - Length = string__length(Functor)
> - ;
> - % 2 is added because if a term has arguments then the
> - % shortest way to print it is "functor/Arity"
> - % Assuming Arity is a single digit
> - Length = string__length(Functor) + 2
> - ),
> TotalLength = Length + RestTotalLength,
> int__max((Length + Correction), RestMaxLength, MaxLength),
> - get_arg_length(Rest, RestTotalLength, RestMaxLength).
> + get_arg_length(Rest, MaybeList, Index + 1, RestTotalLength,
> + RestMaxLength).
>
> %------------------------------------------------------------------------------%
> --- Review/mercury/trace/mercury_trace_browse.c Tue Jan 16 12:13:15 2001
> +++ Database/mercury/trace/mercury_trace_browse.c Mon Feb 19 18:09:18 2001
> @@ -40,6 +40,8 @@
>
> #include <stdio.h>
>
> +typedef MR_Word MercuryList;
> +
> static MR_Word MR_trace_browser_persistent_state;
> static MR_TypeInfo MR_trace_browser_persistent_state_type;
>
> @@ -204,6 +206,106 @@
> MR_make_permanent(MR_trace_browser_persistent_state,
> MR_trace_browser_persistent_state_type);
> return TRUE;
> +}
> +
> +/*
> +** adding type information to the database stored in the persistent
> +** state
This comment should be written as a sentence. This applies in a few other
places, too.
> +*/
> +bool
> +MR_trace_set_database(char **words, int word_count)
> +{
> + int i, arg, length = 0;
> + MR_String type_name;
> + MercuryList arg_list, database;
> + bool flag = FALSE;
> +
> + length = strlen(words[1]) + 1;
> +
> + type_name = malloc(sizeof(char) * length);
> +
> + strcpy(type_name, words[1]);
You should allocate this string on the Mercury heap, using
MR_make_aligned_string_copy. It would be better to do this further down,
just before it is used, because that way it won't be unnecessarily allocated
if this function exits early. Note that the call to
MR_make_aligned_string_copy should be done from within MR_TRACE_CALL_MERCURY
(or MR_TRACE_USE_HP).
> +
> + arg_list = MR_list_empty();
> + database = MR_list_empty();
> +
> +
> + for(i = 2 ; (i < word_count && MR_trace_is_number(words[i], &arg)) ;
> + i++)
> + {
> + arg_list = MR_list_cons((MR_Word) arg, arg_list);
> + }
> +
> + if (i != word_count)
> + {
> + return FALSE;
> + }
> +
> + MR_trace_browse_ensure_init();
> +
> + MR_TRACE_CALL_MERCURY(
> + ML_BROWSE_get_database(MR_trace_browser_persistent_state,
> + &database);
> + );
> +
> + MR_TRACE_CALL_MERCURY(
> + SIZED_PRETTY_adding_to_database((MR_String) type_name,
> + arg_list, database, &database);
> + );
> +
> + MR_TRACE_CALL_MERCURY(
> + ML_BROWSE_set_database(MR_trace_browser_persistent_state,
> + database, &MR_trace_browser_persistent_state);
> + );
All three calls can go inside one MR_TRACE_CALL_MERCURY.
> +
> + return TRUE;
> +}
> +
> +/*
> +** clearing the database stored in the persistent state. In other words
> +** replace it with an empty list.
> +*/
> +void
> +MR_trace_clear_database()
> +{
> + MercuryList database;
> +
> + database = MR_list_empty();
> +
> + MR_trace_browse_ensure_init();
> +
> + MR_TRACE_CALL_MERCURY(
> + ML_BROWSE_set_database(MR_trace_browser_persistent_state,
> + database, &MR_trace_browser_persistent_state);
> + );
> +
> + return;
> +}
> +
> +/*
> +** saving the database into a file
> +*/
> +void
> +MR_trace_save_database(FILE *file)
> +{
> + MercuryList database;
> + MR_String string = NULL;
> + int i = 0;
> +
> + database = MR_list_empty();
> +
> + MR_trace_browse_ensure_init();
> +
> + MR_TRACE_CALL_MERCURY(
> + ML_BROWSE_get_database(MR_trace_browser_persistent_state,
> + &database);
> + );
> +
> + MR_TRACE_CALL_MERCURY(
> + SIZED_PRETTY_database_to_string(database, &string);
> + );
> +
> + fputs(string, file);
> }
>
> static bool
> --- Review/mercury/trace/mercury_trace_browse.h Thu Feb 15 20:00:33 2001
> +++ Database/mercury/trace/mercury_trace_browse.h Mon Feb 19 17:54:43 2001
> @@ -64,6 +64,20 @@
> MR_Bool verbose, MR_Bool pretty, const char *param,
> const char *value);
>
> +extern bool MR_trace_set_database(char **words, int word_count);
I think it would be better to use "update" rather than "set", since you are
not getting rid of all of the existing contents, but merely updating some
of the contents to new values.
> +
> +extern void MR_trace_clear_database(void);
> +
> +extern void MR_trace_save_database(FILE *file);
> +
> +extern void ML_BROWSE_get_database(MR_Word persistent_state,
> + MR_Word * database);
> +
> +extern void SIZED_PRETTY_adding_to_database(MR_String, MR_Word, MR_Word,
> + MR_Word *);
> +
> +extern void SIZED_PRETTY_database_to_string(MR_Word, MR_String *);
You shouldn't need to write prototypes for those functions exported from
Mercury. They will be in the automatically generated mdb.sized_pretty.h file,
which can be #included in mercury_trace_browse.c.
> +
> /*
> ** Invoke an interactive query.
> */
> --- Review/mercury/trace/mercury_trace_internal.c Tue Jan 23 12:11:32 2001
> +++ Database/mercury/trace/mercury_trace_internal.c Mon Feb 19 18:08:14 2001
> @@ -29,6 +29,7 @@
>
> #include "mdb.browse.h"
> #include "mdb.program_representation.h"
> +#include "mdb.sized_pretty.h"
This file needn't be included here.
>
> #include <stdio.h>
> #include <stdlib.h>
> @@ -2017,6 +2018,8 @@
> MR_trace_print_all_aliases(fp, TRUE);
> found_error = MR_save_spy_points(fp, MR_mdb_err);
>
> + MR_trace_save_database(fp);
> +
> if (found_error) {
> fflush(MR_mdb_out);
> fprintf(MR_mdb_err, "mdb: could not save "
> @@ -2119,6 +2122,35 @@
> "available from EXIT, FAIL or EXCP events.\n");
> }
> #endif /* MR_USE_DECLARATIVE_DEBUGGER */
> + } else if (streq(words[0], "add_to_database")) {
You need to follow the instructions at the top of MR_trace_handle_cmd,
which say:
/*
** IMPORTANT: if you add any new commands, you will need to
** (a) include them in MR_trace_valid_command_list, defined below.
** (b) document them in doc/user_guide.texi
*/
> + if (word_count > 1)
> + {
> + if (! MR_trace_set_database(words, word_count))
> + {
> + fprintf(MR_mdb_err, "mdb: Invalid arguments to"
> + " add_to_database\n");
> + fprintf(MR_mdb_err, "Usage: add_to_database "
> + "<string> <int> <int> ..\n");
> + fflush(MR_mdb_out);
The fflush(MR_mdb_out) needs to be done before printing anything to
MR_mdb_err. See the comment near the top of mercury_trace_internal.c for
an explanation.
You should use MR_trace_usage() to print the usage message, once
documentation has been added.
> + }
> + }
> + else {
> + fprintf(MR_mdb_err,
> + "mdb: add_to_database requires atleast one "
> + "argument.\n");
> + fprintf(MR_mdb_err, "Usage: add_to_database <string> "
> + "<int> <int> ..\n");
> + }
> + } else if (streq(words[0], "clear_database")) {
> + if (word_count == 1)
> + {
> + MR_trace_clear_database();
> + }
> + else {
> + fprintf(MR_mdb_err,
> + "mdb: clear_database doesn't take any "
> + "arguments.\n");
> + }
> } else {
> fflush(MR_mdb_out);
> fprintf(MR_mdb_err, "Unknown command `%s'. "
>
>
> --------------------------------------------------------------------------
> mercury-developers mailing list
> Post messages to: mercury-developers at cs.mu.oz.au
> Administrative Queries: owner-mercury-developers at cs.mu.oz.au
> Subscriptions: mercury-developers-request at cs.mu.oz.au
> --------------------------------------------------------------------------
>
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list