[m-dev.] for review: add types to MLDS statements
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Feb 23 16:03:58 AEDT 2000
Hi,
I'm guessing Fergus will be reviewing this one.
===================================================================
Estimated hours taken: 15 (some work done in tandem with fjh)
Extend MLDS to cope with alternate backends, and hopefully to allow
easier implementation of high level data structures in the C backend.
Add type information that is required for more heavily typed backends
(with C you can just cast to void * to escape the type system when it is
inconvenient, with other systems this is impossible, e.g. a Java backend).
Introduce new "cast" statement, that does an assignment that may
also modify the type (through a cast).
compiler/mercury_compile.m:
Split the generation of MLDS from outputting high-level C code.
MLDS can be connected up to other backends.
compiler/ml_base_type_info.m:
compiler/ml_call_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_tailcall.m:
compiler/ml_unify_gen.m:
Add a type to code address constants (the type signature of the
function).
Add the type of the field and the type of the object to field
instructions.
Add a type to mem_ref (the type of the reference).
compiler/ml_elim_nested.m:
Add types to code addresses, fields and mem_refs.
Use cast where appropriate.
compiler/mlds.m:
Add cast statement.
Add types to code addresses, fields and mem_refs.
compiler/mlds_to_c.m:
Output casts, generally ignore the types in code addresses,
fields and mem_refs (high level C code doesn't really need them,
although it might be nice to use them in future).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.148
diff -u -r1.148 mercury_compile.m
--- compiler/mercury_compile.m 2000/02/10 04:37:38 1.148
+++ compiler/mercury_compile.m 2000/02/18 02:04:32
@@ -429,7 +429,8 @@
( { AditiOnly = yes } ->
[]
; { HighLevelCode = yes } ->
- mercury_compile__mlds_backend(HLDS50),
+ mercury_compile__mlds_backend(HLDS50, MLDS),
+ mercury_compile__mlds_to_high_level_c(MLDS),
globals__io_lookup_bool_option(compile_to_c,
CompileToC),
( { CompileToC = no } ->
@@ -2218,12 +2219,12 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-% The `--high-level-C' MLDS-based alternative backend
+% The MLDS-based alternative backend
-:- pred mercury_compile__mlds_backend(module_info, io__state, io__state).
-:- mode mercury_compile__mlds_backend(in, di, uo) is det.
+:- pred mercury_compile__mlds_backend(module_info, mlds, io__state, io__state).
+:- mode mercury_compile__mlds_backend(in, out, di, uo) is det.
-mercury_compile__mlds_backend(HLDS50) -->
+mercury_compile__mlds_backend(HLDS50, MLDS) -->
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
@@ -2250,7 +2251,16 @@
ml_elim_nested(MLDS1, MLDS)
;
{ MLDS = MLDS1 }
- ),
+ ).
+
+% The `--high-level-C' MLDS output pass
+
+:- pred mercury_compile__mlds_to_high_level_c(mlds, io__state, io__state).
+:- mode mercury_compile__mlds_to_high_level_c(in, di, uo) is det.
+
+mercury_compile__mlds_to_high_level_c(MLDS) -->
+ globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(statistics, Stats),
maybe_write_string(Verbose, "% Converting MLDS to C...\n"),
mlds_to_c__output_mlds(MLDS),
Index: compiler/ml_base_type_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_base_type_info.m,v
retrieving revision 1.4
diff -u -r1.4 ml_base_type_info.m
--- compiler/ml_base_type_info.m 1999/12/30 18:04:54 1.4
+++ compiler/ml_base_type_info.m 2000/02/22 05:57:14
@@ -206,7 +206,10 @@
%
ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, PredModule),
QualifiedProcLabel = qual(PredModule, PredLabel - ProcId),
- ProcAddrRval = const(code_addr_const(proc(QualifiedProcLabel))),
+ Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
+ Signature = mlds__get_func_signature(Params),
+ ProcAddrRval = const(code_addr_const(proc(QualifiedProcLabel,
+ Signature))),
%
% Convert the procedure address to a generic type.
% We need to use a generic type because since the actual type
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.1
diff -u -r1.1 ml_call_gen.m
--- compiler/ml_call_gen.m 1999/12/29 08:09:10 1.1
+++ compiler/ml_call_gen.m 2000/02/23 03:37:14
@@ -119,7 +119,9 @@
_Arity) },
ml_gen_var(ClosureVar, ClosureLval),
{ FieldId = offset(const(int_const(1))) },
- { FuncLval = field(yes(0), lval(ClosureLval), FieldId) },
+ % XXX are these types right?
+ { FuncLval = field(yes(0), lval(ClosureLval), FieldId,
+ mlds__generic_type, ClosureArgType) },
{ FuncType = mlds__func_type(Params) },
{ FuncRval = unop(unbox(FuncType), lval(FuncLval)) }
;
@@ -351,8 +353,11 @@
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
PredLabel, PredModule) },
+ { Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId) },
+ { Signature = mlds__get_func_signature(Params) },
{ QualifiedProcLabel = qual(PredModule, PredLabel - ProcId) },
- { CodeAddrRval = const(code_addr_const(proc(QualifiedProcLabel))) }.
+ { CodeAddrRval = const(code_addr_const(proc(QualifiedProcLabel,
+ Signature))) }.
%
% Generate rvals and lvals for the arguments of a procedure call
@@ -460,7 +465,7 @@
% we optimize &*Rval to just Rval.
:- func ml_gen_mem_addr(mlds__lval) = mlds__rval.
ml_gen_mem_addr(Lval) =
- (if Lval = mem_ref(Rval) then Rval else mem_addr(Lval)).
+ (if Lval = mem_ref(Rval, _) then Rval else mem_addr(Lval)).
% Convert VarRval, of type SourceType,
% to ArgRval, of type DestType.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.29
diff -u -r1.29 ml_code_gen.m
--- compiler/ml_code_gen.m 2000/02/10 04:47:43 1.29
+++ compiler/ml_code_gen.m 2000/02/17 07:07:59
@@ -882,16 +882,19 @@
%
:- func ml_gen_local_var_decls(prog_varset, map(prog_var, prog_type),
mlds__context, prog_vars) = mlds__defns.
-ml_gen_local_var_decls(VarSet, VarTypes, Context, Vars) =
- list__map(ml_gen_local_var_decl(VarSet, VarTypes, Context), Vars).
+ml_gen_local_var_decls(VarSet, VarTypes, Context, Vars) = LocalDecls :-
+ list__filter_map(ml_gen_local_var_decl(VarSet, VarTypes, Context),
+ Vars, LocalDecls).
% Generate a declaration for a local variable.
%
-:- func ml_gen_local_var_decl(prog_varset, map(prog_var, prog_type),
- mlds__context, prog_var) = mlds__defn.
-ml_gen_local_var_decl(VarSet, VarTypes, Context, Var) = MLDS_Defn :-
- VarName = ml_gen_var_name(VarSet, Var),
+:- pred ml_gen_local_var_decl(prog_varset, map(prog_var, prog_type),
+ mlds__context, prog_var, mlds__defn).
+:- mode ml_gen_local_var_decl(in, in, in, in, out) is semidet.
+ml_gen_local_var_decl(VarSet, VarTypes, Context, Var, MLDS_Defn) :-
map__lookup(VarTypes, Var, Type),
+ not type_util__is_dummy_argument_type(Type),
+ VarName = ml_gen_var_name(VarSet, Var),
MLDS_Defn = ml_gen_var_decl(VarName, Type, Context).
% Generate the code for a procedure body.
@@ -1802,7 +1805,7 @@
llds_out__name_mangle(VarName, MangledVarName),
string__append_list([MangledModuleName, "__",
MangledVarName], Var_ArgName)
- ; ArgRval = lval(mem_ref(lval(var(qual(ModuleName, VarName))))) ->
+ ; ArgRval = lval(mem_ref(lval(var(qual(ModuleName, VarName))), _)) ->
SymName = mlds_module_name_to_sym_name(ModuleName),
llds_out__sym_name_mangle(SymName, MangledModuleName),
llds_out__name_mangle(VarName, MangledVarName),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.2
diff -u -r1.2 ml_code_util.m
--- compiler/ml_code_util.m 1999/12/30 17:00:30 1.2
+++ compiler/ml_code_util.m 2000/02/18 02:17:22
@@ -727,9 +727,17 @@
{ ml_gen_info_get_proc_id(Info, ProcId) },
{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
PredLabel, PredModule) },
+ { ml_gen_info_use_gcc_nested_functions(UseNestedFuncs, Info, _) },
+ { UseNestedFuncs = yes ->
+ ArgTypes = []
+ ;
+ ArgTypes = [mlds__generic_env_ptr_type]
+ },
+ { Signature = mlds__func_signature(ArgTypes, []) },
+
{ ProcLabel = qual(PredModule, PredLabel - ProcId) },
{ FuncLabelRval = const(code_addr_const(internal(ProcLabel,
- FuncLabel))) }.
+ FuncLabel, Signature))) }.
% Generate the mlds__pred_label and module name
% for a given procedure.
@@ -826,9 +834,10 @@
{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
{ VarName = ml_gen_var_name(VarSet, Var) },
{ VarLval = var(qual(MLDS_Module, VarName)) },
+ { MLDS_Type = mercury_type_to_mlds_type(Type) },
% output variables are passed by reference...
{ list__member(Var, OutputVars) ->
- Lval = mem_ref(lval(VarLval))
+ Lval = mem_ref(lval(VarLval), MLDS_Type)
;
Lval = VarLval
}
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.3
diff -u -r1.3 ml_elim_nested.m
--- compiler/ml_elim_nested.m 1999/11/15 10:35:18 1.3
+++ compiler/ml_elim_nested.m 2000/02/22 05:41:18
@@ -153,13 +153,19 @@
ml_elim_nested_defns(ModuleName, OuterVars, Defn0) = FlatDefns :-
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
( DefnBody0 = mlds__function(PredProcId, Params, yes(FuncBody0)) ->
+ EnvName = ml_env_name(Name),
+ % XXX this should be optimized to generate
+ % EnvTypeName from just EnvName
+ ml_create_env(EnvName, [], Context, ModuleName,
+ _EnvType, EnvTypeName, _EnvDecls, _InitEnv),
+
%
% traverse the function body, finding (and removing)
% any nested functions, and fixing up any references
% to the arguments or to local variables which
% occur in nested functions
%
- ElimInfo0 = elim_info_init(ModuleName, OuterVars),
+ ElimInfo0 = elim_info_init(ModuleName, OuterVars, EnvTypeName),
Params = mlds__func_params(Arguments, _RetValues),
ml_maybe_add_args(Arguments, FuncBody0, ModuleName,
Context, ElimInfo0, ElimInfo1),
@@ -173,33 +179,33 @@
FuncBody = FuncBody1,
HoistedDefns = []
;
- %
- % If the function's arguments are referenced by
- % nested functions, then we need to copy them to
- % local variables in the environment structure.
- %
- ml_maybe_copy_args(Arguments, FuncBody0, ModuleName,
- Context, _ArgsToCopy, CodeToCopyArgs),
-
%
- % create a struct to hold the local variables,
+ % Create a struct to hold the local variables,
% and initialize the environment pointers for
% both the containing function and the nested
% functions
%
- EnvName = ml_env_name(Name),
ml_create_env(EnvName, LocalVars, Context, ModuleName,
- EnvType, EnvDecls, InitEnv),
+ EnvType, _EnvTypeName, EnvDecls, InitEnv),
list__map(ml_insert_init_env(EnvName, ModuleName),
NestedFuncs0, NestedFuncs),
%
+ % If the function's arguments are referenced by
+ % nested functions, then we need to copy them to
+ % local variables in the environment structure.
+ %
+ ml_maybe_copy_args(Arguments, FuncBody0, ModuleName,
+ EnvTypeName, Context, _ArgsToCopy,
+ CodeToCopyArgs),
+
+ %
% insert the definition and initialization of the
% environment struct variable at the start of the
% top-level function's body
%
FuncBody = ml_block(EnvDecls,
- list__append([InitEnv | CodeToCopyArgs],
+ list__append([InitEnv | CodeToCopyArgs],
[FuncBody1]),
Context),
%
@@ -245,16 +251,17 @@
% to the environment struct.
%
:- pred ml_maybe_copy_args(mlds__arguments, mlds__statement,
- mlds_module_name, mlds__context, mlds__defns, mlds__statements).
-:- mode ml_maybe_copy_args(in, in, in, in, out, out) is det.
+ mlds_module_name, mlds__type, mlds__context,
+ mlds__defns, mlds__statements).
+:- mode ml_maybe_copy_args(in, in, in, in, in, out, out) is det.
-ml_maybe_copy_args([], _, _, _, [], []).
-ml_maybe_copy_args([Arg|Args], FuncBody, ModuleName, Context,
+ml_maybe_copy_args([], _, _, _, _, [], []).
+ml_maybe_copy_args([Arg|Args], FuncBody, ModuleName, ClassType, Context,
ArgsToCopy, CodeToCopyArgs) :-
- ml_maybe_copy_args(Args, FuncBody, ModuleName, Context,
+ ml_maybe_copy_args(Args, FuncBody, ModuleName, ClassType, Context,
ArgsToCopy0, CodeToCopyArgs0),
(
- Arg = data(var(VarName)) - _Type,
+ Arg = data(var(VarName)) - FieldType,
ml_should_add_local_var(ModuleName, VarName, [], [FuncBody])
->
ml_conv_arg_to_var(Context, Arg, ArgToCopy),
@@ -268,7 +275,8 @@
FieldName = named_field(QualVarName),
Tag = yes(0),
EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
- EnvArgLval = field(Tag, EnvPtr, FieldName),
+ EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType,
+ ClassType),
ArgRval = lval(var(QualVarName)),
AssignToEnv = assign(EnvArgLval, ArgRval),
CodeToCopyArg = mlds__statement(atomic(AssignToEnv), Context),
@@ -293,12 +301,12 @@
% env_ptr = &env;
%
:- pred ml_create_env(mlds__class_name, list(mlds__defn), mlds__context,
- mlds_module_name, mlds__defn,
+ mlds_module_name, mlds__defn, mlds__type,
list(mlds__defn), mlds__statement).
-:- mode ml_create_env(in, in, in, in, out, out, out) is det.
+:- mode ml_create_env(in, in, in, in, out, out, out, out) is det.
ml_create_env(EnvClassName, LocalVars, Context, ModuleName,
- EnvType, EnvDecls, InitEnv) :-
+ EnvType, EnvTypeName, EnvDecls, InitEnv) :-
%
% generate the following type:
%
@@ -306,11 +314,12 @@
% <LocalVars>
% };
%
- EnvTypeName = type(EnvClassName, 0),
+ EnvTypeEntityName = type(EnvClassName, 0),
+ EnvTypeName = class_type(qual(ModuleName, EnvClassName), 0),
EnvTypeFlags = env_decl_flags,
- EnvTypeDefnBody = mlds__class(mlds__class_defn(mlds__struct, [], [], [],
- LocalVars)),
- EnvType = mlds__defn(EnvTypeName, Context, EnvTypeFlags,
+ EnvTypeDefnBody = mlds__class(mlds__class_defn(mlds__struct, [],
+ [mlds__generic_env_ptr_type], [], LocalVars)),
+ EnvType = mlds__defn(EnvTypeEntityName, Context, EnvTypeFlags,
EnvTypeDefnBody),
%
@@ -362,12 +371,6 @@
DefnBody0 = mlds__function(PredProcId, Params, yes(FuncBody0)),
statement_contains_var(FuncBody0, qual(ModuleName, "env_ptr"))
->
- %
- % XXX we should really insert a type cast here,
- % to convert from mlds__generic_ptr_type (i.e. `void *') to
- % the mlds__class_type (i.e. `struct <EnvClassName> *').
- % But the MLDS doesn't have any representation for casts.
- %
EnvPtrVal = lval(var(qual(ModuleName, "env_ptr_arg"))),
ml_init_env(ClassName, EnvPtrVal, Context, ModuleName,
EnvPtrDecl, InitEnvPtr),
@@ -410,10 +413,10 @@
%
% generate the following statement:
%
- % env_ptr = <EnvPtrVal>;
+ % env_ptr = (EnvPtrVarType) <EnvPtrVal>;
%
EnvPtrVar = qual(ModuleName, "env_ptr"),
- AssignEnvPtr = assign(var(EnvPtrVar), EnvPtrVal),
+ AssignEnvPtr = cast(var(EnvPtrVar), EnvPtrVal, EnvPtrVarType),
InitEnvPtr = mlds__statement(atomic(AssignEnvPtr), Context).
% Given the declaration for a function parameter, produce a
@@ -745,6 +748,9 @@
fixup_atomic_stmt(assign(Lval0, Rval0), assign(Lval, Rval)) -->
fixup_lval(Lval0, Lval),
fixup_rval(Rval0, Rval).
+fixup_atomic_stmt(cast(Lval0, Rval0, Type), cast(Lval, Rval, Type)) -->
+ fixup_lval(Lval0, Lval),
+ fixup_rval(Rval0, Rval).
fixup_atomic_stmt(new_object(Target0, MaybeTag, Type, MaybeSize, MaybeCtorName,
Args0, ArgTypes),
new_object(Target, MaybeTag, Type, MaybeSize, MaybeCtorName,
@@ -815,9 +821,10 @@
:- pred fixup_lval(mlds__lval, mlds__lval, elim_info, elim_info).
:- mode fixup_lval(in, out, in, out) is det.
-fixup_lval(field(MaybeTag, Rval0, FieldId), field(MaybeTag, Rval, FieldId)) -->
+fixup_lval(field(MaybeTag, Rval0, FieldId, FieldType, ClassType),
+ field(MaybeTag, Rval, FieldId, FieldType, ClassType)) -->
fixup_rval(Rval0, Rval).
-fixup_lval(mem_ref(Rval0), mem_ref(Rval)) -->
+fixup_lval(mem_ref(Rval0, Type), mem_ref(Rval, Type)) -->
fixup_rval(Rval0, Rval).
fixup_lval(var(Var0), VarLval) -->
fixup_var(Var0, VarLval).
@@ -837,6 +844,7 @@
ThisVar = qual(ThisVarModuleName, ThisVarName),
ModuleName = elim_info_get_module_name(ElimInfo),
LocalVars = elim_info_get_local_vars(ElimInfo),
+ ClassType = elim_info_get_env_type_name(ElimInfo),
(
%
% Check for references to local variables
@@ -844,13 +852,17 @@
% and replace them with `env_ptr->foo'.
%
ThisVarModuleName = ModuleName,
- list__member(Var, LocalVars),
- Var = mlds__defn(data(var(ThisVarName)), _, _, _)
+ IsLocal = (pred(VarType::out) is nondet :-
+ list__member(Var, LocalVars),
+ Var = mlds__defn(data(var(ThisVarName)), _, _,
+ data(VarType, _))
+ ),
+ solutions(IsLocal, [FieldType])
->
EnvPtr = lval(var(qual(ModuleName, "env_ptr"))),
FieldName = named_field(ThisVar),
Tag = yes(0),
- Lval = field(Tag, EnvPtr, FieldName)
+ Lval = field(Tag, EnvPtr, FieldName, FieldType, ClassType)
;
%
% leave everything else unchanged
@@ -1160,6 +1172,10 @@
( lval_contains_var(Lval, Name)
; rval_contains_var(Rval, Name)
).
+atomic_stmt_contains_var(cast(Lval, Rval, _Type), Name) :-
+ ( lval_contains_var(Lval, Name)
+ ; rval_contains_var(Rval, Name)
+ ).
atomic_stmt_contains_var(new_object(Target, _MaybeTag, _Type, _MaybeSize,
_MaybeCtorName, Args, _ArgTypes), Name) :-
( lval_contains_var(Target, Name)
@@ -1227,9 +1243,9 @@
:- pred lval_contains_var(mlds__lval, mlds__var).
:- mode lval_contains_var(in, in) is semidet.
-lval_contains_var(field(_MaybeTag, Rval, _FieldId), Name) :-
+lval_contains_var(field(_MaybeTag, Rval, _FieldId, _, _), Name) :-
rval_contains_var(Rval, Name).
-lval_contains_var(mem_ref(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! */
@@ -1264,7 +1280,10 @@
% The list of local variables that we must
% put in the environment structure
% This list is stored in reverse order.
- list(mlds__defn)
+ list(mlds__defn),
+
+ % Type of the introduced environment struct
+ mlds__type
).
% The lists of local variables for
@@ -1272,34 +1291,37 @@
% innermost first
:- type outervars == list(list(mlds__defn)).
-:- func elim_info_init(mlds_module_name, outervars) = elim_info.
-elim_info_init(ModuleName, OuterVars) =
- elim_info(ModuleName, OuterVars, [], []).
+:- func elim_info_init(mlds_module_name, outervars, mlds__type) = elim_info.
+elim_info_init(ModuleName, OuterVars, EnvTypeName) =
+ elim_info(ModuleName, OuterVars, [], [], EnvTypeName).
:- func elim_info_get_module_name(elim_info) = mlds_module_name.
-elim_info_get_module_name(elim_info(ModuleName, _, _, _)) = ModuleName.
+elim_info_get_module_name(elim_info(ModuleName, _, _, _, _)) = ModuleName.
:- func elim_info_get_outer_vars(elim_info) = outervars.
-elim_info_get_outer_vars(elim_info(_, OuterVars, _, _)) = OuterVars.
+elim_info_get_outer_vars(elim_info(_, OuterVars, _, _, _)) = OuterVars.
:- func elim_info_get_local_vars(elim_info) = list(mlds__defn).
-elim_info_get_local_vars(elim_info(_, _, _, LocalVars)) = LocalVars.
+elim_info_get_local_vars(elim_info(_, _, _, LocalVars, _)) = LocalVars.
+
+:- func elim_info_get_env_type_name(elim_info) = mlds__type.
+elim_info_get_env_type_name(elim_info(_, _, _, _, EnvTypeName)) = EnvTypeName.
:- pred elim_info_add_nested_func(mlds__defn, elim_info, elim_info).
:- mode elim_info_add_nested_func(in, in, out) is det.
-elim_info_add_nested_func(NestedFunc, elim_info(A, B, NestedFuncs0, D),
- elim_info(A, B, NestedFuncs, D)) :-
+elim_info_add_nested_func(NestedFunc, elim_info(A, B, NestedFuncs0, D, E),
+ elim_info(A, B, NestedFuncs, D, E)) :-
NestedFuncs = [NestedFunc | NestedFuncs0].
:- pred elim_info_add_local_var(mlds__defn, elim_info, elim_info).
:- mode elim_info_add_local_var(in, in, out) is det.
-elim_info_add_local_var(LocalVar, elim_info(A, B, C, LocalVars0),
- elim_info(A, B, C, LocalVars)) :-
+elim_info_add_local_var(LocalVar, elim_info(A, B, C, LocalVars0, E),
+ elim_info(A, B, C, LocalVars, E)) :-
LocalVars = [LocalVar | LocalVars0].
:- pred elim_info_finish(elim_info, list(mlds__defn), list(mlds__defn)).
:- mode elim_info_finish(in, out, out) is det.
-elim_info_finish(elim_info(_ModuleName, _OuterVars, RevFuncs, RevLocalVars),
+elim_info_finish(elim_info(_ModuleName, _OuterVars, RevFuncs, RevLocalVars, _),
Funcs, LocalVars) :-
Funcs = list__reverse(RevFuncs),
LocalVars = list__reverse(RevLocalVars).
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.1
diff -u -r1.1 ml_tailcall.m
--- compiler/ml_tailcall.m 1999/11/10 16:21:13 1.1
+++ compiler/ml_tailcall.m 2000/02/17 06:48:39
@@ -317,14 +317,14 @@
% We just assume it is local. (This assumption is
% true for the code generated by ml_code_gen.m.)
true.
-lval_is_local(field(_Tag, Rval, _Field)) :-
+lval_is_local(field(_Tag, Rval, _Field, _, _)) :-
% a field of a local variable is local
( Rval = mem_addr(Lval) ->
lval_is_local(Lval)
;
fail
).
-lval_is_local(mem_ref(_Rval)) :-
+lval_is_local(mem_ref(_Rval, _Type)) :-
fail.
%-----------------------------------------------------------------------------%
@@ -381,9 +381,9 @@
:- pred check_lval(mlds__lval, locals).
:- mode check_lval(in, in) is semidet.
-check_lval(field(_MaybeTag, Rval, _FieldId), Locals) :-
+check_lval(field(_MaybeTag, Rval, _FieldId, _, _), Locals) :-
check_rval(Rval, Locals).
-check_lval(mem_ref(_), _) :-
+check_lval(mem_ref(_, _), _) :-
% We assume that the addresses of local variables are only
% ever passed down to other functions, or assigned to,
% so a mem_ref lval can never refer to a local variable.
@@ -453,10 +453,10 @@
function_is_local(CodeAddr, Locals) :-
(
- CodeAddr = proc(QualifiedProcLabel),
+ CodeAddr = proc(QualifiedProcLabel, _Sig),
MaybeSeqNum = no
;
- CodeAddr = internal(QualifiedProcLabel, SeqNum),
+ CodeAddr = internal(QualifiedProcLabel, SeqNum, _Sig),
MaybeSeqNum = yes(SeqNum)
),
% XXX we ignore the ModuleName --
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.2
diff -u -r1.2 ml_unify_gen.m
--- compiler/ml_unify_gen.m 1999/12/30 17:00:31 1.2
+++ compiler/ml_unify_gen.m 2000/02/23 04:32:22
@@ -668,7 +668,8 @@
;
% output arguments are passed by reference,
% so we need to dereference them
- Lval = mem_ref(lval(VarLval))
+ MLDS_Type = mercury_type_to_mlds_type(Type),
+ Lval = mem_ref(lval(VarLval), MLDS_Type)
},
ml_gen_wrapper_arg_lvals(Names1, Types1, Modes1, Lvals1),
{ Lvals = [Lval|Lvals1] }
@@ -690,7 +691,9 @@
% generate `MR_field(MR_mktag(0), closure, <N>)'
%
{ FieldId = offset(const(int_const(ArgNum + Offset))) },
- { FieldLval = field(yes(0), lval(ClosureLval), FieldId) },
+ % XXX these types might not be right
+ { FieldLval = field(yes(0), lval(ClosureLval), FieldId,
+ mlds__generic_env_ptr_type, mlds__generic_type) },
%
% recursively handle the remaining fields
%
@@ -946,7 +949,10 @@
% Generate lvals for the LHS and the RHS
%
{ FieldId = offset(const(int_const(ArgNum))) },
- { FieldLval = field(yes(PrimaryTag), lval(VarLval), FieldId) },
+ { MLDS_ArgType = mercury_type_to_mlds_type(ArgType) },
+ % XXX these types might not be right
+ { FieldLval = field(yes(PrimaryTag), lval(VarLval), FieldId,
+ MLDS_ArgType, mlds__generic_type) },
ml_gen_var(Arg, ArgLval),
%
% Now generate code to unify them
@@ -1128,8 +1134,10 @@
binop(and,
binop(eq, unop(std_unop(tag), Rval),
unop(std_unop(mktag), const(int_const(Bits)))),
+ % XXX these types might not be right
binop(eq, lval(field(yes(Bits), Rval,
- offset(const(int_const(0))))),
+ offset(const(int_const(0))),
+ mlds__int_type, mlds__generic_type)),
const(int_const(Num)))).
ml_gen_tag_test_rval(shared_local_tag(Bits, Num), Rval) =
binop(eq, Rval,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.15
diff -u -r1.15 mlds.m
--- compiler/mlds.m 1999/12/03 20:22:45 1.15
+++ compiler/mlds.m 2000/02/22 05:58:46
@@ -492,7 +492,7 @@
% that can be used to point to the environment
% (set of local variables) of the containing function.
% This is used for handling nondeterminism,
- % if the target language doesn't supported
+ % if the target language doesn't support
% nested functions, and also for handling
% closures for higher-order code.
; mlds__generic_env_ptr_type
@@ -767,6 +767,11 @@
% Assign the value specified by rval to the location
% specified by lval.
+ ; cast(mlds__lval, mlds__rval, mlds__type)
+ % cast(Location, Value, Type):
+ % Assign the value specified by rval to the location
+ % specified by lval and cast it to type.
+
%
% heap management
%
@@ -933,8 +938,10 @@
% values on the heap
% or fields of a structure
%
- ---> field(maybe(mlds__tag), mlds__rval, field_id)
- % field(Tag, Address, FieldName)
+ ---> field(maybe(mlds__tag), mlds__rval, field_id,
+ mlds__type, mlds__type)
+ % field(Tag, Address, FieldName, FieldType,
+ % ClassType)
% selects a field of a compound term.
% Address is a tagged pointer to a cell
% on the heap; the offset into the cell
@@ -944,13 +951,19 @@
% The value of the tag should be given if
% it is known, since this will lead to
% faster code.
+ % The FieldType is the type of the field.
+ % The ClassType is the type of the object from
+ % which we are fetching the field.
%
% values somewhere in memory
% this is the deference operator (e.g. unary `*' in C)
%
- ; mem_ref(mlds__rval) % The rval should have
- % originally come from a mem_addr rval.
+ ; mem_ref(mlds__rval, mlds__type)
+ % The rval should have originally come
+ % from a mem_addr rval.
+ % The type is the type of the value being
+ % dereferenced
%
% variables
@@ -1007,8 +1020,9 @@
; data_addr_const(mlds__data_addr).
:- type mlds__code_addr
- ---> proc(mlds__qualified_proc_label)
- ; internal(mlds__qualified_proc_label, mlds__func_sequence_num).
+ ---> proc(mlds__qualified_proc_label, mlds__func_signature)
+ ; internal(mlds__qualified_proc_label, mlds__func_sequence_num,
+ mlds__func_signature).
:- type mlds__data_addr
---> data_addr(mlds_module_name, mlds__data_name).
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.21
diff -u -r1.21 mlds_to_c.m
--- compiler/mlds_to_c.m 1999/12/30 17:00:32 1.21
+++ compiler/mlds_to_c.m 2000/02/23 04:34:08
@@ -1269,10 +1269,10 @@
%
FuncRval = const(code_addr_const(CodeAddr)),
(
- CodeAddr = proc(QualifiedProcLabel),
+ CodeAddr = proc(QualifiedProcLabel, _Sig),
MaybeSeqNum = no
;
- CodeAddr = internal(QualifiedProcLabel, SeqNum),
+ CodeAddr = internal(QualifiedProcLabel, SeqNum, _Sig),
MaybeSeqNum = yes(SeqNum)
),
QualifiedProcLabel = qual(ModuleName, PredLabel - ProcId),
@@ -1366,6 +1366,15 @@
mlds_output_rval(Rval),
io__write_string(";\n").
+mlds_output_atomic_stmt(Indent, cast(Lval, Rval, Type), _) -->
+ mlds_indent(Indent),
+ mlds_output_lval(Lval),
+ io__write_string(" = ( "),
+ mlds_output_type(Type),
+ io__write_string(" ) "),
+ mlds_output_rval(Rval),
+ io__write_string(";\n").
+
%
% heap management
%
@@ -1473,7 +1482,7 @@
:- pred mlds_output_lval(mlds__lval, io__state, io__state).
:- mode mlds_output_lval(in, di, uo) is det.
-mlds_output_lval(field(MaybeTag, Rval, offset(OffsetRval))) -->
+mlds_output_lval(field(MaybeTag, Rval, offset(OffsetRval), _, _)) -->
( { MaybeTag = yes(Tag) } ->
io__write_string("MR_field("),
mlds_output_tag(Tag),
@@ -1485,7 +1494,7 @@
io__write_string(", "),
mlds_output_rval(OffsetRval),
io__write_string(")").
-mlds_output_lval(field(MaybeTag, PtrRval, named_field(FieldId))) -->
+mlds_output_lval(field(MaybeTag, PtrRval, named_field(FieldId), _, _)) -->
( { MaybeTag = yes(0) } ->
( { PtrRval = mem_addr(Lval) } ->
mlds_output_bracketed_lval(Lval),
@@ -1507,7 +1516,7 @@
io__write_string("->")
),
mlds_output_fully_qualified(FieldId, io__write_string).
-mlds_output_lval(mem_ref(Rval)) -->
+mlds_output_lval(mem_ref(Rval, _Type)) -->
io__write_string("*"),
mlds_output_bracketed_rval(Rval).
mlds_output_lval(var(VarName)) -->
@@ -1562,7 +1571,7 @@
% the MR_const_field() macro, not the MR_field() macro,
% to avoid warnings about discarding const,
% and similarly for MR_mask_field.
- ( { Lval = field(MaybeTag, Rval, FieldNum) } ->
+ ( { Lval = field(MaybeTag, Rval, FieldNum, _, _) } ->
( { MaybeTag = yes(Tag) } ->
io__write_string("MR_const_field("),
mlds_output_tag(Tag),
@@ -1787,9 +1796,9 @@
:- pred mlds_output_code_addr(mlds__code_addr, io__state, io__state).
:- mode mlds_output_code_addr(in, di, uo) is det.
-mlds_output_code_addr(proc(Label)) -->
+mlds_output_code_addr(proc(Label, _Sig)) -->
mlds_output_fully_qualified(Label, mlds_output_proc_label).
-mlds_output_code_addr(internal(Label, SeqNum)) -->
+mlds_output_code_addr(internal(Label, SeqNum, _Sig)) -->
mlds_output_fully_qualified(Label, mlds_output_proc_label),
io__write_string("_"),
io__write_int(SeqNum).
--
Tyson Dowd #
# Surreal humour isn't eveyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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