[m-dev.] for review: changes to MLDS
Julien Fischer
juliensf at students.cs.mu.oz.au
Wed Jan 31 13:15:12 AEDT 2001
Estimated hours taken: 9
General improvements and bug fixes to the MLDS backend, most
of which were prompted by working on the Java backend.
The definition of mlds__lval now includes type information for
variables. This is necessary because if enumerations are treated
as objects (as in the Java backend) rather than integers we need to know
when to create new objects. At the level this occurs there was
previously no way to distinguish between an integer that is an integer,
and one that represents an enumeration.
Added the access specifier `local' to the declaration flags. This fixes
a bug in which the local variables of a function were being declared
`private'.
Redefined ctor_name so that they are fully qualified. This was necessary
because the Java backend represents discriminated unions as nested
classes and we need to be able to determine the fully qualified name of
the constructor in order to call it, do casts, etc.
Added `mlds__unknown_type' to `mlds__type'. This is due to the change
in the definition of mlds_lval above. In ml_code_util.m, env_ptr's are
created as dangling references. The new definition of mlds__lval expects
there to be a type as well, but at this point it hasn't been
generated (and won't be until the ml_elim_nested pass). Rather than just
guess the type we should declare the type to be unknown and print out an
error message if an unknown type makes it through to one of the backends.
Fixed a bug in the `--det-copy-out' option.
compiler/mlds.m:
Added `local' as an access specifier.
Extended definition of mlds__lval to include type information
for variables.
Added `mlds__unknown_type' to the mlds types so that when
the compiler generates variables without yet knowing their
type we can mark them as this, rather than hoping that the
correct types eventually get added.
Redefined ctor_name so that it is fully qualified.
Made changes to comments to reflect above changes.
compiler/ml_code_gen.m:
Mark the generated functions as `one_copy' rather than `per_instance',
so that they get generated as static methods for the Java back-end.
Fixed a bug with the --det-copy-out option.
compiler/ml_code_util.m:
Fixed a bug that was causing the wrong declaration flags to be
set for fields in du constructors.
Changed the name of the predicate `ml_qualify_var' to
`ml_gen_var_lval'.
compiler/ml_type_gen.m:
Mark the generated types as `one_copy' rather than `per_instance',
so that they get generated as static nested classes for the Java
back-end.
Changed comments to reflect that classes and enumeration constants
should be static.
Export functions that generate declaration flags because they
are used in other modules as well.
Added a new predicate `ml_gen_mlds_field_decl' that correctly
generates fields of classes in discriminated unions.
compiler/ml_unify_gen.m:
Changed the code that generates ctor_id's so that it generates
the new sort.
compiler/ml_call_gen.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_string_switch.m:
compiler/ml_tailcall.m:
compiler/mlds_to_il.m:
compiler/mlds_to_c.m:
compiler/mlds_to_ilasm.m:
compiler/mlds_to_rtti.m:
Fixed things so that they conform to the changes above.
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.19
diff -u -r1.19 ml_call_gen.m
--- compiler/ml_call_gen.m 2000/12/03 02:22:38 1.19
+++ compiler/ml_call_gen.m 2001/01/31 01:41:58
@@ -207,7 +207,7 @@
FuncVarName) },
{ FuncVarDecl = ml_gen_mlds_var_decl(var(FuncVarName), FuncType,
mlds__make_context(Context)) },
- ml_qualify_var(FuncVarName, FuncVarLval),
+ ml_gen_var_lval(FuncVarName, FuncType, FuncVarLval),
{ AssignFuncVar = ml_gen_assign(FuncVarLval, FuncRval, Context) },
{ FuncVarRval = lval(FuncVarLval) },
@@ -475,8 +475,8 @@
ml_gen_new_func_label(yes(Params),
ContFuncLabel, ContFuncLabelRval),
/* push nesting level */
- ml_gen_copy_args_to_locals(OutputArgLvals, Context,
- CopyDecls, CopyStatements),
+ ml_gen_copy_args_to_locals(OutputArgLvals, OutputArgTypes,
+ Context, CopyDecls, CopyStatements),
ml_gen_call_current_success_cont(Context, CallCont),
{ CopyStatement = ml_gen_block(CopyDecls,
list__append(CopyStatements, [CallCont]), Context) },
@@ -513,26 +513,33 @@
{ Argument = data(var(ArgName)) - Type },
ml_gen_cont_params_2(Types, ArgNum + 1, Arguments).
-:- pred ml_gen_copy_args_to_locals(list(mlds__lval), prog_context,
- mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
-:- mode ml_gen_copy_args_to_locals(in, in, out, out, in, out) is det.
+:- pred ml_gen_copy_args_to_locals(list(mlds__lval), list(mlds__type),
+ prog_context, mlds__defns, mlds__statements,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_copy_args_to_locals(in, in, in, out, out, in, out) is det.
-ml_gen_copy_args_to_locals(ArgLvals, Context, CopyDecls, CopyStatements) -->
+ml_gen_copy_args_to_locals(ArgLvals, ArgTypes, Context,
+ CopyDecls, CopyStatements) -->
{ CopyDecls = [] },
- ml_gen_copy_args_to_locals_2(ArgLvals, 1, Context, CopyStatements).
+ ml_gen_copy_args_to_locals_2(ArgLvals, ArgTypes, 1, Context,
+ CopyStatements).
-:- pred ml_gen_copy_args_to_locals_2(list(mlds__lval), int, prog_context,
- mlds__statements, ml_gen_info, ml_gen_info).
-:- mode ml_gen_copy_args_to_locals_2(in, in, in, out, in, out) is det.
-
-ml_gen_copy_args_to_locals_2([], _, _, []) --> [].
-ml_gen_copy_args_to_locals_2([LocalLval | LocalLvals], ArgNum, Context,
- [Statement | Statements]) -->
+:- pred ml_gen_copy_args_to_locals_2(list(mlds__lval), list(mlds__type), int,
+ prog_context, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_copy_args_to_locals_2(in, in, in, in, out, in, out) is det.
+
+ml_gen_copy_args_to_locals_2([], [], _, _, []) --> [].
+ml_gen_copy_args_to_locals_2([LocalLval | LocalLvals], [Type|Types], ArgNum,
+ Context, [Statement | Statements]) -->
{ ArgName = ml_gen_arg_name(ArgNum) },
- ml_qualify_var(ArgName, ArgLval),
+ ml_gen_var_lval(ArgName, Type, ArgLval),
{ Statement = ml_gen_assign(LocalLval, lval(ArgLval), Context) },
- ml_gen_copy_args_to_locals_2(LocalLvals, ArgNum + 1, Context,
+ ml_gen_copy_args_to_locals_2(LocalLvals, Types, ArgNum + 1, Context,
Statements).
+ml_gen_copy_args_to_locals_2([], [_|_], _, _, _) -->
+ { error("ml_gen_copy_args_to_locals_2: list length mismatch") }.
+ml_gen_copy_args_to_locals_2([_|_], [], _, _, _) -->
+ { error("ml_gen_copy_args_to_locals_2: list length mismatch") }.
:- func ml_gen_arg_name(int) = string.
ml_gen_arg_name(ArgNum) = ArgName :-
@@ -773,8 +780,8 @@
%
% If that didn't work, then we need to declare a fresh variable
% to use as the arg, and to generate statements to box/unbox
- % that fresh arg variable and assign it to/from the output argument
- % whose address we were passed.
+ % that fresh arg variable and assign it to/from the output
+ % argument whose address we were passed.
%
% generate a declaration for the fresh variable
@@ -789,7 +796,8 @@
% create the lval for the variable and use it for the
% argument lval
- ml_qualify_var(ArgVarName, ArgLval),
+ ml_gen_type(CalleeType, MLDS_CalleeType),
+ ml_gen_var_lval(ArgVarName, MLDS_CalleeType, ArgLval),
( { type_util__is_dummy_argument_type(CallerType) } ->
% if it is a dummy argument type (e.g. io__state),
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.74
diff -u -r1.74 ml_code_gen.m
--- compiler/ml_code_gen.m 2001/01/23 06:01:04 1.74
+++ compiler/ml_code_gen.m 2001/01/31 01:41:58
@@ -1014,7 +1014,7 @@
;
Access = private
),
- PerInstance = per_instance,
+ PerInstance = one_copy,
Virtuality = non_virtual,
Finality = overridable,
Constness = modifiable,
@@ -1074,25 +1074,40 @@
% value (rather than being passed by reference) and remove
% them from the byref_output_vars field in the ml_gen_info.
( CodeModel = model_non ->
- ml_set_up_initial_succ_cont(ModuleInfo,
+
+ ml_set_up_initial_succ_cont(ModuleInfo,
CopiedOutputVars, MLDSGenInfo0, MLDSGenInfo1)
+ ;
+
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, det_copy_out,
+ DetCopyOut),
+ (
+ DetCopyOut = yes
+ ->
+ % all of the output vars are returned by value
+ % rather than passed by reference
+ ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
+ OutputVars),
+ CopiedOutputVars = OutputVars,
+ ml_gen_info_set_byref_output_vars([],
+ MLDSGenInfo0, MLDSGenInfo1)
;
- (
- is_output_det_function(ModuleInfo, PredId,
- ProcId, ResultVar)
- ->
+ is_output_det_function(ModuleInfo, PredId, ProcId,
+ ResultVar)
+ ->
CopiedOutputVars = [ResultVar],
ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
ByRefOutputVars0),
- list__delete_all(ByRefOutputVars0,
- ResultVar, ByRefOutputVars),
+ list__delete_all(ByRefOutputVars0, ResultVar,
+ ByRefOutputVars),
ml_gen_info_set_byref_output_vars(
- ByRefOutputVars,
- MLDSGenInfo0, MLDSGenInfo1)
+ ByRefOutputVars, MLDSGenInfo0, MLDSGenInfo1)
;
CopiedOutputVars = [],
MLDSGenInfo1 = MLDSGenInfo0
)
+
),
% This would generate all the local variables at the top of
@@ -1573,7 +1588,7 @@
ml_gen_info_new_commit_label(CommitLabelNum),
{ string__format("commit_%d", [i(CommitLabelNum)],
CommitRef) },
- ml_qualify_var(CommitRef, CommitRefLval),
+ ml_gen_var_lval(CommitRef, mlds__commit_type, CommitRefLval),
{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
CommitRef) },
{ DoCommitStmt = do_commit(lval(CommitRefLval)) },
@@ -1658,7 +1673,7 @@
ml_gen_info_new_commit_label(CommitLabelNum),
{ string__format("commit_%d", [i(CommitLabelNum)],
CommitRef) },
- ml_qualify_var(CommitRef, CommitRefLval),
+ ml_gen_var_lval(CommitRef, mlds__commit_type, CommitRefLval),
{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
CommitRef) },
{ DoCommitStmt = do_commit(lval(CommitRefLval)) },
@@ -1691,7 +1706,6 @@
[TryCommitStatement], Context,
CommitFuncDecls, MLDS_Statements),
{ MLDS_Decls = LocalVarDecls ++ CommitFuncDecls },
-
ml_gen_info_set_var_lvals(OrigVarLvalMap)
;
% no commit required
@@ -1848,21 +1862,21 @@
%
=(MLDSGenInfo),
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
- { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ OutputVarName = ml_gen_var_name(VarSet, OutputVar) },
%
% Generate a declaration for a corresponding local variable.
- %
{ string__append("local_", OutputVarName, LocalVarName) },
- { LocalVarDefn = ml_gen_var_decl(LocalVarName, Type,
- mlds__make_context(Context), ModuleInfo) },
-
+
+ ml_gen_type(Type, MLDS_Type),
+ { LocalVarDefn = ml_gen_mlds_var_decl(var(LocalVarName), MLDS_Type,
+ mlds__make_context(Context)) },
+
%
% Generate code to assign from the local var to the output var
%
ml_gen_var(OutputVar, OutputVarLval),
- ml_qualify_var(LocalVarName, LocalVarLval),
+ ml_gen_var_lval(LocalVarName, MLDS_Type, LocalVarLval),
{ Assign = ml_gen_assign(OutputVarLval, lval(LocalVarLval), Context) },
%
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.32
diff -u -r1.32 ml_code_util.m
--- compiler/ml_code_util.m 2000/12/10 07:39:39 1.32
+++ compiler/ml_code_util.m 2001/01/31 01:41:58
@@ -220,12 +220,12 @@
%
:- func ml_gen_var_name(prog_varset, prog_var) = mlds__var_name.
- % Qualify the name of the specified variable
- % with the current module name.
+ % Generate an lval from the variable name and type. The variable
+ % name will be qualified with the current module name.
%
-:- pred ml_qualify_var(mlds__var_name, mlds__lval,
+:- pred ml_gen_var_lval(mlds__var_name, mlds__type, mlds__lval,
ml_gen_info, ml_gen_info).
-:- mode ml_qualify_var(in, out, in, out) is det.
+:- mode ml_gen_var_lval(in, in, out, in, out) is det.
% Generate a declaration for an MLDS variable, given its HLDS type.
%
@@ -243,6 +243,15 @@
:- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type, mlds__initializer,
mlds__context) = mlds__defn.
+ % Generate declaration flags for a local variable
+ %
+ %
+:- func ml_gen_local_var_decl_flags = mlds__decl_flags.
+
+ % Generate declaration flags for a public field
+ % of a class.
+ %
+:- func ml_gen_public_field_decl_flags = mlds__decl_flags.
%-----------------------------------------------------------------------------%
%
% Routines for dealing with static constants
@@ -563,13 +572,15 @@
% Set the `const' sequence number
% corresponding to a given HLDS variable.
%
-:- pred ml_gen_info_set_const_num(prog_var, const_seq, ml_gen_info, ml_gen_info).
+:- pred ml_gen_info_set_const_num(prog_var, const_seq,
+ ml_gen_info, ml_gen_info).
:- mode ml_gen_info_set_const_num(in, in, in, out) is det.
% Lookup the `const' sequence number
% corresponding to a given HLDS variable.
%
-:- pred ml_gen_info_lookup_const_num(prog_var, const_seq, ml_gen_info, ml_gen_info).
+:- pred ml_gen_info_lookup_const_num(prog_var, const_seq,
+ ml_gen_info, ml_gen_info).
:- mode ml_gen_info_lookup_const_num(in, out, in, out) is det.
%
@@ -890,7 +901,8 @@
%
:- func ml_gen_label_func_decl_flags = mlds__decl_flags.
ml_gen_label_func_decl_flags = MLDS_DeclFlags :-
- Access = private,
+ Access = private, % XXX if we're using nested functions,
+ % this should be `local' rather than `private'
PerInstance = per_instance,
Virtuality = non_virtual,
Finality = overridable,
@@ -1277,18 +1289,19 @@
%
{ mercury_private_builtin_module(PrivateBuiltin) },
{ MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin) },
- { Lval = var(qual(MLDS_Module, "dummy_var")) }
+ ml_gen_type(Type, MLDS_Type),
+ { Lval = var(qual(MLDS_Module, "dummy_var"), MLDS_Type) }
;
=(MLDSGenInfo),
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
{ VarName = ml_gen_var_name(VarSet, Var) },
- ml_qualify_var(VarName, VarLval),
+ ml_gen_type(Type, MLDS_Type),
+ ml_gen_var_lval(VarName, MLDS_Type, VarLval),
%
% output variables may be passed by reference...
%
{ ml_gen_info_get_byref_output_vars(MLDSGenInfo, OutputVars) },
( { list__member(Var, OutputVars) } ->
- ml_gen_type(Type, MLDS_Type),
{ Lval = mem_ref(lval(VarLval), MLDS_Type) }
;
{ Lval = VarLval }
@@ -1338,11 +1351,11 @@
% Qualify the name of the specified variable
% with the current module name.
%
-ml_qualify_var(VarName, QualifiedVarLval) -->
+ml_gen_var_lval(VarName, VarType, QualifiedVarLval) -->
=(MLDSGenInfo),
{ ml_gen_info_get_module_name(MLDSGenInfo, ModuleName) },
{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
- { QualifiedVarLval = var(qual(MLDS_Module, VarName)) }.
+ { QualifiedVarLval = var(qual(MLDS_Module, VarName), VarType) }.
% Generate a declaration for an MLDS variable, given its HLDS type.
%
@@ -1362,7 +1375,7 @@
ml_gen_mlds_var_decl(DataName, MLDS_Type, Initializer, Context) = MLDS_Defn :-
Name = data(DataName),
Defn = data(MLDS_Type, Initializer),
- DeclFlags = ml_gen_var_decl_flags,
+ DeclFlags = ml_gen_local_var_decl_flags,
MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
% Generate a definition of a local static constant,
@@ -1376,10 +1389,10 @@
MLDS_Context = mlds__make_context(Context),
MLDS_Defn = mlds__defn(Name, MLDS_Context, DeclFlags, Defn).
- % Return the declaration flags appropriate for a local variable.
+ % Return the declaration flags appropriate for a public field
+ % in the derived constructor class of a discriminated union.
%
-:- func ml_gen_var_decl_flags = mlds__decl_flags.
-ml_gen_var_decl_flags = MLDS_DeclFlags :-
+ml_gen_public_field_decl_flags = MLDS_DeclFlags :-
Access = public,
PerInstance = per_instance,
Virtuality = non_virtual,
@@ -1389,14 +1402,25 @@
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Virtuality, Finality, Constness, Abstractness).
+ % Return the declaration flags appropriate for a local variable.
+ml_gen_local_var_decl_flags = MLDS_DeclFlags :-
+ Access = local,
+ PerInstance = per_instance,
+ Virtuality = non_virtual,
+ Finality = overridable,
+ Constness = modifiable,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
+
% Return the declaration flags appropriate for an
% initialized local static constant.
%
ml_static_const_decl_flags = MLDS_DeclFlags :-
- Access = private,
+ Access = local,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = overridable,
+ Finality = final,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
@@ -1497,9 +1521,8 @@
% Return the lval for the `succeeded' flag.
% (`succeeded' is a boolean variable used to record
% the success or failure of model_semi procedures.)
- %
ml_success_lval(SucceededLval) -->
- ml_qualify_var("succeeded", SucceededLval).
+ ml_gen_var_lval("succeeded", mlds__native_bool_type, SucceededLval).
% Return an rval which will test the value of the `succeeded' flag.
% (`succeeded' is a boolean variable used to record
@@ -1529,7 +1552,8 @@
mlds__native_bool_type, Context).
ml_cond_var_lval(CondVar, CondVarLval) -->
- ml_qualify_var(ml_gen_cond_var_name(CondVar), CondVarLval).
+ ml_gen_var_lval(ml_gen_cond_var_name(CondVar), mlds__native_bool_type,
+ CondVarLval).
ml_gen_test_cond_var(CondVar, CondVarRval) -->
ml_cond_var_lval(CondVar, CondVarLval),
@@ -1542,11 +1566,12 @@
%-----------------------------------------------------------------------------%
ml_initial_cont(OutputVarLvals0, OutputVarTypes0, Cont) -->
- ml_qualify_var("cont", ContLval),
- ml_qualify_var("cont_env_ptr", ContEnvLval),
{ ml_skip_dummy_argument_types(OutputVarTypes0, OutputVarLvals0,
OutputVarTypes, OutputVarLvals) },
list__map_foldl(ml_gen_type, OutputVarTypes, MLDS_OutputVarTypes),
+ ml_gen_var_lval("cont", mlds__cont_type(MLDS_OutputVarTypes), ContLval),
+ ml_gen_var_lval("cont_env_ptr", mlds__generic_env_ptr_type,
+ ContEnvLval),
{ Cont = success_cont(lval(ContLval), lval(ContEnvLval),
MLDS_OutputVarTypes, OutputVarLvals) }.
@@ -1638,8 +1663,8 @@
ml_gen_cont_params(ArgTypes0, InnerFuncParams0),
{ InnerFuncParams0 = func_params(InnerArgs0, Rets) },
{ InnerArgRvals = list__map(
- (func(Data - _Type)
- = lval(var(qual(MLDS_Module, VarName))) :-
+ (func(Data - Type)
+ = lval(var(qual(MLDS_Module, VarName), Type)) :-
( Data = data(var(VarName0)) ->
VarName = VarName0
;
@@ -1648,7 +1673,8 @@
),
InnerArgs0) },
{ InnerFuncArgType = mlds__cont_type(ArgTypes0) },
- { InnerFuncRval = lval(var(qual(MLDS_Module, "passed_cont"))) },
+ { InnerFuncRval = lval(var(qual(MLDS_Module, "passed_cont"),
+ InnerFuncArgType)) },
{ InnerFuncParams = func_params(
[data(var("passed_cont")) - InnerFuncArgType | InnerArgs0],
Rets) },
@@ -1694,9 +1720,11 @@
% (the set of local variables in the containing procedure).
% Note that we generate this as a dangling reference.
% The ml_elim_nested pass will insert the declaration
- % of the env_ptr variable.
+ % of the env_ptr variable. At this point the type of these rvals
+ % is `mlds__unknown_type'.
+ %
ml_get_env_ptr(lval(EnvPtrLval)) -->
- ml_qualify_var("env_ptr", EnvPtrLval).
+ ml_gen_var_lval("env_ptr", mlds__unknown_type, EnvPtrLval).
% Return an rval for a pointer to the current environment
% (the set of local variables in the containing procedure).
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.20
diff -u -r1.20 ml_elim_nested.m
--- compiler/ml_elim_nested.m 2000/12/21 03:10:10 1.20
+++ compiler/ml_elim_nested.m 2001/01/31 01:41:58
@@ -329,10 +329,11 @@
FieldName = named_field(qual(EnvModuleName, VarName),
EnvPtrTypeName),
Tag = yes(0),
- EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
+ EnvPtr = lval(var(qual(ModuleName, "env_ptr"),
+ EnvPtrTypeName)),
EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType,
EnvPtrTypeName),
- ArgRval = lval(var(QualVarName)),
+ ArgRval = lval(var(QualVarName, FieldType)),
AssignToEnv = assign(EnvArgLval, ArgRval),
CodeToCopyArg = mlds__statement(atomic(AssignToEnv), Context),
@@ -401,18 +402,20 @@
% XXX Perhaps if we used value classes this could go
% away.
( Target = il ->
- EnvVarAddr = lval(var(EnvVar)),
+ EnvVarAddr = lval(var(EnvVar, EnvTypeName)),
ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
Globals, EnvPtrVarDecl, InitEnv0),
+
NewObj = mlds__statement(
- atomic(new_object(var(EnvVar),
- no, EnvTypeName, no, yes(""), [], [])),
+ atomic(new_object(
+ var(EnvVar, EnvTypeName),
+ no, EnvTypeName, no, no, [], [])),
Context),
InitEnv = mlds__statement(block([],
[NewObj, InitEnv0]), Context),
EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
;
- EnvVarAddr = mem_addr(var(EnvVar)),
+ EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
Globals, EnvPtrVarDecl, InitEnv),
EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
@@ -447,7 +450,8 @@
DefnBody0 = mlds__function(PredProcId, Params, yes(FuncBody0)),
statement_contains_var(FuncBody0, qual(ModuleName, "env_ptr"))
->
- EnvPtrVal = lval(var(qual(ModuleName, "env_ptr_arg"))),
+ EnvPtrVal = lval(var(qual(ModuleName, "env_ptr_arg"),
+ mlds__generic_env_ptr_type)),
ml_init_env(TypeName, EnvPtrVal, Context, ModuleName, Globals,
EnvPtrDecl, InitEnvPtr),
FuncBody = mlds__statement(block([EnvPtrDecl],
@@ -498,9 +502,11 @@
%
% env_ptr = (EnvPtrVarType) <EnvPtrVal>;
%
+ % XXX Do we need the cast? If so, why?
+ %
EnvPtrVar = qual(ModuleName, "env_ptr"),
- AssignEnvPtr = assign(var(EnvPtrVar), unop(cast(EnvPtrVarType),
- EnvPtrVal)),
+ AssignEnvPtr = assign(var(EnvPtrVar, EnvPtrVarType),
+ unop(cast(EnvPtrVarType), EnvPtrVal)),
InitEnvPtr = mlds__statement(atomic(AssignEnvPtr), Context).
% Given the declaration for a function parameter, produce a
@@ -986,8 +992,8 @@
fixup_rval(Rval0, Rval).
fixup_lval(mem_ref(Rval0, Type), mem_ref(Rval, Type)) -->
fixup_rval(Rval0, Rval).
-fixup_lval(var(Var0), VarLval) -->
- fixup_var(Var0, VarLval).
+fixup_lval(var(Var0, VarType), VarLval) -->
+ fixup_var(Var0, VarType, VarLval).
%-----------------------------------------------------------------------------%
@@ -997,10 +1003,10 @@
% containing function to go via the environment pointer
%
-:- pred fixup_var(mlds__var, mlds__lval, elim_info, elim_info).
-:- mode fixup_var(in, out, in, out) is det.
+:- pred fixup_var(mlds__var, mlds__type, mlds__lval, elim_info, elim_info).
+:- mode fixup_var(in, in, out, in, out) is det.
-fixup_var(ThisVar, Lval, ElimInfo, ElimInfo) :-
+fixup_var(ThisVar, ThisVarType, Lval, ElimInfo, ElimInfo) :-
ThisVar = qual(ThisVarModuleName, ThisVarName),
ModuleName = elim_info_get_module_name(ElimInfo),
Locals = elim_info_get_local_data(ElimInfo),
@@ -1021,7 +1027,8 @@
),
solutions(IsLocalVar, [FieldType])
->
- EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
+ EnvPtr = lval(var(qual(ModuleName, "env_ptr"),
+ EnvPtrVarType)),
EnvModuleName = ml_env_module_name(ClassType),
FieldName = named_field(qual(EnvModuleName, ThisVarName),
EnvPtrVarType),
@@ -1031,7 +1038,7 @@
%
% leave everything else unchanged
%
- Lval = var(ThisVar)
+ Lval = var(ThisVar, ThisVarType)
).
/*****************************
The following code is what we would have to use if we couldn't
@@ -1069,7 +1076,7 @@
%
% leave everything else unchanged
%
- Lval = var(ThisVar)
+ Lval = var(ThisVar, ThisVarType)
).
% check if the specified variable is contained in the
@@ -1490,7 +1497,7 @@
rval_contains_var(Rval, Name).
lval_contains_var(mem_ref(Rval, _Type), Name) :-
rval_contains_var(Rval, Name).
-lval_contains_var(var(Name), Name). /* this is where we can succeed! */
+lval_contains_var(var(Name, _VarType), Name). % this is where we can succeed!
%-----------------------------------------------------------------------------%
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.4
diff -u -r1.4 ml_optimize.m
--- compiler/ml_optimize.m 2000/11/21 13:37:43 1.4
+++ compiler/ml_optimize.m 2001/01/31 01:41:58
@@ -238,7 +238,7 @@
%
% don't bother assigning a variable to itself
%
- Arg = lval(var(QualVarName))
+ Arg = lval(var(QualVarName, _VarType))
->
generate_assign_args(OptInfo, Rest, Args,
Statements, TempDefns)
@@ -268,8 +268,8 @@
Statement = statement(
atomic(assign(
- var(QualVarName),
- lval(var(QualTempName)))),
+ var(QualVarName, Type),
+ lval(var(QualTempName, Type)))),
OptInfo ^ context),
generate_assign_args(OptInfo, Rest, Args, Statements0,
TempDefns0),
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.4
diff -u -r1.4 ml_string_switch.m
--- compiler/ml_string_switch.m 2000/11/23 04:32:44 1.4
+++ compiler/ml_string_switch.m 2001/01/31 01:41:58
@@ -57,13 +57,13 @@
{ SlotVarName = string__format("slot_%d", [i(SlotVarSeq)]) },
{ SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName),
mlds__native_int_type, MLDS_Context) },
- ml_qualify_var(SlotVarName, SlotVarLval),
+ ml_gen_var_lval(SlotVarName, mlds__native_int_type, SlotVarLval),
ml_gen_info_new_cond_var(StringVarSeq),
{ StringVarName = string__format("str_%d", [i(StringVarSeq)]) },
{ StringVarDefn = ml_gen_mlds_var_decl(var(StringVarName),
ml_string_type, MLDS_Context) },
- ml_qualify_var(StringVarName, StringVarLval),
+ ml_gen_var_lval(StringVarName, ml_string_type, StringVarLval),
%
% Generate new labels
@@ -114,7 +114,7 @@
{ NextSlotsDefn = ml_gen_static_const_defn(NextSlotsName,
NextSlotsType,
init_array(NextSlots), Context) },
- ml_qualify_var(NextSlotsName, NextSlotsLval),
+ ml_gen_var_lval(NextSlotsName, NextSlotsType, NextSlotsLval),
ml_gen_info_new_const(StringTableSeq),
ml_format_static_const_name("string_table", StringTableSeq,
@@ -122,7 +122,7 @@
{ StringTableType = mlds__array_type(ml_string_type) },
{ StringTableDefn = ml_gen_static_const_defn(StringTableName,
StringTableType, init_array(Strings), Context) },
- ml_qualify_var(StringTableName, StringTableLval),
+ ml_gen_var_lval(StringTableName, StringTableType ,StringTableLval),
%
% Generate code which does the hash table lookup.
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.5
diff -u -r1.5 ml_tailcall.m
--- compiler/ml_tailcall.m 2000/11/21 13:37:44 1.5
+++ compiler/ml_tailcall.m 2001/01/31 01:41:58
@@ -355,7 +355,7 @@
:- pred lval_is_local(mlds__lval).
:- mode lval_is_local(in) is semidet.
-lval_is_local(var(_)) :-
+lval_is_local(var(_, _)) :-
% We just assume it is local. (This assumption is
% true for the code generated by ml_code_gen.m.)
true.
@@ -430,7 +430,7 @@
% ever passed down to other functions, or assigned to,
% so a mem_ref lval can never refer to a local variable.
true.
-check_lval(var(Var0), Locals) :-
+check_lval(var(Var0, _), Locals) :-
\+ var_is_local(Var0, Locals).
%
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.4
diff -u -r1.4 ml_type_gen.m
--- compiler/ml_type_gen.m 2000/06/06 07:32:28 1.4
+++ compiler/ml_type_gen.m 2001/01/31 01:41:58
@@ -36,6 +36,23 @@
:- pred ml_gen_type_name(type_id, mlds__class, arity).
:- mode ml_gen_type_name(in, out, out) is det.
+ % Return the declaration flags appropriate for a type.
+ %
+:- func ml_gen_type_decl_flags = mlds__decl_flags.
+
+ % Return the declaration flags appropriate for an enumeration constant.
+ %
+:- func ml_gen_enum_constant_decl_flags = mlds__decl_flags.
+
+ % Return the declaration flags appropriate for a member variable.
+ %
+:- func ml_gen_member_decl_flags = mlds__decl_flags.
+
+ % Return the declaration flags appropriate for a member of a class
+ % that was transformed from a special predicate. These differ
+ % from normal members in that their finality is final.
+ %
+:- func ml_gen_special_member_decl_flags = mlds__decl_flags.
%-----------------------------------------------------------------------------%
:- implementation.
@@ -99,8 +116,8 @@
% For each enumeration, we generate an MLDS type of the following form:
%
% struct <ClassName> {
- % static const int <ctor1> = 0;
- % static const int <ctor2> = 1;
+ % static final const int <ctor1> = 0;
+ % static final const int <ctor2> = 1;
% ...
% int value;
% };
@@ -186,11 +203,11 @@
% For each discriminated union type, we generate an MLDS type of the
% following form:
%
- % class <ClassName> {
+ % static class <ClassName> {
% public:
% #if some_but_not_all_ctors_use_secondary_tag
% /* A nested derived class for the secondary tag */
- % class tag_type : public <ClassName> {
+ % static class tag_type : public <ClassName> {
% public:
% #endif
% #if some_ctors_use_secondary_tag
@@ -221,7 +238,7 @@
% ** secondary tag, we put the secondary tag members
% ** directly in the base class.
% */
- % class <ctor1> : public <ClassName> {
+ % static class <ctor1> : public <ClassName> {
% public:
% /*
% ** fields, one for each argument of this
@@ -231,7 +248,7 @@
% MR_Word F2;
% ...
% };
- % class <ctor2> : public <ClassName>::tag_type {
+ % static class <ctor2> : public <ClassName>::tag_type {
% public:
% ...
% };
@@ -526,10 +543,20 @@
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type)
),
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum0),
- MLDS_Defn = ml_gen_mlds_var_decl(var(FieldName), MLDS_Type,
+ MLDS_Defn = ml_gen_mlds_field_decl(var(FieldName), MLDS_Type,
mlds__make_context(Context)),
ArgNum = ArgNum0 + 1.
+
+:- func ml_gen_mlds_field_decl(mlds__data_name, mlds__type, mlds__context)
+ = mlds__defn.
+
+ml_gen_mlds_field_decl(DataName, MLDS_Type, Context) = MLDS_Defn :-
+ Name = data(DataName),
+ Defn = data(MLDS_Type, no_initializer),
+ DeclFlags = ml_gen_public_field_decl_flags,
+ MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
+
%-----------------------------------------------------------------------------%
%
% Miscellaneous helper routines.
@@ -559,12 +586,10 @@
% Routines for generating declaration flags.
%
- % Return the declaration flags appropriate for a type.
-:- func ml_gen_type_decl_flags = mlds__decl_flags.
ml_gen_type_decl_flags = MLDS_DeclFlags :-
% XXX are these right?
Access = public,
- PerInstance = per_instance,
+ PerInstance = one_copy,
Virtuality = non_virtual,
Finality = overridable,
Constness = modifiable,
@@ -572,8 +597,6 @@
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Virtuality, Finality, Constness, Abstractness).
- % Return the declaration flags appropriate for a member variable.
-:- func ml_gen_member_decl_flags = mlds__decl_flags.
ml_gen_member_decl_flags = MLDS_DeclFlags :-
Access = public,
PerInstance = per_instance,
@@ -584,14 +607,21 @@
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Virtuality, Finality, Constness, Abstractness).
- % Return the declaration flags appropriate for an enumeration constant.
-:- func ml_gen_enum_constant_decl_flags = mlds__decl_flags.
ml_gen_enum_constant_decl_flags = MLDS_DeclFlags :-
Access = public,
PerInstance = one_copy,
+ Virtuality = non_virtual,
+ Finality = final,
+ Constness = const,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
+
+ml_gen_special_member_decl_flags = MLDS_DeclFlags :-
+ Access = public,
+ PerInstance = per_instance,
Virtuality = non_virtual,
- Finality = overridable, % XXX should we use `final' instead?
- % does it make any difference?
+ Finality = final,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.27
diff -u -r1.27 ml_unify_gen.m
--- compiler/ml_unify_gen.m 2001/01/23 06:01:05 1.27
+++ compiler/ml_unify_gen.m 2001/01/31 01:41:58
@@ -307,8 +307,11 @@
% If this argument is something that would normally be allocated
% on the heap, just generate a reference to the static constant
% that we must have already generated for it.
+ % XXX This is probably wrong when `--high-level-data' is
+ % enabled.
%
- ml_gen_static_const_addr(Var, ConstAddrRval),
+ { ConstType = mlds__array_type(mlds__generic_type) },
+ ml_gen_static_const_addr(Var, ConstType, ConstAddrRval),
{ TagVal = 0 ->
TaggedRval = ConstAddrRval
;
@@ -468,7 +471,8 @@
% the pointer will not be tagged (i.e. the tag will be zero)
%
{ Tag = 0 },
- { CtorName = "<closure>" },
+ { CtorDefn = ctor_id("<closure>", 0) },
+ { QualifiedCtorId = qual(MLDS_PrivateBuiltinModule, CtorDefn) },
%
% put all the extra arguments of the closure together
@@ -480,9 +484,9 @@
% generate a `new_object' statement (or static constant)
% for the closure
%
- ml_gen_new_object(no, Tag, CtorName, Var, ExtraArgRvals, ExtraArgTypes,
- ArgVars, ArgModes, HowToConstruct, Context,
- MLDS_Decls, MLDS_Statements).
+ ml_gen_new_object(no, Tag, QualifiedCtorId, Var, ExtraArgRvals,
+ ExtraArgTypes, ArgVars, ArgModes, HowToConstruct, Context,
+ MLDS_Decls, MLDS_Statements).
%
% ml_gen_closure_wrapper:
@@ -614,7 +618,8 @@
WrapperBoxedArgTypes, WrapperArgModes, PredOrFunc, CodeModel) },
% then insert the `closure_arg' parameter
- { ClosureArg = data(var("closure_arg")) - mlds__generic_type },
+ { ClosureArgType = mlds__generic_type },
+ { ClosureArg = data(var("closure_arg")) - ClosureArgType },
{ WrapperParams0 = mlds__func_params(WrapperArgs0, WrapperRetType) },
{ WrapperParams = mlds__func_params([ClosureArg | WrapperArgs0],
WrapperRetType) },
@@ -641,10 +646,11 @@
{ ClosureName = "closure" },
{ ClosureArgName = "closure_arg" },
{ MLDS_Context = mlds__make_context(Context) },
+ { ClosureType = mlds__generic_type },
{ ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
- mlds__generic_type, MLDS_Context) },
- ml_qualify_var(ClosureName, ClosureLval),
- ml_qualify_var(ClosureArgName, ClosureArgLval),
+ ClosureType, MLDS_Context) },
+ ml_gen_var_lval(ClosureName, ClosureType, ClosureLval),
+ ml_gen_var_lval(ClosureArgName, ClosureArgType, ClosureArgLval),
{ InitClosure = ml_gen_assign(ClosureLval, lval(ClosureArgLval),
Context) },
@@ -782,7 +788,8 @@
ml_gen_wrapper_arg_lvals(Names1, Types1, Modes1,
PredOrFunc, CodeModel, Context,
Defns1, Lvals1, CopyOutLvals1),
- ml_qualify_var(Name, VarLval),
+ ml_gen_type(Type, MLDS_Type),
+ ml_gen_var_lval(Name, MLDS_Type, VarLval),
=(Info),
{ ml_gen_info_get_module_info(Info, ModuleInfo) },
{ mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode) },
@@ -832,7 +839,6 @@
% output arguments are passed by reference,
% so we need to dereference them
%
- ml_gen_type(Type, MLDS_Type),
{ Lval = mem_ref(lval(VarLval), MLDS_Type) },
{ CopyOutLvals = CopyOutLvals1 },
{ Defns = Defns1 }
@@ -1012,6 +1018,8 @@
%
% Generate a local static constant for this term.
+ % XXX This is probably wrong when `--high-level-data'
+ % is enabled.
%
ml_gen_static_const_name(Var, ConstName),
{ ConstType = mlds__array_type(mlds__generic_type) },
@@ -1024,7 +1032,7 @@
% Assign the address of the local static constant to
% the variable.
%
- ml_gen_static_const_addr(Var, ConstAddrRval),
+ ml_gen_static_const_addr(Var, ConstType, ConstAddrRval),
{ MaybeTag = no ->
TaggedRval = ConstAddrRval
;
@@ -1145,7 +1153,7 @@
% Return as the boxed rval the address of that constant,
% cast to mlds__generic_type
%
- ml_qualify_var(ConstName, ConstLval),
+ ml_gen_var_lval(ConstName, Type, ConstLval),
{ ConstAddrRval = mem_addr(ConstLval) },
{ BoxedRval = unop(cast(mlds__generic_type), ConstAddrRval) }
;
@@ -1194,19 +1202,28 @@
% Generate an rval containing the address of the local static constant
% for a given variable.
%
-:- pred ml_gen_static_const_addr(prog_var, mlds__rval,
+:- pred ml_gen_static_const_addr(prog_var, mlds__type, mlds__rval,
ml_gen_info, ml_gen_info).
-:- mode ml_gen_static_const_addr(in, out, in, out) is det.
-ml_gen_static_const_addr(Var, ConstAddrRval) -->
+:- mode ml_gen_static_const_addr(in, in, out, in, out) is det.
+ml_gen_static_const_addr(Var, Type, ConstAddrRval) -->
ml_lookup_static_const_name(Var, ConstName),
- ml_qualify_var(ConstName, ConstLval),
+ ml_gen_var_lval(ConstName, Type, ConstLval),
{ ConstAddrRval = mem_addr(ConstLval) }.
:- pred ml_cons_name(cons_id, ctor_name, ml_gen_info, ml_gen_info).
:- mode ml_cons_name(in, out, in, out) is det.
-ml_cons_name(ConsId, ConsName) -->
- { hlds_out__cons_id_to_string(ConsId, ConsName) }.
+ml_cons_name(HLDS_ConsId, QualifiedConsId) -->
+ (
+ { HLDS_ConsId = cons(SymName, Arity),
+ SymName = qualified(SymModuleName, ConsName) }
+ ->
+ { ConsId = ctor_id(ConsName, Arity) },
+ { ModuleName = mercury_module_name_to_mlds(SymModuleName) },
+ { QualifiedConsId = qual(ModuleName, ConsId) }
+ ;
+ { error("mlds_unify_gen.m: not a constructor id") }
+ ).
% Return an rval for the `SIZEOF_WORD' constant.
% This constant is supposed to be defined by the Mercury library.
@@ -1218,7 +1235,8 @@
ml_sizeof_word_rval = SizeofWordRval :-
mercury_private_builtin_module(PrivateBuiltin),
MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
- SizeofWordRval = lval(var(qual(MLDS_Module, "SIZEOF_WORD"))).
+ SizeofWordRval = lval(var(qual(MLDS_Module, "SIZEOF_WORD"),
+ mlds__native_int_type)).
:- pred ml_gen_cons_args(list(mlds__lval), list(prog_type),
list(uni_mode), module_info, list(mlds__rval)).
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.5
diff -u -r1.5 ml_util.m
--- compiler/ml_util.m 2001/01/11 14:25:39 1.5
+++ compiler/ml_util.m 2001/01/31 01:41:58
@@ -68,8 +68,8 @@
:- pred defn_is_public(mlds__defn).
:- mode defn_is_public(in) is semidet.
-%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- implementation.
:- import_module rtti.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.45
diff -u -r1.45 mlds.m
--- compiler/mlds.m 2001/01/17 17:37:17 1.45
+++ compiler/mlds.m 2001/01/31 01:41:59
@@ -547,8 +547,15 @@
; mlds__pseudo_type_info_type
- ; mlds__rtti_type(rtti_name).
+ ; mlds__rtti_type(rtti_name)
+ % A type used internally by the ML code generator to
+ % mark variables whose type is yet to be generated. This
+ % occurs once in ml_code_util.m where env_ptr's are created,
+ % but their type remains unknown until the ml_elim_nested.m
+ % pass.
+ ; mlds__unknown_type.
+
:- type mercury_type == prog_data__type.
:- func mercury_type_to_mlds_type(module_info, mercury_type) = mlds__type.
@@ -565,11 +572,17 @@
:- type mlds__decl_flags.
:- type access
- ---> public
- ; protected
- ; private
- ; default. % Java "default" access: accessible to anything
+ ---> public % accessible to anyone
+ ; 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.
+ ; local % use for local variables:
+ % only accessible within the function
+ % (or block) in which the variable is
+ % defined
+ .
:- type per_instance
---> one_copy % i.e. "static" storage duration
@@ -1052,8 +1065,13 @@
; name(mlds__qualified_entity_name)
.
- % XXX I'm not sure what representation we should use here
-:- type ctor_name == string.
+ %
+ % constructor id
+ %
+:- type ctor_name == mlds__qualified_ctor_id.
+:- type mlds__ctor_id ---> ctor_id(mlds__class_name, arity).
+:- type mlds__qualified_ctor_id ==
+ mlds__fully_qualified_name(mlds__ctor_id).
%
% trail management
@@ -1152,8 +1170,7 @@
% variables
% these may be local or they may come from some enclosing scope
% the variable name should be fully qualified
- %
- ; var(mlds__var)
+ ; var(mlds__var, mlds__type)
.
@@ -1425,7 +1442,8 @@
access_bits(private) = 0x01.
access_bits(protected) = 0x02.
access_bits(default) = 0x03.
-% 0x4 - 0x7 reserved
+access_bits(local) = 0x04.
+% 0x5 - 0x7 reserved
:- func access_mask = int.
access_mask = 0x07.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.78
diff -u -r1.78 mlds_to_c.m
--- compiler/mlds_to_c.m 2001/01/29 06:47:16 1.78
+++ compiler/mlds_to_c.m 2001/01/31 01:41:59
@@ -632,7 +632,8 @@
io__write_string("MR_Word").
mlds_output_pragma_export_type(prefix, mlds__rtti_type(_)) -->
io__write_string("MR_Word").
-
+mlds_output_pragma_export_type(prefix, mlds__unknown_type) -->
+ { error("mlds_to_c.m: prefix has unknown type") }.
%
% Output the definition body for a pragma export
@@ -1579,6 +1580,8 @@
mlds_output_type_prefix(mlds__rtti_type(RttiName)) -->
io__write_string("MR_"),
io__write_string(mlds_rtti_type_name(RttiName)).
+mlds_output_type_prefix(mlds__unknown_type) -->
+ { error("mlds_to_c.m: prefix has unknown type") }.
:- pred mlds_output_mercury_type_prefix(mercury_type, builtin_type,
io__state, io__state).
@@ -1666,7 +1669,6 @@
io__state, io__state).
:- mode mlds_output_type_suffix(in, in, di, uo) is det.
-
mlds_output_type_suffix(mercury_type(_, _), _) --> [].
mlds_output_type_suffix(mlds__native_int_type, _) --> [].
mlds_output_type_suffix(mlds__native_float_type, _) --> [].
@@ -1705,6 +1707,8 @@
;
[]
).
+mlds_output_type_suffix(mlds__unknown_type, _) -->
+ { error("mlds_to_c.m: suffix has unknown type") }.
:- pred mlds_output_array_type_suffix(initializer_array_size::in,
io__state::di, io__state::uo) is det.
@@ -1768,6 +1772,7 @@
mlds_output_access_comment_2(private) --> io__write_string("/* private: */ ").
mlds_output_access_comment_2(protected) --> io__write_string("/* protected: */ ").
mlds_output_access_comment_2(default) --> io__write_string("/* default access */ ").
+mlds_output_access_comment_2(local) --> [].
:- pred mlds_output_per_instance_comment(per_instance, io__state, io__state).
:- mode mlds_output_per_instance_comment(in, di, uo) is det.
@@ -2272,8 +2277,10 @@
io__write_string(", """),
mlds_output_fully_qualified_name(FuncName),
io__write_string(""", "),
- ( { MaybeCtorName = yes(CtorName) } ->
+ ( { MaybeCtorName = yes(CtorId) } ->
io__write_char('"'),
+ { CtorId = qual(_ModuleName, CtorDefn) },
+ { CtorDefn = ctor_id(CtorName, _CtorArity) },
c_util__output_quoted_string(CtorName),
io__write_char('"')
;
@@ -2422,8 +2429,10 @@
io__write_int(-1)
),
io__write_string(", "),
- ( { MaybeCtorName = yes(CtorName) } ->
+ ( { MaybeCtorName = yes(QualifiedCtorId) } ->
io__write_char('"'),
+ { QualifiedCtorId = qual(_ModuleName, CtorDefn) },
+ { CtorDefn = ctor_id(CtorName, _CtorArity) },
c_util__output_quoted_string(CtorName),
io__write_char('"')
;
@@ -2596,7 +2605,7 @@
mlds_output_lval(mem_ref(Rval, _Type)) -->
io__write_string("*"),
mlds_output_bracketed_rval(Rval).
-mlds_output_lval(var(VarName)) -->
+mlds_output_lval(var(VarName, _VarType)) -->
mlds_output_var(VarName).
:- pred mlds_output_var(mlds__var, io__state, io__state).
@@ -2618,7 +2627,7 @@
mlds_output_bracketed_lval(Lval) -->
(
% if it's just a variable name, then we don't need parentheses
- { Lval = var(_) }
+ { Lval = var(_, _) }
->
mlds_output_lval(Lval)
;
@@ -2633,7 +2642,7 @@
mlds_output_bracketed_rval(Rval) -->
(
% if it's just a variable name, then we don't need parentheses
- { Rval = lval(var(_))
+ { Rval = lval(var(_,_))
; Rval = const(code_addr_const(_))
}
->
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.11
diff -u -r1.11 mlds_to_il.m
--- compiler/mlds_to_il.m 2001/01/22 04:20:31 1.11
+++ compiler/mlds_to_il.m 2001/01/31 01:41:59
@@ -520,15 +520,16 @@
Tree0, Tree) -->
(
{ Name = data(DataName) },
- { Entity = mlds__data(_MldsType, Initializer) }
+ { Entity = mlds__data(MLDSType, Initializer) }
->
( { Initializer = no_initializer } ->
{ Tree = Tree0 }
;
( { DataName = var(VarName) } ->
il_info_get_module_name(ModuleName),
- get_load_store_lval_instrs(
- var(qual(ModuleName, VarName)),
+ { Lval = var(qual(ModuleName, VarName),
+ MLDSType) },
+ get_load_store_lval_instrs(Lval,
LoadMemRefInstrs, StoreLvalInstrs),
{ NameString = VarName }
;
@@ -1143,7 +1144,7 @@
:- mode load(in, out, in, out) is det.
load(lval(Lval), Instrs, Info0, Info) :-
- ( Lval = var(Var),
+ ( Lval = var(Var, _),
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, Info0) ->
Instrs = instr_node(ldloc(name(MangledVarStr)))
@@ -1236,7 +1237,7 @@
{ Instrs = tree__list([R1LoadInstrs, R2LoadInstrs, BinaryOpInstrs]) }.
load(mem_addr(Lval), Instrs, Info0, Info) :-
- ( Lval = var(Var),
+ ( Lval = var(Var, _VarType),
mangle_mlds_var(Var, MangledVarStr),
Info0 = Info,
( is_local(MangledVarStr, Info) ->
@@ -1272,7 +1273,7 @@
% instruction. Annoying, eh?
unexpected(this_file, "store into mem_ref").
-store(var(Var), Instrs, Info, Info) :-
+store(var(Var, _VarType), Instrs, Info, Info) :-
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, Info) ->
Instrs = instr_node(stloc(name(MangledVarStr)))
@@ -1813,6 +1814,8 @@
ILType = il_array_type
).
+mlds_type_to_ilds_type(mlds__unknown_type) = _ :-
+ error("mlds_to_il.m: unknown type").
%-----------------------------------------------------------------------------
%
@@ -2043,7 +2046,7 @@
il_info::in, il_info::out) is det.
rval_to_type(lval(Lval), Type, Info0, Info) :-
- ( Lval = var(Var),
+ ( Lval = var(Var, _VarType),
mangle_mlds_var(Var, MangledVarStr),
il_info_get_mlds_type(MangledVarStr, Type, Info0, Info)
; Lval = field(_, _, _, Type, _),
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.7
diff -u -r1.7 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 2001/01/12 03:49:25 1.7
+++ compiler/mlds_to_ilasm.m 2001/01/31 01:41:59
@@ -550,7 +550,7 @@
write_managed_cpp_lval(mem_ref(Rval, _)) -->
io__write_string("*"),
write_managed_cpp_rval(Rval).
-write_managed_cpp_lval(var(Var)) -->
+write_managed_cpp_lval(var(Var, _VarType)) -->
{ mangle_mlds_var(Var, Id) },
io__write_string(Id).
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.11
diff -u -r1.11 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 2001/01/16 03:24:39 1.11
+++ compiler/rtti_to_mlds.m 2001/01/31 01:42:00
@@ -564,7 +564,11 @@
gen_init_builtin_const(Name) = init_obj(Rval) :-
mercury_private_builtin_module(PrivateBuiltin),
MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
- Rval = lval(var(qual(MLDS_Module, Name))).
+ % XXX These are actually enumeration constants.
+ % Perhaps we should be using an enumeration type here,
+ % rather than `mlds__native_int_type'.
+ Type = mlds__native_int_type,
+ Rval = lval(var(qual(MLDS_Module, Name), Type)).
%-----------------------------------------------------------------------------%
%
--------------------------------------------------------------------------
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