[m-dev.] for review: merge HAL branch onto main branch
David Jeffery
dgj at cs.mu.OZ.AU
Thu Feb 15 17:03:07 AEDT 2001
Hi,
This diff is a merge of the HAL branch onto the main branch. It is not quite
ready to commit yet (there still being a few XXXs outstanding, and a couple
of test cases I'd like to fix), but I would appreciate review comments now
(from either fjh or zs, I guess) at this stage.
In particular, I'd appreciate comments on how to reduce the maintenance
impact of this change --- I've tried to reduce the likelihood of maintenance
problems, but there are probably things I haven't thought of.
-------------------------------------------------------------------------
Estimated hours taken: 40
(to do this merge... several 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 gradess.
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'.
extras/references/Mmakefile:
Add `.rt' grades to the list of grades built for the trailed
references modules. HAL uses these to implement various things such
as backtrackable global variables.
XXX should this change really affect everyone?
compiler/builtin_ops.m:
library/builtin.m:
Add `any' modes for unsafe_promise_unique.
XXX builtin_ops.m should probably be checked in as a separate change,
before the rest of these changes, otherwise it falls over when
compiling builtin.m because there is no definition for
unsafe_promise_unique with the new modes. This works in my workspace
because I have a Mmake.params file that ignores warnings for this file.
library/private_builtin.m:
Add `any' modes for var/1
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:
Add `any' modes for type_to_univ.
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 options `--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.
-------------------------------------------------------------------------
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/builtin_ops.m,v
retrieving revision 1.5
diff -u -t -r1.5 builtin_ops.m
--- compiler/builtin_ops.m 2001/01/20 15:42:41 1.5
+++ compiler/builtin_ops.m 2001/02/15 05:40:07
@@ -154,6 +154,8 @@
[X, Y], assign(Y, leaf(X))).
builtin_translation("builtin", "unsafe_promise_unique", 0,
[X, Y], assign(Y, leaf(X))).
+builtin_translation("builtin", "unsafe_promise_unique", 1,
+ [X, Y], assign(Y, leaf(X))).
builtin_translation("private_builtin", "builtin_int_gt", 0, [X, Y],
test(binary((>), leaf(X), leaf(Y)))).
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/15 03:11:28
@@ -1802,6 +1802,7 @@
)
;
{ map__set(Types0, TypeId, T, Types) },
+ { construct_qualified_term(Name, Args, Type) },
(
{ Body = du_type(ConsList, _, _, _) }
->
@@ -1818,10 +1819,15 @@
CtorFields, Module1a) },
globals__io_lookup_bool_option(unboxed_no_tag_types,
AllowNoTagTypes),
-
+ globals__io_lookup_bool_option(reserve_tag,
+ ReserveTag),
{
- AllowNoTagTypes = yes,
- type_constructors_are_no_tag_type(ConsList,
+ (
+ AllowNoTagTypes = yes, ReserveTag = no
+ ;
+ type_util__is_dummy_argument_type(Type)
+ ),
+ type_constructors_are_no_tag_type(ConsList,
Name, CtorArgType, _)
->
NoTagType = no_tag_type(Args,
@@ -1838,7 +1844,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/15 03:52:52
@@ -66,25 +66,40 @@
% 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
+ % (this also disables enumerations and no_tag types)
+ globals__lookup_bool_option(Globals, reserve_tag, ReserveTag),
+ ( 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)
+ % (unless it is type_info/1 or we are reserving a tag)
globals__lookup_bool_option(Globals,
unboxed_no_tag_types, yes),
type_constructors_are_no_tag_type(Ctors, SingleFunc,
- SingleArg, _)
+ SingleArg, _),
+ (
+ ReserveTag = no
+ ;
+ constructors_are_dummy_argument_type(Ctors)
+ )
->
make_cons_id_from_qualified_sym_name(SingleFunc,
[SingleArg], SingleConsId),
@@ -92,6 +107,13 @@
;
NumTagBits = 0
->
+ ( ReserveTag = yes ->
+ % XXX Need to fix this.
+ % What architectures does this occur on?
+ error("Oops: sorry, not implemented: --reserve-tag with num_tag_bits = 0")
+ ;
+ true
+ ),
( Ctors = [_SingleCtor] ->
assign_unshared_tags(Ctors, 0, 1,
CtorTags0, CtorTags)
@@ -104,7 +126,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 +146,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 +159,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.308
diff -u -t -r1.308 options.m
--- compiler/options.m 2001/02/05 06:55:33 1.308
+++ compiler/options.m 2001/02/06 05:41:21
@@ -154,6 +154,7 @@
; stack_trace
; require_tracing
; use_trail
+ ; reserve_tag
; use_minimal_model
; pic_reg
; tags
@@ -576,6 +577,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"),
@@ -992,6 +994,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).
@@ -2026,6 +2029,10 @@
"\tEnable use of a trail.",
"\tThis is necessary for interfacing with constraint solvers,",
"\tor for backtrackable destructive update.",
+ "--reserve-tag\t\t\t(grade modifier: `.rt')",
+ "\tReserve a tag.",
+ "\tThis is necessary for a seamless Herbrand solver -",
+ "\tintended for 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/06 05:47:19
@@ -296,6 +296,15 @@
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 var tag first
+ output_dummy_ptag_layout_defns
+ ;
+ []
+ ),
output_ptag_layout_defns(PtagLayouts, RttiTypeId),
io__write_string("\n};\n").
output_rtti_data_defn(type_ctor_info(RttiTypeId, Unify, Compare,
@@ -542,6 +551,13 @@
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.
+:- pred output_dummy_ptag_layout_defns(io__state::di, io__state::uo) is det.
+
+output_dummy_ptag_layout_defns -->
+ 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/15 03:59:14
@@ -288,12 +288,13 @@
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
;
@@ -301,9 +302,15 @@
globals__lookup_bool_option(Globals,
unboxed_no_tag_types, NoTagOption),
(
- NoTagOption = yes,
+ NoTagOption = yes,
type_constructors_are_no_tag_type(Ctors,
- Name, ArgType, MaybeArgName)
+ Name, ArgType, MaybeArgName),
+ (
+ ReserveTag = no
+ ;
+ constructors_are_dummy_argument_type(
+ Ctors)
+ )
->
( term__is_ground(ArgType) ->
Inst = equiv_type_is_ground
@@ -399,12 +406,21 @@
% 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,
+ (
+ % XXX Surely this isn't right for enumerations?
+
+ ReserveTag = yes,
+ InitTag = 1
+ ;
+ ReserveTag = no,
+ 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 +491,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 +511,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 +779,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/15 03:52:07
@@ -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,11 @@
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.
+
% 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 +612,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 +985,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
@@ -995,6 +1002,29 @@
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 = [].
%-----------------------------------------------------------------------------%
Index: extras/references/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/references/Mmakefile,v
retrieving revision 1.4
diff -u -t -r1.4 Mmakefile
--- extras/references/Mmakefile 2000/11/21 23:52:32 1.4
+++ extras/references/Mmakefile 2001/02/07 04:49:32
@@ -10,7 +10,7 @@
# Install in an "extras" subdirectory of the main installation tree
INSTALL_PREFIX := $(INSTALL_PREFIX)/extras
-LIBGRADES = asm_fast.tr asm_fast.gc.tr.debug
+LIBGRADES = asm_fast.tr asm_fast.tr.rt asm_fast.gc.tr.rt asm_fast.gc.tr.rt.debug
MAIN_TARGET = libglobal
Index: library/builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/builtin.m,v
retrieving revision 1.51
diff -u -t -r1.51 builtin.m
--- library/builtin.m 2001/02/04 04:10:34 1.51
+++ library/builtin.m 2001/02/07 05:18:27
@@ -125,6 +125,7 @@
:- pred unsafe_promise_unique(T, T).
:- mode unsafe_promise_unique(in, uo) is det.
+:- mode unsafe_promise_unique(in(any), uo) is det.
%-----------------------------------------------------------------------------%
Index: library/private_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/private_builtin.m,v
retrieving revision 1.68
diff -u -t -r1.68 private_builtin.m
--- library/private_builtin.m 2001/02/04 04:10:34 1.68
+++ library/private_builtin.m 2001/02/07 04:56:34
@@ -1009,6 +1009,7 @@
:- impure pred var(T).
:- mode var(ui) is failure.
:- mode var(in) is failure.
+:- mode var(in(any)) is failure.
:- mode var(unused) is det.
:- impure pred nonvar(T).
@@ -1026,6 +1027,10 @@
[thread_safe, will_not_call_mercury], "
SUCCESS_INDICATOR = FALSE;
").
+:- pragma foreign_code("C", var(_X::in(any)),
+ [thread_safe, will_not_call_mercury], "
+ SUCCESS_INDICATOR = FALSE;
+").
:- pragma foreign_code("C", var(_X::unused),
[thread_safe, will_not_call_mercury], "").
@@ -1043,6 +1048,10 @@
SUCCESS_INDICATOR = FALSE;
").
:- pragma foreign_code("MC++", var(_X::in),
+ [thread_safe, will_not_call_mercury], "
+ SUCCESS_INDICATOR = FALSE;
+").
+:- pragma foreign_code("MC++", var(_X::in(any)),
[thread_safe, will_not_call_mercury], "
SUCCESS_INDICATOR = FALSE;
").
Index: library/sparse_bitset.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/sparse_bitset.m,v
retrieving revision 1.4
diff -u -t -r1.4 sparse_bitset.m
--- library/sparse_bitset.m 2001/01/01 04:03:52 1.4
+++ library/sparse_bitset.m 2001/02/12 06:51:47
@@ -767,12 +767,18 @@
:- 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;
+#ifdef MR_RESERVE_TAG
+#define ML_BITSET_TAG 1
+#else
+#define ML_BITSET_TAG 0
+#endif
+ 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 be fixed too
:- pragma foreign_code("MC++", make_bitset_elem(A::in, B::in) = (Pair::out),
[will_not_call_mercury, thread_safe],
"{
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.221
diff -u -t -r1.221 std_util.m
--- library/std_util.m 2001/02/05 06:50:13 1.221
+++ library/std_util.m 2001/02/12 05:03:11
@@ -41,6 +41,7 @@
:- pred type_to_univ(T, univ).
:- mode type_to_univ(di, uo) is det.
:- mode type_to_univ(in, out) is det.
+:- mode type_to_univ(in(any), out(any)) is det.
:- mode type_to_univ(out, in) is semidet.
% univ_to_type(Univ, Object) :- type_to_univ(Object, Univ).
@@ -57,6 +58,7 @@
%
:- func univ(T) = univ.
:- mode univ(in) = out is det.
+:- mode univ(in(any)) = out(any) is det.
:- mode univ(di) = uo is det.
:- mode univ(out) = in is semidet.
@@ -2048,7 +2050,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_mktag(MR_UNIV_TAG), MR_list_head(ArgList),
MR_UNIV_OFFSET_FOR_DATA);
break;
@@ -2086,7 +2088,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_mktag(MR_UNIV_TAG),
+ MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -2101,7 +2104,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_mktag(MR_UNIV_TAG),
+ MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -2131,7 +2135,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_mktag(MR_UNIV_TAG),
+ MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -2152,8 +2157,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_initialise_univ(Term, type_info, new_data);
}
SUCCESS_INDICATOR = success;
@@ -2241,7 +2245,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_mktag(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);
@@ -2251,8 +2256,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_initialise_univ(Term, type_info, new_data);
}
").
@@ -2443,7 +2447,7 @@
return FALSE;
}
- list_arg_type_info = (MR_TypeInfo) MR_field(MR_mktag(0),
+ list_arg_type_info = (MR_TypeInfo) MR_field(MR_mktag(MR_UNIV_TAG),
MR_list_head(arg_list), MR_UNIV_OFFSET_FOR_TYPEINFO);
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
@@ -2484,7 +2488,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_mktag(MR_UNIV_TAG), MR_list_head(arg_list),
MR_UNIV_OFFSET_FOR_DATA);
arg_list = MR_list_tail(arg_list);
}
@@ -3137,14 +3141,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;
}
@@ -3547,8 +3553,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_initialise_univ(ArgumentUniv, arg_type_info, *argument_ptr);
}
SUCCESS_INDICATOR = success;
@@ -3646,8 +3651,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_initialise_univ(Argument,
expand_info.arg_type_infos[i],
expand_info.arg_values[i + expand_info.num_extra_args]);
@@ -3721,8 +3725,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_initialise_univ(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3732,8 +3735,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_initialise_univ(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3771,8 +3773,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_initialise_univ(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3780,8 +3781,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_initialise_univ(ExpUniv, exp_type_info, value);
SUCCESS_INDICATOR = TRUE;
break;
@@ -3907,9 +3907,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_initialise_univ(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/08 05:57:37
@@ -78,9 +78,26 @@
** depend on the data representation scheme used by compiler/make_tags.m.
*/
+#ifdef MR_RESERVE_TAG
+
+#define MR_RAW_TAG_VAR 0 /* for Prolog-style variables */
+#define MR_RAW_TAG_NIL 1
+#define MR_RAW_TAG_CONS 2
+
+#define MR_UNIV_TAG 1
+
+#else
+
#define MR_RAW_TAG_NIL 0
#define MR_RAW_TAG_CONS 1
+#define MR_UNIV_TAG 0
+
+#endif
+
+#ifdef MR_RESERVE_TAG
+#define MR_TAG_VAR MR_mktag(MR_RAW_TAG_VAR)
+#endif
#define MR_TAG_NIL MR_mktag(MR_RAW_TAG_NIL)
#define MR_TAG_CONS MR_mktag(MR_RAW_TAG_CONS)
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.64
diff -u -t -r1.64 mercury_type_info.h
--- runtime/mercury_type_info.h 2001/02/05 05:19:02 1.64
+++ runtime/mercury_type_info.h 2001/02/09 02:47:19
@@ -343,9 +343,15 @@
** Definitions for handwritten code, mostly for mercury_compare_typeinfo.
*/
+#ifdef MR_RESERVE_TAG
+#define MR_COMPARE_EQUAL 1
+#define MR_COMPARE_LESS 5
+#define MR_COMPARE_GREATER 9
+#else
#define MR_COMPARE_EQUAL 0
#define MR_COMPARE_LESS 1
#define MR_COMPARE_GREATER 2
+#endif
/*---------------------------------------------------------------------------*/
@@ -402,18 +408,25 @@
#define MR_unravel_univ(univ, typeinfo, value) \
do { \
- typeinfo = (MR_TypeInfo) MR_field(MR_mktag(0), (univ), \
+ typeinfo = (MR_TypeInfo) MR_field(MR_mktag(MR_UNIV_TAG), (univ),\
MR_UNIV_OFFSET_FOR_TYPEINFO); \
- value = MR_field(MR_mktag(0), (univ), \
+ value = MR_field(MR_mktag(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_mktag(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_mktag(MR_UNIV_TAG), (univ), MR_UNIV_OFFSET_FOR_DATA) \
= (MR_Word) (value); \
+ } while (0)
+
+#define MR_initialise_univ(univ, typeinfo, value) \
+ do { \
+ MR_tag_incr_hp_msg((univ), MR_mktag(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.14
diff -u -t -r1.14 init_grade_options.sh-subr
--- scripts/init_grade_options.sh-subr 2001/01/29 01:55:08 1.14
+++ scripts/init_grade_options.sh-subr 2001/02/07 05:05:15
@@ -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.19
diff -u -t -r1.19 parse_grade_options.sh-subr
--- scripts/parse_grade_options.sh-subr 2001/01/29 01:55:08 1.19
+++ scripts/parse_grade_options.sh-subr 2001/02/07 05:10:11
@@ -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/15 05:54:06
@@ -73,15 +73,18 @@
my_exist_t = 43.
+:- pragma c_header_code(
+"
+").
:- 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_mktag(MR_UNIV_TAG), Univ, 0);
+ Value = MR_field(MR_mktag(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_mktag(MR_UNIV_TAG), 2);
+ MR_field(MR_mktag(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_mktag(MR_UNIV_TAG), Univ, 1) = (MR_Word) Value;
").
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: 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/12 06:11:40
@@ -1106,12 +1106,8 @@
}
MR_TRACE_USE_HP(
- MR_tag_incr_hp(arg, MR_mktag(0), 2);
+ MR_initialise_univ(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/13 05:33:51
@@ -1114,13 +1114,9 @@
}
MR_TRACE_USE_HP(
- MR_incr_hp(univ, 2);
+ MR_initialise_univ(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_initialise_univ(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.97
diff -u -t -r1.97 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2001/01/18 03:01:48 1.97
+++ trace/mercury_trace_internal.c 2001/02/13 00:57:36
@@ -478,10 +478,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