[m-rev.] Re: for review: merge HAL branch onto main branch
David Jeffery
dgj at cs.mu.OZ.AU
Fri Mar 16 16:27:09 AEDT 2001
On 13-Mar-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 13-Mar-2001, David Jeffery <dgj at cs.mu.OZ.AU> wrote:
> > There is an XXX in rtti_out.m above the code that generates this saying that
> > a new MR_SECTAG_xxx should be added (etc.).
> >
> > Are you happy with that being left as an XXX for now?
>
> I guess I can live with it. But in that case I think you should
> comment out the documentation for the `--reserve-tag' option and
> the `.rt' grades, with an XXX explaining that the option is not
> documented because it the compiler generates broken RTTI when
> that option is used.
OK, I have fixed that now. I have introduced a new secondary tag type
'MR_SECTAG_VARIABLE', and added cases throughout the runtime and the library
to abort if they ever get their hands on one.
The new diff and log message are below.
---------------------------------------------------------------------------
Estimated hours taken: 65
(to do this merge... 100s of hours on the HAL branch
itself by myself and Warwick Harvey though).
Merge the changes from the HAL branch onto the main branch. With the recent
changes made to the HAL implementation, this means adding just one grade,
`.rt' or --reserve-tag, which reserves one tag (zero) in each type for
use by HAL's Herbrand constraint solver. This disables no-tag types and
enumerations.
This grade will now bootstrap, and passes all tests, except for a few failing
cases in the debugger and tabling directories.
compiler/options.m:
compiler/handle_options.m:
Add the `.rt' or --reserve-tag grade option.
runtime/mercury_conf_param.h:
Document the macro MR_RESERVE_TAG
doc/user_guide.texi:
Document the `.rt' grade.
compiler/make_hlds.m:
Don't record any types as no-tag types if we are in a .rt grade.
compiler/make_tags.m:
compiler/type_ctor_info.m:
Allocate tags starting from `1' in .rt grades.
compiler/rtti_out.m:
In .rt grades, output a dummy ptag definition for tag `0'.
compiler/type_util.m:
Add predicates `type_util__constructors_are_dummy_argument_type' and
`type_constructors_are_type_info' for use when allocating tags to
ensure that type infos and dummy types (io__state/0 and store__store/1)
are still treated as no-tag types in .rt grades.
library/sparse_bitset.m:
When allocating a sparse bitset element, use tag `1' if we are in a
.rt grade.
runtime/mercury_tags.h:
Define a macro `MR_UNIV_TAG' which is `1' is we in a .rt grade and
`0' otherwise. (Now that univ is a user defined type, it is a also
assigned a `var' tag).
Also make the definitions of MR_RAW_TAG_NIL and MR_RAW_TAG_CONS take the
.rt grade into account.
runtime/mercury_type_info.h:
Define `MR_unravel_univ' and
`MR_initialise_univ' for taking apart and putting together univs.
Add a new secondary tag alternative: MR_SECTAG_VARIABLE, used to
represent Herbrand variables.
library/std_util.m:
Use MR_UNIV_TAG, MR_unravel_univ and MR_initialise_univ when
manipulating univs.
Handle the new MR_SECTAG_VARIABLE secondary tag by aborting.
runtime/mercury_deep_copy_body.h:
runtime/mercury_tabling.c:
runtime/mercury_unify_compare_body.h:
Handle the new MR_SECTAG_VARIABLE secondary tag by aborting.
library/std_util.m:
Add a constant for MR_SECTAG_VARIABLE in the MC++ back end.
scripts/canonical_grade.sh-subr:
scripts/init_grade_options.sh-subr:
scripts/mgnuc.in:
scripts/parse_grade_options.sh-subr:
Process the new grade.
scripts/mmake.in:
Add an option `--include-makefile', which includes a Makefile given
as a command line argument into the Makefile generated by mmake.
This is used to implement `halmake', a make program for HAL which
just passes a bunch of extra rules and variable definitions onto
mmake.
tests/debugger/existential_type_classes.m:
tests/hard_coded/existential_types_test.m:
trace/mercury_trace_declarative.c:
trace/mercury_trace_external.c:
trace/mercury_trace_internal.c:
Use MR_UNIV_TAG.
TODO:
- The declarative debugger falls over in .rt grades. This is possibly
because compiler/static_term.m assumes that the generated code uses
the same data representation as the compiler itself. This should be
fixed, although it is not critical; the declarative debugger won't
work with trailing as is, and the .rt grade is only ever used in
conjunction with trailing (.tr) at this stage.
---------------------------------------------------------------------------
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.104
diff -u -t -r1.104 handle_options.m
--- compiler/handle_options.m 2001/03/02 10:09:17 1.104
+++ compiler/handle_options.m 2001/03/14 03:09:56
@@ -793,6 +793,7 @@
; gc % the kind of GC to use
; prof % what profiling options to use
; trail % whether or not to use trailing
+ ; tag % whether or not to reserve a tag
; minimal_model % whether we set up for minimal model tabling
; pic % Do we need to reserve a register for
% PIC (position independent code)?
@@ -1018,6 +1019,9 @@
% Trailing components
grade_component_table("tr", trail, [use_trail - bool(yes)]).
+ % Tag reservation components
+grade_component_table("rt", tag, [reserve_tag - bool(yes)]).
+
% Mimimal model tabling components
grade_component_table("mm", minimal_model, [use_minimal_model - bool(yes)]).
@@ -1058,6 +1062,7 @@
grade_start_values(profile_calls - bool(no)).
grade_start_values(profile_memory - bool(no)).
grade_start_values(use_trail - bool(no)).
+grade_start_values(reserve_tag - bool(no)).
grade_start_values(use_minimal_model - bool(no)).
grade_start_values(pic_reg - bool(no)).
grade_start_values(stack_trace - bool(no)).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.364
diff -u -t -r1.364 make_hlds.m
--- compiler/make_hlds.m 2001/01/17 01:41:58 1.364
+++ compiler/make_hlds.m 2001/02/23 05:09:40
@@ -1802,6 +1802,7 @@
)
;
{ map__set(Types0, TypeId, T, Types) },
+ { construct_qualified_term(Name, Args, Type) },
(
{ Body = du_type(ConsList, _, _, _) }
->
@@ -1816,13 +1817,9 @@
{ module_info_set_ctors(Module0, Ctors, Module1) },
{ module_info_set_ctor_field_table(Module1,
CtorFields, Module1a) },
- globals__io_lookup_bool_option(unboxed_no_tag_types,
- AllowNoTagTypes),
-
{
- AllowNoTagTypes = yes,
- type_constructors_are_no_tag_type(ConsList,
- Name, CtorArgType, _)
+ type_constructors_should_be_no_tag(ConsList,
+ Globals, Name, CtorArgType, _)
->
NoTagType = no_tag_type(Args,
Name, CtorArgType),
@@ -1838,7 +1835,6 @@
;
{ Module2 = Module0 }
),
- { construct_qualified_term(Name, Args, Type) },
{ add_special_preds(Module2, TVarSet, Type, TypeId,
Body, Context, Status, Module3) },
{ module_info_set_types(Module3, Types, Module) },
Index: compiler/make_tags.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_tags.m,v
retrieving revision 1.32
diff -u -t -r1.32 make_tags.m
--- compiler/make_tags.m 2000/12/18 07:40:31 1.32
+++ compiler/make_tags.m 2001/02/25 23:41:06
@@ -56,7 +56,7 @@
:- implementation.
-:- import_module prog_util, type_util, globals, options.
+:- import_module prog_util, type_util, error_util, globals, options.
:- import_module int, map, std_util, require.
%-----------------------------------------------------------------------------%
@@ -66,25 +66,37 @@
% work out how many tag bits there are
globals__lookup_int_option(Globals, num_tag_bits, NumTagBits),
+ % determine if we need to reserve a tag for use by HAL's
+ % Herbrand constraint solver
+ % (this also disables enumerations and no_tag types)
+ globals__lookup_bool_option(Globals, reserve_tag, ReserveTag),
+
+ % We do not bother reserving a tag for type_infos --- these
+ % types are implemented in C, and there is no way (at present)
+ % to have a type become bound to a (HAL Herbrand solver)
+ % variable.
+ ( ReserveTag = yes, \+ type_constructors_are_type_info(Ctors) ->
+ InitTag = 1
+ ;
+ InitTag = 0
+ ),
+
% now assign them
map__init(CtorTags0),
(
% All the constructors must be constant, and we
% must be allowed to make unboxed enums.
globals__lookup_bool_option(Globals, unboxed_enums, yes),
- ctors_are_all_constants(Ctors)
+ ctors_are_all_constants(Ctors),
+ ReserveTag = no
->
IsEnum = yes,
- assign_enum_constants(Ctors, 0, CtorTags0, CtorTags)
+ assign_enum_constants(Ctors, InitTag, CtorTags0, CtorTags)
;
IsEnum = no,
(
- % assign single functor of arity one a `no_tag' tag
- % (unless it is type_info/1)
- globals__lookup_bool_option(Globals,
- unboxed_no_tag_types, yes),
- type_constructors_are_no_tag_type(Ctors, SingleFunc,
- SingleArg, _)
+ type_constructors_should_be_no_tag(Ctors, Globals,
+ SingleFunc, SingleArg, _)
->
make_cons_id_from_qualified_sym_name(SingleFunc,
[SingleArg], SingleConsId),
@@ -92,6 +104,13 @@
;
NumTagBits = 0
->
+ ( ReserveTag = yes ->
+ % XXX Need to fix this.
+ % This occurs for the .NET and Java backends
+ sorry("make_tags", "--reserve-tag with num_tag_bits = 0")
+ ;
+ true
+ ),
( Ctors = [_SingleCtor] ->
assign_unshared_tags(Ctors, 0, 1,
CtorTags0, CtorTags)
@@ -104,7 +123,7 @@
MaxTag is MaxNumTags - 1,
split_constructors(Ctors, Constants, Functors),
assign_constant_tags(Constants, CtorTags0,
- CtorTags1, NextTag),
+ CtorTags1, InitTag, NextTag),
assign_unshared_tags(Functors, NextTag, MaxTag,
CtorTags1, CtorTags)
)
@@ -124,8 +143,8 @@
assign_enum_constants(Rest, Val1, CtorTags1, CtorTags).
:- pred assign_constant_tags(list(constructor), cons_tag_values,
- cons_tag_values, int).
-:- mode assign_constant_tags(in, in, out, out) is det.
+ cons_tag_values, int, int).
+:- mode assign_constant_tags(in, in, out, in, out) is det.
% If there's no constants, don't do anything. Otherwise,
% allocate the first tag for the constants, and give
@@ -137,14 +156,14 @@
% because deconstruction of the shared_local_tag
% is more efficient.
-assign_constant_tags(Constants, CtorTags0, CtorTags1, NextTag) :-
+assign_constant_tags(Constants, CtorTags0, CtorTags1, InitTag, NextTag) :-
( Constants = [] ->
- NextTag = 0,
+ NextTag = InitTag,
CtorTags1 = CtorTags0
;
- NextTag = 1,
+ NextTag = InitTag + 1,
assign_shared_local_tags(Constants,
- 0, 0, CtorTags0, CtorTags1)
+ InitTag, 0, CtorTags0, CtorTags1)
).
:- pred assign_unshared_tags(list(constructor), int, int, cons_tag_values,
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.315
diff -u -t -r1.315 options.m
--- compiler/options.m 2001/03/05 03:35:26 1.315
+++ compiler/options.m 2001/03/14 03:10:09
@@ -155,6 +155,7 @@
; stack_trace
; require_tracing
; use_trail
+ ; reserve_tag
; use_minimal_model
; pic_reg
; tags
@@ -577,6 +578,7 @@
require_tracing - bool(no),
stack_trace - bool(no),
use_trail - bool(no),
+ reserve_tag - bool(no),
use_minimal_model - bool(no),
pic_reg - bool(no),
tags - string("low"),
@@ -997,6 +999,7 @@
% long_option("stack-trace", stack_trace).
% long_option("require-tracing", require_tracing).
long_option("use-trail", use_trail).
+long_option("reserve-tag", reserve_tag).
long_option("use-minimal-model", use_minimal_model).
long_option("pic", pic).
long_option("pic-reg", pic_reg).
@@ -1942,8 +1945,8 @@
% and the --gcc-nested-functions option is not yet documented.
% "\t`hl', `hl_nest', `hlc_nest'",
"\tor one of those with one or more of the grade modifiers",
- "\t`.gc', `.prof', `.memprof', `.tr', `.debug', `.par', and/or",
- "\t`.pic_reg' appended.",
+ "\t`.gc', `.prof', `.memprof', `.tr', `.rt', `.debug', `.par'",
+ "\tand/or `.pic_reg' appended.",
"\tDepending on your particular installation, only a subset",
"\tof these possible grades will have been installed.",
"\tAttempting to use a grade which has not been installed",
@@ -2061,6 +2064,12 @@
"\tThis is necessary for interfacing with constraint solvers,",
"\tor for backtrackable destructive update.",
"\tThis option is not yet supported for the IL or Java back-ends.",
+ "--reserve-tag\t\t\t(grade modifier: `.rt')",
+ "\tReserve a tag in the data representation of the generated ",
+ "\tcode. This tag is intended to be used to give an explicit",
+ "\trepresentation to free variables.",
+ "\tThis is necessary for a seamless Herbrand constraint solver -",
+ "\tfor use with HAL.",
"-p, --profiling, --time-profiling",
"\t\t\t\t(grade modifier: `.prof')",
"\tEnable time and call profiling. Insert profiling hooks in the",
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/rtti_out.m,v
retrieving revision 1.20
diff -u -t -r1.20 rtti_out.m
--- compiler/rtti_out.m 2001/01/18 01:18:54 1.20
+++ compiler/rtti_out.m 2001/03/14 00:11:13
@@ -296,6 +296,16 @@
output_generic_rtti_data_defn_start(RttiTypeId,
du_ptag_ordered_table, DeclSet1, DeclSet),
io__write_string(" = {\n"),
+ globals__io_lookup_bool_option(reserve_tag, ReserveTag),
+ (
+ { ReserveTag = yes }
+ ->
+ % Output a dummy ptag definition for the
+ % reserved tag first
+ output_dummy_ptag_layout_defn
+ ;
+ []
+ ),
output_ptag_layout_defns(PtagLayouts, RttiTypeId),
io__write_string("\n};\n").
output_rtti_data_defn(type_ctor_info(RttiTypeId, Unify, Compare,
@@ -542,6 +552,19 @@
io__write_string(" },\n")
),
output_ptag_layout_defns(DuPtagLayouts, RttiTypeId).
+
+ % Output a `dummy' ptag layout, for use by tags that aren't *real*
+ % tags, such as the tag reserved when --reserve-tag is on.
+ %
+ % XXX Note that if one of these dummy ptag definitions is actually
+ % accessed by the Mercury runtime, or the construct/deconstruct
+ % code in library/std_util.m, the result will be undefined.
+ % This should be fixed by adding a MR_SECTAG_DUMMY and handling it
+ % gracefully.
+:- pred output_dummy_ptag_layout_defn(io__state::di, io__state::uo) is det.
+
+output_dummy_ptag_layout_defn -->
+ io__write_string("\t{ 0, MR_SECTAG_VARIABLE, NULL },\n").
%-----------------------------------------------------------------------------%
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.12
diff -u -t -r1.12 type_ctor_info.m
--- compiler/type_ctor_info.m 2000/12/21 06:10:23 1.12
+++ compiler/type_ctor_info.m 2001/03/14 01:02:42
@@ -50,7 +50,7 @@
:- import_module hlds_data, hlds_pred, hlds_out.
:- import_module make_tags, prog_data, prog_util, prog_out.
:- import_module code_util, special_pred, type_util, globals, options.
-:- import_module builtin_ops.
+:- import_module builtin_ops, error_util.
:- import_module bool, string, int, map, std_util, assoc_list, require.
:- import_module term.
@@ -288,22 +288,20 @@
EqualityAxioms = standard
),
list__length(Ctors, NumFunctors),
+ globals__lookup_bool_option(Globals, reserve_tag, ReserveTag),
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
(
Enum = yes,
TypeCtorRep = enum(EqualityAxioms),
type_ctor_info__make_enum_tables(Ctors, ConsTagMap,
- RttiTypeId, TypeTables,
+ RttiTypeId, ReserveTag, TypeTables,
FunctorsInfo, LayoutInfo),
NumPtags = -1
;
Enum = no,
- globals__lookup_bool_option(Globals,
- unboxed_no_tag_types, NoTagOption),
(
- NoTagOption = yes,
- type_constructors_are_no_tag_type(Ctors,
- Name, ArgType, MaybeArgName)
+ type_constructors_should_be_no_tag(Ctors,
+ Globals, Name, ArgType, MaybeArgName)
->
( term__is_ground(ArgType) ->
Inst = equiv_type_is_ground
@@ -399,12 +397,24 @@
% Make the functor and notag tables for an enum type.
:- pred type_ctor_info__make_enum_tables(list(constructor)::in,
- cons_tag_values::in, rtti_type_id::in, list(rtti_data)::out,
+ cons_tag_values::in, rtti_type_id::in, bool::in, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
-type_ctor_info__make_enum_tables(Ctors, ConsTagMap, RttiTypeId,
+type_ctor_info__make_enum_tables(Ctors, ConsTagMap, RttiTypeId, ReserveTag,
TypeTables, FunctorInfo, LayoutInfo) :-
- type_ctor_info__make_enum_functor_tables(Ctors, 0, ConsTagMap,
+ (
+ % If there are any existentially quantified type variables,
+ % then the type will contain hidden fields holding the
+ % type_infos and/or typeclass infos for those type variables,
+ % so it won't be a single-argument type.
+
+ ReserveTag = yes
+ ->
+ unexpected("type_ctor_info", "enum in .rt grade")
+ ;
+ InitTag = 0
+ ),
+ type_ctor_info__make_enum_functor_tables(Ctors, InitTag, ConsTagMap,
RttiTypeId, FunctorDescs, OrdinalOrderRttiNames, SortInfo0),
list__sort(SortInfo0, SortInfo),
assoc_list__values(SortInfo, NameOrderedRttiNames),
@@ -475,8 +485,16 @@
type_ctor_info__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo, TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
+ module_info_globals(ModuleInfo, Globals),
+ (
+ globals__lookup_bool_option(Globals, reserve_tag, yes)
+ ->
+ InitTag = 1
+ ;
+ InitTag = 0
+ ),
map__init(TagMap0),
- type_ctor_info__make_du_functor_tables(Ctors, 0, ConsTagMap,
+ type_ctor_info__make_du_functor_tables(Ctors, InitTag, ConsTagMap,
RttiTypeId, ModuleInfo,
FunctorDescs, SortInfo0, TagMap0, TagMap),
list__sort(SortInfo0, SortInfo),
@@ -487,7 +505,7 @@
NameOrderedTableRttiName = du_name_ordered_table,
FunctorInfo = du_functors(NameOrderedTableRttiName),
- type_ctor_info__make_du_ptag_ordered_table(TagMap, MaxPtag,
+ type_ctor_info__make_du_ptag_ordered_table(TagMap, InitTag, MaxPtag,
RttiTypeId, ValueOrderedTableRttiName, ValueOrderedTables,
NumPtags),
LayoutInfo = du_layout(ValueOrderedTableRttiName),
@@ -755,15 +773,16 @@
map__det_insert(TagMap0, Ptag, Locn - NewSharerMap, TagMap)
).
-:- pred type_ctor_info__make_du_ptag_ordered_table(tag_map::in, int::in,
- rtti_type_id::in, rtti_name::out, list(rtti_data)::out, int::out)
- is det.
+:- pred type_ctor_info__make_du_ptag_ordered_table(tag_map::in,
+ int::in, int::in, rtti_type_id::in,
+ rtti_name::out, list(rtti_data)::out, int::out) is det.
-type_ctor_info__make_du_ptag_ordered_table(TagMap, MaxPtagValue,
+type_ctor_info__make_du_ptag_ordered_table(TagMap, MinPtagValue, MaxPtagValue,
RttiTypeId, PtagOrderedRttiName, Tables, NumPtags) :-
map__to_assoc_list(TagMap, TagList),
- type_ctor_info__make_du_ptag_layouts(TagList, 0, MaxPtagValue,
- RttiTypeId, PtagLayouts, SubTables, NumPtags),
+ type_ctor_info__make_du_ptag_layouts(TagList,
+ MinPtagValue, MaxPtagValue, RttiTypeId,
+ PtagLayouts, SubTables, NumPtags),
PtagOrderedTable = du_ptag_ordered_table(RttiTypeId, PtagLayouts),
PtagOrderedRttiName = du_ptag_ordered_table,
Tables = [PtagOrderedTable | SubTables].
Index: compiler/type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.93
diff -u -t -r1.93 type_util.m
--- compiler/type_util.m 2000/12/18 07:40:34 1.93
+++ compiler/type_util.m 2001/02/23 05:37:46
@@ -18,7 +18,7 @@
:- interface.
-:- import_module hlds_module, hlds_pred, hlds_data, prog_data.
+:- import_module hlds_module, hlds_pred, hlds_data, prog_data, globals.
:- import_module term.
:- import_module std_util, list, map.
@@ -70,6 +70,9 @@
:- pred type_util__is_dummy_argument_type(type).
:- mode type_util__is_dummy_argument_type(in) is semidet.
+:- pred type_util__constructors_are_dummy_argument_type(list(constructor)).
+:- mode type_util__constructors_are_dummy_argument_type(in) is semidet.
+
:- pred type_is_io_state(type).
:- mode type_is_io_state(in) is semidet.
@@ -265,6 +268,17 @@
maybe(string)).
:- mode type_constructors_are_no_tag_type(in, out, out, out) is semidet.
+ % Given a list of constructors for a type, check whether that
+ % type is a private_builtin:type_info/n or similar type.
+:- pred type_constructors_are_type_info(list(constructor)).
+:- mode type_constructors_are_type_info(in) is semidet.
+
+ % Check whether some constructors are a no_tag type, and that this
+ % is compatible with the grade options set in the globals.
+:- pred type_constructors_should_be_no_tag(list(constructor), globals,
+ sym_name, type, maybe(string)).
+:- mode type_constructors_should_be_no_tag(in, in, out, out, out) is semidet.
+
% Unify (with occurs check) two types with respect to a type
% substitution and update the type bindings.
% The third argument is a list of type variables which cannot
@@ -604,6 +618,11 @@
type_util__is_dummy_argument_type_2("io", "state", 0). % io:state/0
type_util__is_dummy_argument_type_2("store", "store", 1). % store:store/1.
+type_util__constructors_are_dummy_argument_type([Ctor]) :-
+ Ctor = ctor([], [], qualified(unqualified("io"), "state"), [_]).
+type_util__constructors_are_dummy_argument_type([Ctor]) :-
+ Ctor = ctor([], [], qualified(unqualified("store"), "store"), [_]).
+
type_is_io_state(Type) :-
type_to_type_id(Type,
qualified(unqualified("io"), "state") - 0, []).
@@ -972,15 +991,9 @@
% type_constructors_are_no_tag_type/3 is called.
type_constructors_are_no_tag_type(Ctors, Ctor, ArgType, MaybeArgName) :-
- Ctors = [SingleCtor],
- SingleCtor = ctor(ExistQVars, _Constraints, Ctor,
- [MaybeSymName - ArgType]),
- ExistQVars = [],
+ type_is_single_ctor_single_arg(Ctors, Ctor, MaybeSymName, ArgType),
unqualify_name(Ctor, Name),
- Name \= "type_info",
- Name \= "type_ctor_info",
- Name \= "typeclass_info",
- Name \= "base_typeclass_info",
+ \+ name_is_type_info(Name),
% We don't handle unary tuples as no_tag types --
% they are rare enough that it's not worth
@@ -994,6 +1007,52 @@
;
MaybeSymName = no,
MaybeArgName = no
+ ).
+
+type_constructors_are_type_info(Ctors) :-
+ type_is_single_ctor_single_arg(Ctors, Ctor, _, _),
+ unqualify_name(Ctor, Name),
+ name_is_type_info(Name).
+
+:- pred name_is_type_info(string).
+:- mode name_is_type_info(in) is semidet.
+
+name_is_type_info("type_info").
+name_is_type_info("type_ctor_info").
+name_is_type_info("typeclass_info").
+name_is_type_info("base_typeclass_info").
+
+:- pred type_is_single_ctor_single_arg(list(constructor), sym_name,
+ maybe(sym_name), type).
+:- mode type_is_single_ctor_single_arg(in, out, out, out) is semidet.
+
+type_is_single_ctor_single_arg(Ctors, Ctor, MaybeSymName, ArgType) :-
+ Ctors = [SingleCtor],
+ SingleCtor = ctor(ExistQVars, _Constraints, Ctor,
+ [MaybeSymName - ArgType]),
+ ExistQVars = [].
+
+%-----------------------------------------------------------------------------%
+
+ % assign single functor of arity one a `no_tag' tag
+ % (unless it is type_info/1 or we are reserving a tag,
+ % or if it is one of the dummy types)
+type_constructors_should_be_no_tag(Ctors, Globals,
+ SingleFunc, SingleArg, MaybeArgName) :-
+ type_constructors_are_no_tag_type(Ctors, SingleFunc, SingleArg,
+ MaybeArgName),
+ (
+ globals__lookup_bool_option(Globals, reserve_tag, no),
+ globals__lookup_bool_option(Globals, unboxed_no_tag_types, yes)
+ ;
+ % Dummy types always need to be treated as no-tag types
+ % as the low-level C back end just passes around
+ % rubbish for them. When eg. using the debugger, it is
+ % crucial that these values are treated as unboxed
+ % c_pointers, not as tagged pointers to c_pointers
+ % (otherwise the system winds up following a bogus
+ % pointer).
+ constructors_are_dummy_argument_type(Ctors)
).
%-----------------------------------------------------------------------------%
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unify_proc.m,v
retrieving revision 1.91
diff -u -t -r1.91 unify_proc.m
--- compiler/unify_proc.m 2000/11/06 08:28:40 1.91
+++ compiler/unify_proc.m 2001/03/13 01:00:39
@@ -719,8 +719,8 @@
unify_proc__quantify_clauses_body([H1, H2], Goal,
Context, Clauses)
;
- unify_proc__generate_du_unify_clauses(Ctors,
- H1, H2, Context, Clauses)
+ unify_proc__generate_du_unify_clauses(Ctors, H1, H2,
+ Context, Clauses)
)
;
{ TypeBody = eqv_type(_Type) },
Index: doc/user_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/user_guide.texi,v
retrieving revision 1.245
diff -u -t -r1.245 user_guide.texi
--- doc/user_guide.texi 2001/03/05 03:35:33 1.245
+++ doc/user_guide.texi 2001/03/14 03:10:21
@@ -3476,6 +3476,9 @@
@item Whether to enable the trail:
@samp{tr} (the default is no trailing).
+ at item Whether or not to reserve a tag in the data representation of the generated code:
+ at samp{rt} (the default is no reserved tag)
+
@item What debugging features to enable:
@samp{debug} (the default is no debugging features).
@@ -3558,6 +3561,9 @@
@item @samp{.tr}
@code{--use-trail}.
+ at item @samp{.rt}
+ at code{--reserve-tag}.
+
@item @samp{.debug}
@code{--debug}.
@@ -3680,6 +3686,13 @@
This is necessary for interfacing with constraint solvers,
or for backtrackable destructive update.
This option is not yet supported for the IL or Java back-ends.
+ at sp 1
+ at item @code{--reserve-tag} (grades: any grade containing @samp{.rt})
+Reserve a tag in the data representation of the generated
+code. This tag is intended to be used to give an explicit
+representation to free variables.
+This is necessary for a seamless Herbrand constraint solver ---
+for use with HAL.
@sp 1
@item @code{--pic-reg} (grades: any grade containing `.pic_reg')
[For Unix with intel x86 architecture only.]
Index: library/private_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/private_builtin.m,v
retrieving revision 1.69
diff -u -t -r1.69 private_builtin.m
--- library/private_builtin.m 2001/02/26 01:34:07 1.69
+++ library/private_builtin.m 2001/03/14 03:10:36
@@ -565,6 +565,7 @@
static int MR_SECTAG_NONE = 0;
static int MR_SECTAG_LOCAL = 1;
static int MR_SECTAG_REMOTE = 2;
+static int MR_SECTAG_VARIABLE = 3;
static int
Index: library/sparse_bitset.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/sparse_bitset.m,v
retrieving revision 1.6
diff -u -t -r1.6 sparse_bitset.m
--- library/sparse_bitset.m 2001/02/26 01:34:08 1.6
+++ library/sparse_bitset.m 2001/03/14 03:10:37
@@ -771,15 +771,22 @@
:- pragma foreign_code("C", make_bitset_elem(A::in, B::in) = (Pair::out),
[will_not_call_mercury, thread_safe],
"{
- MR_incr_hp_atomic_msg(Pair, 2, MR_PROC_LABEL,
- ""sparse_bitset:bitset_elem/0"");
- MR_field(MR_mktag(0), Pair, 0) = A;
- MR_field(MR_mktag(0), Pair, 1) = B;
+
+#define ML_BITSET_TAG MR_FIRST_UNRESERVED_RAW_TAG
+
+ MR_tag_incr_hp_atomic_msg(Pair, MR_mktag(ML_BITSET_TAG),
+ 2, MR_PROC_LABEL, ""sparse_bitset:bitset_elem/0"");
+ MR_field(MR_mktag(ML_BITSET_TAG), Pair, 0) = A;
+ MR_field(MR_mktag(ML_BITSET_TAG), Pair, 1) = B;
}").
+% XXX this needs to take reserve-tag into account too
:- pragma foreign_code("MC++", make_bitset_elem(A::in, B::in) = (Pair::out),
[will_not_call_mercury, thread_safe],
"{
+#ifdef MR_RESERVE_TAG
+ #error ""sparse_bitset not implemented for MC++ in .rt grades""
+#endif
MR_newobj((Pair), 0, 2);
MR_objset((Pair), 1, (mercury::runtime::Convert::ToObject(A)));
MR_objset((Pair), 2, (mercury::runtime::Convert::ToObject(B)));
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.224
diff -u -t -r1.224 std_util.m
--- library/std_util.m 2001/02/08 10:47:58 1.224
+++ library/std_util.m 2001/03/14 00:53:49
@@ -2054,7 +2054,7 @@
MR_fatal_error(""notag arg list is too long"");
}
- new_data = MR_field(MR_mktag(0), MR_list_head(ArgList),
+ new_data = MR_field(MR_UNIV_TAG, MR_list_head(ArgList),
MR_UNIV_OFFSET_FOR_DATA);
break;
@@ -2092,7 +2092,8 @@
functor_desc->MR_du_functor_secondary;
for (i = 0; i < arity; i++) {
MR_field(ptag, new_data, i + 1) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
+ MR_field(MR_UNIV_TAG,
+ MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -2107,12 +2108,15 @@
for (i = 0; i < arity; i++) {
MR_field(ptag, new_data, i) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
+ MR_field(MR_UNIV_TAG,
+ MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
break;
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error(""construct(): cannot construct variable"");
}
if (! MR_list_is_empty(arg_list)) {
@@ -2137,7 +2141,8 @@
arg_list = ArgList;
for (i = 0; i < arity; i++) {
MR_field(MR_mktag(0), new_data, i) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
+ MR_field(MR_UNIV_TAG,
+ MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -2158,8 +2163,7 @@
** Create a univ.
*/
- MR_incr_hp_msg(Term, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Term, type_info, new_data);
+ MR_new_univ_on_hp(Term, type_info, new_data);
}
SUCCESS_INDICATOR = success;
@@ -2247,7 +2251,8 @@
MR_incr_hp_msg(new_data, Arity, MR_PROC_LABEL,
""<created by std_util:construct_tuple/1>"");
for (i = 0; i < Arity; i++) {
- arg_value = MR_field(MR_mktag(0), MR_list_head(Args),
+ arg_value = MR_field(MR_UNIV_TAG,
+ MR_list_head(Args),
MR_UNIV_OFFSET_FOR_DATA);
MR_field(MR_mktag(0), new_data, i) = arg_value;
Args = MR_list_tail(Args);
@@ -2257,8 +2262,7 @@
/*
** Create a univ.
*/
- MR_incr_hp_msg(Term, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Term, type_info, new_data);
+ MR_new_univ_on_hp(Term, type_info, new_data);
}
").
@@ -2449,7 +2453,7 @@
return FALSE;
}
- list_arg_type_info = (MR_TypeInfo) MR_field(MR_mktag(0),
+ list_arg_type_info = (MR_TypeInfo) MR_field(MR_UNIV_TAG,
MR_list_head(arg_list), MR_UNIV_OFFSET_FOR_TYPEINFO);
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
@@ -2490,7 +2494,7 @@
for (i = 0; i < arity; i++) {
MR_field(MR_mktag(0), term_vector, i) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
+ MR_field(MR_UNIV_TAG, MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -2913,6 +2917,8 @@
ptag_layout->MR_sectag_alternatives[sectag];
arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
break;
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error(""ML_expand(): cannot expand variable"");
}
expand_info->arity = functor_desc->MR_du_functor_orig_arity;
@@ -3143,14 +3149,16 @@
case MR_TYPECTOR_REP_UNIV: {
MR_Word data_word;
+
+ MR_TypeInfo univ_type_info;
+ MR_Word univ_data;
/*
* Univ is a two word structure, containing
* type_info and data.
*/
data_word = *data_word_ptr;
- ML_expand((MR_TypeInfo)
- ((MR_Word *) data_word)[MR_UNIV_OFFSET_FOR_TYPEINFO],
- &((MR_Word *) data_word)[MR_UNIV_OFFSET_FOR_DATA], expand_info);
+ MR_unravel_univ(data_word, univ_type_info, univ_data);
+ ML_expand(univ_type_info, &univ_data, expand_info);
break;
}
@@ -3399,6 +3407,8 @@
functor_desc =
ptag_layout->MR_sectag_alternatives[sectag];
break;
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error(""ML_named_arg_num(): unexpected variable"");
}
if (functor_desc->MR_du_functor_arg_names == NULL) {
@@ -3553,8 +3563,7 @@
if (success) {
/* Allocate enough room for a univ */
- MR_incr_hp_msg(ArgumentUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ArgumentUniv, arg_type_info, *argument_ptr);
+ MR_new_univ_on_hp(ArgumentUniv, arg_type_info, *argument_ptr);
}
SUCCESS_INDICATOR = success;
@@ -3652,8 +3661,7 @@
while (--i >= 0) {
/* Create an argument on the heap */
- MR_incr_hp_msg(Argument, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Argument,
+ MR_new_univ_on_hp(Argument,
expand_info.arg_type_infos[i],
expand_info.arg_values[i + expand_info.num_extra_args]);
@@ -3727,8 +3735,7 @@
functor_desc = type_ctor_info->type_functors.functors_notag;
exp_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_notag_functor_arg_type);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3738,8 +3745,7 @@
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
functor_desc->MR_notag_functor_arg_type);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3777,8 +3783,7 @@
case MR_TYPECTOR_REP_EQUIV:
exp_type_info = MR_pseudo_type_info_is_ground(
type_ctor_info->type_layout.layout_equiv);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3786,8 +3791,7 @@
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
type_ctor_info->type_layout.layout_equiv);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_new_univ_on_hp(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3913,13 +3917,15 @@
functor_desc->MR_du_functor_arg_types[i]);
}
- MR_incr_hp_msg(arg, 2, MR_PROC_LABEL,
- ""std_util:univ/0"");
- MR_define_univ_fields(arg,
+ MR_new_univ_on_hp(arg,
arg_type_info, arg_vector[i]);
Args = MR_list_cons_msg(arg, Args, MR_PROC_LABEL);
}
break;
+
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error(
+ ""get_du_functor_info: unexpected variable"");
default:
MR_fatal_error(
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.46
diff -u -t -r1.46 mercury_conf_param.h
--- runtime/mercury_conf_param.h 2001/02/19 02:07:15 1.46
+++ runtime/mercury_conf_param.h 2001/03/13 01:10:51
@@ -50,6 +50,7 @@
** NO_TYPE_LAYOUT
** BOXED_FLOAT
** MR_USE_TRAIL
+** MR_RESERVE_TAG
** MR_USE_MINIMAL_MODEL
** See the documentation for
** --high-level-code
@@ -63,6 +64,7 @@
** --no-type-layout
** --unboxed-float
** --use-trail
+** --reserve-tag
** --use-minimal-model
** (respectively) in the mmc help message or the Mercury User's Guide.
**
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.35
diff -u -t -r1.35 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 2001/01/09 23:30:21 1.35
+++ runtime/mercury_deep_copy_body.h 2001/03/14 00:33:21
@@ -295,6 +295,9 @@
}
break;
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error("copy(): attempt to copy variable");
+
default:
MR_fatal_error("copy(): unknown sectag_locn");
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.39
diff -u -t -r1.39 mercury_tabling.c
--- runtime/mercury_tabling.c 2001/01/13 09:38:58 1.39
+++ runtime/mercury_tabling.c 2001/03/14 00:39:34
@@ -669,6 +669,8 @@
functor_desc = ptag_layout->MR_sectag_alternatives[sectag];
arg_vector = (MR_Word *) MR_body(data, ptag) + 1;
break;
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error("MR_table_type(): unexpected variable");
default:
MR_fatal_error("MR_table_type(): unknown sectag_locn");
}
Index: runtime/mercury_tags.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_tags.h,v
retrieving revision 1.10
diff -u -t -r1.10 mercury_tags.h
--- runtime/mercury_tags.h 2000/11/23 02:00:45 1.10
+++ runtime/mercury_tags.h 2001/03/13 01:13:29
@@ -73,16 +73,31 @@
#define MR_const_mask_field(p, i) ((const MR_Word *) MR_strip_tag(p))[i]
/*
-** the following MR_list_* macros are used by handwritten C code
-** that needs to access Mercury lists. The definitions of these macros
-** depend on the data representation scheme used by compiler/make_tags.m.
+** the following macros are used by handwritten C code that needs to access
+** Mercury data structures. The definitions of these macros depend on the data
+** representation scheme used by compiler/make_tags.m.
*/
-#define MR_RAW_TAG_NIL 0
-#define MR_RAW_TAG_CONS 1
+#ifdef MR_RESERVE_TAG
+ #define MR_RAW_TAG_VAR 0 /* for Prolog-style variables */
+ #define MR_FIRST_UNRESERVED_RAW_TAG 1
+#else
+ #define MR_FIRST_UNRESERVED_RAW_TAG 0
+#endif
+#define MR_RAW_TAG_NIL MR_FIRST_UNRESERVED_RAW_TAG
+#define MR_RAW_TAG_CONS (MR_FIRST_UNRESERVED_RAW_TAG + 1)
+
+#define MR_RAW_UNIV_TAG MR_FIRST_UNRESERVED_RAW_TAG
+
#define MR_TAG_NIL MR_mktag(MR_RAW_TAG_NIL)
#define MR_TAG_CONS MR_mktag(MR_RAW_TAG_CONS)
+
+#ifdef MR_RESERVE_TAG
+ #define MR_TAG_VAR MR_mktag(MR_RAW_TAG_VAR)
+#endif
+
+#define MR_UNIV_TAG MR_mktag(MR_RAW_UNIV_TAG)
#if TAGBITS > 0
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.66
diff -u -t -r1.66 mercury_type_info.h
--- runtime/mercury_type_info.h 2001/02/26 01:16:13 1.66
+++ runtime/mercury_type_info.h 2001/03/14 03:10:45
@@ -347,9 +347,24 @@
** Definitions for handwritten code, mostly for mercury_compare_typeinfo.
*/
-#define MR_COMPARE_EQUAL 0
-#define MR_COMPARE_LESS 1
-#define MR_COMPARE_GREATER 2
+#ifdef MR_RESERVE_TAG
+ /*
+ ** In reserve-tag grades, enumerations are disabled, so the
+ ** representation of the 'comparison_result' type is quite different.
+ ** The enumeration constants (for (<), (=) and (>)) wind up sharing
+ ** the same primary tag (1), and are all allocated secondary tags
+ ** starting from 0.
+ */
+ #define MR_COMPARE_TAG MR_mktag(MR_FIRST_UNRESERVED_RAW_TAG)
+
+ #define MR_COMPARE_EQUAL MR_mkword(MR_COMPARE_TAG, MR_mkbody(0))
+ #define MR_COMPARE_LESS MR_mkword(MR_COMPARE_TAG, MR_mkbody(1))
+ #define MR_COMPARE_GREATER MR_mkword(MR_COMPARE_TAG, MR_mkbody(2))
+#else
+ #define MR_COMPARE_EQUAL 0
+ #define MR_COMPARE_LESS 1
+ #define MR_COMPARE_GREATER 2
+#endif
/*---------------------------------------------------------------------------*/
@@ -406,20 +421,28 @@
#define MR_unravel_univ(univ, typeinfo, value) \
do { \
- typeinfo = (MR_TypeInfo) MR_field(MR_mktag(0), (univ), \
+ typeinfo = (MR_TypeInfo) MR_field(MR_UNIV_TAG, (univ),\
MR_UNIV_OFFSET_FOR_TYPEINFO); \
- value = MR_field(MR_mktag(0), (univ), \
+ value = MR_field(MR_UNIV_TAG, (univ), \
MR_UNIV_OFFSET_FOR_DATA); \
} while (0)
#define MR_define_univ_fields(univ, typeinfo, value) \
do { \
- MR_field(MR_mktag(0), (univ), MR_UNIV_OFFSET_FOR_TYPEINFO) \
+ MR_field(MR_UNIV_TAG, (univ), MR_UNIV_OFFSET_FOR_TYPEINFO) \
= (MR_Word) (typeinfo); \
- MR_field(MR_mktag(0), (univ), MR_UNIV_OFFSET_FOR_DATA) \
+ MR_field(MR_UNIV_TAG, (univ), MR_UNIV_OFFSET_FOR_DATA) \
= (MR_Word) (value); \
} while (0)
+/* Allocate a univ on the heap */
+#define MR_new_univ_on_hp(univ, typeinfo, value) \
+ do { \
+ MR_tag_incr_hp_msg((univ), MR_UNIV_TAG, \
+ 2, MR_PROC_LABEL, ""std_util:univ/0""); \
+ MR_define_univ_fields((univ), (typeinfo), (value)); \
+ } while (0)
+
/*---------------------------------------------------------------------------*/
/*
@@ -688,7 +711,8 @@
typedef enum {
MR_DEFINE_ENUM_CONST(MR_SECTAG_NONE),
MR_DEFINE_ENUM_CONST(MR_SECTAG_LOCAL),
- MR_DEFINE_ENUM_CONST(MR_SECTAG_REMOTE)
+ MR_DEFINE_ENUM_CONST(MR_SECTAG_REMOTE),
+ MR_DEFINE_ENUM_CONST(MR_SECTAG_VARIABLE)
} MR_Sectag_Locn;
typedef struct {
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.8
diff -u -t -r1.8 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 2001/01/09 23:30:22 1.8
+++ runtime/mercury_unify_compare_body.h 2001/03/14 00:38:07
@@ -126,6 +126,8 @@
case MR_SECTAG_NONE: \
sectag = 0; \
break; \
+ case MR_SECTAG_VARIABLE: \
+ MR_fatal_error("find_du_functor_desc(): attempt get functor desc of variable"); \
} \
\
functor_desc = ptaglayout->MR_sectag_alternatives[sectag];\
@@ -185,6 +187,9 @@
case MR_SECTAG_NONE:
x_sectag = 0;
break;
+
+ case MR_SECTAG_VARIABLE:
+ MR_fatal_error("find_du_functor_desc(): attempt get functor desc of variable"); \
}
functor_desc = ptaglayout->MR_sectag_alternatives[x_sectag];
Index: scripts/canonical_grade.sh-subr
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/canonical_grade.sh-subr,v
retrieving revision 1.1
diff -u -t -r1.1 canonical_grade.sh-subr
--- scripts/canonical_grade.sh-subr 2000/12/18 07:17:44 1.1
+++ scripts/canonical_grade.sh-subr 2001/02/12 02:54:45
@@ -1,5 +1,5 @@
#---------------------------------------------------------------------------#
-# Copyright (C) 2000 The University of Melbourne.
+# Copyright (C) 2000-2001 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.
#---------------------------------------------------------------------------#
@@ -85,6 +85,11 @@
case $use_trail in
true) GRADE="$GRADE.tr" ;;
+ false) ;;
+esac
+
+case $reserve_tag in
+ true) GRADE="$GRADE.rt" ;;
false) ;;
esac
Index: scripts/init_grade_options.sh-subr
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/init_grade_options.sh-subr,v
retrieving revision 1.16
diff -u -t -r1.16 init_grade_options.sh-subr
--- scripts/init_grade_options.sh-subr 2001/02/11 14:53:41 1.16
+++ scripts/init_grade_options.sh-subr 2001/02/16 06:51:53
@@ -36,6 +36,7 @@
--profile-time
--profile-memory
--use-trail
+ --reserve-tag
--use-minimal-model
--pic-reg
--no-stack-trace
@@ -63,6 +64,7 @@
profile_memory=false
profile_deep=false
use_trail=false
+reserve_tag=false
use_minimal_model=false
pic_reg=false
stack_trace=false
Index: scripts/mgnuc.in
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/mgnuc.in,v
retrieving revision 1.77
diff -u -t -r1.77 mgnuc.in
--- scripts/mgnuc.in 2001/01/28 10:23:11 1.77
+++ scripts/mgnuc.in 2001/02/07 05:06:10
@@ -303,6 +303,11 @@
false) TRAIL_OPTS="" ;;
esac
+case $reserve_tag in
+ true) RESERVE_TAG_OPTS="-DMR_RESERVE_TAG" ;;
+ false) RESERVE_TAG_OPTS="" ;;
+esac
+
case $use_minimal_model in
true) MINIMAL_MODEL_OPTS="-DMR_USE_MINIMAL_MODEL" ;;
false) MINIMAL_MODEL_OPTS="" ;;
@@ -476,7 +481,8 @@
$HLC_OPTS $HLD_OPTS $GCC_OPTS $GC_OPTS $DEFINE_OPTS \
$TRACE_OPTS $STACK_TRACE_OPTS $LLDEBUG_OPTS $C_DEBUG_OPTS \
$PROF_TIME_OPTS $PROF_CALLS_OPTS $PROF_MEMORY_OPTS \
- $INLINE_ALLOC_OPTS $TRAIL_OPTS $MINIMAL_MODEL_OPTS \
+ $INLINE_ALLOC_OPTS $TRAIL_OPTS $RESERVE_TAG_OPTS \
+ $MINIMAL_MODEL_OPTS \
$SPLIT_OPTS $THREAD_OPTS $PICREG_OPTS $ARCH_OPTS $ARG_OPTS"
case $verbose in true)
Index: scripts/mmake.in
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/mmake.in,v
retrieving revision 1.32
diff -u -t -r1.32 mmake.in
--- scripts/mmake.in 2001/01/17 09:16:51 1.32
+++ scripts/mmake.in 2001/02/07 05:09:08
@@ -81,6 +81,7 @@
TMPDIR=${TMPDIR=/tmp}
MMAKE=$0
+include_makefile=
verbose=false
save_makefile=false
if [ -d Mercury ]; then
@@ -152,6 +153,13 @@
warn_undefined_vars=false
shift
;;
+ --include-makefile)
+ # XXX check that $2 exists first
+ MMAKE="$MMAKE $1 $2"
+ include_makefile="$include_makefile $2"
+ shift
+ shift
+ ;;
--)
MMAKE="$MMAKE $1"
shift
@@ -282,7 +290,8 @@
echo export MERCURY_INT_DIR
echo MERCURY_DEFAULT_GRADE=$MERCURY_DEFAULT_GRADE
echo export MERCURY_DEFAULT_GRADE
- echo cat ${MMAKE_VARS} $dvs $ds $mmake $deps ${MMAKE_RULES} ">>" $tmp
+ echo cat ${MMAKE_VARS} $dvs $ds $include_makefile $mmake $deps \
+ ${MMAKE_RULES} ">>" $tmp
echo ${MMAKE_MAKE} ${MMAKE_MAKE_OPTS} -f $tmp -r ${set_target_asm} "$@"
fi
export MMAKE
@@ -290,7 +299,7 @@
export MMAKE_USE_SUBDIRS
export MERCURY_INT_DIR
export MERCURY_DEFAULT_GRADE
-cat ${MMAKE_VARS} $dvs $ds $mmake $deps ${MMAKE_RULES} > $tmp
+cat ${MMAKE_VARS} $dvs $ds $include_makefile $mmake $deps ${MMAKE_RULES} > $tmp
case $# in
# Note that we can't use `exec' here, because if we did that,
# that `trap' code which removes $tmp would never get executed.
Index: scripts/parse_grade_options.sh-subr
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/parse_grade_options.sh-subr,v
retrieving revision 1.21
diff -u -t -r1.21 parse_grade_options.sh-subr
--- scripts/parse_grade_options.sh-subr 2001/02/11 14:53:41 1.21
+++ scripts/parse_grade_options.sh-subr 2001/02/16 06:51:54
@@ -131,6 +131,11 @@
--no-use-trail)
use_trail=false ;;
+ --reserve-tag)
+ reserve_tag=true ;;
+ --no-reserve-tag)
+ reserve_tag=false ;;
+
--use-minimal-model)
use_minimal_model=true ;;
--no-use-minimal-model)
@@ -183,6 +188,7 @@
profile_memory=false
profile_deep=false
use_trail=false
+ reserve_tag=false
use_minimal_model=false
pic_reg=false
stack_trace=false
@@ -359,6 +365,10 @@
tr)
use_trail=true
+ ;;
+
+ rt)
+ reserve_tag=true
;;
mm)
Index: tests/debugger/existential_type_classes.m
===================================================================
RCS file: /home/staff/zs/imp/tests/debugger/existential_type_classes.m,v
retrieving revision 1.5
diff -u -t -r1.5 existential_type_classes.m
--- tests/debugger/existential_type_classes.m 2000/12/05 02:08:41 1.5
+++ tests/debugger/existential_type_classes.m 2001/02/22 06:57:14
@@ -75,13 +75,13 @@
:- pragma c_code(my_univ_value(Univ::in) = (Value::out), will_not_call_mercury, "
TypeClassInfo_for_existential_type_classes__fooable_T =
- MR_field(MR_mktag(0), Univ, 0);
- Value = MR_field(MR_mktag(0), Univ, 1);
+ MR_field(MR_UNIV_TAG, Univ, 0);
+ Value = MR_field(MR_UNIV_TAG, Univ, 1);
").
:- pragma c_code(my_univ(Value::in) = (Univ::out), will_not_call_mercury, "
- MR_incr_hp(Univ, 2);
- MR_field(MR_mktag(0), Univ, 0) =
+ MR_tag_incr_hp(Univ, MR_UNIV_TAG, 2);
+ MR_field(MR_UNIV_TAG, Univ, 0) =
(MR_Word) TypeClassInfo_for_existential_type_classes__fooable_T;
- MR_field(MR_mktag(0), Univ, 1) = (MR_Word) Value;
+ MR_field(MR_UNIV_TAG, Univ, 1) = (MR_Word) Value;
").
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.25
diff -u -t -r1.25 Mmakefile
--- tests/debugger/declarative/Mmakefile 2001/01/17 18:55:18 1.25
+++ tests/debugger/declarative/Mmakefile 2001/03/16 03:45:50
@@ -65,22 +65,27 @@
# Debugging does not work in MLDS (hl*) grades.
# Base grades `jump' and `fast' cannot be used with
# stack layouts (which are required for tracing).
+# Currently, declarative debugging does not work in `rt' grades.
# Also, declarative debugging only works in `.gc' grades.
ifneq "$(findstring hl,$(GRADE))" ""
PROGS=
else
ifneq "$(findstring .gc,$(GRADE))" ""
- ifneq "$(findstring asm_,$(GRADE))" ""
- PROGS=$(PROGS_2)
+ ifneq "$(findstring rt,$(GRADE))" ""
+ PROGS=
else
- ifneq "$(findstring jump,$(GRADE))" ""
- PROGS=
+ ifneq "$(findstring asm_,$(GRADE))" ""
+ PROGS=$(PROGS_2)
else
- ifneq "$(findstring fast,$(GRADE))" ""
+ ifneq "$(findstring jump,$(GRADE))" ""
PROGS=
else
- PROGS=$(PROGS_2)
+ ifneq "$(findstring fast,$(GRADE))" ""
+ PROGS=
+ else
+ PROGS=$(PROGS_2)
+ endif
endif
endif
endif
Index: tests/hard_coded/existential_types_test.m
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/existential_types_test.m,v
retrieving revision 1.5
diff -u -t -r1.5 existential_types_test.m
--- tests/hard_coded/existential_types_test.m 2000/12/04 18:28:52 1.5
+++ tests/hard_coded/existential_types_test.m 2001/02/12 03:59:24
@@ -40,10 +40,7 @@
call_my_univ_value(Univ) = my_univ_value(Univ).
:- pragma c_code(my_univ_value(Univ::in) = (Value::out), will_not_call_mercury, "
- TypeInfo_for_T = MR_field(MR_mktag(0), Univ,
- MR_UNIV_OFFSET_FOR_TYPEINFO);
- Value = MR_field(MR_mktag(0), Univ,
- MR_UNIV_OFFSET_FOR_DATA);
+ MR_unravel_univ(Univ, TypeInfo_for_T, Value);
").
% The predicate has_type/2 is basically an existentially typed
Index: tests/tabling/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/tabling/Mmakefile,v
retrieving revision 1.15
diff -u -t -r1.15 Mmakefile
--- tests/tabling/Mmakefile 2001/01/08 02:37:17 1.15
+++ tests/tabling/Mmakefile 2001/02/23 04:15:02
@@ -38,11 +38,16 @@
# consumer_in_commit
# consumer_in_solutions
+# Tabling does not yet work in .rt grades
ifneq "$(findstring .gc,$(GRADE))" ""
- ifneq "$(findstring .mm,$(GRADE))" ""
- PROGS=$(SIMPLE_PROGS) $(NONDET_PROGS)
+ ifneq "$(findstring .rt,$(GRADE))" ""
+ PROGS=
else
- PROGS=$(SIMPLE_PROGS)
+ ifneq "$(findstring .mm,$(GRADE))" ""
+ PROGS=$(SIMPLE_PROGS) $(NONDET_PROGS)
+ else
+ PROGS=$(SIMPLE_PROGS)
+ endif
endif
else
PROGS=
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.41
diff -u -t -r1.41 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 2001/01/18 01:19:15 1.41
+++ trace/mercury_trace_declarative.c 2001/02/22 06:59:12
@@ -1106,12 +1106,8 @@
}
MR_TRACE_USE_HP(
- MR_tag_incr_hp(arg, MR_mktag(0), 2);
+ MR_new_univ_on_hp(arg, arg_type, arg_value);
);
- MR_field(MR_mktag(0), arg, MR_UNIV_OFFSET_FOR_TYPEINFO) =
- (MR_Word) arg_type;
- MR_field(MR_mktag(0), arg, MR_UNIV_OFFSET_FOR_DATA) =
- arg_value;
MR_TRACE_CALL_MERCURY(
atom = MR_DD_add_trace_atom_arg(atom,
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.54
diff -u -t -r1.54 mercury_trace_external.c
--- trace/mercury_trace_external.c 2001/03/07 08:00:00 1.54
+++ trace/mercury_trace_external.c 2001/03/14 03:11:18
@@ -1104,13 +1104,9 @@
}
MR_TRACE_USE_HP(
- MR_incr_hp(univ, 2);
+ MR_new_univ_on_hp(univ, type_info, value);
);
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_TYPEINFO)
- = (MR_Word) type_info;
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_DATA) = value;
-
MR_TRACE_USE_HP(
var_list = MR_list_cons(univ, var_list);
);
@@ -1217,16 +1213,13 @@
var_number = MR_get_var_number(debugger_request);
/* debugger_request should be of the form:
current_nth_var(var_number) */
- MR_TRACE_USE_HP(
- MR_incr_hp(univ, 2);
- );
problem = MR_trace_return_var_info(var_number, NULL,
&type_info, &value);
if (problem == NULL) {
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_TYPEINFO)
- = (MR_Word) type_info;
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_DATA) = value;
+ MR_TRACE_USE_HP(
+ MR_new_univ_on_hp(univ, type_info, value);
+ );
} else {
/*
** Should never occur since we check in the external debugger
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.98
diff -u -t -r1.98 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2001/02/23 04:15:24 1.98
+++ trace/mercury_trace_internal.c 2001/02/23 05:01:49
@@ -479,10 +479,7 @@
return "missing exception value";
}
- type_info = MR_field(MR_mktag(0), exception,
- MR_UNIV_OFFSET_FOR_TYPEINFO);
- value = MR_field(MR_mktag(0), exception,
- MR_UNIV_OFFSET_FOR_DATA);
+ MR_unravel_univ(exception, type_info, value);
(*browser)(type_info, value, caller, format);
---------------------------------------------------------------------------
dgj
--
David Jeffery (dgj at cs.mu.oz.au) | If you want to build a ship, don't drum up
PhD student, | people together to collect wood or assign
Dept. of Comp. Sci. & Soft. Eng.| them tasks and work, but rather teach them
The University of Melbourne | to long for the endless immensity of the sea.
Australia | -- Antoine de Saint Exupery
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list