[m-rev.] [dotnet-foreign] diff: specify location of foreign_type
Peter Ross
peter.ross at miscrit.be
Wed Apr 11 21:17:50 AEST 2001
Hi,
===================================================================
Estimated hours taken: 4
Branches: dotnet-foreign
Add an extra field to the foreign_type pragma which specifiers where
that foreign type is located.
compiler/hlds_data.m:
compiler/mlds.m:
compiler/prog_data.m:
Record where a foreign type can be found.
compiler/prog_io_pragma.m:
Parse the new field to the foreign_type pragma.
compiler/make_hlds.m:
Store the foreign_type location in the hlds_type_body.
compiler/mlds_to_il.m:
Record in the class name for a foreign type where it is found.
compiler/mlds_to_ilasm.m:
Place the foreign_code decls outside the namespace generation code.
compiler/export.m:
compiler/hlds_out.m:
compiler/intermod.m:
compiler/magic_util.m:
compiler/mercury_to_mercury.m:
compiler/ml_type_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_java.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/term_util.m:
compiler/type_ctor_info.m:
compiler/unify_proc.m:
Changes to the handle the changed foreign_type constructor.
Index: export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.46.8.1
diff -u -r1.46.8.1 export.m
--- export.m 2001/04/09 14:07:48 1.46.8.1
+++ export.m 2001/04/11 11:06:55
@@ -621,7 +621,7 @@
% XXX how we output the type depends on
% which foreign language we are using.
hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = foreign_type(ForeignType) ->
+ ( Body = foreign_type(ForeignType, _) ->
Result = sym_name_to_string(ForeignType) ++ " *"
;
Result = "MR_Word"
Index: hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.53.4.1
diff -u -r1.53.4.1 hlds_data.m
--- hlds_data.m 2001/04/09 14:07:50 1.53.4.1
+++ hlds_data.m 2001/04/11 11:06:55
@@ -284,14 +284,20 @@
---> du_type(
list(constructor), % the ctors for this type
cons_tag_values, % their tag values
- bool, % is this type an enumeration?
- maybe(sym_name) % user-defined equality pred
+ bool, % is this type an enumeration?
+ maybe(sym_name) % user-defined equality pred
)
- ; uu_type(list(type)) % not yet implemented!
+ ; uu_type(list(type)) % not yet implemented!
; eqv_type(type)
; abstract_type
- ; foreign_type(sym_name). % Name of foreign type which represents
- % the mercury type.
+ ; foreign_type(
+ sym_name, % Structured name of foreign
+ % type which represents
+ % the mercury type.
+ string % String which represents
+ % where I can find this
+ % type.
+ ).
% The `cons_tag_values' type stores the information on how
% a discriminated union type is represented.
Index: hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.258.2.1
diff -u -r1.258.2.1 hlds_out.m
--- hlds_out.m 2001/04/09 14:07:51 1.258.2.1
+++ hlds_out.m 2001/04/11 11:06:56
@@ -2570,7 +2570,7 @@
hlds_out__write_type_body(_Indent, _Tvarset, abstract_type) -->
io__write_string(".\n").
-hlds_out__write_type_body(_Indent, _Tvarset, foreign_type(_)) -->
+hlds_out__write_type_body(_Indent, _Tvarset, foreign_type(_, _)) -->
{ error("hlds_out__write_type_body: foreign type body found") }.
:- pred hlds_out__write_constructors(int, tvarset, list(constructor),
Index: intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.97.2.1
diff -u -r1.97.2.1 intermod.m
--- intermod.m 2001/04/09 14:07:54 1.97.2.1
+++ intermod.m 2001/04/11 11:06:57
@@ -1257,7 +1257,7 @@
mercury_output_type_defn(VarSet,
abstract_type(Name, Args), Context)
;
- { Body = foreign_type(_) },
+ { Body = foreign_type(_, _) },
{ error("foreign types not implemented") }
).
Index: magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.12.14.1
diff -u -r1.12.14.1 magic_util.m
--- magic_util.m 2001/04/09 14:08:04 1.12.14.1
+++ magic_util.m 2001/04/11 11:06:57
@@ -1380,7 +1380,7 @@
{ error("magic_util__check_type_defn: eqv_type") }.
magic_util__check_type_defn(abstract_type, _, Errors0, Errors) -->
{ set__insert(Errors0, abstract, Errors) }.
-magic_util__check_type_defn(foreign_type(_), _, _, _) -->
+magic_util__check_type_defn(foreign_type(_, _), _, _, _) -->
{ error("magic_util__check_type_defn: foreign_type") }.
:- pred magic_util__check_ctor(set(type_id)::in, constructor::in,
Index: make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.368.2.1
diff -u -r1.368.2.1 make_hlds.m
--- make_hlds.m 2001/04/09 14:08:05 1.368.2.1
+++ make_hlds.m 2001/04/11 11:07:00
@@ -414,11 +414,12 @@
{ Module = Module0 }
;
% XXXX
- { Pragma = foreign_type(MercuryType, _, ForeignType) },
+ { Pragma = foreign_type(MercuryType, _, ForeignType,
+ ForeignTypeLocation) },
{ module_info_types(Module0, Types0) },
{ type_to_type_id(MercuryType, TypeId, _) ->
- Body = foreign_type(ForeignType),
+ Body = foreign_type(ForeignType, ForeignTypeLocation),
hlds_data__set_type_defn(varset__init, [], Body,
ImportStatus, Context, TypeDefn),
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.184.2.1
diff -u -r1.184.2.1 mercury_to_mercury.m
--- mercury_to_mercury.m 2001/04/09 14:08:13 1.184.2.1
+++ mercury_to_mercury.m 2001/04/11 11:07:01
@@ -359,13 +359,16 @@
PredOrFunc, Vars, VarSet, PragmaCode)
;
{ Pragma = foreign_type(_MercuryType,
- MercuryTypeSymName, ForeignType) },
+ MercuryTypeSymName, ForeignType,
+ ForeignTypeLoc) },
io__write_string(":- pragma foreign_type("),
% output_type(varset__init, no, MercuryType),
mercury_output_sym_name(MercuryTypeSymName),
io__write_string(", "),
mercury_output_sym_name(ForeignType),
- io__write_string(").\n")
+ io__write_string(", \""),
+ io__write_string(ForeignTypeLoc),
+ io__write_string("\").\n")
;
{ Pragma = import(Pred, PredOrFunc, ModeList, Attributes,
C_Function) },
Index: ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.5.4.1
diff -u -r1.5.4.1 ml_type_gen.m
--- ml_type_gen.m 2001/04/09 14:08:20 1.5.4.1
+++ ml_type_gen.m 2001/04/11 11:07:01
@@ -107,7 +107,7 @@
Ctors, TagValues, MaybeEqualityMembers)
).
% XXXX
-ml_gen_type_2(foreign_type(_), _, _, _) -->
+ml_gen_type_2(foreign_type(_, _), _, _, _) -->
{ error("sorry, foreign types not implemented") }.
%-----------------------------------------------------------------------------%
Index: mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.49.4.1
diff -u -r1.49.4.1 mlds.m
--- mlds.m 2001/04/09 14:08:22 1.49.4.1
+++ mlds.m 2001/04/11 11:07:01
@@ -513,7 +513,7 @@
% This is a type of the MLDS target language. Currently
% this is only used by the il backend.
- ; mlds__foreign_type(sym_name)
+ ; mlds__foreign_type(sym_name, string)
% MLDS types defined using mlds__class_defn
; mlds__class_type(
@@ -1396,8 +1396,8 @@
map__search(Types, TypeId, TypeDefn)
->
hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = foreign_type(ForeignType) ->
- MLDS_Type = mlds__foreign_type(ForeignType)
+ ( Body = foreign_type(ForeignType, ForeignLoc) ->
+ MLDS_Type = mlds__foreign_type(ForeignType, ForeignLoc)
;
MLDS_Type = mercury_type(Type, Category, TypeString)
)
Index: mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.83.4.2
diff -u -r1.83.4.2 mlds_to_c.m
--- mlds_to_c.m 2001/04/11 09:08:19 1.83.4.2
+++ mlds_to_c.m 2001/04/11 11:07:02
@@ -620,7 +620,7 @@
io__write_string("MR_Float").
mlds_output_pragma_export_type(prefix, mlds__native_char_type) -->
io__write_string("MR_Char").
-mlds_output_pragma_export_type(prefix, mlds__foreign_type(_)) -->
+mlds_output_pragma_export_type(prefix, mlds__foreign_type(_, _)) -->
{ error("mlds_output_pragma_export_type: foreign_type") }.
mlds_output_pragma_export_type(prefix, mlds__class_type(_, _, _)) -->
io__write_string("MR_Word").
@@ -1526,7 +1526,7 @@
mlds_output_type_prefix(mlds__native_float_type) --> io__write_string("float").
mlds_output_type_prefix(mlds__native_bool_type) --> io__write_string("bool").
mlds_output_type_prefix(mlds__native_char_type) --> io__write_string("char").
-mlds_output_type_prefix(mlds__foreign_type(_)) -->
+mlds_output_type_prefix(mlds__foreign_type(_, _)) -->
{ error("mlds_output_type_prefix: foreign_type") }.
mlds_output_type_prefix(mlds__class_type(Name, Arity, ClassKind)) -->
( { ClassKind = mlds__enum } ->
@@ -1685,7 +1685,7 @@
mlds_output_type_suffix(mlds__native_float_type, _) --> [].
mlds_output_type_suffix(mlds__native_bool_type, _) --> [].
mlds_output_type_suffix(mlds__native_char_type, _) --> [].
-mlds_output_type_suffix(mlds__foreign_type(_), _) --> [].
+mlds_output_type_suffix(mlds__foreign_type(_, _), _) --> [].
mlds_output_type_suffix(mlds__class_type(_, _, _), _) --> [].
mlds_output_type_suffix(mlds__ptr_type(_), _) --> [].
mlds_output_type_suffix(mlds__array_type(_), ArraySize) -->
Index: mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.15.4.4
diff -u -r1.15.4.4 mlds_to_il.m
--- mlds_to_il.m 2001/04/11 10:09:06 1.15.4.4
+++ mlds_to_il.m 2001/04/11 11:07:03
@@ -1809,11 +1809,10 @@
mlds_type_to_ilds_type(mlds__native_float_type) = ilds__type([], float64).
-mlds_type_to_ilds_type(mlds__foreign_type(ForeignType))
+mlds_type_to_ilds_type(mlds__foreign_type(ForeignType, Assembly))
= ilds__type([], Class) :-
- % XXX we should really get the assembly right here.
sym_name_to_class_name(ForeignType, ForeignClassName),
- Class = class(structured_name("", ForeignClassName)).
+ Class = class(structured_name(Assembly, ForeignClassName)).
mlds_type_to_ilds_type(mlds__ptr_type(MLDSType)) =
Index: mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.8.4.3
diff -u -r1.8.4.3 mlds_to_ilasm.m
--- mlds_to_ilasm.m 2001/04/11 10:09:06 1.8.4.3
+++ mlds_to_ilasm.m 2001/04/11 11:07:04
@@ -196,15 +196,15 @@
"extern ""C"" int _fltused=0;\n",
"\n"]),
+ generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
+ ForeignCode),
+
{ Namespace = get_class_namespace(ClassName) },
io__write_list(Namespace, "\n",
(pred(N::in, di, uo) is det -->
io__format("namespace %s {", [s(N)])
)),
-
- generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
- ForeignCode),
io__write_strings([
"\n__gc public class ",
Index: mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.2.4.1
diff -u -r1.2.4.1 mlds_to_java.m
--- mlds_to_java.m 2001/04/09 14:08:26 1.2.4.1
+++ mlds_to_java.m 2001/04/11 11:07:04
@@ -875,7 +875,7 @@
get_java_type_initializer(mlds__native_int_type) = "0".
get_java_type_initializer(mlds__native_float_type) = "0".
get_java_type_initializer(mlds__native_char_type) = "0".
-get_java_type_initializer(mlds__foreign_type(_)) = _ :-
+get_java_type_initializer(mlds__foreign_type(_, _)) = _ :-
unexpected(this_file,
"get_type_initializer: variable has foreign_type").
get_java_type_initializer(mlds__class_type(_, _, _)) = "null".
@@ -1216,7 +1216,7 @@
output_type(mlds__native_float_type) --> io__write_string("double").
output_type(mlds__native_bool_type) --> io__write_string("boolean").
output_type(mlds__native_char_type) --> io__write_string("char").
-output_type(mlds__foreign_type(_)) -->
+output_type(mlds__foreign_type(_, _)) -->
{ unexpected(this_file, "output_type: foreign_type NYI.") }.
output_type(mlds__class_type(Name, Arity, ClassKind)) -->
( { ClassKind = mlds__enum } ->
Index: module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.65.2.1
diff -u -r1.65.2.1 module_qual.m
--- module_qual.m 2001/04/09 14:08:27 1.65.2.1
+++ module_qual.m 2001/04/11 11:07:05
@@ -211,7 +211,7 @@
collect_mq_info_2(pred_mode(_,_,_,_,_), Info, Info).
collect_mq_info_2(func_mode(_,_,_,_,_,_), Info, Info).
collect_mq_info_2(pragma(Pragma), Info0, Info) :-
- ( Pragma = foreign_type(_Type, SymName, _ForeignType) ->
+ ( Pragma = foreign_type(_Type, SymName, _ForeignType, _ForeignLoc) ->
add_type_defn(abstract_type(SymName, []), Info0, Info)
;
Info = Info0
@@ -906,8 +906,8 @@
qualify_pragma(source_file(File), source_file(File), Info, Info) --> [].
qualify_pragma(foreign_decl(L, Code), foreign_decl(L, Code), Info, Info) --> [].
qualify_pragma(foreign_code(L, C), foreign_code(L, C), Info, Info) --> [].
-qualify_pragma(foreign_type(Type0, SymName, F),
- foreign_type(Type, SymName, F), Info0, Info) -->
+qualify_pragma(foreign_type(Type0, SymName, F, L),
+ foreign_type(Type, SymName, F, L), Info0, Info) -->
qualify_type(Type0, Type, Info0, Info).
qualify_pragma(
foreign_proc(Rec, SymName, PredOrFunc, PragmaVars0, Varset, Code),
Index: modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.158.2.1
diff -u -r1.158.2.1 modules.m
--- modules.m 2001/04/09 14:08:29 1.158.2.1
+++ modules.m 2001/04/11 11:07:06
@@ -1029,7 +1029,7 @@
pragma_allowed_in_interface(foreign_decl(_, _), no).
pragma_allowed_in_interface(foreign_code(_, _), no).
pragma_allowed_in_interface(foreign_proc(_, _, _, _, _, _), no).
-pragma_allowed_in_interface(foreign_type(_, _, _), yes).
+pragma_allowed_in_interface(foreign_type(_, _, _, _), yes).
pragma_allowed_in_interface(inline(_, _), no).
pragma_allowed_in_interface(no_inline(_, _), no).
pragma_allowed_in_interface(obsolete(_, _), yes).
Index: prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.65.2.1
diff -u -r1.65.2.1 prog_data.m
--- prog_data.m 2001/04/09 14:08:35 1.65.2.1
+++ prog_data.m 2001/04/11 11:07:07
@@ -159,8 +159,9 @@
% PredName, Predicate or Function, Vars/Mode,
% VarNames, Foreign Code Implementation Info
- ; foreign_type((type), sym_name, sym_name)
- % MercuryType, MercuryTypeName, ForeignType
+ ; foreign_type((type), sym_name, sym_name, string)
+ % MercuryType, MercuryTypeName, ForeignType,
+ % ForeignTypeLocation
; type_spec(sym_name, sym_name, arity, maybe(pred_or_func),
maybe(list(mode)), type_subst, tvarset)
Index: prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.30.2.1
diff -u -r1.30.2.1 prog_io_pragma.m
--- prog_io_pragma.m 2001/04/09 14:08:37 1.30.2.1
+++ prog_io_pragma.m 2001/04/11 11:07:07
@@ -72,7 +72,7 @@
parse_pragma_type(ModuleName, "foreign_type", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
- ( PragmaTerms = [MercuryName, ForeignName] ->
+ ( PragmaTerms = [MercuryName, ForeignName, ForeignLocation] ->
parse_implicitly_qualified_term(ModuleName, MercuryName,
ErrorTerm, "`:- pragma unused_args' declaration",
MaybeMercuryType),
@@ -85,9 +85,19 @@
(
MaybeForeignType = ok(ForeignType, ForeignArgs),
( ForeignArgs = [] ->
- term__coerce(MercuryName, MercuryType),
- Result = ok(pragma(foreign_type(MercuryType,
- MercuryTypeSymName, ForeignType)))
+ (
+ ForeignLocation = term__functor(
+ term__string(ForeignLocationString), [], _)
+ ->
+ term__coerce(MercuryName, MercuryType),
+ Result = ok(pragma(foreign_type(MercuryType,
+ MercuryTypeSymName, ForeignType,
+ ForeignLocationString)))
+ ;
+ Result = error(
+ "foreign type location not a string",
+ ForeignLocation)
+ )
;
Result = error("foreign type arity not 0", ErrorTerm)
)
Index: term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.14.14.1
diff -u -r1.14.14.1 term_util.m
--- term_util.m 2001/04/09 14:08:39 1.14.14.1
+++ term_util.m 2001/04/11 11:07:07
@@ -270,7 +270,7 @@
Weights = Weights0
;
% This type does not introduce any functors
- TypeBody = foreign_type(_),
+ TypeBody = foreign_type(_, _),
Weights = Weights0
).
Index: type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.13.4.1
diff -u -r1.13.4.1 type_ctor_info.m
--- type_ctor_info.m 2001/04/09 14:08:41 1.13.4.1
+++ type_ctor_info.m 2001/04/11 11:07:08
@@ -88,7 +88,7 @@
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
TypeBody \= abstract_type,
% XXXX
- TypeBody \= foreign_type(_),
+ TypeBody \= foreign_type(_, _),
\+ type_id_has_hand_defined_rtti(TypeId)
->
type_ctor_info__gen_type_ctor_gen_info(TypeId,
@@ -264,7 +264,7 @@
NumPtags = -1
;
% XXXX
- TypeBody = foreign_type(_),
+ TypeBody = foreign_type(_, _),
TypeCtorRep = unknown,
NumFunctors = -1,
FunctorsInfo = no_functors,
Index: unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.92.4.1
diff -u -r1.92.4.1 unify_proc.m
--- unify_proc.m 2001/04/09 14:08:41 1.92.4.1
+++ unify_proc.m 2001/04/11 11:07:08
@@ -745,7 +745,7 @@
{ TypeBody = abstract_type },
{ error("trying to create unify proc for abstract type") }
;
- { TypeBody = foreign_type(_) },
+ { TypeBody = foreign_type(_, _) },
{ error("trying to create unify proc for foreign type") }
).
@@ -802,7 +802,7 @@
{ TypeBody = abstract_type },
{ error("trying to create index proc for abstract type") }
;
- { TypeBody = foreign_type(_) },
+ { TypeBody = foreign_type(_, _) },
{ error("trying to create index proc for foreign type") }
).
@@ -872,7 +872,7 @@
{ TypeBody = abstract_type },
{ error("trying to create compare proc for abstract type") }
;
- { TypeBody = foreign_type(_) },
+ { TypeBody = foreign_type(_, _) },
{ error("trying to create compare proc for foreign type") }
).
--------------------------------------------------------------------------
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