[m-rev.] diff: stable foreign types
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Jun 24 12:22:36 AEST 2004
Provide a mechanism for declaring foreign types that can be operated on by
compare_representation. The intended use of the mechanism is to declare
a foreign type to represent proc_layouts in the declarative debugger,
as part of the representation of atoms; since atoms are keys in maps
in the oracle, they are input to compare_representation.
Since we don't want the result of compare_representation to change as
execution proceeds, we require an assertion that the foreign value is
stable, i.e. that the value of the foreign type variable completely
determines the data it points to, directly and indirectly. Proc_layouts
are static, so this is not a problem. Being able to do the comparison
requires the foreign type to be an integral type or a pointer, which
is what the existing can_pass_as_mercury_type assertion promises.
The stability is promised by a new assertion.
For foreign types that have both assertions, we use a new type_ctor_rep,
which differs from the existing type_ctor_rep for foreign types by doing
a real comparison instead of an abort in compare_representation.
doc/reference_manual.texi:
Document the new kind of assertion.
compiler/prog_data.m:
Add the new kind of assertion.
compiler/prog_io_pragma.m:
Parse the new kind of assertion.
compiler/rtti.m:
Add the representation of the new type_ctor_rep. Factor out the
stability of c_pointers as well as foreign types.
compiler/type_ctor_info.m:
Generate the new type_ctor_rep for types with both assertions.
compiler/foreign.m:
Export a predicate for use by type_ctor_info.m.
compiler/mercury_to_mercury.m:
Print the new assertion.
compiler/*.m:
Minor changes to conform to the diffs above.
Use state variable notation.
library/rtti_implementation.m:
Handle the new type_ctor_rep.
runtime/mercury_mcpp.h:
runtime/mercury_type_info.h:
java/runtime/TypeCtorRep.java:
Add the new type_ctor_rep to the runtime.
runtime/mercury_mcpp.h:
runtime/mercury_type_info.h:
compiler/type_ctor_info.m:
Increment the rtti version number.
When we rely on the availability of this new capability,
we should add a test for the new rtti version number to configure.in.
runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_ml_expand_body.h:
runtime/mercury_term_size.h:
Handle stable foreign types the same way as other foreign types.
runtime/mercury_deep_copy_body.h:
runtime/mercury_tabling.h:
runtime/mercury_unify_compare_body.h:
Handle stable foreign types in a useful manner, relying on the
assertions behind them.
tests/hard_coded/stable_foreign.{m,exp}:
A test case for the handling of values of a stable foreign type.
tests/hard_coded/Mmakefile:
Enable the new test case.
Zoltan.
cvs server: Diffing .
cvs server: Diffing analysis
cvs server: Diffing bindist
cvs server: Diffing boehm_gc
cvs server: Diffing boehm_gc/Mac_files
cvs server: Diffing boehm_gc/cord
cvs server: Diffing boehm_gc/cord/private
cvs server: Diffing boehm_gc/doc
cvs server: Diffing boehm_gc/include
cvs server: Diffing boehm_gc/include/private
cvs server: Diffing boehm_gc/tests
cvs server: Diffing browser
cvs server: Diffing bytecode
cvs server: Diffing compiler
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.40
diff -u -b -r1.40 foreign.m
--- compiler/foreign.m 17 Jun 2004 04:17:52 -0000 1.40
+++ compiler/foreign.m 24 Jun 2004 02:22:05 -0000
@@ -96,6 +96,14 @@
:- func foreign_type_body_has_user_defined_eq_comp_pred(module_info,
foreign_type_body) = unify_compare is semidet.
+ % Find the current target backend from the module_info, and given
+ % a foreign_type_body, return the name of the foreign language type
+ % the identity of any user-defined unify/compare predicates, and the
+ % assertions applicable to that backend.
+:- pred foreign_type_body_to_exported_type(module_info::in,
+ foreign_type_body::in, sym_name::out, maybe(unify_compare)::out,
+ list(foreign_type_assertion)::out) is det.
+
% Given the exported_type representation for a type, determine
% whether or not it is a foreign type, and if yes, return the foreign
% type's assertions.
@@ -670,10 +678,6 @@
foreign_type_body_to_exported_type(ModuleInfo, Body, _,
MaybeUserEqComp, _),
MaybeUserEqComp = yes(UserEqComp).
-
-:- pred foreign_type_body_to_exported_type(module_info::in,
- foreign_type_body::in, sym_name::out, maybe(unify_compare)::out,
- list(foreign_type_assertion)::out) is det.
foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
MaybeUserEqComp, Assertions) :-
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.243
diff -u -b -r1.243 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 14 Jun 2004 04:16:16 -0000 1.243
+++ compiler/mercury_to_mercury.m 24 Jun 2004 02:22:05 -0000
@@ -403,14 +403,14 @@
% output the declarations one by one
-:- pred mercury_output_item_list(bool, list(item_and_context),
- io__state, io__state).
-:- mode mercury_output_item_list(in, in, di, uo) is det.
+:- pred mercury_output_item_list(bool::in, list(item_and_context)::in,
+ io::di, io::uo) is det.
-mercury_output_item_list(_, []) --> [].
-mercury_output_item_list(UnqualifiedItemNames, [Item - Context | Items]) -->
- mercury_output_item(UnqualifiedItemNames, Item, Context),
- mercury_output_item_list(UnqualifiedItemNames, Items).
+mercury_output_item_list(_, [], !IO).
+mercury_output_item_list(UnqualifiedItemNames, [Item - Context | Items],
+ !IO) :-
+ mercury_output_item(UnqualifiedItemNames, Item, Context, !IO),
+ mercury_output_item_list(UnqualifiedItemNames, Items, !IO).
%-----------------------------------------------------------------------------%
@@ -418,8 +418,8 @@
{ UnqualifiedItemNames = no },
mercury_output_item(UnqualifiedItemNames, Item, Context).
-:- pred mercury_output_item(bool, item, prog_context, io__state, io__state).
-:- mode mercury_output_item(in, in, in, di, uo) is det.
+:- pred mercury_output_item(bool::in, item::in, prog_context::in,
+ io::di, io::uo) is det.
% dispatch on the different types of items
@@ -746,14 +746,12 @@
%-----------------------------------------------------------------------------%
-:- pred output_class_methods(list(class_method), io__state, io__state).
-:- mode output_class_methods(in, di, uo) is det.
+:- pred output_class_methods(list(class_method)::in, io::di, io::uo) is det.
output_class_methods(Methods) -->
io__write_list(Methods, ",\n", output_class_method).
-:- pred output_class_method(class_method, io__state, io__state).
-:- mode output_class_method(in, di, uo) is det.
+:- pred output_class_method(class_method::in, io::di, io::uo) is det.
output_class_method(Method) -->
io__write_string("\t"),
@@ -814,8 +812,7 @@
mercury_output_instance_methods(Methods) -->
io__write_list(Methods, ",\n", output_instance_method).
-:- pred output_instance_method(instance_method, io__state, io__state).
-:- mode output_instance_method(in, di, uo) is det.
+:- pred output_instance_method(instance_method::in, io::di, io::uo) is det.
output_instance_method(Method) -->
{ Method = instance_method(PredOrFunc, Name1, Defn, Arity, Context) },
@@ -1646,9 +1643,11 @@
mercury_output_foreign_type_assertion(can_pass_as_mercury_type, !IO) :-
io__write_string("can_pass_as_mercury_type", !IO).
+mercury_output_foreign_type_assertion(stable, !IO) :-
+ io__write_string("stable", !IO).
-:- pred mercury_output_begin_type_decl(is_solver_type, io__state, io__state).
-:- mode mercury_output_begin_type_decl(in, di, uo) is det.
+:- pred mercury_output_begin_type_decl(is_solver_type::in,
+ io::di, io::uo) is det.
mercury_output_begin_type_decl(solver_type) -->
io__write_string(":- solver type ").
@@ -1656,7 +1655,7 @@
io__write_string(":- type ").
:- pred mercury_output_equality_compare_preds(maybe(unify_compare)::in,
- io__state::di, io__state::uo) is det.
+ io::di, io::uo) is det.
mercury_output_equality_compare_preds(no) --> [].
mercury_output_equality_compare_preds(
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.110
diff -u -b -r1.110 prog_data.m
--- compiler/prog_data.m 14 Jun 2004 04:16:29 -0000 1.110
+++ compiler/prog_data.m 24 Jun 2004 02:22:05 -0000
@@ -1150,7 +1150,8 @@
).
:- type foreign_type_assertion
- ---> can_pass_as_mercury_type.
+ ---> can_pass_as_mercury_type
+ ; stable.
:- type constructor
---> ctor(
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.68
diff -u -b -r1.68 prog_io_pragma.m
--- compiler/prog_io_pragma.m 14 Jun 2004 04:16:30 -0000 1.68
+++ compiler/prog_io_pragma.m 24 Jun 2004 02:22:05 -0000
@@ -434,6 +434,10 @@
Term = term__functor(term__atom(Constant), [], _),
Constant = "can_pass_as_mercury_type",
Assertion = can_pass_as_mercury_type.
+parse_foreign_type_assertion(Term, Assertion) :-
+ Term = term__functor(term__atom(Constant), [], _),
+ Constant = "stable",
+ Assertion = stable.
% This predicate parses both c_header_code and foreign_decl pragmas.
:- pred parse_pragma_foreign_decl_pragma(module_name, string,
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.49
diff -u -b -r1.49 rtti.m
--- compiler/rtti.m 14 Jun 2004 04:16:35 -0000 1.49
+++ compiler/rtti.m 24 Jun 2004 02:22:05 -0000
@@ -189,7 +189,9 @@
; impl_artifact(
impl_ctor :: impl_ctor
)
- ; foreign.
+ ; foreign(
+ is_stable :: is_stable
+ ).
% For a given du family type, this says whether the user has defined
% their own unification predicate for the type.
@@ -365,8 +367,7 @@
; char
; string
; void
- ; c_pointer
- ; stable_c_pointer
+ ; c_pointer(is_stable)
; pred_ctor
; func_ctor
; tuple
@@ -391,6 +392,10 @@
; base_typeclass_info
; subgoal. % coming soon
+:- type is_stable
+ ---> is_stable
+ ; is_not_stable.
+
%-----------------------------------------------------------------------------%
%
% The data structures representing type class dictionaries.
@@ -1440,7 +1445,7 @@
TypeCtorDetails = impl_artifact(ImplCtor),
impl_ctor_rep_to_string(ImplCtor, RepStr)
;
- TypeCtorDetails = foreign,
+ TypeCtorDetails = foreign(IsStable),
(
type_ctor_is_array(
qualified(TypeCtorData ^ tcr_module_name,
@@ -1452,8 +1457,14 @@
% provide tracing functions for foreign types.
RepStr = "MR_TYPECTOR_REP_ARRAY"
;
+ (
+ IsStable = is_stable,
+ RepStr = "MR_TYPECTOR_REP_STABLE_FOREIGN"
+ ;
+ IsStable = is_not_stable,
RepStr = "MR_TYPECTOR_REP_FOREIGN"
)
+ )
).
:- pred builtin_ctor_rep_to_string(builtin_ctor::in, string::out) is det.
@@ -1463,8 +1474,9 @@
builtin_ctor_rep_to_string(float, "MR_TYPECTOR_REP_FLOAT").
builtin_ctor_rep_to_string(char, "MR_TYPECTOR_REP_CHAR").
builtin_ctor_rep_to_string(void, "MR_TYPECTOR_REP_VOID").
-builtin_ctor_rep_to_string(c_pointer, "MR_TYPECTOR_REP_C_POINTER").
-builtin_ctor_rep_to_string(stable_c_pointer,
+builtin_ctor_rep_to_string(c_pointer(is_not_stable),
+ "MR_TYPECTOR_REP_C_POINTER").
+builtin_ctor_rep_to_string(c_pointer(is_stable),
"MR_TYPECTOR_REP_STABLE_C_POINTER").
builtin_ctor_rep_to_string(pred_ctor, "MR_TYPECTOR_REP_PRED").
builtin_ctor_rep_to_string(func_ctor, "MR_TYPECTOR_REP_FUNC").
@@ -1520,7 +1532,7 @@
type_ctor_details_num_ptags(eqv(_)) = -1.
type_ctor_details_num_ptags(builtin(_)) = -1.
type_ctor_details_num_ptags(impl_artifact(_)) = -1.
-type_ctor_details_num_ptags(foreign) = -1.
+type_ctor_details_num_ptags(foreign(_)) = -1.
type_ctor_details_num_functors(enum(_, Functors, _, _)) =
list__length(Functors).
@@ -1532,7 +1544,7 @@
type_ctor_details_num_functors(eqv(_)) = -1.
type_ctor_details_num_functors(builtin(_)) = -1.
type_ctor_details_num_functors(impl_artifact(_)) = -1.
-type_ctor_details_num_functors(foreign) = -1.
+type_ctor_details_num_functors(foreign(_)) = -1.
du_arg_info_name(ArgInfo) = ArgInfo ^ du_arg_name.
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.46
diff -u -b -r1.46 rtti_out.m
--- compiler/rtti_out.m 19 May 2004 03:59:34 -0000 1.46
+++ compiler/rtti_out.m 24 Jun 2004 02:22:05 -0000
@@ -699,7 +699,7 @@
MaybeLayoutName = no,
MaybeFunctorsName = no
;
- TypeCtorDetails = foreign,
+ TypeCtorDetails = foreign(_),
MaybeLayoutName = no,
MaybeFunctorsName = no
).
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.52
diff -u -b -r1.52 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 14 Jun 2004 04:16:35 -0000 1.52
+++ compiler/rtti_to_mlds.m 24 Jun 2004 02:22:05 -0000
@@ -584,7 +584,7 @@
LayoutInit = gen_init_null_pointer(mlds__generic_type),
FunctorInit = gen_init_null_pointer(mlds__generic_type)
;
- TypeCtorDetails = foreign,
+ TypeCtorDetails = foreign(_),
Defns = [],
LayoutInit = gen_init_null_pointer(mlds__generic_type),
FunctorInit = gen_init_null_pointer(mlds__generic_type)
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.56
diff -u -b -r1.56 type_ctor_info.m
--- compiler/type_ctor_info.m 24 Mar 2004 00:39:29 -0000 1.56
+++ compiler/type_ctor_info.m 24 Jun 2004 02:22:05 -0000
@@ -60,6 +60,7 @@
:- implementation.
:- import_module backend_libs__builtin_ops.
+:- import_module backend_libs__foreign.
:- import_module backend_libs__pseudo_type_info.
:- import_module backend_libs__rtti.
:- import_module backend_libs__type_class_info.
@@ -314,7 +315,6 @@
BuiltinCtor)
->
Details = builtin(BuiltinCtor)
-
;
ModuleName = unqualified(ModuleStr),
impl_type_ctor(ModuleStr, TypeName, TypeArity,
@@ -327,8 +327,19 @@
error("type_ctor_info__gen_type_ctor_data: " ++
"abstract_type")
;
- TypeBody = foreign_type(_, _),
- Details = foreign
+ TypeBody = foreign_type(ForeignBody, _),
+ foreign_type_body_to_exported_type(ModuleInfo,
+ ForeignBody, _, _, Assertions),
+ (
+ list__member(can_pass_as_mercury_type,
+ Assertions),
+ list__member(stable, Assertions)
+ ->
+ IsStable = is_stable
+ ;
+ IsStable = is_not_stable
+ ),
+ Details = foreign(IsStable)
;
TypeBody = eqv_type(Type),
% There can be no existentially typed args to
@@ -339,8 +350,8 @@
UnivTvars, ExistTvars, MaybePseudoTypeInfo),
Details = eqv(MaybePseudoTypeInfo)
;
- TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred,
- ReservedTag, _, _),
+ TypeBody = du_type(Ctors, ConsTagMap, Enum,
+ EqualityPred, ReservedTag, _, _),
(
EqualityPred = yes(_),
EqualityAxioms = user_defined
@@ -410,8 +421,8 @@
builtin_type_ctor("builtin", "float", 0, float).
builtin_type_ctor("builtin", "character", 0, char).
builtin_type_ctor("builtin", "void", 0, void).
-builtin_type_ctor("builtin", "c_pointer", 0, c_pointer).
-builtin_type_ctor("builtin", "stable_c_pointer", 0, stable_c_pointer).
+builtin_type_ctor("builtin", "c_pointer", 0, c_pointer(is_not_stable)).
+builtin_type_ctor("builtin", "stable_c_pointer", 0, c_pointer(is_stable)).
builtin_type_ctor("builtin", "pred", 0, pred_ctor).
builtin_type_ctor("builtin", "func", 0, func_ctor).
builtin_type_ctor("builtin", "tuple", 0, tuple).
@@ -459,7 +470,7 @@
:- func type_ctor_info_rtti_version = int.
-type_ctor_info_rtti_version = 8.
+type_ctor_info_rtti_version = 9.
% Construct an rtti_data for a pseudo_type_info,
% and also construct rtti_data definitions for all of the pseudo_type_infos
cvs server: Diffing compiler/notes
cvs server: Diffing debian
cvs server: Diffing deep_profiler
cvs server: Diffing deep_profiler/notes
cvs server: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.294
diff -u -b -r1.294 reference_manual.texi
--- doc/reference_manual.texi 9 Jun 2004 07:56:20 -0000 1.294
+++ doc/reference_manual.texi 24 Jun 2004 02:22:05 -0000
@@ -5753,9 +5753,9 @@
:- pragma foreign_type(@var{Lang}, @var{MercuryTypeName}, @var{ForeignTypeDescriptor}, [@var{ForeignTypeAssertion}, ...]).
@end example
-Currently, only one kind of assertion is supported:
- at samp{can_pass_as_mercury_type}.
-This asserts that on the C backends, values of the given type
+Currently, two kinds of assertions are supported.
+The @samp{can_pass_as_mercury_type} assertion
+states that on the C backends, values of the given type
can be passed to and from Mercury code without boxing,
via simple casts, which is faster.
This requires the type to be either an integer type or a pointer type,
@@ -5766,6 +5766,13 @@
the generated executable silently doing the wrong thing,
we do not recommend the use of assertions
unless you are an implementor of the Mercury system.
+The @samp{stable} assertion is meaningful
+only in the presence of the @samp{can_pass_as_mercury_type} assertion.
+It states that either the C type is an integer type,
+or it is a pointer type pointing to memory that will never change.
+Together, these assertions are sufficient to allow
+tabling and the @samp{compare_representation} primitive
+to work on values of such types.
As with discriminated union types, programmers can specify the unification
@w{and/or} comparison predicates to use for values of the type using the
cvs server: Diffing extras
cvs server: Diffing extras/aditi
cvs server: Diffing extras/cgi
cvs server: Diffing extras/complex_numbers
cvs server: Diffing extras/complex_numbers/samples
cvs server: Diffing extras/complex_numbers/tests
cvs server: Diffing extras/concurrency
cvs server: Diffing extras/curs
cvs server: Diffing extras/curs/samples
cvs server: Diffing extras/curses
cvs server: Diffing extras/curses/sample
cvs server: Diffing extras/dynamic_linking
cvs server: Diffing extras/error
cvs server: Diffing extras/graphics
cvs server: Diffing extras/graphics/mercury_glut
cvs server: Diffing extras/graphics/mercury_opengl
cvs server: Diffing extras/graphics/mercury_tcltk
cvs server: Diffing extras/graphics/samples
cvs server: Diffing extras/graphics/samples/calc
cvs server: Diffing extras/graphics/samples/gears
cvs server: Diffing extras/graphics/samples/maze
cvs server: Diffing extras/graphics/samples/pent
cvs server: Diffing extras/lazy_evaluation
cvs server: Diffing extras/lex
cvs server: Diffing extras/lex/samples
cvs server: Diffing extras/lex/tests
cvs server: Diffing extras/logged_output
cvs server: Diffing extras/moose
cvs server: Diffing extras/moose/samples
cvs server: Diffing extras/moose/tests
cvs server: Diffing extras/morphine
cvs server: Diffing extras/morphine/non-regression-tests
cvs server: Diffing extras/morphine/scripts
cvs server: Diffing extras/morphine/source
cvs server: Diffing extras/odbc
cvs server: Diffing extras/posix
cvs server: Diffing extras/quickcheck
cvs server: Diffing extras/quickcheck/tutes
cvs server: Diffing extras/references
cvs server: Diffing extras/references/samples
cvs server: Diffing extras/references/tests
cvs server: Diffing extras/stream
cvs server: Diffing extras/trailed_update
cvs server: Diffing extras/trailed_update/samples
cvs server: Diffing extras/trailed_update/tests
cvs server: Diffing extras/xml
cvs server: Diffing extras/xml/samples
cvs server: Diffing java
cvs server: Diffing java/runtime
Index: java/runtime/TypeCtorRep.java
===================================================================
RCS file: /home/mercury1/repository/mercury/java/runtime/TypeCtorRep.java,v
retrieving revision 1.4
diff -u -b -r1.4 TypeCtorRep.java
--- java/runtime/TypeCtorRep.java 13 May 2003 08:51:53 -0000 1.4
+++ java/runtime/TypeCtorRep.java 24 Jun 2004 02:22:05 -0000
@@ -50,7 +50,8 @@
public static final int MR_TYPECTOR_REP_FOREIGN = 37;
public static final int MR_TYPECTOR_REP_REFERENCE = 38;
public static final int MR_TYPECTOR_REP_STABLE_C_POINTER = 39;
- public static final int MR_TYPECTOR_REP_UNKNOWN = 40;
+ public static final int MR_TYPECTOR_REP_STABLE_FOREIGN = 40;
+ public static final int MR_TYPECTOR_REP_UNKNOWN = 41;
// Instance variable for TypeCtorRep objects.
cvs server: Diffing library
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.52
diff -u -b -r1.52 rtti_implementation.m
--- library/rtti_implementation.m 26 Feb 2004 08:17:54 -0000 1.52
+++ library/rtti_implementation.m 24 Jun 2004 02:22:05 -0000
@@ -149,6 +149,7 @@
; foreign
; reference
; stable_c_pointer
+ ; stable_foreign
; unknown.
% We keep all the other types abstract.
@@ -260,6 +261,8 @@
NumFunctors = -1
; TypeCtorRep = foreign,
NumFunctors = -1
+ ; TypeCtorRep = stable_foreign,
+ NumFunctors = -1
; TypeCtorRep = reference,
NumFunctors = -1
@@ -400,6 +403,8 @@
fail
; TypeCtorRep = foreign,
fail
+ ; TypeCtorRep = stable_foreign,
+ fail
; TypeCtorRep = reference,
fail
@@ -1287,6 +1292,11 @@
;
TypeCtorRep = foreign,
Functor = "<<foreign>>",
+ Arity = 0,
+ Arguments = []
+ ;
+ TypeCtorRep = stable_foreign,
+ Functor = "<<stable_foreign>>",
Arity = 0,
Arguments = []
;
cvs server: Diffing profiler
cvs server: Diffing robdd
cvs server: Diffing runtime
Index: runtime/mercury_construct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_construct.c,v
retrieving revision 1.12
diff -u -b -r1.12 mercury_construct.c
--- runtime/mercury_construct.c 20 Oct 2003 07:29:31 -0000 1.12
+++ runtime/mercury_construct.c 24 Jun 2004 02:22:05 -0000
@@ -167,6 +167,7 @@
case MR_TYPECTOR_REP_TRAIL_PTR:
case MR_TYPECTOR_REP_TICKET:
case MR_TYPECTOR_REP_FOREIGN:
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
case MR_TYPECTOR_REP_REFERENCE:
return MR_FALSE;
@@ -327,6 +328,7 @@
case MR_TYPECTOR_REP_TRAIL_PTR:
case MR_TYPECTOR_REP_TICKET:
case MR_TYPECTOR_REP_FOREIGN:
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
case MR_TYPECTOR_REP_REFERENCE:
return -1;
Index: runtime/mercury_deconstruct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deconstruct.c,v
retrieving revision 1.15
diff -u -b -r1.15 mercury_deconstruct.c
--- runtime/mercury_deconstruct.c 13 May 2003 08:52:06 -0000 1.15
+++ runtime/mercury_deconstruct.c 24 Jun 2004 02:22:05 -0000
@@ -295,6 +295,7 @@
case MR_TYPECTOR_REP_TUPLE:
case MR_TYPECTOR_REP_ARRAY:
case MR_TYPECTOR_REP_FOREIGN:
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
case MR_TYPECTOR_REP_UNKNOWN:
return MR_FALSE;
}
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.66
diff -u -b -r1.66 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 21 Jan 2004 02:52:37 -0000 1.66
+++ runtime/mercury_deep_copy_body.h 24 Jun 2004 02:22:05 -0000
@@ -592,7 +592,8 @@
case MR_TYPECTOR_REP_HP:
assert(MR_tag(data) == 0);
if (in_range((MR_Word *) data)) {
- MR_fatal_error("Sorry, not implemented: copying saved heap pointer");
+ MR_fatal_error("Sorry, not implemented: "
+ "copying saved heap pointer");
} else {
new_data = data;
}
@@ -629,6 +630,10 @@
}
return new_data;
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
+ /* by definition, stable foreign values are never relocated */
+ return data;
+
case MR_TYPECTOR_REP_FOREIGN:
{
MR_Word *data_value;
@@ -636,9 +641,9 @@
data_value = (MR_Word *) MR_strip_tag(data);
/*
- ** XXX It is bad that the behaviour here depends on
- ** the value of the foreign type. But I don't see any
- ** better alternative at the moment.
+ ** Foreign types that are not pointers should not have
+ ** MR_TYPECTOR_REP_FOREIGN; instead, they should have
+ ** MR_TYPECTOR_REP_STABLE_FOREIGN.
*/
if (lower_limit != NULL && !in_range(data_value)) {
/*
Index: runtime/mercury_mcpp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.h,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_mcpp.h
--- runtime/mercury_mcpp.h 23 Oct 2003 02:08:55 -0000 1.30
+++ runtime/mercury_mcpp.h 24 Jun 2004 02:22:05 -0000
@@ -9,11 +9,9 @@
// It is written using Managed Extensions for C++ (usually called Managed C++
// or MC++).
-
// We need a definition of NULL
#include <stddef.h>
-
namespace mercury {
typedef int MR_Integer;
@@ -33,15 +31,12 @@
typedef System::String *MR_String;
typedef void (*MR_Cont) (void *);
-
// Should these be MR_ qualified?
#define TRUE 1
#define FALSE 0
#define MR_TRUE 1
#define MR_FALSE 0
-
-
typedef __gc public class System::Object * MR_Word[];
typedef __gc public class System::Object * MR_Box;
typedef __gc public class System::Array * MR_Array;
@@ -68,7 +63,6 @@
typedef __gc public class System::Object * MR_TypeInfoParams[];
typedef __gc public class System::Object * MR_TypeClassInfo[];
-
// XXX This code is duplicated in mercury_type_info.h.
// We should factor out these definitions and use a shared version.
@@ -133,7 +127,7 @@
#define MR_TYPECTOR_REP(a) MR_BOX_INT(mercury::runtime::Constants::a)
// XXX This is hardcoded
-#define MR_RTTI_VERSION MR_BOX_INT(8)
+#define MR_RTTI_VERSION MR_BOX_INT(9)
// XXX It is intended that we eventually define the constants in
// private_builtin.m and mercury_mcpp.cpp in terms of these #defines
@@ -178,7 +172,8 @@
#define MR_TYPECTOR_REP_FOREIGN_val 37
#define MR_TYPECTOR_REP_REFERENCE_val 38
#define MR_TYPECTOR_REP_STABLE_C_POINTER_val 39
-#define MR_TYPECTOR_REP_UNKNOWN_val 40
+#define MR_TYPECTOR_REP_STABLE_FOREIGN_val 40
+#define MR_TYPECTOR_REP_UNKNOWN_val 41
// XXX we should integrate this macro in with the version in
// mercury_typeinfo.h
@@ -244,7 +239,6 @@
#define MR_list_tail(List) \
(dynamic_cast<MR_Word>((List)->GetValue(2)))
-
// Some definitions for writing code by hand that constructs any type.
#define MR_newobj(Obj, Tag, Size) \
@@ -278,11 +272,9 @@
#define MR_newenum(Obj, Tag) \
MR_newobj(Obj, Tag, 0)
-
// A few macros to define some RTTI slots.
// At the moment RTTI support in the .NET backend is very minimal.
-
#define MR_TYPEINFO_TYPE_CTOR_INFO_SLOT 0
#define MR_TYPE_CTOR_INFO_ARITY_SLOT 0
@@ -290,4 +282,3 @@
#define MR_TYPE_CTOR_INFO_COMPARE_PRED_SLOT 6
} /* end namespace mercury */
-
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.32
diff -u -b -r1.32 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h 23 May 2004 22:16:51 -0000 1.32
+++ runtime/mercury_ml_expand_body.h 24 Jun 2004 02:22:05 -0000
@@ -1161,6 +1161,11 @@
handle_zero_arity_args();
return;
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
+ handle_functor_name("<<stable_foreign>>");
+ handle_zero_arity_args();
+ return;
+
case MR_TYPECTOR_REP_REFERENCE:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.62
diff -u -b -r1.62 mercury_tabling.c
--- runtime/mercury_tabling.c 31 May 2004 04:13:06 -0000 1.62
+++ runtime/mercury_tabling.c 24 Jun 2004 02:22:05 -0000
@@ -1032,6 +1032,14 @@
*/
MR_DEBUG_TABLE_INT(table, data);
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
+ /*
+ ** This works because a stable foreign type guarantees that the
+ ** data structures pointed to, indirectly as well as directly,
+ ** will remain stable until the program exits.
+ */
+ MR_DEBUG_TABLE_INT(table, data);
+
case MR_TYPECTOR_REP_TYPEINFO:
case MR_TYPECTOR_REP_TYPEDESC:
MR_DEBUG_TABLE_TYPEINFO(table, (MR_TypeInfo) data);
Index: runtime/mercury_term_size.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_term_size.c,v
retrieving revision 1.1
diff -u -b -r1.1 mercury_term_size.c
--- runtime/mercury_term_size.c 20 Oct 2003 07:29:32 -0000 1.1
+++ runtime/mercury_term_size.c 24 Jun 2004 02:22:05 -0000
@@ -280,6 +280,7 @@
case MR_TYPECTOR_REP_C_POINTER:
case MR_TYPECTOR_REP_STABLE_C_POINTER:
case MR_TYPECTOR_REP_FOREIGN:
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
#ifdef MR_DEBUG_TERM_SIZES
if (MR_heapdebug && MR_lld_print_enabled) {
printf("MR_term_size: c_pointer/foreign %p\n", (void *) term);
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.113
diff -u -b -r1.113 mercury_type_info.h
--- runtime/mercury_type_info.h 19 May 2004 03:59:52 -0000 1.113
+++ runtime/mercury_type_info.h 24 Jun 2004 02:22:05 -0000
@@ -75,7 +75,7 @@
** compiler/type_ctor_info.m and with MR_RTTI_VERSION in mercury_mcpp.h.
*/
-#define MR_RTTI_VERSION MR_RTTI_VERSION__FLAG
+#define MR_RTTI_VERSION MR_RTTI_VERSION__STABLE_FOREIGN
#define MR_RTTI_VERSION__INITIAL 2
#define MR_RTTI_VERSION__USEREQ 3
#define MR_RTTI_VERSION__CLEAN_LAYOUT 4
@@ -83,6 +83,7 @@
#define MR_RTTI_VERSION__COMPACT 6
#define MR_RTTI_VERSION__REP 7
#define MR_RTTI_VERSION__FLAG 8
+#define MR_RTTI_VERSION__STABLE_FOREIGN 9
/*
** Check that the RTTI version is in a sensible range.
@@ -614,6 +615,7 @@
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_FOREIGN),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_REFERENCE),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_STABLE_C_POINTER),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_STABLE_FOREIGN),
/*
** MR_TYPECTOR_REP_UNKNOWN should remain the last alternative;
** MR_TYPE_CTOR_STATS depends on this.
@@ -679,6 +681,7 @@
"FOREIGN", \
"REFERENCE", \
"STABLE_C_POINTER", \
+ "STABLE_FOREIGN", \
"UNKNOWN"
extern MR_ConstString MR_ctor_rep_name[];
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.35
diff -u -b -r1.35 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 19 May 2004 03:59:54 -0000 1.35
+++ runtime/mercury_unify_compare_body.h 24 Jun 2004 02:22:05 -0000
@@ -405,6 +405,7 @@
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_ARRAY:
case MR_TYPECTOR_REP_FOREIGN:
+ case MR_TYPECTOR_REP_STABLE_FOREIGN:
/*
** We call the type-specific compare routine as
@@ -574,6 +575,9 @@
**
** XXX This is a temporary measure.
*/
+#ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_STABLE_FOREIGN: /* fallthru */
+#endif
case MR_TYPECTOR_REP_STABLE_C_POINTER: /* fallthru */
case MR_TYPECTOR_REP_C_POINTER:
#ifdef select_compare_code
cvs server: Diffing runtime/GETOPT
cvs server: Diffing runtime/machdeps
cvs server: Diffing samples
cvs server: Diffing samples/c_interface
cvs server: Diffing samples/c_interface/c_calls_mercury
cvs server: Diffing samples/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/c_interface/mercury_calls_c
cvs server: Diffing samples/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/c_interface/mercury_calls_fortran
cvs server: Diffing samples/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/diff
cvs server: Diffing samples/muz
cvs server: Diffing samples/rot13
cvs server: Diffing samples/solutions
cvs server: Diffing samples/tests
cvs server: Diffing samples/tests/c_interface
cvs server: Diffing samples/tests/c_interface/c_calls_mercury
cvs server: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs server: Diffing samples/tests/c_interface/mercury_calls_c
cvs server: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs server: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs server: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs server: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs server: Diffing samples/tests/diff
cvs server: Diffing samples/tests/muz
cvs server: Diffing samples/tests/rot13
cvs server: Diffing samples/tests/solutions
cvs server: Diffing samples/tests/toplevel
cvs server: Diffing scripts
cvs server: Diffing tests
cvs server: Diffing tests/benchmarks
cvs server: Diffing tests/debugger
cvs server: Diffing tests/debugger/declarative
cvs server: Diffing tests/dppd
cvs server: Diffing tests/general
cvs server: Diffing tests/general/accumulator
cvs server: Diffing tests/general/string_format
cvs server: Diffing tests/general/structure_reuse
cvs server: Diffing tests/grade_subdirs
cvs server: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.232
diff -u -b -r1.232 Mmakefile
--- tests/hard_coded/Mmakefile 19 May 2004 03:59:59 -0000 1.232
+++ tests/hard_coded/Mmakefile 24 Jun 2004 02:22:05 -0000
@@ -381,6 +381,7 @@
$(BACKEND_PROGS_2) \
compare_representation \
compare_rep_usereq \
+ stable_foreign \
type_tables
else
BACKEND_PROGS =
Index: tests/hard_coded/stable_foreign.exp
===================================================================
RCS file: tests/hard_coded/stable_foreign.exp
diff -N tests/hard_coded/stable_foreign.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/stable_foreign.exp 24 Jun 2004 02:22:05 -0000
@@ -0,0 +1,27 @@
+5 u= 5
+5 c= 5
+5 r= 5
+5 u!= 21
+5 c< 21
+5 r< 21
+5 u!= 38
+5 c< 38
+5 r< 38
+21 u= 21
+21 c= 21
+21 r= 21
+21 u!= 5
+21 c> 5
+21 r> 5
+21 u!= 38
+21 c< 38
+21 r< 38
+38 u!= 5
+38 c> 5
+38 r> 5
+38 u!= 21
+38 c> 21
+38 r> 21
+38 u= 38
+38 c= 38
+38 r= 38
Index: tests/hard_coded/stable_foreign.m
===================================================================
RCS file: tests/hard_coded/stable_foreign.m
diff -N tests/hard_coded/stable_foreign.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/stable_foreign.m 24 Jun 2004 02:22:05 -0000
@@ -0,0 +1,115 @@
+:- module stable_foreign.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+main(!IO) :-
+ init(Base),
+ offset(Base, 10, First),
+ offset(Base, 42, Second),
+ offset(Base, 77, Third),
+ test(First, First, !IO),
+ test(First, Second, !IO),
+ test(First, Third, !IO),
+ test(Second, Second, !IO),
+ test(Second, First, !IO),
+ test(Second, Third, !IO),
+ test(Third, First, !IO),
+ test(Third, Second, !IO),
+ test(Third, Third, !IO).
+
+:- pred test(ptr::in, ptr::in, io::di, io::uo) is cc_multi.
+
+test(P1, P2, !IO) :-
+ rep(P1, V1),
+ rep(P2, V2),
+
+ io__write_int(V1, !IO),
+ ( unify(P1, P2) ->
+ io__write_string(" u= ", !IO)
+ ;
+ io__write_string(" u!= ", !IO)
+ ),
+ io__write_int(V2, !IO),
+ io__write_string("\n", !IO),
+
+ compare(R, P1, P2),
+ io__write_int(V1, !IO),
+ (
+ R = (<),
+ io__write_string(" c< ", !IO)
+ ;
+ R = (=),
+ io__write_string(" c= ", !IO)
+ ;
+ R = (>),
+ io__write_string(" c> ", !IO)
+ ),
+ io__write_int(V2, !IO),
+ io__write_string("\n", !IO),
+
+ compare_representation(RR, P1, P2),
+ io__write_int(V1, !IO),
+ (
+ RR = (<),
+ io__write_string(" r< ", !IO)
+ ;
+ RR = (=),
+ io__write_string(" r= ", !IO)
+ ;
+ RR = (>),
+ io__write_string(" r> ", !IO)
+ ),
+ io__write_int(V2, !IO),
+ io__write_string("\n", !IO).
+
+:- pragma foreign_decl(c, "
+#define STABLE_FOREIGN_MAX 100
+static int stable_foreign_array[STABLE_FOREIGN_MAX];
+").
+
+:- type ptr.
+:- pragma foreign_type(c, ptr, "int *", [can_pass_as_mercury_type, stable]).
+
+:- pred init(ptr::out) is det.
+
+:- pragma foreign_proc(c,
+ init(Ptr::out),
+ [will_not_call_mercury, promise_pure],
+"
+ int i;
+
+ for (i = 0; i < STABLE_FOREIGN_MAX ; i++) {
+ stable_foreign_array[i] = i/2;
+ }
+
+ Ptr = &stable_foreign_array[0];
+").
+
+:- pred offset(ptr::in, int::in, ptr::out) is det.
+
+:- pragma foreign_proc(c,
+ offset(Base::in, N::in, Ptr::out),
+ [will_not_call_mercury, promise_pure],
+"
+ /* Base */
+ if (0 <= N && N < STABLE_FOREIGN_MAX) {
+ Ptr = &stable_foreign_array[N];
+ } else {
+ MR_fatal_error(""bad offset"");
+ }
+").
+
+:- pred rep(ptr::in, int::out) is det.
+
+:- pragma foreign_proc(c,
+ rep(Ptr::in, Val::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Val = *Ptr;
+").
cvs server: Diffing tests/hard_coded/exceptions
cvs server: Diffing tests/hard_coded/purity
cvs server: Diffing tests/hard_coded/sub-modules
cvs server: Diffing tests/hard_coded/typeclasses
cvs server: Diffing tests/invalid
cvs server: Diffing tests/invalid/purity
cvs server: Diffing tests/misc_tests
cvs server: Diffing tests/mmc_make
cvs server: Diffing tests/mmc_make/lib
cvs server: Diffing tests/recompilation
cvs server: Diffing tests/tabling
cvs server: Diffing tests/term
cvs server: Diffing tests/valid
cvs server: Diffing tests/warnings
cvs server: Diffing tools
cvs server: Diffing trace
cvs server: Diffing util
cvs server: Diffing vim
cvs server: Diffing vim/after
cvs server: Diffing vim/ftplugin
cvs server: Diffing vim/syntax
--------------------------------------------------------------------------
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