[m-rev.] for review: refactor mlds_to_il.m
Peter Ross
peter.ross at miscrit.be
Wed Jul 11 00:50:22 AEST 2001
===================================================================
Estimated hours taken: 2
Branches: main
compiler/ml_elim_nested.m:
compiler/mlds.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
Address review comments of fjh.
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.30
diff -u -r1.30 ml_elim_nested.m
--- compiler/ml_elim_nested.m 9 Jul 2001 15:55:04 -0000 1.30
+++ compiler/ml_elim_nested.m 10 Jul 2001 14:45:39 -0000
@@ -373,13 +373,22 @@
EnvTypeEntityName = type(EnvClassName, 0),
EnvTypeFlags = env_type_decl_flags,
Fields = list__map(convert_local_to_field, LocalVars),
+
+ % IL uses classes instead of structs, so the code
+ % generated needs to be a little different.
+ % XXX Perhaps if we used value classes this could go
+ % away.
+ globals__get_target(Globals, Target),
( Target = il ->
+ % Generate a ctor for the class which
+ % initilaises the commit field.
ThisPtr = self(mlds__commit_type),
FieldType = mlds__commit_type,
CtorType = mlds__commit_type,
- % PtrType is unused by the IL backend.
- % so this field is the wrong type.
- PtrType = mlds__commit_type,
+ PtrType = EnvTypeName,
+
+ % Note we have to do the correct name mangling
+ % for the IL backend.
FieldName = qual(mlds__append_name(ModuleName,
EnvClassName ++ "_0"), "commit_1"),
Lval = field(no, ThisPtr, named_field(FieldName, CtorType),
@@ -418,11 +427,7 @@
% initialize the `env_ptr' with the address of `env'
%
EnvVar = qual(ModuleName, mlds__var_name("env", no)),
- globals__get_target(Globals, Target),
- % IL uses classes instead of structs, so the code
- % generated needs to be a little different.
- % XXX Perhaps if we used value classes this could go
- % away.
+
( Target = il ->
EnvVarAddr = lval(var(EnvVar, EnvTypeName)),
ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
@@ -572,6 +577,9 @@
% type declaration.
:- func env_type_decl_flags = mlds__decl_flags.
env_type_decl_flags = MLDS_DeclFlags :-
+ % On the IL backend we use classes instead of structs so
+ % these fields must be accessible to the mercury_code
+ % class in the same assembly, hence the public access.
Access = public,
PerInstance = one_copy,
Virtuality = non_virtual,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.58
diff -u -r1.58 mlds.m
--- compiler/mlds.m 10 Jul 2001 12:51:03 -0000 1.58
+++ compiler/mlds.m 10 Jul 2001 14:45:40 -0000
@@ -298,14 +298,19 @@
%
:- type mlds
---> mlds(
- mercury_module_name, % The Mercury module name
+ % The Mercury module name.
+ name :: mercury_module_name,
- mlds__foreign_code, % Code defined in some other language,
- % e.g. for `pragma c_header_code', etc.
+ % Code defined in some other language, e.g. for
+ % `pragma c_header_code', etc.
+ foreign_code :: mlds__foreign_code,
+
+ % The MLDS code itself
+ % Packages/classes to import
+ toplevel_imports :: mlds__imports,
- % The MLDS code itself
- mlds__imports, % Packages/classes to import
- mlds__defns % Definitions of code and data
+ % Definitions of code and data
+ defns :: mlds__defns
).
:- func mlds__get_module_name(mlds) = mercury_module_name.
@@ -352,7 +357,12 @@
:- func mlds__append_class_qualifier(mlds_module_name, mlds__class_name, arity) =
mlds_module_name.
+% Append a mercury_code qualifier to the module name and leave the
+% package name unchanged.
:- func mlds__append_mercury_code(mlds_module_name) = mlds_module_name.
+
+% Append an arbitarty qualifier to the module name and leave the package
+% name unchanged.
:- func mlds__append_name(mlds_module_name, string) = mlds_module_name.
:- type mlds__defns == list(mlds__defn).
@@ -609,8 +619,9 @@
; protected % only accessible to the class and to
% derived classes
; private % only accessible to the class
- ; default % Java "default" access: accessible to anything
- % defined in the same package.
+ ; default % Java "default" access or .NET assembly
+ % access: accessible to anything defined
+ % in the same package.
%
% used for entities defined in a block/2 statement,
% i.e. local variables and nested functions
@@ -1494,8 +1505,7 @@
string__format("%s_%d", [s(ClassName), i(ClassArity)],
ClassQualifier).
-mlds__append_mercury_code(name(Package, Module))
- = name(Package, qualified(Module, "mercury_code")).
+mlds__append_mercury_code(Name) = mlds__append_name(Name, "mercury_code").
mlds__append_name(name(Package, Module), Name)
= name(Package, qualified(Module, Name)).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.93
diff -u -r1.93 mlds_to_c.m
--- compiler/mlds_to_c.m 9 Jul 2001 15:55:05 -0000 1.93
+++ compiler/mlds_to_c.m 10 Jul 2001 14:45:41 -0000
@@ -964,7 +964,8 @@
{ Ctors = [] ->
true
;
- error("mlds_output_class: non empty constructor list")
+ unexpected(this_file,
+ "mlds_output_class: non empty constructor list")
},
( { Kind = mlds__enum } ->
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.43
diff -u -r1.43 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 9 Jul 2001 15:55:06 -0000 1.43
+++ compiler/mlds_to_gcc.m 10 Jul 2001 14:45:41 -0000
@@ -1268,7 +1268,7 @@
{ Ctors = [] ->
true
;
- sorry(this_file, "constructors")
+ unexpected(this_file, "constructors")
},
( { Kind = mlds__enum } ->
{ StaticMembers = [] },
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.39
diff -u -r1.39 mlds_to_il.m
--- compiler/mlds_to_il.m 10 Jul 2001 12:51:03 -0000 1.39
+++ compiler/mlds_to_il.m 10 Jul 2001 14:45:46 -0000
@@ -233,29 +233,19 @@
%-----------------------------------------------------------------------------%
% Move all the top level methods and data definitions into the
- % mercury_code class, and then rename all the definitions as
- % necessary to reflect this new hierachy.
+ % mercury_code class, and then fix all the references so that
+ % they refer to their new names.
:- func transform_mlds(mlds) = mlds.
-transform_mlds(mlds(MercuryModuleName, ForeignCode, Imports, Defns))
- = mlds(
- MercuryModuleName,
- ForeignCode,
- Imports,
- [mercury_code_class(list__map(rename_defn, Members)) | Others]
- ) :-
+transform_mlds(MLDS0) = MLDS :-
list__filter((pred(D::in) is semidet :-
( D = mlds__defn(_, _, _, mlds__function(_, _, _))
- % XXX we need to place all the RTTI
- % datastructures inside this class, so
- % they are generated as fields.
- % Maybe what we should do is make all
- % the RTTI data structures nested
- % classes. I think that would work
- % better.
; D = mlds__defn(_, _, _, mlds__data(_, _))
)
- ), Defns, Members, Others).
+ ), MLDS0 ^ defns, MercuryCodeMembers, Others),
+ MLDS = MLDS0 ^ defns := [mercury_code_class(
+ list__map(rename_defn, MercuryCodeMembers)) | Others].
+
:- func mercury_code_class(mlds__defns) = mlds__defn.
@@ -263,8 +253,7 @@
= mlds__defn(
export("mercury_code"),
mlds__make_context(term__context_init),
- init_decl_flags(public, per_instance, non_virtual,
- final, const, concrete),
+ ml_gen_type_decl_flags,
mlds__class(
mlds__class_defn(mlds__package, [], [], [], [], Members)
)
@@ -284,7 +273,7 @@
),
Entity = function(MaybePredProcId, Params, MaybeStmt)
; Entity0 = class(_),
- sorry(this_file, "renaming nested classes")
+ unexpected(this_file, "nested class")
).
:- func rename_statement(mlds__statement) = mlds__statement.
@@ -359,9 +348,9 @@
rename_atomic(comment(S)) = comment(S).
rename_atomic(assign(L, R)) = assign(rename_lval(L), rename_rval(R)).
rename_atomic(delete_object(O)) = delete_object(rename_lval(O)).
-rename_atomic(new_object(L, T, Type, MaybeSize, C, Args, Types))
- = new_object(rename_lval(L), T, Type, MaybeSize,
- C, list__map(rename_rval, Args), Types).
+rename_atomic(new_object(L, Tag, Type, MaybeSize, Ctxt, Args, Types))
+ = new_object(rename_lval(L), Tag, Type, MaybeSize,
+ Ctxt, list__map(rename_rval, Args), Types).
rename_atomic(mark_hp(L)) = mark_hp(rename_lval(L)).
rename_atomic(restore_hp(R)) = restore_hp(rename_rval(R)).
rename_atomic(trail_op(T)) = trail_op(T).
@@ -394,18 +383,11 @@
:- func rename_code_addr(mlds__code_addr) = mlds__code_addr.
rename_code_addr(proc(Label, Signature))
- = proc(rename_label(Label), Signature).
+ = proc(rename_proc_label(Label), Signature).
rename_code_addr(internal(Label, Seq, Signature))
- = internal(rename_label(Label), Seq, Signature).
-
-:- func rename_data_addr(data_addr) = data_addr.
-
-rename_data_addr(data_addr(ModuleName, Name))
- = data_addr(append_mercury_code(ModuleName), Name).
+ = internal(rename_proc_label(Label), Seq, Signature).
-:- func rename_label(mlds__qualified_proc_label) = mlds__qualified_proc_label.
-
-rename_label(qual(Module, Name)) = qual(append_mercury_code(Module), Name).
+rename_proc_label(qual(Module, Name)) = qual(append_mercury_code(Module), Name).
:- func rename_lval(mlds__lval) = mlds__lval.
@@ -420,11 +402,6 @@
rename_field_id(offset(Rval)) = offset(rename_rval(Rval)).
rename_field_id(named_field(Name, Type)) = named_field(Name, Type).
-:- func rename_var(mlds__var, mlds__type) = mlds__var.
-
-rename_var(qual(ModuleName, Name), _Type)
- = qual(append_mercury_code(ModuleName), Name).
-
:- func rename_initializer(mlds__initializer) = mlds__initializer.
rename_initializer(init_obj(Rval)) = init_obj(rename_rval(Rval)).
@@ -434,6 +411,23 @@
= init_array(list__map(rename_initializer, Inits)).
rename_initializer(no_initializer) = no_initializer.
+ % We need to append a mercury_code so that we access the RTTI
+ % fields correctly.
+:- func rename_data_addr(data_addr) = data_addr.
+
+rename_data_addr(data_addr(ModuleName, Name))
+ = data_addr(append_mercury_code(ModuleName), Name).
+
+ % We need to append a mercury_code so that we refer to the
+ % methods of the mercury_code class.
+:- func rename_proc_label(mlds__qualified_proc_label) =
+ mlds__qualified_proc_label.
+
+ % Again append a mercury_code to the var name.
+:- func rename_var(mlds__var, mlds__type) = mlds__var.
+
+rename_var(qual(ModuleName, Name), _Type)
+ = qual(append_mercury_code(ModuleName), Name).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -441,6 +435,10 @@
:- pred mlds_defn_to_ilasm_decl(mlds__defn::in, ilasm__decl::out,
il_info::in, il_info::out) is det.
+ % IL supports top-level (i.e. "global") function definitions and
+ % data definitions, but they're not part of the CLS.
+ % Since they are not part of the CLS, we don't generate them,
+ % and so there's no need to handle them here.
mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags, data(_Type, _Init)),
_Decl, Info, Info) :-
sorry(this_file, "top level data definition!").
@@ -478,9 +476,9 @@
IlCtors, Info2, Info3),
MethodsAndFieldsAndCtors = IlCtors ++ MethodsAndFields,
- % XXX Maybe it would be better to just check to see
- % whether or not there are any init instructions than
- % explicitly checking for the name mercury_code.
+ % Only the mercury_code class needs to have the
+ % initialization instructions executed by the class
+ % constructor.
( EntityName = "mercury_code" ->
Imports = Info3 ^ imports,
InitInstrs = list__condense(tree__flatten(Info3 ^ init_instrs)),
@@ -508,6 +506,9 @@
class_name(Module, Name) = structured_name(Assembly, ClassName ++ [Name]) :-
ClassName = sym_name_to_list(mlds_module_name_to_sym_name(Module)),
+ % Any name beginning with mercury is in the standard
+ % library. The standard library is placed into one
+ % assembly called mercury.
( ClassName = ["mercury" | _] ->
Assembly = "mercury"
;
@@ -565,7 +566,7 @@
; AccessFlag = private,
Access = [private]
; AccessFlag = default,
- error("decl_flags_to_methattrs: default access flag")
+ Access = [assembly]
; AccessFlag = local,
error("decl_flags_to_methattrs: local access flag")
),
@@ -607,7 +608,7 @@
; AccessFlag = private,
Access = [private]
; AccessFlag = default,
- error("decl_flags_to_fieldattrs: default access flag")
+ Access = [assembly]
; AccessFlag = local,
error("decl_flags_to_fieldattrs: local access flag")
),
--------------------------------------------------------------------------
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