[m-dev.] for review: merge HAL branch onto main branch
David Jeffery
dgj at cs.mu.OZ.AU
Fri Feb 23 16:30:29 AEDT 2001
Here's a new diff for Fergus to review. Zoltan may want to have a look too.
Note that I have removed the changes to support type_to_univ with `any' modes
as it turned out that we don't actually use it in HAL, and there were parts
that were objected to.
I am currently running a bootcheck, which I expect to complete successfully.
-----------------------------------------------------------------------------
Estimated hours taken: 60
(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.
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.
library/std_util.m:
Use MR_UNIV_TAG, MR_unravel_univ and MR_initialise_univ when
manipulating univs.
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.
tests/debugger/declarative/Mmakefile:
tests/tabling/Mmakefile:
Disable these tests in .rt grades as we currently don't support
declarative debugging or tabling.
TODO:
- rtti_out.m generates invalid ptag_layouts for the `var' tag. It
should instead generate a real "dummy" layout that the runtime and
library should be taught to handle
- 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.101
diff -u -t -r1.101 handle_options.m
--- compiler/handle_options.m 2001/02/05 06:55:31 1.101
+++ compiler/handle_options.m 2001/02/06 05:18:15
@@ -771,6 +771,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)?
@@ -996,6 +997,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)]).
@@ -1036,6 +1040,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/23 04:54:32
@@ -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.313
diff -u -t -r1.313 options.m
--- compiler/options.m 2001/02/19 06:28:35 1.313
+++ compiler/options.m 2001/02/23 05:14:43
@@ -154,6 +154,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"),
@@ -995,6 +997,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-reg", pic_reg).
long_option("tags", tags).
@@ -2055,6 +2058,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",
+ "\treprestation to free variables.",
+ "\tThis is necessary for a seamless Herbrand 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/02/21 06:29:25
@@ -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_NONE, 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/02/23 04:53:31
@@ -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,19 @@
% 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,
+ (
+ ReserveTag = yes
+ ->
+ error("type_ctor_info__make_enum_tables: no enums 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 +480,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 +500,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 +768,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:11:34
@@ -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/02/12 03:30:07
@@ -719,8 +719,22 @@
unify_proc__quantify_clauses_body([H1, H2], Goal,
Context, Clauses)
;
- unify_proc__generate_du_unify_clauses(Ctors,
- H1, H2, Context, Clauses)
+ % Check to see if it's a single zero-arity functor.
+ % This hack is required for --reserve-tag, which
+ % disables enumeration types, so that the compiler
+ % does not warn about inferring the unify to be
+ % det rather than semidet.
+ ( { Ctors = [ctor(_ExistQVars, _Constraints, _FunctorName, [])] , semidet_fail } ->
+ % We must at least pretend a unification is
+ % required?
+ { create_atomic_unification(H1, var(H2),
+ Context, explicit, [], Goal) },
+ unify_proc__quantify_clauses_body([H1, H2],
+ Goal, Context, Clauses)
+ ;
+ unify_proc__generate_du_unify_clauses(Ctors,
+ H1, H2, Context, Clauses)
+ )
)
;
{ TypeBody = eqv_type(_Type) },
Index: library/sparse_bitset.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/sparse_bitset.m,v
retrieving revision 1.5
diff -u -t -r1.5 sparse_bitset.m
--- library/sparse_bitset.m 2001/02/11 11:45:13 1.5
+++ library/sparse_bitset.m 2001/02/23 05:08:39
@@ -767,15 +767,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/02/23 05:12:39
@@ -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,7 +2108,8 @@
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);
}
@@ -2137,7 +2139,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 +2161,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 +2249,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 +2260,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 +2451,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 +2492,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);
}
@@ -3143,14 +3145,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;
}
@@ -3553,8 +3557,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 +3655,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 +3729,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 +3739,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 +3777,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 +3785,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,9 +3911,7 @@
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);
}
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/02/21 05:17:48
@@ -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.65
diff -u -t -r1.65 mercury_type_info.h
--- runtime/mercury_type_info.h 2001/02/23 01:11:04 1.65
+++ runtime/mercury_type_info.h 2001/02/23 05:01:17
@@ -347,9 +347,22 @@
** 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_EQUAL ((0 << LOW_TAG_BITS) + 1)
+ #define MR_COMPARE_LESS ((1 << LOW_TAG_BITS) + 1)
+ #define MR_COMPARE_GREATER ((2 << LOW_TAG_BITS) + 1)
+#else
+ #define MR_COMPARE_EQUAL 0
+ #define MR_COMPARE_LESS 1
+ #define MR_COMPARE_GREATER 2
+#endif
/*---------------------------------------------------------------------------*/
@@ -406,18 +419,26 @@
#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)
/*---------------------------------------------------------------------------*/
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/02/23 04:04:09
@@ -65,6 +65,7 @@
# 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))" ""
@@ -80,7 +81,11 @@
ifneq "$(findstring fast,$(GRADE))" ""
PROGS=
else
- PROGS=$(PROGS_2)
+ ifneq "$(findstring rt,$(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.53
diff -u -t -r1.53 mercury_trace_external.c
--- trace/mercury_trace_external.c 2001/01/18 01:19:15 1.53
+++ trace/mercury_trace_external.c 2001/02/22 06:59:22
@@ -1114,13 +1114,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);
);
@@ -1227,16 +1223,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 your thesis is utterly vacuous
PhD student, | Use first-order predicate calculus.
Dept. of Comp. Sci. & Soft. Eng.| With sufficient formality
The University of Melbourne | The sheerist banality
Australia | Will be hailed by the critics: "Miraculous!"
| -- Anon.
--------------------------------------------------------------------------
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