[m-dev.] for review: accessing fields by name in mdb
Zoltan Somogyi
zs at cs.mu.OZ.AU
Mon Dec 18 11:57:02 AEDT 2000
For review by Tyson, Mark or Fergus.
The bug fix for ML_arg must be included in the release. The rest of this
does not need to be, but it would be nice.
Also, for now I took field names to contain letters, numbers and/or
underscores. Simon, are there restrictions on what characters can appear
in field names? I could not find any in the reference manual.
Zoltan.
----------------------------------------------------
In mdb's print and browse commands, allow the field to be printed to be
specified by name as well as by number. This required extending the RTTI
for notag types to record field names.
trace/mercury_trace_vars.m:
Allow the field to be printed to be specified by name as well as by
number.
library/std_util.m:
Add code to find out whether a term has a field with a given name,
and if yes, which field that is. At the moment, this functionality
is accessible only from C. (There is no point to adding to the
user-visible interface before a redesign of that interface.)
Fix an old bug: ML_arg() was not compensating for the extra type_info
and/or typeclass_info arguments inserted at the start of a cell for
functors with existentially typed arguments. Document the ML_expand
data structure better to make that bug less likely in the future.
runtime/mercury_type_info.h:
Add an extra field to the type for notag type functors, recording
the field name of the argument, if it has one.
compiler/rtti.m:
Add a maybe-argument-name field to the record for notag types.
compiler/type_ctor_info.m:
Record the name of the single argument of the single functor of a
notag type, if it has one.
compiler/type_util.m:
Make that argument name available.
compiler/rtti_out.m:
Print out that argument name.
compiler/make_tags.m:
compiler/make_hlds.m:
compiler/rtti_to_mlds.m:
Ignore that argument name.
tests/debugger/field_names.{m,inp,exp}:
A new test case to test the printing of subterms specified by field
numbers and/or names.
tests/debugger/Mmakefile:
Enable the new test case.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.361
diff -u -b -r1.361 make_hlds.m
--- compiler/make_hlds.m 2000/12/13 00:00:23 1.361
+++ compiler/make_hlds.m 2000/12/17 02:52:07
@@ -1822,7 +1822,7 @@
{
AllowNoTagTypes = yes,
type_constructors_are_no_tag_type(ConsList,
- Name, CtorArgType)
+ Name, CtorArgType, _)
->
NoTagType = no_tag_type(Args,
Name, CtorArgType),
Index: compiler/make_tags.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_tags.m,v
retrieving revision 1.31
diff -u -b -r1.31 make_tags.m
--- compiler/make_tags.m 2000/08/10 05:10:57 1.31
+++ compiler/make_tags.m 2000/12/17 02:52:31
@@ -84,7 +84,7 @@
globals__lookup_bool_option(Globals,
unboxed_no_tag_types, yes),
type_constructors_are_no_tag_type(Ctors, SingleFunc,
- SingleArg)
+ SingleArg, _)
->
make_cons_id_from_qualified_sym_name(SingleFunc,
[SingleArg], SingleConsId),
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.11
diff -u -b -r1.11 rtti.m
--- compiler/rtti.m 2000/11/23 04:32:46 1.11
+++ compiler/rtti.m 2000/12/17 02:39:47
@@ -194,9 +194,10 @@
% the MR_NotagFunctorDesc C type.
string, % functor name
- rtti_data % pseudo typeinfo of argument
+ rtti_data, % pseudo typeinfo of argument
% (as a pseudo_type_info
% rtti_data)
+ maybe(string) % the argument's name, if any
)
; du_functor_desc(
rtti_type_id, % identifies the type
@@ -448,7 +449,7 @@
RttiTypeId, field_types(Ordinal)).
rtti_data_to_name(enum_functor_desc(RttiTypeId, _, Ordinal),
RttiTypeId, enum_functor_desc(Ordinal)).
-rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _),
+rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _, _),
RttiTypeId, notag_functor_desc).
rtti_data_to_name(du_functor_desc(RttiTypeId, _,_,_,_, Ordinal, _,_,_,_,_),
RttiTypeId, du_functor_desc(Ordinal)).
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.18
diff -u -b -r1.18 rtti_out.m
--- compiler/rtti_out.m 2000/11/15 14:00:17 1.18
+++ compiler/rtti_out.m 2000/12/17 03:26:43
@@ -163,8 +163,8 @@
io__write_string(""",\n\t"),
io__write_int(Ordinal),
io__write_string("\n};\n").
-output_rtti_data_defn(notag_functor_desc(RttiTypeId, FunctorName, ArgType),
- DeclSet0, DeclSet) -->
+output_rtti_data_defn(notag_functor_desc(RttiTypeId, FunctorName, ArgType,
+ MaybeArgName), DeclSet0, DeclSet) -->
output_rtti_data_decls(ArgType, "", "", 0, _, DeclSet0, DeclSet1),
output_generic_rtti_data_defn_start(RttiTypeId, notag_functor_desc,
DeclSet1, DeclSet),
@@ -172,6 +172,16 @@
c_util__output_quoted_string(FunctorName),
io__write_string(""",\n\t "),
output_addr_of_rtti_data(ArgType),
+ io__write_string(",\n\t"),
+ (
+ { MaybeArgName = yes(ArgName) },
+ io__write_string(""""),
+ io__write_string(ArgName),
+ io__write_string("""")
+ ;
+ { MaybeArgName = no },
+ io__write_string("NULL")
+ ),
io__write_string("\n};\n").
output_rtti_data_defn(du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
Locn, Ordinal, Arity, ContainsVarBitVector, MaybeArgTypes,
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.9
diff -u -b -r1.9 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 2000/11/15 14:00:17 1.9
+++ compiler/rtti_to_mlds.m 2000/12/17 02:41:55
@@ -148,8 +148,8 @@
gen_init_string(FunctorName),
gen_init_int(Ordinal)
]).
-gen_init_rtti_data_defn(notag_functor_desc(_RttiTypeId, FunctorName, ArgType),
- ModuleName, _, Init, []) :-
+gen_init_rtti_data_defn(notag_functor_desc(_RttiTypeId, FunctorName, ArgType,
+ _MaybeArgName), ModuleName, _, Init, []) :-
Init = init_struct([
gen_init_string(FunctorName),
gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.10
diff -u -b -r1.10 type_ctor_info.m
--- compiler/type_ctor_info.m 2000/11/15 14:00:17 1.10
+++ compiler/type_ctor_info.m 2000/12/17 02:50:30
@@ -300,9 +300,11 @@
Enum = no,
globals__lookup_bool_option(Globals,
unboxed_no_tag_types, NoTagOption),
- ( NoTagOption = yes,
- type_constructors_are_no_tag_type(Ctors, Name,
- ArgType) ->
+ (
+ NoTagOption = yes,
+ type_constructors_are_no_tag_type(Ctors,
+ Name, ArgType, MaybeArgName)
+ ->
( term__is_ground(ArgType) ->
Inst = equiv_type_is_ground
;
@@ -310,7 +312,7 @@
),
TypeCtorRep = notag(EqualityAxioms, Inst),
type_ctor_info__make_notag_tables(Name,
- ArgType, RttiTypeId,
+ ArgType, MaybeArgName, RttiTypeId,
TypeTables, FunctorsInfo, LayoutInfo),
NumPtags = -1
;
@@ -369,10 +371,10 @@
% Make the functor and notag tables for a notag type.
:- pred type_ctor_info__make_notag_tables(sym_name::in, (type)::in,
- rtti_type_id::in, list(rtti_data)::out,
+ maybe(string)::in, rtti_type_id::in, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
-type_ctor_info__make_notag_tables(SymName, ArgType, RttiTypeId,
+type_ctor_info__make_notag_tables(SymName, ArgType, MaybeArgName, RttiTypeId,
TypeTables, FunctorsInfo, LayoutInfo) :-
unqualify_name(SymName, FunctorName),
RttiTypeId = rtti_type_id(_, _, UnivTvars),
@@ -381,7 +383,8 @@
ExistTvars = [],
make_pseudo_type_info_and_tables(ArgType, UnivTvars, ExistTvars,
RttiData, [], Tables0),
- FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, RttiData),
+ FunctorDesc = notag_functor_desc(RttiTypeId, FunctorName, RttiData,
+ MaybeArgName),
FunctorRttiName = notag_functor_desc,
FunctorsInfo = notag_functors(FunctorRttiName),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.92
diff -u -b -r1.92 type_util.m
--- compiler/type_util.m 2000/10/26 06:05:35 1.92
+++ compiler/type_util.m 2000/12/17 02:51:00
@@ -20,7 +20,7 @@
:- import_module hlds_module, hlds_pred, hlds_data, prog_data.
:- import_module term.
-:- import_module list, map.
+:- import_module std_util, list, map.
%-----------------------------------------------------------------------------%
@@ -253,15 +253,17 @@
% (i.e. one with only one constructor, and
% whose one constructor has only one argument,
% and which is not private_builtin:type_info/1),
- % and if so, return its constructor symbol and argument type.
+ % and if so, return its constructor symbol, argument type,
+ % and the argument's name (if it has one).
%
% This doesn't do any checks for options that might be set
% (such as turning off no_tag_types). If you want those checks
% you should use type_is_no_tag_type/4, or if you really know
% what you are doing, perform the checks yourself.
-:- pred type_constructors_are_no_tag_type(list(constructor), sym_name, type).
-:- mode type_constructors_are_no_tag_type(in, out, out) is semidet.
+:- pred type_constructors_are_no_tag_type(list(constructor), sym_name, type,
+ maybe(string)).
+:- mode type_constructors_are_no_tag_type(in, out, out, out) is semidet.
% Unify (with occurs check) two types with respect to a type
% substitution and update the type bindings.
@@ -433,7 +435,7 @@
:- import_module prog_io, prog_io_goal, prog_util, options, globals.
:- import_module bool, char, int, string.
-:- import_module assoc_list, require, std_util, varset.
+:- import_module assoc_list, require, varset.
type_util__type_id_module(_ModuleInfo, TypeName - _Arity, ModuleName) :-
sym_name_get_module_name(TypeName, unqualified(""), ModuleName).
@@ -969,9 +971,10 @@
% would always be fully module-qualified at points where
% type_constructors_are_no_tag_type/3 is called.
-type_constructors_are_no_tag_type(Ctors, Ctor, ArgType) :-
+type_constructors_are_no_tag_type(Ctors, Ctor, ArgType, MaybeArgName) :-
Ctors = [SingleCtor],
- SingleCtor = ctor(ExistQVars, _Constraints, Ctor, [_FName - ArgType]),
+ SingleCtor = ctor(ExistQVars, _Constraints, Ctor,
+ [MaybeSymName - ArgType]),
ExistQVars = [],
unqualify_name(Ctor, Name),
Name \= "type_info",
@@ -982,7 +985,16 @@
% We don't handle unary tuples as no_tag types --
% they are rare enough that it's not worth
% the implementation effort.
- Name \= "{}".
+ Name \= "{}",
+
+ (
+ MaybeSymName = yes(SymName),
+ unqualify_name(SymName, ArgName),
+ MaybeArgName = yes(ArgName)
+ ;
+ MaybeSymName = no,
+ MaybeArgName = no
+ ).
%-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing library
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.213
diff -u -b -r1.213 std_util.m
--- library/std_util.m 2000/12/15 07:41:16 1.213
+++ library/std_util.m 2000/12/18 00:28:42
@@ -2594,11 +2594,19 @@
** non-zero). The arity will always be set.
**
** ML_expand will fill in the other fields (functor, arity,
- ** arg_values, arg_type_infos, and non_canonical_type)
- ** accordingly, but
- ** the values of fields not asked for should be assumed to
- ** contain random data when ML_expand returns.
- ** (that is, they should not be relied on to remain unchanged).
+ ** arg_values, arg_type_infos, and non_canonical_type) accordingly,
+ ** but the values of fields not asked for should be assumed to contain
+ ** random data when ML_expand returns (that is, they should not be
+ ** relied on to remain unchanged).
+ **
+ ** The arg_type_infos field will contain a pointer to an array of arity
+ ** MR_TypeInfos, one for each user-visible field of the cell. The
+ ** arg_values field will contain a pointer to an arity + num_extra_args
+ ** MR_Words, one for each field of the cell, whether user-visible or not.
+ ** The first num_extra_args words will be the type infos and/or typeclass
+ ** infos added by the implementation to describe the types of the
+ ** existentially typed fields, while the last arity words will be the
+ ** user-visible fields themselves.
*/
/* The `#ifndef ... #define ... #endif' guards against multiple inclusion */
@@ -2632,6 +2640,12 @@
extern bool ML_arg(MR_TypeInfo type_info, MR_Word *term, int arg_index,
MR_TypeInfo *arg_type_info_ptr, MR_Word **argument_ptr);
+ /*
+ ** NB. ML_named_arg_num() is used in mercury_trace_vars.c.
+ */
+extern bool ML_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr,
+ char *arg_name, int *arg_num_ptr);
+
").
:- pragma c_code("
@@ -3149,7 +3163,8 @@
success = (arg_index >= 0 && arg_index < expand_info.arity);
if (success) {
*arg_type_info_ptr = expand_info.arg_type_infos[arg_index];
- *arg_ptr = &expand_info.arg_values[arg_index];
+ *arg_ptr = &expand_info.arg_values[
+ arg_index + expand_info.num_extra_args];
}
/*
@@ -3162,6 +3177,108 @@
}
return success;
+}
+
+/*
+** ML_named_arg() takes the address of a term, its type, and an argument name.
+** If the given term has an argument with the given name, it succeeds and
+** returns the argument number (counted starting from 0) of the argument;
+** if it doesn't, it fails (i.e. returns FALSE).
+*/
+
+bool
+ML_named_arg_num(MR_TypeInfo type_info, MR_Word *term_ptr, char *arg_name,
+ int *arg_num_ptr)
+{
+ MR_TypeCtorInfo type_ctor_info;
+ const MR_DuPtagLayout *ptag_layout;
+ const MR_DuFunctorDesc *functor_desc;
+ const MR_NotagFunctorDesc *notag_functor_desc;
+ MR_Word data;
+ int ptag;
+ MR_Word sectag;
+ MR_TypeInfo eqv_type_info;
+ int i;
+
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
+ switch (type_ctor_info->type_ctor_rep) {
+ case MR_TYPECTOR_REP_DU_USEREQ:
+ case MR_TYPECTOR_REP_DU:
+ data = *term_ptr;
+ ptag = MR_tag(data);
+ ptag_layout = &type_ctor_info->type_layout.layout_du[ptag];
+
+ switch (ptag_layout->MR_sectag_locn) {
+ case MR_SECTAG_NONE:
+ functor_desc = ptag_layout->MR_sectag_alternatives[0];
+ break;
+ case MR_SECTAG_LOCAL:
+ sectag = MR_unmkbody(data);
+ functor_desc =
+ ptag_layout->MR_sectag_alternatives[sectag];
+ break;
+ case MR_SECTAG_REMOTE:
+ sectag = MR_field(ptag, data, 0);
+ functor_desc =
+ ptag_layout->MR_sectag_alternatives[sectag];
+ break;
+ }
+
+ if (functor_desc->MR_du_functor_arg_names == NULL) {
+ return FALSE;
+ }
+
+ for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
+ if (functor_desc->MR_du_functor_arg_names[i] != NULL
+ && streq(arg_name, functor_desc->MR_du_functor_arg_names[i]))
+ {
+ *arg_num_ptr = i;
+ return TRUE;
+ }
+ }
+
+ return FALSE;
+
+ case MR_TYPECTOR_REP_EQUIV:
+ eqv_type_info = MR_create_type_info(
+ MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
+ type_ctor_info->type_layout.layout_equiv);
+ return ML_named_arg_num(eqv_type_info, term_ptr, arg_name,
+ arg_num_ptr);
+
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
+ eqv_type_info = MR_pseudo_type_info_is_ground(
+ type_ctor_info->type_layout.layout_equiv);
+ return ML_named_arg_num(eqv_type_info, term_ptr, arg_name,
+ arg_num_ptr);
+
+ case MR_TYPECTOR_REP_EQUIV_VAR:
+ /*
+ ** The current version of the RTTI gives all such equivalence types
+ ** the EQUIV type_ctor_rep, not EQUIV_VAR.
+ */
+ MR_fatal_error(""unexpected EQUIV_VAR type_ctor_rep"");
+ break;
+
+ case MR_TYPECTOR_REP_NOTAG:
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ notag_functor_desc = type_ctor_info->type_functors.functors_notag;
+
+ if (notag_functor_desc->MR_notag_functor_arg_name != NULL
+ && streq(arg_name, notag_functor_desc->MR_notag_functor_arg_name))
+ {
+ *arg_num_ptr = 0;
+ return TRUE;
+ }
+
+ return FALSE;
+
+ default:
+ return FALSE;
+ }
}
").
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.60
diff -u -b -r1.60 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/12/04 18:28:42 1.60
+++ runtime/mercury_type_info.h 2000/12/17 02:34:50
@@ -684,6 +684,7 @@
typedef struct {
MR_ConstString MR_notag_functor_name;
MR_PseudoTypeInfo MR_notag_functor_arg_type;
+ MR_ConstString MR_notag_functor_arg_name;
} MR_NotagFunctorDesc;
/*---------------------------------------------------------------------------*/
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.46
diff -u -b -r1.46 Mmakefile
--- tests/debugger/Mmakefile 2000/12/06 06:05:52 1.46
+++ tests/debugger/Mmakefile 2000/12/17 00:36:13
@@ -26,6 +26,7 @@
exception_value \
exception_vars \
existential_type_classes \
+ field_names \
implied_instance \
interpreter \
loopcheck \
@@ -174,6 +175,9 @@
existential_type_classes.inp
$(MDB) ./existential_type_classes < existential_type_classes.inp 2>&1 | \
sed 's/string.m:[0-9]*/string.m:NNNN/g' > existential_type_classes.out
+
+field_names.out: field_names field_names.inp
+ $(MDB) ./field_names < field_names.inp > field_names.out 2>&1
implied_instance.out: implied_instance implied_instance.inp
$(MDB) ./implied_instance < implied_instance.inp \
Index: tests/debugger/field_names.exp
===================================================================
RCS file: field_names.exp
diff -N field_names.exp
--- /dev/null Thu Sep 2 15:00:04 1999
+++ field_names.exp Sun Dec 17 16:59:11 2000
@@ -0,0 +1,265 @@
+ 1: 1 1 CALL pred field_names:main/2-0 (det) field_names.m:51
+mdb> echo on
+Command echo enabled.
+mdb> context none
+Contexts will not be printed.
+mdb> step
+ 2: 2 2 CALL pred field_names:make_t1f1/5-0 (det)
+mdb> finish
+ 3: 2 2 EXIT pred field_names:make_t1f1/5-0 (det)
+mdb> p 5
+ HeadVar__5 t1f1(41, 42, 43, 44)
+mdb> p 5^1x
+mdb: bad component selector.
+mdb> p 5^1
+ HeadVar__5 41
+mdb> p 5^2
+ HeadVar__5 42
+mdb> p 5^3
+ HeadVar__5 43
+mdb> p 5^4
+ HeadVar__5 44
+mdb> p 5^t1a
+ HeadVar__5 41
+mdb> p 5^t1b
+ HeadVar__5 42
+mdb> p 5^t1c
+mdb: the path t1c does not exist.
+mdb> p 5^t1d
+ HeadVar__5 44
+mdb> p 5^t1e
+mdb: the path t1e does not exist.
+mdb> step
+ 4: 3 2 CALL pred field_names:make_t1f2/4-0 (det)
+mdb> finish
+ 5: 3 2 EXIT pred field_names:make_t1f2/4-0 (det)
+mdb> p 4
+ HeadVar__4 t1f2(51, 52, 53)
+mdb> p 4^1
+ HeadVar__4 51
+mdb> p 4^2
+ HeadVar__4 52
+mdb> p 4^3
+ HeadVar__4 53
+mdb> p 4^t1a
+mdb: the path t1a does not exist.
+mdb> p 4^t1e
+ HeadVar__4 51
+mdb> p 4^t1f
+mdb: the path t1f does not exist.
+mdb> p 4^t1g
+ HeadVar__4 53
+mdb> step
+ 6: 4 2 CALL pred field_names:make_t2/5-0 (det)
+mdb> finish
+ 7: 4 2 EXIT pred field_names:make_t2/5-0 (det)
+mdb> p 5
+ HeadVar__5 t2f(0.600000000000000, 61, t1f1(41, 42, 43, 44), t1f2(51, 52, 53))
+mdb> p 5^1
+ HeadVar__5 0.600000000000000
+mdb> p 5^2
+ HeadVar__5 61
+mdb> p 5^3
+ HeadVar__5 t1f1(41, 42, 43, 44)
+mdb> p 5^3^t1a
+ HeadVar__5 41
+mdb> p 5^3^t1b
+ HeadVar__5 42
+mdb> p 5^3^t1c
+mdb: the path t1c does not exist.
+mdb> p 5^3^t1d
+ HeadVar__5 44
+mdb> p 5^3^t1e
+mdb: the path t1e does not exist.
+mdb> p 5^4
+ HeadVar__5 t1f2(51, 52, 53)
+mdb> p 5^4^t1a
+mdb: the path t1a does not exist.
+mdb> p 5^4^t1e
+ HeadVar__5 51
+mdb> p 5^4^t1f
+mdb: the path t1f does not exist.
+mdb> p 5^4^t1g
+ HeadVar__5 53
+mdb> p 5^t2a
+ HeadVar__5 0.600000000000000
+mdb> p 5^t2b
+ HeadVar__5 t1f1(41, 42, 43, 44)
+mdb> p 5^t2b^t1a
+ HeadVar__5 41
+mdb> p 5^t2b^t1b
+ HeadVar__5 42
+mdb> p 5^t2b^t1c
+mdb: the path t1c does not exist.
+mdb> p 5^t2b^t1d
+ HeadVar__5 44
+mdb> p 5^t2b^t1e
+mdb: the path t1e does not exist.
+mdb> p 5^t2c
+ HeadVar__5 t1f2(51, 52, 53)
+mdb> p 5^t2c^t1a
+mdb: the path t1a does not exist.
+mdb> p 5^t2c^t1e
+ HeadVar__5 51
+mdb> p 5^t2c^t1f
+mdb: the path t1f does not exist.
+mdb> p 5^t2c^t1g
+ HeadVar__5 53
+mdb> step
+ 8: 5 2 CALL pred field_names:make_t3/4-0 (det)
+mdb> finish
+ 9: 5 2 EXIT pred field_names:make_t3/4-0 (det)
+mdb> p 4
+ HeadVar__4 t3f(t1f2(51, 52, 53), 72, "xyzzy", t1f1(41, 42, 43, 44))
+mdb> p 4^1
+ HeadVar__4 t1f2(51, 52, 53)
+mdb> p 4^1^1
+ HeadVar__4 51
+mdb> p 4^1^t1a
+mdb: the path t1a does not exist.
+mdb> p 4^1^t1e
+ HeadVar__4 51
+mdb> p 4^1^t1g
+ HeadVar__4 53
+mdb> p 4^2
+ HeadVar__4 72
+mdb> p 4^3
+ HeadVar__4 "xyzzy"
+mdb> p 4^3^1
+mdb: the path 1 does not exist.
+mdb> p 4^3^t1a
+mdb: the path t1a does not exist.
+mdb> p 4^4
+ HeadVar__4 t1f1(41, 42, 43, 44)
+mdb> p 4^4^t1a
+ HeadVar__4 41
+mdb> p 4^4^t1b
+ HeadVar__4 42
+mdb> p 4^4^t1c
+mdb: the path t1c does not exist.
+mdb> p 4^4^t1d
+ HeadVar__4 44
+mdb> p 4^4^t1e
+mdb: the path t1e does not exist.
+mdb> p 4^t3a
+ HeadVar__4 t1f2(51, 52, 53)
+mdb> p 4^t3a^1
+ HeadVar__4 51
+mdb> p 4^t3a^t1a
+mdb: the path t1a does not exist.
+mdb> p 4^t3a^t1e
+ HeadVar__4 51
+mdb> p 4^t3a^t1g
+ HeadVar__4 53
+mdb> p 4^t3b
+ HeadVar__4 72
+mdb> p 4^t3c
+ HeadVar__4 "xyzzy"
+mdb> p 4^t3d
+ HeadVar__4 t1f1(41, 42, 43, 44)
+mdb> p 4^t3d^t1a
+ HeadVar__4 41
+mdb> p 4^t3d^t1b
+ HeadVar__4 42
+mdb> p 4^t3d^t1c
+mdb: the path t1c does not exist.
+mdb> p 4^t3d^t1d
+ HeadVar__4 44
+mdb> p 4^t3d^t1e
+mdb: the path t1e does not exist.
+mdb> p 4^t3e^t1a
+mdb: the path t3e^t1a does not exist.
+mdb> step
+ 10: 6 2 CALL pred field_names:make_t4/2-0 (det)
+mdb> finish
+ 11: 6 2 EXIT pred field_names:make_t4/2-0 (det)
+mdb> p 2
+ HeadVar__2 t2f(0.600000000000000, 61, t1f1(41, 42, 43, 44), t1f2(51, 52, 53))
+mdb> p 2^1
+ HeadVar__2 0.600000000000000
+mdb> p 2^2
+ HeadVar__2 61
+mdb> p 2^3^t1a
+ HeadVar__2 41
+mdb> p 2^3^t1b
+ HeadVar__2 42
+mdb> p 2^3^t1c
+mdb: the path t1c does not exist.
+mdb> p 2^3^t1d
+ HeadVar__2 44
+mdb> p 2^3^t1e
+mdb: the path t1e does not exist.
+mdb> p 2^4
+ HeadVar__2 t1f2(51, 52, 53)
+mdb> p 2^4^t1a
+mdb: the path t1a does not exist.
+mdb> p 2^4^t1e
+ HeadVar__2 51
+mdb> p 2^4^t1f
+mdb: the path t1f does not exist.
+mdb> p 2^4^t1g
+ HeadVar__2 53
+mdb> p 2^t2a
+ HeadVar__2 0.600000000000000
+mdb> p 2^t2b
+ HeadVar__2 t1f1(41, 42, 43, 44)
+mdb> p 2^t2b^t1a
+ HeadVar__2 41
+mdb> p 2^t2b^t1b
+ HeadVar__2 42
+mdb> p 2^t2b^t1c
+mdb: the path t1c does not exist.
+mdb> p 2^t2b^t1d
+ HeadVar__2 44
+mdb> p 2^t2b^t1e
+mdb: the path t1e does not exist.
+mdb> p 2^t2c
+ HeadVar__2 t1f2(51, 52, 53)
+mdb> p 2^t2c^t1a
+mdb: the path t1a does not exist.
+mdb> p 2^t2c^t1e
+ HeadVar__2 51
+mdb> p 2^t2c^t1f
+mdb: the path t1f does not exist.
+mdb> p 2^t2c^t1g
+ HeadVar__2 53
+mdb> step
+ 12: 7 2 CALL pred field_names:make_t5/2-0 (det)
+mdb> finish
+ 13: 7 2 EXIT pred field_names:make_t5/2-0 (det)
+mdb> p 2
+ HeadVar__2 t5f(t1f1(41, 42, 43, 44))
+mdb> p 2/1
+ HeadVar__2 t1f1(41, 42, 43, 44)
+mdb> p 2/1/1
+ HeadVar__2 41
+mdb> p 2/1/t1a
+ HeadVar__2 41
+mdb> p 2/t5a
+ HeadVar__2 t1f1(41, 42, 43, 44)
+mdb> p 2/t5a/1
+ HeadVar__2 41
+mdb> p 2/t5a/t1a
+ HeadVar__2 41
+mdb> p 2/t6a
+mdb: the path t6a does not exist.
+mdb> step
+ 14: 8 2 CALL pred field_names:make_t6/2-0 (det)
+mdb> finish
+ 15: 8 2 EXIT pred field_names:make_t6/2-0 (det)
+mdb> p 2
+ HeadVar__2 t6f(0.900000000000000)
+mdb> p 2/1
+ HeadVar__2 0.900000000000000
+mdb> p 2/t5a
+mdb: the path t5a does not exist.
+mdb> p 2/t6a
+mdb: the path t6a does not exist.
+mdb> continue -S
+t1f1(41, 42, 43, 44)
+t1f2(51, 52, 53)
+t2f(0.600000000000000, 61, t1f1(41, 42, 43, 44), t1f2(51, 52, 53))
+t3f(t1f2(51, 52, 53), 72, "xyzzy", t1f1(41, 42, 43, 44))
+t2f(0.600000000000000, 61, t1f1(41, 42, 43, 44), t1f2(51, 52, 53))
+t5f(t1f1(41, 42, 43, 44))
+t6f(0.900000000000000)
Index: tests/debugger/field_names.inp
===================================================================
RCS file: field_names.inp
diff -N field_names.inp
--- /dev/null Thu Sep 2 15:00:04 1999
+++ field_names.inp Sun Dec 17 16:58:57 2000
@@ -0,0 +1,129 @@
+echo on
+context none
+step
+finish
+p 5
+p 5^1x
+p 5^1
+p 5^2
+p 5^3
+p 5^4
+p 5^t1a
+p 5^t1b
+p 5^t1c
+p 5^t1d
+p 5^t1e
+step
+finish
+p 4
+p 4^1
+p 4^2
+p 4^3
+p 4^t1a
+p 4^t1e
+p 4^t1f
+p 4^t1g
+step
+finish
+p 5
+p 5^1
+p 5^2
+p 5^3
+p 5^3^t1a
+p 5^3^t1b
+p 5^3^t1c
+p 5^3^t1d
+p 5^3^t1e
+p 5^4
+p 5^4^t1a
+p 5^4^t1e
+p 5^4^t1f
+p 5^4^t1g
+p 5^t2a
+p 5^t2b
+p 5^t2b^t1a
+p 5^t2b^t1b
+p 5^t2b^t1c
+p 5^t2b^t1d
+p 5^t2b^t1e
+p 5^t2c
+p 5^t2c^t1a
+p 5^t2c^t1e
+p 5^t2c^t1f
+p 5^t2c^t1g
+step
+finish
+p 4
+p 4^1
+p 4^1^1
+p 4^1^t1a
+p 4^1^t1e
+p 4^1^t1g
+p 4^2
+p 4^3
+p 4^3^1
+p 4^3^t1a
+p 4^4
+p 4^4^t1a
+p 4^4^t1b
+p 4^4^t1c
+p 4^4^t1d
+p 4^4^t1e
+p 4^t3a
+p 4^t3a^1
+p 4^t3a^t1a
+p 4^t3a^t1e
+p 4^t3a^t1g
+p 4^t3b
+p 4^t3c
+p 4^t3d
+p 4^t3d^t1a
+p 4^t3d^t1b
+p 4^t3d^t1c
+p 4^t3d^t1d
+p 4^t3d^t1e
+p 4^t3e^t1a
+step
+finish
+p 2
+p 2^1
+p 2^2
+p 2^3^t1a
+p 2^3^t1b
+p 2^3^t1c
+p 2^3^t1d
+p 2^3^t1e
+p 2^4
+p 2^4^t1a
+p 2^4^t1e
+p 2^4^t1f
+p 2^4^t1g
+p 2^t2a
+p 2^t2b
+p 2^t2b^t1a
+p 2^t2b^t1b
+p 2^t2b^t1c
+p 2^t2b^t1d
+p 2^t2b^t1e
+p 2^t2c
+p 2^t2c^t1a
+p 2^t2c^t1e
+p 2^t2c^t1f
+p 2^t2c^t1g
+step
+finish
+p 2
+p 2/1
+p 2/1/1
+p 2/1/t1a
+p 2/t5a
+p 2/t5a/1
+p 2/t5a/t1a
+p 2/t6a
+step
+finish
+p 2
+p 2/1
+p 2/t5a
+p 2/t6a
+continue -S
Index: tests/debugger/field_names.m
===================================================================
RCS file: field_names.m
diff -N field_names.m
--- /dev/null Thu Sep 2 15:00:04 1999
+++ field_names.m Sun Dec 17 12:53:13 2000
@@ -0,0 +1,86 @@
+:- module field_names.
+
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, state::uo) is det.
+
+:- implementation.
+
+:- type t1
+ ---> t1f1(
+ t1a :: int,
+ t1b :: int,
+ int,
+ t1d :: int
+ )
+ ; t1f2(
+ t1e :: int,
+ int,
+ t1g :: int
+ ).
+
+:- type t2(U)
+ ---> t2f(
+ t2a :: U,
+ int,
+ t2b :: t1,
+ t2c :: t1
+ ).
+
+:- type t3(V)
+ ---> some [W] t3f(
+ t3a :: V,
+ t3b :: int,
+ t3c :: W,
+ t3d :: t1
+ ).
+
+:- type t4 == t2(float).
+
+:- type t5
+ ---> t5f(
+ t5a :: t1
+ ).
+
+:- type t6
+ ---> t6f(
+ float
+ ).
+
+main -->
+ { make_t1f1(41, 42, 43, 44, T1F1) },
+ { make_t1f2(51, 52, 53, T1F2) },
+ { make_t2(0.6, 61, T1F1, T1F2, T2) },
+ { make_t3(T1F2, 72, T1F1, T3) },
+ { make_t4(T2, T4) },
+ { make_t5(T1F1, T5) },
+ { make_t6(0.9, T6) },
+ io__write(T1F1), nl,
+ io__write(T1F2), nl,
+ io__write(T2), nl,
+ io__write(T3), nl,
+ io__write(T4), nl,
+ io__write(T5), nl,
+ io__write(T6), nl.
+
+:- pred make_t1f1(int::in, int::in, int::in, int::in, t1::out) is det.
+make_t1f1(A, B, C, D, t1f1(A, B, C, D)).
+
+:- pred make_t1f2(int::in, int::in, int::in, t1::out) is det.
+make_t1f2(A, B, C, t1f2(A, B, C)).
+
+:- pred make_t2(T::in, int::in, t1::in, t1::in, t2(T)::out) is det.
+make_t2(A, B, C, D, t2f(A, B, C, D)).
+
+:- pred make_t3(T::in, int::in, t1::in, t3(T)::out) is det.
+make_t3(A, B, C, 'new t3f'(A, B, "xyzzy", C)).
+
+:- pred make_t4(t2(float)::in, t4::out) is det.
+make_t4(A, A).
+
+:- pred make_t5(t1::in, t5::out) is det.
+make_t5(A, t5f(A)).
+
+:- pred make_t6(float::in, t6::out) is det.
+make_t6(A, t6f(A)).
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 2000/10/27 08:38:58 1.23
+++ trace/mercury_trace_vars.c 2000/12/17 01:35:58
@@ -672,13 +672,17 @@
if (MR_isdigit(*s)) {
s++;
- } else {
- return "bad component selector";
- }
-
while (MR_isdigit(*s)) {
s++;
}
+ } else if (MR_isalnumunder(*s)) {
+ s++;
+ while (MR_isalnumunder(*s)) {
+ s++;
+ }
+ } else {
+ return "bad component selector";
+ }
} while (*s != '\0');
*path = '\0';
@@ -836,6 +840,10 @@
/* ML_arg() is defined in std_util.m */
extern bool ML_arg(MR_TypeInfo term_type_info, MR_Word *term, int arg_index,
MR_TypeInfo *arg_type_info_ptr, MR_Word **arg_ptr);
+/* ML_named_arg_num() is defined in std_util.m */
+extern bool ML_named_arg_num(MR_TypeInfo term_type_info, MR_Word *term,
+ char *arg_name, int *arg_num_ptr);
+
static char *
MR_trace_browse_var(FILE *out, MR_Var_Details *var, char *path,
@@ -857,18 +865,44 @@
while (*path != '\0') {
old_path = path;
+ if (MR_isdigit(*path)) {
+ /* we have a field number */
+
arg_num = 0;
while (MR_isdigit(*path)) {
arg_num = arg_num * 10 + *path - '0';
path++;
}
+ /* ML_arg numbers fields from 0, not 1 */
+ --arg_num;
+ } else {
+ /* we have a field name */
+ char saved_char;
+
+ while (MR_isalnumunder(*path)) {
+ path++;
+ }
+
+ saved_char = *path;
+ *path = '\0';
+
+ if (! ML_named_arg_num(typeinfo, value,
+ old_path, &arg_num))
+ {
+ *path = saved_char;
+ return old_path;
+ }
+
+ *path = saved_char;
+ }
+
if (*path != '\0') {
+ MR_assert(*path == '^' || *path == '/');
path++; /* step over / or ^ */
}
- /* ML_arg starts indexing fields from 0, not 1 */
- if (ML_arg(typeinfo, value, arg_num - 1,
+ if (ML_arg(typeinfo, value, arg_num,
&new_typeinfo, &new_value))
{
typeinfo = new_typeinfo;
cvs diff: Diffing trial
cvs diff: Diffing util
--------------------------------------------------------------------------
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