[m-rev.] diff: mlds functor prefixes to prevent ambiguities
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Jun 10 16:24:35 AEST 2009
compiler/mlds.m:
Add prefixes to some function symbols to prevent ambiguities.
compiler/*.m:
Conform to the change in mlds.m. There are no algorithmic changes.
Zoltan.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.83
diff -u -b -r1.83 ml_call_gen.m
--- compiler/ml_call_gen.m 16 Jan 2009 02:31:23 -0000 1.83
+++ compiler/ml_call_gen.m 6 Jun 2009 14:30:51 -0000
@@ -199,8 +199,8 @@
% `closure_arg'.
GCStatement = gc_no_stmt,
ClosureArgType = mlds_generic_type,
- ClosureArg =
- mlds_argument(entity_data(var(mlds_var_name("closure_arg", no))),
+ ClosureArg = mlds_argument(
+ entity_data(mlds_data_var(mlds_var_name("closure_arg", no))),
ClosureArgType, GCStatement),
Params0 = mlds_func_params(ArgParams0, RetParam),
Params = mlds_func_params([ClosureArg | ArgParams0], RetParam),
@@ -210,12 +210,12 @@
(
GenericCall = higher_order(ClosureVar, _Purity, _PredOrFunc, _Arity),
ml_gen_var(!.Info, ClosureVar, ClosureLval),
- FieldId = offset(const(mlconst_int(1))),
+ FieldId = ml_field_offset(ml_const(mlconst_int(1))),
% XXX are these types right?
- FuncLval = field(yes(0), lval(ClosureLval), FieldId,
+ FuncLval = ml_field(yes(0), ml_lval(ClosureLval), FieldId,
mlds_generic_type, ClosureArgType),
FuncType = mlds_func_type(Params),
- FuncRval = unop(unbox(FuncType), lval(FuncLval))
+ FuncRval = ml_unop(unbox(FuncType), ml_lval(FuncLval))
;
GenericCall = class_method(TypeClassInfoVar, MethodNum,
_ClassId, _PredName),
@@ -226,19 +226,19 @@
ClosureLval = TypeClassInfoLval,
% Extract the base_typeclass_info from the typeclass_info.
- BaseTypeclassInfoFieldId = offset(const(mlconst_int(0))),
- BaseTypeclassInfoLval = field(yes(0),
- lval(TypeClassInfoLval), BaseTypeclassInfoFieldId,
+ BaseTypeclassInfoFieldId = ml_field_offset(ml_const(mlconst_int(0))),
+ BaseTypeclassInfoLval = ml_field(yes(0),
+ ml_lval(TypeClassInfoLval), BaseTypeclassInfoFieldId,
mlds_generic_type, ClosureArgType),
% Extract the method address from the base_typeclass_info.
Offset = ml_base_typeclass_info_method_offset,
MethodFieldNum = MethodNum + Offset,
- MethodFieldId = offset(const(mlconst_int(MethodFieldNum))),
- FuncLval = field(yes(0), lval(BaseTypeclassInfoLval),
+ MethodFieldId = ml_field_offset(ml_const(mlconst_int(MethodFieldNum))),
+ FuncLval = ml_field(yes(0), ml_lval(BaseTypeclassInfoLval),
MethodFieldId, mlds_generic_type, mlds_generic_type),
FuncType = mlds_func_type(Params),
- FuncRval = unop(unbox(FuncType), lval(FuncLval))
+ FuncRval = ml_unop(unbox(FuncType), ml_lval(FuncLval))
),
% Assign the function address rval to a new local variable. This makes
@@ -252,11 +252,11 @@
% The function address is always a pointer to code,
% not to the heap, so the GC doesn't need to trace it.
GCStatement = gc_no_stmt,
- FuncVarDecl = ml_gen_mlds_var_decl(var(FuncVarName),
+ FuncVarDecl = ml_gen_mlds_var_decl(mlds_data_var(FuncVarName),
FuncType, GCStatement, mlds_make_context(Context)),
ml_gen_var_lval(!.Info, FuncVarName, FuncType, FuncVarLval),
AssignFuncVar = ml_gen_assign(FuncVarLval, FuncRval, Context),
- FuncVarRval = lval(FuncVarLval),
+ FuncVarRval = ml_lval(FuncVarLval),
% Generate code to box/unbox the arguments and compute the list of properly
% converted rvals/lvals to pass as the function call's arguments and
@@ -267,7 +267,7 @@
ArgModes, PredOrFunc, CodeModel, Context, no, 1,
InputRvals, OutputLvals, OutputTypes,
ConvArgDecls, ConvOutputStatements, !Info),
- ClosureRval = unop(unbox(ClosureArgType), lval(ClosureLval)),
+ ClosureRval = ml_unop(unbox(ClosureArgType), ml_lval(ClosureLval)),
% Prepare to generate the call, passing the closure as the first argument.
% (We can't actually generate the call yet, since it might be nondet,
@@ -323,7 +323,7 @@
;
IsDummy = is_not_dummy_type,
ml_gen_box_or_unbox_rval(SrcType, DestType, native_if_possible,
- lval(SrcLval), CastRval, !Info),
+ ml_lval(SrcLval), CastRval, !Info),
Assign = ml_gen_assign(DestLval, CastRval, Context),
Statements = [Assign]
),
@@ -568,7 +568,7 @@
% reponsibility of fillling this in properly if needed.
GCStatement = gc_no_stmt,
Argument =
- mlds_argument(entity_data(var(ArgName)), Type, GCStatement),
+ mlds_argument(entity_data(mlds_data_var(ArgName)), Type, GCStatement),
ml_gen_cont_params_2(Types, ArgNum + 1, Arguments).
:- pred ml_gen_copy_args_to_locals(ml_gen_info::in, list(mlds_lval)::in,
@@ -590,7 +590,7 @@
ArgNum, Context, [Statement | Statements]) :-
ArgName = ml_gen_arg_name(ArgNum),
ml_gen_var_lval(Info, ArgName, Type, ArgLval),
- Statement = ml_gen_assign(LocalLval, lval(ArgLval), Context),
+ Statement = ml_gen_assign(LocalLval, ml_lval(ArgLval), Context),
ml_gen_copy_args_to_locals_2(Info, LocalLvals, Types, ArgNum + 1,
Context, Statements).
ml_gen_copy_args_to_locals_2(_Info, [], [_ | _], _, _, _) :-
@@ -610,7 +610,7 @@
Signature = mlds_get_func_signature(Params),
ProcLabel = mlds_proc_label(PredLabel, ProcId),
QualifiedProcLabel = qual(PredModule, module_qual, ProcLabel),
- CodeAddrRval = const(mlconst_code_addr(
+ CodeAddrRval = ml_const(mlconst_code_addr(
code_addr_proc(QualifiedProcLabel, Signature))).
% Generate rvals and lvals for the arguments of a procedure call
@@ -670,10 +670,10 @@
% generate a dummy value for it. Using `0' here is more
% efficient than using private_builtin.dummy_var, which is
% what ml_gen_var will have generated for this variable.
- VarRval = const(mlconst_int(0))
+ VarRval = ml_const(mlconst_int(0))
;
CallerIsDummy = is_not_dummy_type,
- VarRval = lval(VarLval)
+ VarRval = ml_lval(VarLval)
),
ml_gen_box_or_unbox_rval(CallerType, CalleeType,
native_if_possible, VarRval, ArgRval, !Info),
@@ -727,7 +727,7 @@
:- 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 = ml_mem_ref(Rval, _) then Rval else ml_mem_addr(Lval)).
ml_gen_box_or_unbox_rval(SourceType, DestType, BoxPolicy, VarRval, ArgRval,
!Info) :-
@@ -743,22 +743,22 @@
DestType \= type_variable(_, _)
->
ml_gen_type(!.Info, DestType, MLDS_DestType),
- ArgRval = unop(unbox(MLDS_DestType), VarRval)
+ ArgRval = ml_unop(unbox(MLDS_DestType), VarRval)
;
% If converting from concrete type to polymorphic type, then box.
SourceType \= type_variable(_, _),
DestType = type_variable(_, _)
->
ml_gen_type(!.Info, SourceType, MLDS_SourceType),
- ArgRval = unop(box(MLDS_SourceType), VarRval)
+ ArgRval = ml_unop(box(MLDS_SourceType), VarRval)
;
% If converting to float, cast to mlds_generic_type and then unbox.
DestType = builtin_type(builtin_type_float),
SourceType \= builtin_type(builtin_type_float)
->
ml_gen_type(!.Info, DestType, MLDS_DestType),
- ArgRval = unop(unbox(MLDS_DestType),
- unop(cast(mlds_generic_type), VarRval))
+ ArgRval = ml_unop(unbox(MLDS_DestType),
+ ml_unop(cast(mlds_generic_type), VarRval))
;
% If converting from float, box and then cast the result.
SourceType = builtin_type(builtin_type_float),
@@ -766,8 +766,8 @@
->
ml_gen_type(!.Info, SourceType, MLDS_SourceType),
ml_gen_type(!.Info, DestType, MLDS_DestType),
- ArgRval = unop(cast(MLDS_DestType),
- unop(box(MLDS_SourceType), VarRval))
+ ArgRval = ml_unop(cast(MLDS_DestType),
+ ml_unop(box(MLDS_SourceType), VarRval))
;
% If converting from an array(T) to array(X) where X is a concrete
% instance, we should insert a cast to the concrete instance.
@@ -788,7 +788,7 @@
SourceType \= DestType
->
ml_gen_type(!.Info, DestType, MLDS_DestType),
- ArgRval = unop(cast(MLDS_DestType), VarRval)
+ ArgRval = ml_unop(cast(MLDS_DestType), VarRval)
;
% If converting from one concrete type to a different one, then
% cast. This is needed to handle construction/deconstruction
@@ -797,7 +797,7 @@
\+ type_unify(SourceType, DestType, [], map.init, _)
->
ml_gen_type(!.Info, DestType, MLDS_DestType),
- ArgRval = unop(cast(MLDS_DestType), VarRval)
+ ArgRval = ml_unop(cast(MLDS_DestType), VarRval)
;
% Otherwise leave unchanged.
ArgRval = VarRval
@@ -811,8 +811,8 @@
% if no boxing/unboxing is required, then ml_box_or_unbox_rval
% will return its argument unchanged, and so we're done.
ml_gen_box_or_unbox_rval(CalleeType, CallerType, BoxPolicy,
- lval(VarLval), BoxedRval, !Info),
- ( BoxedRval = lval(VarLval) ->
+ ml_lval(VarLval), BoxedRval, !Info),
+ ( BoxedRval = ml_lval(VarLval) ->
ArgLval = VarLval,
ConvDecls = [],
ConvInputStatements = [],
@@ -856,8 +856,8 @@
ForClosureWrapper = no,
ml_gen_gc_statement(ArgVarName, CalleeType, CallerType,
Context, GC_Statements, !Info),
- ArgVarDecl = ml_gen_mlds_var_decl(var(ArgVarName), MLDS_CalleeType,
- GC_Statements, mlds_make_context(Context))
+ ArgVarDecl = ml_gen_mlds_var_decl(mlds_data_var(ArgVarName),
+ MLDS_CalleeType, GC_Statements, mlds_make_context(Context))
),
ConvDecls = [ArgVarDecl],
@@ -879,14 +879,14 @@
% Assign to the freshly generated arg variable.
ml_gen_box_or_unbox_rval(CallerType, CalleeType, BoxPolicy,
- lval(VarLval), ConvertedVarRval, !Info),
+ ml_lval(VarLval), ConvertedVarRval, !Info),
AssignInputStatement = ml_gen_assign(ArgLval, ConvertedVarRval,
Context),
ConvInputStatements = [AssignInputStatement],
% Assign from the freshly generated arg variable.
ml_gen_box_or_unbox_rval(CalleeType, CallerType, BoxPolicy,
- lval(ArgLval), ConvertedArgRval, !Info),
+ ml_lval(ArgLval), ConvertedArgRval, !Info),
AssignOutputStatement = ml_gen_assign(VarLval, ConvertedArgRval,
Context),
ConvOutputStatements = [AssignOutputStatement]
@@ -922,7 +922,7 @@
(
% We need to avoid generating assignments to dummy variables
% introduced for types such as io.state.
- Lval = var(_VarName, VarType),
+ Lval = ml_var(_VarName, VarType),
VarType = mercury_type(ProgDataType, _, _),
check_dummy_type(ModuleInfo, ProgDataType) = is_dummy_type
->
@@ -934,9 +934,10 @@
)
;
SimpleCode = ref_assign(AddrLval, ValueLval),
- ( ValueLval = var(_ValueVarName, ValueType) ->
- Statement = ml_gen_assign(mem_ref(lval(AddrLval), ValueType),
- lval(ValueLval), Context),
+ ( ValueLval = ml_var(_ValueVarName, ValueType) ->
+ Statement = ml_gen_assign(
+ ml_mem_ref(ml_lval(AddrLval), ValueType),
+ ml_lval(ValueLval), Context),
Statements = [Statement]
;
unexpected(this_file, "malformed ref_assign")
@@ -973,13 +974,13 @@
:- func ml_gen_simple_expr(simple_expr(mlds_lval)) = mlds_rval.
-ml_gen_simple_expr(leaf(Lval)) = lval(Lval).
-ml_gen_simple_expr(int_const(Int)) = const(mlconst_int(Int)).
-ml_gen_simple_expr(float_const(Float)) = const(mlconst_float(Float)).
+ml_gen_simple_expr(leaf(Lval)) = ml_lval(Lval).
+ml_gen_simple_expr(int_const(Int)) = ml_const(mlconst_int(Int)).
+ml_gen_simple_expr(float_const(Float)) = ml_const(mlconst_float(Float)).
ml_gen_simple_expr(unary(Op, Expr)) =
- unop(std_unop(Op), ml_gen_simple_expr(Expr)).
+ ml_unop(std_unop(Op), ml_gen_simple_expr(Expr)).
ml_gen_simple_expr(binary(Op, ExprA, ExprB)) =
- binop(Op, ml_gen_simple_expr(ExprA), ml_gen_simple_expr(ExprB)).
+ ml_binop(Op, ml_gen_simple_expr(ExprA), ml_gen_simple_expr(ExprB)).
%-----------------------------------------------------------------------------%
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.59
diff -u -b -r1.59 ml_closure_gen.m
--- compiler/ml_closure_gen.m 25 May 2009 02:34:35 -0000 1.59
+++ compiler/ml_closure_gen.m 6 Jun 2009 14:31:47 -0000
@@ -145,16 +145,16 @@
NumArgs, Context, WrapperFuncRval0, WrapperFuncType0, !Info),
% Compute the rval which holds the number of arguments
- NumArgsRval0 = const(mlconst_int(NumArgs)),
+ NumArgsRval0 = ml_const(mlconst_int(NumArgs)),
NumArgsType0 = mlds_native_int_type,
% Put all the extra arguments of the closure together
% Note that we need to box these arguments.
- NumArgsRval = unop(box(NumArgsType0), NumArgsRval0),
+ NumArgsRval = ml_unop(box(NumArgsType0), NumArgsRval0),
NumArgsType = mlds_generic_type,
- WrapperFuncRval = unop(box(WrapperFuncType0), WrapperFuncRval0),
+ WrapperFuncRval = ml_unop(box(WrapperFuncType0), WrapperFuncRval0),
WrapperFuncType = mlds_generic_type,
- ClosureLayoutRval = unop(box(ClosureLayoutType0), ClosureLayoutRval0),
+ ClosureLayoutRval = ml_unop(box(ClosureLayoutType0), ClosureLayoutRval0),
ClosureLayoutType = mlds_generic_type,
ExtraArgRvals = [ClosureLayoutRval, WrapperFuncRval, NumArgsRval],
ExtraArgTypes = [ClosureLayoutType, WrapperFuncType, NumArgsType],
@@ -203,7 +203,7 @@
TvarVectorName),
ml_stack_layout_construct_tvar_vector(ModuleInfo, TvarVectorName,
Context, TVarLocnMap, TVarVectorRval, TVarVectorType, TVarDefns),
- InitTVarVector = init_obj(unop(box(TVarVectorType), TVarVectorRval)),
+ InitTVarVector = init_obj(ml_unop(box(TVarVectorType), TVarVectorRval)),
Inits = [InitProcId, InitTVarVector | InitClosureArgs],
_ArgTypes = [ProcIdType, TVarVectorType | ClosureArgTypes],
@@ -221,8 +221,8 @@
ClosureArgDefns ++ [ClosureLayoutDefn],
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- ClosureLayoutRval = lval(var(qual(MLDS_ModuleName, module_qual, Name),
- ClosureLayoutType)).
+ ClosureLayoutRval = ml_lval(
+ ml_var(qual(MLDS_ModuleName, module_qual, Name), ClosureLayoutType)).
:- pred ml_gen_closure_proc_id(module_info::in, prog_context::in,
mlds_initializer::out, mlds_type::out, list(mlds_defn)::out) is det.
@@ -230,7 +230,7 @@
ml_gen_closure_proc_id(_ModuleInfo, _Context, InitProcId, ProcIdType,
ClosureProcIdDefns) :-
% XXX currently we don't fill in the ProcId field!
- InitProcId = init_obj(const(mlconst_null(ProcIdType))),
+ InitProcId = init_obj(ml_const(mlconst_null(ProcIdType))),
ProcIdType = mlds_generic_type,
ClosureProcIdDefns = [].
% module_info_get_name(ModuleInfo, ModuleName),
@@ -259,9 +259,9 @@
assoc_list.keys(ArgInitsAndTypes, ArgInits),
assoc_list.values(ArgInitsAndTypes, ArgTypes),
Length = list.length(ArgInits),
- LengthRval = const(mlconst_int(Length)),
+ LengthRval = ml_const(mlconst_int(Length)),
LengthType = mlds_native_int_type,
- CastLengthRval = unop(box(LengthType), LengthRval),
+ CastLengthRval = ml_unop(box(LengthType), LengthRval),
ClosureArgInits = [init_obj(CastLengthRval) | ArgInits],
ClosureArgTypes = [LengthType | ArgTypes].
@@ -284,7 +284,7 @@
ExistQTvars, PseudoTypeInfo),
ml_gen_pseudo_type_info(ModuleInfo, PseudoTypeInfo, ArgRval, ArgType,
!Defns),
- CastArgRval = unop(box(ArgType), ArgRval),
+ CastArgRval = ml_unop(box(ArgType), ArgRval),
ArgInit = init_obj(CastArgRval).
:- pred ml_gen_maybe_pseudo_type_info_defn(module_info::in,
@@ -329,7 +329,7 @@
(
PseudoTypeInfo = type_var(N),
% Type variables are represented just as integers.
- Rval = const(mlconst_int(N)),
+ Rval = ml_const(mlconst_int(N)),
Type = mlds_native_int_type
;
( PseudoTypeInfo = plain_arity_zero_pseudo_type_info(_)
@@ -366,7 +366,7 @@
arg_maybe_pseudo_type_infos(PseudoTypeInfo), !Defns)
),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- Rval = const(mlconst_data_addr(data_addr(MLDS_ModuleName,
+ Rval = ml_const(mlconst_data_addr(data_addr(MLDS_ModuleName,
mlds_rtti(RttiId)))),
Type = mlds_rtti_type(item_type(RttiId))
).
@@ -404,7 +404,7 @@
arg_type_infos(TypeInfo), !Defns)
),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- Rval = const(mlconst_data_addr(data_addr(MLDS_ModuleName,
+ Rval = ml_const(mlconst_data_addr(data_addr(MLDS_ModuleName,
mlds_rtti(RttiId)))),
Type = mlds_rtti_type(item_type(RttiId)).
@@ -438,7 +438,7 @@
TVarLocnMap, MLDS_Rval, ArrayType, Defns) :-
ArrayType = mlds_array_type(mlds_native_int_type),
( map.is_empty(TVarLocnMap) ->
- MLDS_Rval = const(mlconst_null(ArrayType)),
+ MLDS_Rval = ml_const(mlconst_null(ArrayType)),
Defns = []
;
Access = acc_local,
@@ -450,7 +450,7 @@
Defns = [Defn],
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
- MLDS_Rval = lval(var(
+ MLDS_Rval = ml_lval(ml_var(
qual(MLDS_ModuleName, module_qual, TvarVectorName),
ArrayType))
).
@@ -463,7 +463,7 @@
ml_stack_layout_construct_type_param_locn_vector(TVarLocns, 1,
TypeParamLocs),
list.length(TypeParamLocs, TypeParamsLength),
- LengthRval = const(mlconst_int(TypeParamsLength)),
+ LengthRval = ml_const(mlconst_int(TypeParamsLength)),
Vector = [init_obj(LengthRval) | TypeParamLocs],
VectorTypes = list.duplicate(TypeParamsLength + 1, mlds_native_int_type).
@@ -488,7 +488,7 @@
unexpected(this_file, "tvar has empty set of locations")
),
stack_layout.represent_locn_as_int(Locn, LocnAsInt),
- Rval = const(mlconst_int(LocnAsInt)),
+ Rval = ml_const(mlconst_int(LocnAsInt)),
ml_stack_layout_construct_type_param_locn_vector(TVarLocns,
NextSlot, VectorTail),
Vector = [init_obj(Rval) | VectorTail]
@@ -496,7 +496,7 @@
% This slot will never be referred to.
ml_stack_layout_construct_type_param_locn_vector(
[TVar - Locns | TVarLocns], NextSlot, VectorTail),
- Vector = [init_obj(const(mlconst_int(0))) | VectorTail]
+ Vector = [init_obj(ml_const(mlconst_int(0))) | VectorTail]
;
unexpected(this_file,
"unsorted tvars in construct_type_param_locn_vector")
@@ -746,7 +746,7 @@
gen_closure_gc_statement(ClosureArgName, ClosureArgDeclType,
ClosureKind, WrapperArgTypes, Purity, PredOrFunc,
Context, ClosureArgGCStatement, !Info),
- ClosureArg = mlds_argument(entity_data(var(ClosureArgName)),
+ ClosureArg = mlds_argument(entity_data(mlds_data_var(ClosureArgName)),
ClosureArgType, ClosureArgGCStatement),
MaybeClosureA = yes({ClosureArgType, ClosureArgName}),
WrapperArgs = [ClosureArg | WrapperArgs1]
@@ -787,12 +787,12 @@
% (unlike the closure_arg parameter) it isn't referenced from
% the GC tracing for other variables.
ClosureGCStatement = gc_no_stmt,
- ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
+ ClosureDecl = ml_gen_mlds_var_decl(mlds_data_var(ClosureName),
ClosureType, ClosureGCStatement, MLDS_Context),
ml_gen_var_lval(!.Info, ClosureName, ClosureType, ClosureLval),
ml_gen_var_lval(!.Info, ClosureArgName1, ClosureArgType1,
ClosureArgLval),
- InitClosure = ml_gen_assign(ClosureLval, lval(ClosureArgLval),
+ InitClosure = ml_gen_assign(ClosureLval, ml_lval(ClosureArgLval),
Context),
MaybeClosureB = yes({ClosureDecl, InitClosure}),
MaybeClosureC = yes(ClosureLval)
@@ -1072,7 +1072,7 @@
;
% Output arguments are passed by reference, so we need to
% dereference them.
- Lval = mem_ref(lval(VarLval), MLDS_Type),
+ Lval = ml_mem_ref(ml_lval(VarLval), MLDS_Type),
CopyOutLvals = CopyOutLvalsTail,
Defns = DefnsTail
)
@@ -1115,9 +1115,9 @@
% We use 'gc_initialiser' for the garbage collection code as it is code to
% initialise local variables used during garbage collection and must
% run before variables are traced.
- ClosureLayoutPtrDecl = ml_gen_mlds_var_decl(var(ClosureLayoutPtrName),
- ClosureLayoutPtrType, gc_initialiser(ClosureLayoutPtrGCInit),
- MLDS_Context),
+ ClosureLayoutPtrDecl = ml_gen_mlds_var_decl(
+ mlds_data_var(ClosureLayoutPtrName), ClosureLayoutPtrType,
+ gc_initialiser(ClosureLayoutPtrGCInit), MLDS_Context),
ml_gen_var_lval(!.Info, ClosureLayoutPtrName, ClosureLayoutPtrType,
ClosureLayoutPtrLval),
@@ -1128,7 +1128,7 @@
% We use 'gc_initialiser' for the garbage collection code as it is code to
% initialise local variables used during garbage collection and must
% run before variables are traced.
- TypeParamsDecl = ml_gen_mlds_var_decl(var(TypeParamsName),
+ TypeParamsDecl = ml_gen_mlds_var_decl(mlds_data_var(TypeParamsName),
TypeParamsType, gc_initialiser(TypeParamsGCInit), MLDS_Context),
ml_gen_var_lval(!.Info, TypeParamsName, TypeParamsType, TypeParamsLval),
(
@@ -1136,7 +1136,7 @@
ClosureLayoutPtrGCInitFragments = [
target_code_output(ClosureLayoutPtrLval),
raw_target_code(" = (MR_Box) ((MR_Closure *)\n", []),
- target_code_input(lval(ClosureArgLval)),
+ target_code_input(ml_lval(ClosureArgLval)),
raw_target_code(")->MR_closure_layout;\n", [])
],
ClosureLayoutPtrGCInit = statement(ml_stmt_atomic(
@@ -1146,7 +1146,7 @@
target_code_output(TypeParamsLval),
raw_target_code(" = (MR_Box) " ++
"MR_materialize_closure_type_params(\n", []),
- target_code_input(lval(ClosureArgLval)),
+ target_code_input(ml_lval(ClosureArgLval)),
raw_target_code(");\n", [])
]
;
@@ -1159,7 +1159,7 @@
ClosureLayoutDefns,
[statement(ml_stmt_atomic(
assign(ClosureLayoutPtrLval,
- unop(box(ClosureLayoutType), ClosureLayoutRval)
+ ml_unop(box(ClosureLayoutType), ClosureLayoutRval)
)), MLDS_Context)]
), MLDS_Context),
TypeParamsGCInitFragments = [
@@ -1167,9 +1167,9 @@
raw_target_code(" = (MR_Box) " ++
"MR_materialize_typeclass_info_type_params(\n"
++ "(MR_Word) ", []),
- target_code_input(lval(ClosureArgLval)),
+ target_code_input(ml_lval(ClosureArgLval)),
raw_target_code(", (MR_Closure_Layout *) ", []),
- target_code_input(lval(ClosureLayoutPtrLval)),
+ target_code_input(ml_lval(ClosureLayoutPtrLval)),
raw_target_code(");\n", [])
]
;
@@ -1222,11 +1222,11 @@
TypeInfoMercuryType = c_pointer_type,
TypeInfoType = mercury_type_to_mlds_type(ModuleInfo, TypeInfoMercuryType),
ml_gen_var_lval(!.Info, TypeInfoName, TypeInfoType, TypeInfoLval),
- TypeInfoDecl = ml_gen_mlds_var_decl(var(TypeInfoName), TypeInfoType,
- gc_no_stmt, MLDS_Context),
+ TypeInfoDecl = ml_gen_mlds_var_decl(mlds_data_var(TypeInfoName),
+ TypeInfoType, gc_no_stmt, MLDS_Context),
ml_gen_gc_statement_with_typeinfo(VarName, Type,
- lval(TypeInfoLval), Context, GCStatement0, !Info),
+ ml_lval(TypeInfoLval), Context, GCStatement0, !Info),
(
(
@@ -1240,9 +1240,9 @@
target_code_output(TypeInfoLval),
raw_target_code(" = (MR_C_Pointer) " ++
"MR_make_type_info_maybe_existq(\n\t", []),
- target_code_input(lval(TypeParamsLval)),
+ target_code_input(ml_lval(TypeParamsLval)),
raw_target_code(", ((MR_Closure_Layout *)\n\t", []),
- target_code_input(lval(ClosureLayoutPtrLval)),
+ target_code_input(ml_lval(ClosureLayoutPtrLval)),
raw_target_code(string.format(")->" ++
"MR_closure_arg_pseudo_type_info[%d - 1],\n\t" ++
"NULL, NULL, &allocated_mem);\n",
@@ -1262,7 +1262,7 @@
GCStatement0 = gc_no_stmt,
GCStatement = GCStatement0
),
- LocalVarDefn = ml_gen_mlds_var_decl(var(VarName),
+ LocalVarDefn = ml_gen_mlds_var_decl(mlds_data_var(VarName),
mercury_type_to_mlds_type(ModuleInfo, Type),
GCStatement, MLDS_Context).
@@ -1275,9 +1275,9 @@
ClosureArgLvals = []
;
% Generate `MR_field(MR_mktag(0), closure, <N>)'.
- FieldId = offset(const(mlconst_int(ArgNum + Offset))),
+ FieldId = ml_field_offset(ml_const(mlconst_int(ArgNum + Offset))),
% XXX These types might not be right.
- FieldLval = field(yes(0), lval(ClosureLval), FieldId,
+ FieldLval = ml_field(yes(0), ml_lval(ClosureLval), FieldId,
mlds_generic_type, mlds_generic_type),
% Recursively handle the remaining fields.
ml_gen_closure_field_lvals(ClosureLval, Offset, ArgNum + 1,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.214
diff -u -b -r1.214 ml_code_gen.m
--- compiler/ml_code_gen.m 16 Jan 2009 02:31:23 -0000 1.214
+++ compiler/ml_code_gen.m 6 Jun 2009 14:32:22 -0000
@@ -1263,14 +1263,14 @@
:- func encode_enum_init(string) = mlds_initializer.
encode_enum_init(EnumConstName) =
- init_obj(const(mlconst_named_const(EnumConstName))).
+ init_obj(ml_const(mlconst_named_const(EnumConstName))).
:- func gen_init_tabling_name(mlds_module_name, mlds_proc_label,
proc_tabling_struct_id) = mlds_initializer.
gen_init_tabling_name(ModuleName, ProcLabel, TablingId) = Rval :-
DataAddr = data_addr(ModuleName, mlds_tabling_ref(ProcLabel, TablingId)),
- Rval = init_obj(const(mlconst_data_addr(DataAddr))).
+ Rval = init_obj(ml_const(mlconst_data_addr(DataAddr))).
:- func tabling_name_and_init_to_defn(mlds_proc_label, mlds_context, constness,
proc_tabling_struct_id, mlds_initializer) = mlds_defn.
@@ -1779,7 +1779,8 @@
% <do Goal>
% succeeded = MR_TRUE
%
- ml_gen_set_success(!.Info, const(mlconst_true), Context, SetSuccessTrue),
+ ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
+ SetSuccessTrue),
!:Statements = !.Statements ++ [SetSuccessTrue].
ml_gen_wrap_goal(model_non, model_det, Context, !Statements, !Info) :-
@@ -1888,7 +1889,7 @@
[i(CommitLabelNum)]), no),
ml_gen_var_lval(!.Info, CommitRef, mlds_commit_type, CommitRefLval),
CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context, CommitRef),
- DoCommitStmt = ml_stmt_do_commit(lval(CommitRefLval)),
+ DoCommitStmt = ml_stmt_do_commit(ml_lval(CommitRefLval)),
DoCommitStatement = statement(DoCommitStmt, MLDS_Context),
% Pop nesting level.
ml_gen_nondet_label_func(!.Info, SuccessFuncLabel, Context,
@@ -1904,9 +1905,9 @@
GoalStatement = ml_gen_block(GoalOtherDecls, GoalStatements,
GoalContext),
ml_gen_info_pop_success_cont(!Info),
- ml_gen_set_success(!.Info, const(mlconst_false), Context,
+ ml_gen_set_success(!.Info, ml_const(mlconst_false), Context,
SetSuccessFalse),
- ml_gen_set_success(!.Info, const(mlconst_true), Context,
+ ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
SetSuccessTrue),
TryCommitStmt = ml_stmt_try_commit(CommitRefLval,
ml_gen_block([], [GoalStatement, SetSuccessFalse], Context),
@@ -1968,7 +1969,7 @@
string.format("commit_%d", [i(CommitLabelNum)]), no),
ml_gen_var_lval(!.Info, CommitRef, mlds_commit_type, CommitRefLval),
CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context, CommitRef),
- DoCommitStmt = ml_stmt_do_commit(lval(CommitRefLval)),
+ DoCommitStmt = ml_stmt_do_commit(ml_lval(CommitRefLval)),
DoCommitStatement = statement(DoCommitStmt, MLDS_Context),
% pop nesting level
ml_gen_nondet_label_func(!.Info, SuccessFuncLabel, Context,
@@ -2150,13 +2151,13 @@
ml_gen_type(!.Info, Type, MLDS_Type),
ml_gen_gc_statement(LocalVarName, Type, Context, GCStatement,
!Info),
- LocalVarDefn = ml_gen_mlds_var_decl(var(LocalVarName), MLDS_Type,
+ LocalVarDefn = ml_gen_mlds_var_decl(mlds_data_var(LocalVarName), MLDS_Type,
GCStatement, mlds_make_context(Context)),
% Generate code to assign from the local var to the output var.
ml_gen_var(!.Info, OutputVar, OutputVarLval),
ml_gen_var_lval(!.Info, LocalVarName, MLDS_Type, LocalVarLval),
- Assign = ml_gen_assign(OutputVarLval, lval(LocalVarLval), Context),
+ Assign = ml_gen_assign(OutputVarLval, ml_lval(LocalVarLval), Context),
% Update the lval for this variable so that any references to it inside
% the commit refer to the local variable rather than to the output
@@ -2169,7 +2170,8 @@
:- func ml_gen_commit_var_decl(mlds_context, mlds_var_name) = mlds_defn.
ml_gen_commit_var_decl(Context, VarName) =
- ml_gen_mlds_var_decl(var(VarName), mlds_commit_type, gc_no_stmt, Context).
+ ml_gen_mlds_var_decl(mlds_data_var(VarName), mlds_commit_type, gc_no_stmt,
+ Context).
% Generate MLDS code for the different kinds of HLDS goals.
%
@@ -2500,13 +2502,13 @@
(
Expr = trace_base(trace_envvar(EnvVar)),
ml_gen_info_add_env_var_name(EnvVar, !Info),
- EnvVarRval = lval(global_var_ref(env_var_ref(EnvVar))),
- ZeroRval = const(mlconst_int(0)),
- CondRval = binop(ne, EnvVarRval, ZeroRval)
+ EnvVarRval = ml_lval(ml_global_var_ref(env_var_ref(EnvVar))),
+ ZeroRval = ml_const(mlconst_int(0)),
+ CondRval = ml_binop(ne, EnvVarRval, ZeroRval)
;
Expr = trace_not(ExprA),
ml_generate_runtime_cond_code(ExprA, RvalA, !Info),
- CondRval = unop(std_unop(logical_not), RvalA)
+ CondRval = ml_unop(std_unop(logical_not), RvalA)
;
Expr = trace_op(TraceOp, ExprA, ExprB),
ml_generate_runtime_cond_code(ExprA, RvalA, !Info),
@@ -2518,7 +2520,7 @@
TraceOp = trace_and,
Op = logical_and
),
- CondRval = binop(Op, RvalA, RvalB)
+ CondRval = ml_binop(Op, RvalA, RvalB)
).
:- pred ml_gen_ordinary_pragma_foreign_proc(code_model::in,
@@ -2671,13 +2673,13 @@
% out into "success".
SuccessIndicatorVarName = mlds_var_name("SUCCESS_INDICATOR", no),
SuccessIndicatorDecl = ml_gen_mlds_var_decl(
- var(SuccessIndicatorVarName),
+ mlds_data_var(SuccessIndicatorVarName),
mlds_native_bool_type,
gc_no_stmt, MLDSContext),
- SuccessIndicatorLval = var(qual(MLDSModuleName, module_qual,
+ SuccessIndicatorLval = ml_var(qual(MLDSModuleName, module_qual,
SuccessIndicatorVarName), mlds_native_bool_type),
SuccessIndicatorStatement = ml_gen_assign(SucceededLval,
- lval(SuccessIndicatorLval), Context),
+ ml_lval(SuccessIndicatorLval), Context),
SuccessVarLocals = [SuccessIndicatorDecl],
SuccessIndicatorStatements = [SuccessIndicatorStatement]
;
@@ -2715,7 +2717,7 @@
mode_to_arg_mode(ModuleInfo, Mode, OrigType, ArgMode),
(
ArgMode = top_in,
- OutlineArg = in(MldsType, ArgName, lval(VarLval))
+ OutlineArg = in(MldsType, ArgName, ml_lval(VarLval))
;
ArgMode = top_out,
OutlineArg = out(MldsType, ArgName, VarLval)
@@ -2830,18 +2832,19 @@
QualVarName = qual(MLDSModuleName, module_qual, VarName),
(
IsByRef = yes,
- OutputVarLval = mem_ref(lval(var(QualVarName, MLDSType)), MLDSType)
+ OutputVarLval = ml_mem_ref(ml_lval(ml_var(QualVarName, MLDSType)),
+ MLDSType)
;
IsByRef = no,
- OutputVarLval = var(QualVarName, MLDSType)
+ OutputVarLval = ml_var(QualVarName, MLDSType)
),
MaybeNameMode = yes(UserVarNameString - _),
NonMangledVarName = mlds_var_name(UserVarNameString, no),
QualLocalVarName= qual(MLDSModuleName, module_qual, NonMangledVarName),
- LocalVarLval = var(QualLocalVarName, MLDSType),
+ LocalVarLval = ml_var(QualLocalVarName, MLDSType),
- Statement = ml_gen_assign(OutputVarLval, lval(LocalVarLval), Context).
+ Statement = ml_gen_assign(OutputVarLval, ml_lval(LocalVarLval), Context).
:- pred ml_gen_pragma_il_proc_var_decl_defn(module_info::in,
mlds_module_name::in, map(prog_var, foreign_arg)::in, prog_varset::in,
@@ -2882,14 +2885,14 @@
;
MLDSType = MLDSType0,
QualVarName = qual(MLDSModuleName, module_qual, VarName),
- Initializer = init_obj(lval(var(QualVarName, MLDSType)))
+ Initializer = init_obj(ml_lval(ml_var(QualVarName, MLDSType)))
),
% XXX Accurate GC is not supported for IL foreign code;
% this would only be useful if interfacing to
% IL when compiling to C, which is not yet supported.
GCStatement = gc_no_stmt,
- Defn = ml_gen_mlds_var_decl_init(var(NonMangledVarName), MLDSType,
- Initializer, GCStatement, MLDSContext).
+ Defn = ml_gen_mlds_var_decl_init(mlds_data_var(NonMangledVarName),
+ MLDSType, Initializer, GCStatement, MLDSContext).
% For ordinary (not model_non) pragma c_proc,
% we generate code of the following form:
@@ -3098,7 +3101,8 @@
ml_gen_info_get_proc_id(Info, ProcId),
ml_gen_proc_label(ModuleInfo, PredId, ProcId, Name, Module),
HashDefine = [raw_target_code("#define MR_PROC_LABEL ", []),
- name(qual(Module, module_qual, Name)), raw_target_code("\n", [])].
+ target_code_name(qual(Module, module_qual, Name)),
+ raw_target_code("\n", [])].
:- func get_target_code_attributes(foreign_language,
pragma_foreign_proc_extra_attributes) = target_code_attributes.
@@ -3229,11 +3233,11 @@
% a dummy value for it. Using `0' here is more efficient than using
% private_builtin.dummy_var, which is what ml_gen_var will have
% generated for this variable.
- ArgRval = const(mlconst_int(0))
+ ArgRval = ml_const(mlconst_int(0))
;
IsDummy = is_not_dummy_type,
ml_gen_box_or_unbox_rval(VarType, OrigType, BoxPolicy,
- lval(VarLval), ArgRval, !Info)
+ ml_lval(VarLval), ArgRval, !Info)
),
% At this point we have an rval with the right type for *internal* use
% in the code generated by the Mercury compiler's MLDS back-end. We need
@@ -3356,10 +3360,10 @@
% It should have the Java foreign language representation
% of that type. Unfortunately this is not easily expressed
% as an mlds_type.
- LocalVarLval = var(QualLocalVarName, MLDSType),
+ LocalVarLval = ml_var(QualLocalVarName, MLDSType),
% We cast this variable back to the corresponding
% MLDS type before assigning it to the lval.
- Rval = unop(cast(MLDSType), lval(LocalVarLval)),
+ Rval = ml_unop(cast(MLDSType), ml_lval(LocalVarLval)),
AssignOutput = [ml_gen_assign(ArgLval, Rval, Context)]
;
% If the variable doesn't occur in the ArgNames list,
@@ -3578,7 +3582,7 @@
ml_gen_info_new_cond_var(CondVar, !Info),
MLDS_Context = mlds_make_context(Context),
CondVarDecl = ml_gen_cond_var_decl(CondVar, MLDS_Context),
- ml_gen_set_cond_var(!.Info, CondVar, const(mlconst_false), Context,
+ ml_gen_set_cond_var(!.Info, CondVar, ml_const(mlconst_false), Context,
SetCondFalse),
% Allocate a name for the `then_func'.
@@ -3595,8 +3599,8 @@
% push nesting level
Then = hlds_goal(_, ThenGoalInfo),
ThenContext = goal_info_get_context(ThenGoalInfo),
- ml_gen_set_cond_var(!.Info, CondVar, const(mlconst_true), ThenContext,
- SetCondTrue),
+ ml_gen_set_cond_var(!.Info, CondVar, ml_const(mlconst_true),
+ ThenContext, SetCondTrue),
ml_gen_goal_as_block(CodeModel, Then, ThenStatement, !Info),
ThenFuncBody = ml_gen_block([], [SetCondTrue, ThenStatement],
ThenContext),
@@ -3608,7 +3612,7 @@
ml_gen_test_cond_var(!.Info, CondVar, CondSucceeded),
ml_gen_goal_as_block(CodeModel, Else, ElseStatement, !Info),
IfStmt = ml_stmt_if_then_else(
- unop(std_unop(logical_not), CondSucceeded),
+ ml_unop(std_unop(logical_not), CondSucceeded),
ElseStatement, no),
IfStatement = statement(IfStmt, MLDS_Context),
@@ -3651,7 +3655,7 @@
CodeModel = model_semi, CondCodeModel = model_det,
ml_gen_goal(model_det, Cond, CondDecls, CondStatements, !Info),
- ml_gen_set_success(!.Info, const(mlconst_false), Context,
+ ml_gen_set_success(!.Info, ml_const(mlconst_false), Context,
SetSuccessFalse),
Decls = CondDecls,
Statements = CondStatements ++ [SetSuccessFalse]
@@ -3665,7 +3669,7 @@
CodeModel = model_semi, CondCodeModel = model_semi,
ml_gen_goal(model_semi, Cond, CondDecls, CondStatements, !Info),
ml_gen_test_success(!.Info, Succeeded),
- ml_gen_set_success(!.Info, unop(std_unop(logical_not), Succeeded),
+ ml_gen_set_success(!.Info, ml_unop(std_unop(logical_not), Succeeded),
Context, InvertSuccess),
Decls = CondDecls,
Statements = CondStatements ++ [InvertSuccess]
@@ -3803,7 +3807,8 @@
RestStatement = ml_gen_block(RestDecls, RestStatements,
Context),
IfStmt = ml_stmt_if_then_else(
- unop(std_unop(logical_not), Succeeded), RestStatement, no),
+ ml_unop(std_unop(logical_not), Succeeded),
+ RestStatement, no),
IfStatement = statement(IfStmt, mlds_make_context(Context)),
Decls = FirstDecls,
Statements = FirstStatements ++ [IfStatement]
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.136
diff -u -b -r1.136 ml_code_util.m
--- compiler/ml_code_util.m 16 Jan 2009 02:31:23 -0000 1.136
+++ compiler/ml_code_util.m 6 Jun 2009 14:33:05 -0000
@@ -782,7 +782,7 @@
(
CodeModel = model_semi,
ml_gen_test_success(Info, Succeeded),
- CopiedOutputVarRvals = list.map(func(Lval) = lval(Lval),
+ CopiedOutputVarRvals = list.map(func(Lval) = ml_lval(Lval),
CopiedOutputVarLvals),
ReturnStmt = ml_stmt_return([Succeeded | CopiedOutputVarRvals]),
ReturnStatement = statement(ReturnStmt,
@@ -792,7 +792,7 @@
CodeModel = model_det,
(
CopiedOutputVarLvals = [_ | _],
- CopiedOutputVarRvals = list.map(func(Lval) = lval(Lval),
+ CopiedOutputVarRvals = list.map(func(Lval) = ml_lval(Lval),
CopiedOutputVarLvals),
ReturnStmt = ml_stmt_return(CopiedOutputVarRvals),
ReturnStatement = statement(ReturnStmt,
@@ -986,15 +986,15 @@
%
ml_gen_and(X, Y) =
- ( X = const(mlconst_true) ->
+ ( X = ml_const(mlconst_true) ->
Y
- ; Y = const(mlconst_true) ->
+ ; Y = ml_const(mlconst_true) ->
X
;
- binop(logical_and, X, Y)
+ ml_binop(logical_and, X, Y)
).
-ml_gen_not(X) = unop(std_unop(logical_not), X).
+ml_gen_not(X) = ml_unop(std_unop(logical_not), X).
%-----------------------------------------------------------------------------%
%
@@ -1148,13 +1148,14 @@
ContType = mlds_cont_type([]),
RetTypes = RetTypes0
),
- ContName = entity_data(var(mlds_var_name("cont", no))),
+ ContName = entity_data(mlds_data_var(mlds_var_name("cont", no))),
% The cont variable always points to code, not to the heap,
% so the GC never needs to trace it.
ContGCStatement = gc_no_stmt,
ContArg = mlds_argument(ContName, ContType, ContGCStatement),
ContEnvType = mlds_generic_env_ptr_type,
- ContEnvName = entity_data(var(mlds_var_name("cont_env_ptr", no))),
+ ContEnvName = entity_data(
+ mlds_data_var(mlds_var_name("cont_env_ptr", no))),
% The cont_env_ptr always points to the stack, since continuation
% environments are always allocated on the stack (unless
% put_nondet_env_on_heap is true, which won't be the case when doing
@@ -1245,7 +1246,7 @@
),
MLDS_ArgType = mlds_ptr_type(MLDS_Type)
),
- Name = entity_data(var(Var)),
+ Name = entity_data(mlds_data_var(Var)),
(
!.MaybeInfo = yes(Info0),
% XXX We should fill in this Context properly.
@@ -1333,7 +1334,8 @@
),
ProcLabel = mlds_proc_label(PredLabel, ProcId),
QualProcLabel = qual(PredModule, module_qual, ProcLabel),
- FuncLabelRval = const(mlconst_code_addr(code_addr_internal(QualProcLabel,
+ FuncLabelRval = ml_const(
+ mlconst_code_addr(code_addr_internal(QualProcLabel,
FuncLabel, Signature))).
% Generate the mlds_pred_label and module name for a given procedure.
@@ -1456,7 +1458,7 @@
PrivateBuiltin = mercury_private_builtin_module,
MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
ml_gen_type(Info, Type, MLDS_Type),
- Lval = var(qual(MLDS_Module, module_qual,
+ Lval = ml_var(qual(MLDS_Module, module_qual,
mlds_var_name("dummy_var", no)), MLDS_Type)
;
IsDummy = is_not_dummy_type,
@@ -1468,7 +1470,7 @@
% Output variables may be passed by reference...
ml_gen_info_get_byref_output_vars(Info, OutputVars),
( list.member(Var, OutputVars) ->
- Lval = mem_ref(lval(VarLval), MLDS_Type)
+ Lval = ml_mem_ref(ml_lval(VarLval), MLDS_Type)
;
Lval = VarLval
)
@@ -1512,12 +1514,13 @@
ml_gen_var_lval(Info, VarName, VarType, QualifiedVarLval) :-
ml_gen_info_get_module_name(Info, ModuleName),
MLDS_Module = mercury_module_name_to_mlds(ModuleName),
- QualifiedVarLval = var(qual(MLDS_Module, module_qual, VarName), VarType).
+ QualifiedVarLval = ml_var(qual(MLDS_Module, module_qual, VarName),
+ VarType).
ml_gen_var_decl(VarName, Type, Context, Defn, !Info) :-
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_gen_gc_statement(VarName, Type, Context, GCStatement, !Info),
- Defn = ml_gen_mlds_var_decl(var(VarName),
+ Defn = ml_gen_mlds_var_decl(mlds_data_var(VarName),
mercury_type_to_mlds_type(ModuleInfo, Type),
GCStatement, mlds_make_context(Context)).
@@ -1534,7 +1537,7 @@
ml_gen_static_const_defn(ConstName, ConstType, Access, Initializer, Context) =
MLDS_Defn :-
- Name = entity_data(var(ConstName)),
+ Name = entity_data(mlds_data_var(ConstName)),
% The GC never needs to trace static constants,
% because they can never point into the heap
% (only to other static constants).
@@ -1654,7 +1657,8 @@
% ===>
% succeeded = MR_TRUE;
%
- ml_gen_set_success(!.Info, const(mlconst_true), Context, SetSuccessTrue).
+ ml_gen_set_success(!.Info, ml_const(mlconst_true), Context,
+ SetSuccessTrue).
ml_gen_success(model_non, Context, [CallCont], !Info) :-
%
% nondet succeed:
@@ -1673,7 +1677,8 @@
% ===>
% succeeded = MR_FALSE;
%
- ml_gen_set_success(!.Info, const(mlconst_false), Context, SetSuccessFalse).
+ ml_gen_set_success(!.Info, ml_const(mlconst_false), Context,
+ SetSuccessFalse).
ml_gen_failure(model_non, _, Statements, !Info) :-
%
% nondet fail:
@@ -1686,7 +1691,7 @@
%-----------------------------------------------------------------------------%
ml_gen_succeeded_var_decl(Context) =
- ml_gen_mlds_var_decl(var(mlds_var_name("succeeded", no)),
+ ml_gen_mlds_var_decl(mlds_data_var(mlds_var_name("succeeded", no)),
mlds_native_bool_type, gc_no_stmt, Context).
ml_success_lval(Info, SucceededLval) :-
@@ -1695,7 +1700,7 @@
ml_gen_test_success(Info, SucceededRval) :-
ml_success_lval(Info, SucceededLval),
- SucceededRval = lval(SucceededLval).
+ SucceededRval = ml_lval(SucceededLval).
ml_gen_set_success(Info, Value, Context, Statement) :-
ml_success_lval(Info, Succeeded),
@@ -1711,7 +1716,7 @@
mlds_var_name(string.append("cond_", string.int_to_string(CondVar)), no).
ml_gen_cond_var_decl(CondVar, Context) =
- ml_gen_mlds_var_decl(var(ml_gen_cond_var_name(CondVar)),
+ ml_gen_mlds_var_decl(mlds_data_var(ml_gen_cond_var_name(CondVar)),
mlds_native_bool_type, gc_no_stmt, Context).
ml_cond_var_lval(Info, CondVar, CondVarLval) :-
@@ -1720,7 +1725,7 @@
ml_gen_test_cond_var(Info, CondVar, CondVarRval) :-
ml_cond_var_lval(Info, CondVar, CondVarLval),
- CondVarRval = lval(CondVarLval).
+ CondVarRval = ml_lval(CondVarLval).
ml_gen_set_cond_var(Info, CondVar, Value, Context, Statement) :-
ml_cond_var_lval(Info, CondVar, CondVarLval),
@@ -1741,7 +1746,7 @@
mlds_cont_type(MLDS_OutputVarTypes), ContLval),
ml_gen_var_lval(Info, mlds_var_name("cont_env_ptr", no),
mlds_generic_env_ptr_type, ContEnvLval),
- Cont = success_cont(lval(ContLval), lval(ContEnvLval),
+ Cont = success_cont(ml_lval(ContLval), ml_lval(ContEnvLval),
MLDS_OutputVarTypes, OutputVarLvals).
:- pred ml_skip_dummy_argument_types(list(mer_type)::in, list(T)::in,
@@ -1769,7 +1774,7 @@
ml_gen_call_current_success_cont(Context, Statement, !Info) :-
ml_gen_info_current_success_cont(!.Info, SuccCont),
SuccCont = success_cont(FuncRval, EnvPtrRval, ArgTypes0, ArgLvals0),
- ArgRvals0 = list.map(func(Lval) = lval(Lval), ArgLvals0),
+ ArgRvals0 = list.map(func(Lval) = ml_lval(Lval), ArgLvals0),
ml_gen_info_use_gcc_nested_functions(!.Info, UseNestedFuncs),
(
UseNestedFuncs = yes,
@@ -1798,7 +1803,7 @@
ml_gen_info_current_success_cont(!.Info, SuccCont),
SuccCont = success_cont(ContinuationFuncRval, EnvPtrRval,
ArgTypes0, ArgLvals0),
- ArgRvals0 = list.map(func(Lval) = lval(Lval), ArgLvals0),
+ ArgRvals0 = list.map(func(Lval) = ml_lval(Lval), ArgLvals0),
ml_gen_info_use_gcc_nested_functions(!.Info, UseNestedFuncs),
(
UseNestedFuncs = yes,
@@ -1833,10 +1838,10 @@
ml_gen_cont_params(ArgTypes0, InnerFuncParams0, !Info),
InnerFuncParams0 = mlds_func_params(InnerArgs0, Rets),
InnerArgRvals = list.map(
- (func(mlds_argument(Data, Type, _GC) )
- = lval(var(qual(MLDS_Module, module_qual, VarName), Type)) :-
- ( Data = entity_data(var(VarName0)) ->
- VarName = VarName0
+ (func(mlds_argument(Data, Type, _GC) ) = Lval :-
+ ( Data = entity_data(mlds_data_var(VarName)) ->
+ Lval = ml_lval(ml_var(qual(MLDS_Module, module_qual, VarName),
+ Type))
;
unexpected(this_file,
"expected variable name in continuation parameters")
@@ -1847,9 +1852,10 @@
% The passed_cont variable always points to code, not to heap,
% so the GC never needs to trace it.
PassedContGCStatement = gc_no_stmt,
- PassedContArg = mlds_argument(entity_data(var(PassedContVarName)),
+ PassedContArg = mlds_argument(
+ entity_data(mlds_data_var(PassedContVarName)),
InnerFuncArgType, PassedContGCStatement),
- InnerFuncRval = lval(var(qual(MLDS_Module, module_qual,
+ InnerFuncRval = ml_lval(ml_var(qual(MLDS_Module, module_qual,
PassedContVarName), InnerFuncArgType)),
InnerFuncParams = mlds_func_params([PassedContArg | InnerArgs0], Rets),
@@ -1871,7 +1877,7 @@
% We call the proxy function.
ProcLabel = mlds_proc_label(PredLabel, ProcId),
QualProcLabel = qual(MLDS_Module, module_qual, ProcLabel),
- ProxyFuncRval = const(mlconst_code_addr(
+ ProxyFuncRval = ml_const(mlconst_code_addr(
code_addr_internal(QualProcLabel, SeqNum, ProxySignature))),
% Put it inside a block where we call it.
@@ -1890,12 +1896,12 @@
% used for nested functions.
%
-ml_get_env_ptr(Info, lval(EnvPtrLval)) :-
+ml_get_env_ptr(Info, ml_lval(EnvPtrLval)) :-
ml_gen_var_lval(Info, mlds_var_name("env_ptr", no),
mlds_unknown_type, EnvPtrLval).
ml_declare_env_ptr_arg(mlds_argument(Name, Type, GCStatement)) :-
- Name = entity_data(var(mlds_var_name("env_ptr_arg", no))),
+ Name = entity_data(mlds_data_var(mlds_var_name("env_ptr_arg", no))),
Type = mlds_generic_env_ptr_type,
% The env_ptr_arg always points to the stack, since continuation
% environments are always allocated on the stack (unless
@@ -2118,7 +2124,7 @@
% Build MLDS code to trace the variable.
ml_gen_var(!.Info, TypeInfoVar, TypeInfoLval),
- ml_gen_trace_var(!.Info, VarName, DeclType, lval(TypeInfoLval), Context,
+ ml_gen_trace_var(!.Info, VarName, DeclType, ml_lval(TypeInfoLval), Context,
MLDS_TraceStatement),
% Generate declarations for any type_info variables used.
@@ -2136,7 +2142,7 @@
(func(Var) = MLDS_Defn :-
LocalVarName = ml_gen_var_name(VarSet, Var),
map.lookup(VarTypes, Var, LocalVarType),
- MLDS_Defn = ml_gen_mlds_var_decl(var(LocalVarName),
+ MLDS_Defn = ml_gen_mlds_var_decl(mlds_data_var(LocalVarName),
mercury_type_to_mlds_type(ModuleInfo, LocalVarType),
gc_no_stmt, MLDS_Context)
),
@@ -2175,12 +2181,12 @@
ctor_cat_user(cat_user_general), non_foreign_type(c_pointer_type)),
ArgTypes = [mlds_pseudo_type_info_type, CPointerType],
Signature = mlds_func_signature(ArgTypes, []),
- FuncAddr = const(mlconst_code_addr(
+ FuncAddr = ml_const(mlconst_code_addr(
code_addr_proc(QualProcLabel, Signature))),
% Generate the call
% `private_builtin.gc_trace(TypeInfo, (MR_C_Pointer) &Var);'.
- CastVarAddr = unop(cast(CPointerType), mem_addr(VarLval)),
+ CastVarAddr = ml_unop(cast(CPointerType), ml_mem_addr(VarLval)),
TraceStatement = statement(
ml_stmt_call(Signature, FuncAddr, no,
[TypeInfoRval, CastVarAddr], [], ordinary_call
@@ -2355,14 +2361,14 @@
VarName = mlds_var_name("new_obj", yes(Id)),
VarType = mlds_array_type(mlds_generic_type),
NullPointers = list.duplicate(list.length(ArgRvals),
- init_obj(const(mlconst_null(mlds_generic_type)))),
+ init_obj(ml_const(mlconst_null(mlds_generic_type)))),
Initializer = init_array(NullPointers),
% This is used for the type_infos allocated during tracing,
% and we don't need to trace them.
GCStatement = gc_no_stmt,
Context = !.Fixup ^ fnoi_context,
- VarDecl = ml_gen_mlds_var_decl_init(var(VarName), VarType, Initializer,
- GCStatement, Context),
+ VarDecl = ml_gen_mlds_var_decl_init(mlds_data_var(VarName), VarType,
+ Initializer, GCStatement, Context),
!Fixup ^ fnoi_next_id := NextId,
% XXX We should keep a more structured representation of the local
% variables, such as a map from variable names.
@@ -2376,9 +2382,10 @@
% atomic_statement occurs, rather than at the local variable
% declaration.
- VarLval = var(qual(!.Fixup ^ fnoi_module_name, module_qual, VarName),
+ VarLval = ml_var(
+ qual(!.Fixup ^ fnoi_module_name, module_qual, VarName),
VarType),
- PtrRval = unop(cast(PointerType), mem_addr(VarLval)),
+ PtrRval = ml_unop(cast(PointerType), ml_mem_addr(VarLval)),
list.map_foldl(init_field_n(PointerType, PtrRval, Context),
ArgRvals, ArgInitStatements, 0, _NumFields),
@@ -2397,18 +2404,19 @@
init_field_n(PointerType, PointerRval, Context, ArgRval, Statement,
FieldNum, FieldNum + 1) :-
- FieldId = offset(const(mlconst_int(FieldNum))),
+ FieldId = ml_field_offset(ml_const(mlconst_int(FieldNum))),
% XXX FieldType is wrong for --high-level-data
FieldType = mlds_generic_type,
MaybeTag = yes(0),
- Field = field(MaybeTag, PointerRval, FieldId, FieldType, PointerType),
+ Field = ml_field(MaybeTag, PointerRval, FieldId, FieldType, PointerType),
AssignStmt = ml_stmt_atomic(assign(Field, ArgRval)),
Statement = statement(AssignStmt, Context).
:- func maybe_tag_rval(maybe(mlds_tag), mlds_type, mlds_rval) = mlds_rval.
maybe_tag_rval(no, _Type, Rval) = Rval.
-maybe_tag_rval(yes(Tag), Type, Rval) = unop(cast(Type), mkword(Tag, Rval)).
+maybe_tag_rval(yes(Tag), Type, Rval) = TaggedRval :-
+ TaggedRval = ml_unop(cast(Type), ml_mkword(Tag, Rval)).
%-----------------------------------------------------------------------------%
%
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.101
diff -u -b -r1.101 ml_elim_nested.m
--- compiler/ml_elim_nested.m 22 Apr 2009 05:26:41 -0000 1.101
+++ compiler/ml_elim_nested.m 6 Jun 2009 14:33:14 -0000
@@ -671,8 +671,9 @@
ml_maybe_add_args([], _, _, _, !Info).
ml_maybe_add_args([Arg|Args], FuncBody, ModuleName, Context, !Info) :-
(
- Arg = mlds_argument(entity_data(var(VarName)), _Type, GCStatement),
- ml_should_add_local_data(!.Info, var(VarName), GCStatement,
+ Arg = mlds_argument(entity_data(mlds_data_var(VarName)), _Type,
+ GCStatement),
+ ml_should_add_local_data(!.Info, mlds_data_var(VarName), GCStatement,
[], [FuncBody])
->
ml_conv_arg_to_var(Context, Arg, ArgToCopy),
@@ -696,8 +697,9 @@
EnvPtrTypeName, Context, ArgsToCopy0, CodeToCopyArgs0),
ModuleName = elim_info_get_module_name(ElimInfo),
(
- Arg = mlds_argument(entity_data(var(VarName)), FieldType, GCStatement),
- ml_should_add_local_data(ElimInfo, var(VarName), GCStatement,
+ Arg = mlds_argument(entity_data(mlds_data_var(VarName)), FieldType,
+ GCStatement),
+ ml_should_add_local_data(ElimInfo, mlds_data_var(VarName), GCStatement,
[], [FuncBody])
->
ml_conv_arg_to_var(Context, Arg, ArgToCopy),
@@ -709,14 +711,15 @@
EnvModuleName = ml_env_module_name(ClassType,
ElimInfo ^ elim_info_globals),
FieldNameString = ml_var_name_to_string(VarName),
- FieldName = named_field(qual(EnvModuleName, type_qual,
+ FieldName = ml_field_named(qual(EnvModuleName, type_qual,
FieldNameString), EnvPtrTypeName),
Tag = yes(0),
EnvPtrName = env_name_base(ElimInfo ^ action) ++ "_ptr",
- EnvPtr = lval(var(qual(ModuleName, module_qual,
+ EnvPtr = ml_lval(ml_var(qual(ModuleName, module_qual,
mlds_var_name(EnvPtrName, no)), EnvPtrTypeName)),
- EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType, EnvPtrTypeName),
- ArgRval = lval(var(QualVarName, FieldType)),
+ EnvArgLval = ml_field(Tag, EnvPtr, FieldName, FieldType,
+ EnvPtrTypeName),
+ ArgRval = ml_lval(ml_var(QualVarName, FieldType)),
AssignToEnv = assign(EnvArgLval, ArgRval),
CodeToCopyArg = statement(ml_stmt_atomic(AssignToEnv), Context),
@@ -849,7 +852,7 @@
% struct <EnvClassName> env; // = { ... }
%
EnvVarName = mlds_var_name(env_name_base(Action), no),
- EnvVarEntityName = entity_data(var(EnvVarName)),
+ EnvVarEntityName = entity_data(mlds_data_var(EnvVarName)),
EnvVarFlags = ml_gen_local_var_decl_flags,
EnvVarDefnBody = mlds_data(EnvTypeName, EnvInitializer, GCStatementEnv),
EnvVarDecl = mlds_defn(EnvVarEntityName, Context, EnvVarFlags,
@@ -865,17 +868,17 @@
%
(
OnHeap = yes,
- EnvVarAddr = lval(var(EnvVar, EnvTypeName)),
+ EnvVarAddr = ml_lval(ml_var(EnvVar, EnvTypeName)),
% OnHeap should be "yes" only on for the IL backend, for which
% the value of MayUseAtomic is immaterial.
MayUseAtomic = may_not_use_atomic_alloc,
NewObj = [statement(
- ml_stmt_atomic(new_object(var(EnvVar, EnvTypeName),
+ ml_stmt_atomic(new_object(ml_var(EnvVar, EnvTypeName),
no, no, EnvTypeName, no, no, [], [], MayUseAtomic)),
Context)]
;
OnHeap = no,
- EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
+ EnvVarAddr = ml_mem_addr(ml_var(EnvVar, EnvTypeName)),
NewObj = []
),
ml_init_env(Action, EnvTypeName, EnvVarAddr, Context, ModuleName,
@@ -900,8 +903,9 @@
%
ThisFrameName = qual(ModuleName, module_qual,
mlds_var_name("this_frame", no)),
- ThisFrameRval = lval(var(ThisFrameName, mlds_generic_type)),
- CastThisFrameRval = unop(cast(mlds_ptr_type(EnvTypeName)), ThisFrameRval),
+ ThisFrameRval = ml_lval(ml_var(ThisFrameName, mlds_generic_type)),
+ CastThisFrameRval = ml_unop(cast(mlds_ptr_type(EnvTypeName)),
+ ThisFrameRval),
ml_init_env(chain_gc_stack_frames, EnvTypeName, CastThisFrameRval,
Context, ModuleName, Globals, FramePtrDecl, InitFramePtr),
@@ -922,14 +926,14 @@
%
% void *prev;
% void (*trace)(...);
- PrevFieldName = entity_data(var(mlds_var_name("prev", no))),
+ PrevFieldName = entity_data(mlds_data_var(mlds_var_name("prev", no))),
PrevFieldFlags = ml_gen_public_field_decl_flags,
PrevFieldType = ml_stack_chain_type,
PrevFieldDefnBody = mlds_data(PrevFieldType, no_initializer, gc_no_stmt),
PrevFieldDecl = mlds_defn(PrevFieldName, Context, PrevFieldFlags,
PrevFieldDefnBody),
- TraceFieldName = entity_data(var(mlds_var_name("trace", no))),
+ TraceFieldName = entity_data(mlds_data_var(mlds_var_name("trace", no))),
TraceFieldFlags = ml_gen_public_field_decl_flags,
TraceFieldType = mlds_func_type(GCTraceFuncParams),
TraceFieldDefnBody = mlds_data(TraceFieldType, no_initializer, gc_no_stmt),
@@ -955,8 +959,8 @@
%
StackChain = ml_stack_chain_var,
EnvInitializer = init_struct(EnvTypeName, [
- init_obj(lval(StackChain)),
- init_obj(const(mlconst_code_addr(GCTraceFuncAddr)))
+ init_obj(ml_lval(StackChain)),
+ init_obj(ml_const(mlconst_code_addr(GCTraceFuncAddr)))
]),
% Generate code to set the global stack chain
@@ -964,7 +968,7 @@
%
% stack_chain = frame_ptr;
EnvPtrTypeName = ml_make_env_ptr_type(Globals, EnvTypeName),
- EnvPtr = lval(var(qual(ModuleName, module_qual,
+ EnvPtr = ml_lval(ml_var(qual(ModuleName, module_qual,
mlds_var_name("frame_ptr", no)), EnvPtrTypeName)),
AssignToStackChain = assign(StackChain, EnvPtr),
LinkStackChain = [statement(ml_stmt_atomic(AssignToStackChain), Context)].
@@ -976,7 +980,7 @@
gen_gc_trace_func(FuncName, PredModule, FramePointerDecl, GCTraceStatements,
Context, GCTraceFuncAddr, FuncParams, GCTraceFuncDefn) :-
% Compute the signature of the GC tracing function
- ArgName = entity_data(var(mlds_var_name("this_frame", no))),
+ ArgName = entity_data(mlds_data_var(mlds_var_name("this_frame", no))),
ArgType = mlds_generic_type,
Argument = mlds_argument(ArgName, ArgType, gc_no_stmt),
FuncParams = mlds_func_params([Argument], []),
@@ -1117,16 +1121,16 @@
DefnBody0 = mlds_function(PredProcId, Params,
body_defined_here(FuncBody0), Attributes, EnvVarNames),
statement_contains_var(FuncBody0, qual(ModuleName, module_qual,
- var(mlds_var_name("env_ptr", no))))
+ mlds_data_var(mlds_var_name("env_ptr", no))))
->
- EnvPtrVal = lval(var(qual(ModuleName, module_qual,
+ EnvPtrVal = ml_lval(ml_var(qual(ModuleName, module_qual,
mlds_var_name("env_ptr_arg", no)),
mlds_generic_env_ptr_type)),
EnvPtrVarType = ml_make_env_ptr_type(Globals, TypeName),
% Insert a cast, to downcast from mlds_generic_env_ptr_type to the
% specific environment type for this procedure.
- CastEnvPtrVal = unop(cast(EnvPtrVarType), EnvPtrVal),
+ CastEnvPtrVal = ml_unop(cast(EnvPtrVarType), EnvPtrVal),
ml_init_env(Action, TypeName, CastEnvPtrVal, Context,
ModuleName, Globals, EnvPtrDecl, InitEnvPtr),
@@ -1169,7 +1173,7 @@
% <EnvTypeName> *env_ptr;
%
EnvPtrVarName = mlds_var_name(env_name_base(Action) ++ "_ptr", no),
- EnvPtrVarEntityName = entity_data(var(EnvPtrVarName)),
+ EnvPtrVarEntityName = entity_data(mlds_data_var(EnvPtrVarName)),
EnvPtrVarFlags = ml_gen_local_var_decl_flags,
EnvPtrVarType = ml_make_env_ptr_type(Globals, EnvTypeName),
% The env_ptr never needs to be traced by the GC, since the environment
@@ -1188,7 +1192,7 @@
% for inserting a cast in <EnvPtrVal> if needed).
%
EnvPtrVar = qual(ModuleName, module_qual, EnvPtrVarName),
- AssignEnvPtr = assign(var(EnvPtrVar, EnvPtrVarType), EnvPtrVal),
+ AssignEnvPtr = assign(ml_var(EnvPtrVar, EnvPtrVarType), EnvPtrVal),
InitEnvPtr = statement(ml_stmt_atomic(AssignEnvPtr), Context).
% Given the declaration for a function parameter, produce a declaration
@@ -1242,7 +1246,7 @@
ml_stack_chain_var = StackChain :-
PrivateBuiltin = mercury_private_builtin_module,
MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin),
- StackChain = var(qual(MLDS_Module, module_qual,
+ StackChain = ml_var(qual(MLDS_Module, module_qual,
mlds_var_name("stack_chain", no)), ml_stack_chain_type).
% The type of the `stack_chain' pointer, i.e. `void *'.
@@ -1612,7 +1616,7 @@
;
% Hoist ordinary local variables.
Name = entity_data(DataName),
- DataName = var(VarName),
+ DataName = mlds_data_var(VarName),
ml_should_add_local_data(!.Info,
DataName, GCStatement0,
FollowingDefns, FollowingStatements)
@@ -1627,8 +1631,8 @@
Init1 = no_initializer,
DefnBody1 = mlds_data(Type, Init1, GCStatement0),
Defn1 = mlds_defn(Name, Context, Flags0, DefnBody1),
- VarLval = var(qual(!.Info ^ module_name, module_qual, VarName),
- Type),
+ VarLval = ml_var(qual(!.Info ^ module_name, module_qual,
+ VarName), Type),
InitStatements = [statement(
ml_stmt_atomic(assign(VarLval, Rval)), Context)]
;
@@ -1824,7 +1828,7 @@
(
( Component0 = raw_target_code(_Code, _Attrs)
; Component0 = user_target_code(_Code, _Context, _Attrs)
- ; Component0 = name(_Name)
+ ; Component0 = target_code_name(_Name)
),
Component = Component0
;
@@ -1884,29 +1888,29 @@
fixup_rval(Rval0, Rval, !Info) :-
(
- Rval0 = lval(Lval0),
+ Rval0 = ml_lval(Lval0),
fixup_lval(Lval0, Lval, !Info),
- Rval = lval(Lval)
+ Rval = ml_lval(Lval)
;
- Rval0 = mem_addr(Lval0),
+ Rval0 = ml_mem_addr(Lval0),
fixup_lval(Lval0, Lval, !Info),
- Rval = mem_addr(Lval)
+ Rval = ml_mem_addr(Lval)
;
- Rval0 = mkword(Tag, BaseRval0),
+ Rval0 = ml_mkword(Tag, BaseRval0),
fixup_rval(BaseRval0, BaseRval, !Info),
- Rval = mkword(Tag, BaseRval)
+ Rval = ml_mkword(Tag, BaseRval)
;
- Rval0 = unop(UnOp, XRval0),
+ Rval0 = ml_unop(UnOp, XRval0),
fixup_rval(XRval0, XRval, !Info),
- Rval = unop(UnOp, XRval)
+ Rval = ml_unop(UnOp, XRval)
;
- Rval0 = binop(BinOp, XRval0, YRval0),
+ Rval0 = ml_binop(BinOp, XRval0, YRval0),
fixup_rval(XRval0, XRval, !Info),
fixup_rval(YRval0, YRval, !Info),
- Rval = binop(BinOp, XRval, YRval)
+ Rval = ml_binop(BinOp, XRval, YRval)
;
- ( Rval0 = const(_)
- ; Rval0 = self(_)
+ ( Rval0 = ml_const(_)
+ ; Rval0 = ml_self(_)
),
Rval = Rval0
).
@@ -1924,18 +1928,18 @@
fixup_lval(Lval0, Lval, !Info) :-
(
- Lval0 = field(MaybeTag, Rval0, FieldId, FieldType, PtrType),
+ Lval0 = ml_field(MaybeTag, Rval0, FieldId, FieldType, PtrType),
fixup_rval(Rval0, Rval, !Info),
- Lval = field(MaybeTag, Rval, FieldId, FieldType, PtrType)
+ Lval = ml_field(MaybeTag, Rval, FieldId, FieldType, PtrType)
;
- Lval0 = mem_ref(Rval0, Type),
+ Lval0 = ml_mem_ref(Rval0, Type),
fixup_rval(Rval0, Rval, !Info),
- Lval = mem_ref(Rval, Type)
+ Lval = ml_mem_ref(Rval, Type)
;
- Lval0 = global_var_ref(_Ref),
+ Lval0 = ml_global_var_ref(_Ref),
Lval = Lval0
;
- Lval0 = var(Var0, VarType),
+ Lval0 = ml_var(Var0, VarType),
fixup_var(Var0, VarType, Lval, !Info)
).
@@ -1997,22 +2001,22 @@
ThisVarModuleName = ModuleName,
IsLocalVar = (pred(VarType::out) is nondet :-
list.member(Var, Locals),
- Var = mlds_defn(entity_data(var(ThisVarName)), _, _,
+ Var = mlds_defn(entity_data(mlds_data_var(ThisVarName)), _, _,
mlds_data(VarType, _, _)),
\+ ml_decl_is_static_const(Var)
),
solutions.solutions(IsLocalVar, [FieldType])
->
- EnvPtr = lval(var(qual(ModuleName, QualKind,
+ EnvPtr = ml_lval(ml_var(qual(ModuleName, QualKind,
mlds_var_name(env_name_base(Action) ++ "_ptr", no)),
EnvPtrVarType)),
EnvModuleName = ml_env_module_name(ClassType, Globals),
ThisVarFieldName = ml_var_name_to_string(ThisVarName),
- FieldName = named_field(
+ FieldName = ml_field_named(
qual(EnvModuleName, type_qual, ThisVarFieldName),
EnvPtrVarType),
Tag = yes(0),
- Lval = field(Tag, EnvPtr, FieldName, FieldType, EnvPtrVarType)
+ Lval = ml_field(Tag, EnvPtr, FieldName, FieldType, EnvPtrVarType)
;
% Check for references to the env_ptr itself.
% For those, the code generator will have left the type as
@@ -2021,10 +2025,10 @@
ThisVarName = mlds_var_name("env_ptr", no),
ThisVarType = mlds_unknown_type
->
- Lval = var(ThisVar, EnvPtrVarType)
+ Lval = ml_var(ThisVar, EnvPtrVarType)
;
% Leave everything else unchanged.
- Lval = var(ThisVar, ThisVarType)
+ Lval = ml_var(ThisVar, ThisVarType)
).
% The following code is what we would have to use if we couldn't
@@ -2317,7 +2321,7 @@
% the already-unchained stack frame.
UnchainFrame = ml_gen_unchain_frame(Context, !.Info),
Statement0 = statement(Stmt0, Context),
- RetRvals = list.map(func(Rval) = lval(Rval), RetLvals),
+ RetRvals = list.map(func(Rval) = ml_lval(Rval), RetLvals),
RetStmt = ml_stmt_return(RetRvals),
RetStatement = statement(RetStmt, Context),
Stmt = ml_stmt_block([], [UnchainFrame, Statement0, RetStatement])
@@ -2383,9 +2387,9 @@
StackChain = ml_stack_chain_var,
Tag = yes(0),
- PrevFieldId = offset(const(mlconst_int(0))),
+ PrevFieldId = ml_field_offset(ml_const(mlconst_int(0))),
PrevFieldType = mlds_generic_type,
- PrevFieldRval = lval(field(Tag, lval(StackChain), PrevFieldId,
+ PrevFieldRval = ml_lval(ml_field(Tag, ml_lval(StackChain), PrevFieldId,
PrevFieldType, EnvPtrTypeName)),
Assignment = assign(StackChain, PrevFieldRval),
UnchainFrame = statement(ml_stmt_atomic(Assignment), Context).
@@ -2398,7 +2402,7 @@
:- func gen_saved_stack_chain_var(int, mlds_context) = mlds_defn.
gen_saved_stack_chain_var(Id, Context) = Defn :-
- Name = entity_data(var(ml_saved_stack_chain_name(Id))),
+ Name = entity_data(mlds_data_var(ml_saved_stack_chain_name(Id))),
Flags = ml_gen_local_var_decl_flags,
Type = ml_stack_chain_type,
Initializer = no_initializer,
@@ -2416,9 +2420,9 @@
statement.
gen_save_stack_chain_var(MLDS_Module, Id, Context) = SaveStatement :-
- SavedStackChain = var(qual(MLDS_Module, module_qual,
+ SavedStackChain = ml_var(qual(MLDS_Module, module_qual,
ml_saved_stack_chain_name(Id)), ml_stack_chain_type),
- Assignment = assign(SavedStackChain, lval(ml_stack_chain_var)),
+ Assignment = assign(SavedStackChain, ml_lval(ml_stack_chain_var)),
SaveStatement = statement(ml_stmt_atomic(Assignment), Context).
% Generate a statement to restore the stack chain pointer:
@@ -2429,9 +2433,9 @@
statement.
gen_restore_stack_chain_var(MLDS_Module, Id, Context) = RestoreStatement :-
- SavedStackChain = var(qual(MLDS_Module, module_qual,
+ SavedStackChain = ml_var(qual(MLDS_Module, module_qual,
ml_saved_stack_chain_name(Id)), ml_stack_chain_type),
- Assignment = assign(ml_stack_chain_var, lval(SavedStackChain)),
+ Assignment = assign(ml_stack_chain_var, ml_lval(SavedStackChain)),
RestoreStatement = statement(ml_stmt_atomic(Assignment), Context).
:- func ml_saved_stack_chain_name(int) = mlds_var_name.
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.56
diff -u -b -r1.56 ml_optimize.m
--- compiler/ml_optimize.m 16 Jan 2009 02:31:24 -0000 1.56
+++ compiler/ml_optimize.m 6 Jun 2009 14:37:37 -0000
@@ -270,7 +270,7 @@
% the C code doesn't help with the --target asm back-end, whereas
% generating the appropriate MLDS instructions does.
- FuncRval = const(mlconst_code_addr(
+ FuncRval = ml_const(mlconst_code_addr(
code_addr_proc(qual(ModName, module_qual, ProcLabel),
_FuncSignature))),
ProcLabel = mlds_proc_label(PredLabel, _ProcId),
@@ -278,7 +278,7 @@
_Arity, _CodeModel, _NonOutputFunc),
(
PredName = "mark_hp",
- CallArgs = [mem_addr(Lval)],
+ CallArgs = [ml_mem_addr(Lval)],
AtomicStmt = mark_hp(Lval)
;
PredName = "restore_hp",
@@ -304,11 +304,11 @@
% `while (true) { ... break; }', and so to branch to the top of the
% function, we just do a `continue' which will continue the next
% iteration of the loop.
- Target = continue
+ Target = goto_continue
;
% A label has been inserted at the start of the function, and so to
% branch to the top of the function, we just branch to that label.
- Target = label(tailcall_loop_label_name)
+ Target = goto_label(tailcall_loop_label_name)
).
% The label name we use for the top of the loop introduced by
@@ -336,13 +336,13 @@
Arg = mlds_argument(Name, Type, _ArgGCStatement),
(
% Extract the variable name.
- Name = entity_data(var(VarName))
+ Name = entity_data(mlds_data_var(VarName))
->
ModuleName = OptInfo ^ oi_module_name,
QualVarName = qual(ModuleName, module_qual, VarName),
(
% Don't bother assigning a variable to itself.
- ArgRval = lval(var(QualVarName, _VarType))
+ ArgRval = ml_lval(ml_var(QualVarName, _VarType))
->
generate_assign_args(OptInfo, Args, ArgRvals,
Statements, TempDefns)
@@ -374,15 +374,15 @@
% are not live across a call or a heap allocation.
GCStatement = gc_no_stmt,
Context = OptInfo ^ oi_context,
- TempDefn = ml_gen_mlds_var_decl_init(var(TempName), Type,
+ TempDefn = ml_gen_mlds_var_decl_init(mlds_data_var(TempName), Type,
Initializer, GCStatement, Context),
TempInitStatement = statement(
- ml_stmt_atomic(assign(var(QualTempName, Type), ArgRval)),
+ ml_stmt_atomic(assign(ml_var(QualTempName, Type), ArgRval)),
Context),
AssignStatement = statement(
ml_stmt_atomic(assign(
- var(QualVarName, Type),
- lval(var(QualTempName, Type)))),
+ ml_var(QualVarName, Type),
+ ml_lval(ml_var(QualTempName, Type)))),
Context),
generate_assign_args(OptInfo, Args, ArgRvals,
Statements0, TempDefns0),
@@ -443,11 +443,11 @@
% }
% Any tail calls in the function body will have
% been replaced with `continue' statements.
- Stmt = ml_stmt_while(const(mlconst_true),
+ Stmt = ml_stmt_while(ml_const(mlconst_true),
statement(ml_stmt_block([],
[CommentStmt,
statement(Stmt0, Context),
- statement(ml_stmt_goto(break), Context)]),
+ statement(ml_stmt_goto(goto_break), Context)]),
Context), no)
;
% Add a loop_top label at the start of the function
@@ -617,9 +617,9 @@
% of the variables declared in the block.
!.Statements = [AssignStatement | !:Statements],
AssignStatement = statement(ml_stmt_atomic(assign(LHS, RHS)), _),
- LHS = var(ThisVar, _ThisType),
+ LHS = ml_var(ThisVar, _ThisType),
ThisVar = qual(Qualifier, QualKind, VarName),
- ThisData = qual(Qualifier, QualKind, var(VarName)),
+ ThisData = qual(Qualifier, QualKind, mlds_data_var(VarName)),
Qualifier = OptInfo ^ oi_module_name,
list.takewhile(isnt(var_defn(VarName)), !.Defns,
_PrecedingDefns, [_VarDefn | FollowingDefns]),
@@ -654,7 +654,7 @@
:- pred var_defn(mlds_var_name::in, mlds_defn::in) is semidet.
var_defn(VarName, Defn) :-
- Defn = mlds_defn(entity_data(var(VarName)), _, _, _).
+ Defn = mlds_defn(entity_data(mlds_data_var(VarName)), _, _, _).
% set_initializer(VarName, Rval, Defns0, Defns):
%
@@ -669,7 +669,7 @@
set_initializer(VarName, Rval, [Defn0 | Defns0], [Defn | Defns]) :-
Defn0 = mlds_defn(Name, Context, Flags, DefnBody0),
(
- Name = entity_data(var(VarName)),
+ Name = entity_data(mlds_data_var(VarName)),
DefnBody0 = mlds_data(Type, _OldInitializer, GCStatement)
->
DefnBody = mlds_data(Type, init_obj(Rval), GCStatement),
@@ -755,7 +755,7 @@
Defn0 = mlds_defn(Name, _Context, Flags, DefnBody),
% Check if this definition is a local variable definition...
- Name = entity_data(var(VarName)),
+ Name = entity_data(mlds_data_var(VarName)),
Flags = ml_gen_local_var_decl_flags,
DefnBody = mlds_data(_Type, Initializer, _GCStatement),
@@ -805,28 +805,28 @@
:- pred rval_is_cheap_enough_to_duplicate(mlds_rval::in) is semidet.
rval_is_cheap_enough_to_duplicate(Rval) :-
- ( Rval = const(_)
- ; Rval = lval(var(_, _))
- ; Rval = mem_addr(_)
- ; Rval = self(_)
+ ( Rval = ml_const(_)
+ ; Rval = ml_lval(ml_var(_, _))
+ ; Rval = ml_mem_addr(_)
+ ; Rval = ml_self(_)
).
% Succeed only if the specified rval definitely won't change in value.
%
:- pred rval_will_not_change(mlds_rval::in) is semidet.
-rval_will_not_change(const(_)).
-rval_will_not_change(mkword(_Tag, Rval)) :-
+rval_will_not_change(ml_const(_)).
+rval_will_not_change(ml_mkword(_Tag, Rval)) :-
rval_will_not_change(Rval).
-rval_will_not_change(unop(_Op, Rval)) :-
+rval_will_not_change(ml_unop(_Op, Rval)) :-
rval_will_not_change(Rval).
-rval_will_not_change(binop(_Op, Rval1, Rval2)) :-
+rval_will_not_change(ml_binop(_Op, Rval1, Rval2)) :-
rval_will_not_change(Rval1),
rval_will_not_change(Rval2).
-rval_will_not_change(mem_addr(var(_, _))).
-rval_will_not_change(mem_addr(mem_ref(Address, _Type))) :-
+rval_will_not_change(ml_mem_addr(ml_var(_, _))).
+rval_will_not_change(ml_mem_addr(ml_mem_ref(Address, _Type))) :-
rval_will_not_change(Address).
-rval_will_not_change(mem_addr(field(_, Address, _, _, _))) :-
+rval_will_not_change(ml_mem_addr(ml_field(_, Address, _, _, _))) :-
rval_will_not_change(Address).
% Succeed only if the given rval definitely can't loop,
@@ -835,11 +835,11 @@
%
:- pred rval_cannot_throw(mlds_rval::in) is semidet.
-rval_cannot_throw(const(_)).
-rval_cannot_throw(mkword(_Tag, Rval)) :-
+rval_cannot_throw(ml_const(_)).
+rval_cannot_throw(ml_mkword(_Tag, Rval)) :-
rval_cannot_throw(Rval).
-rval_cannot_throw(mem_addr(_)).
-rval_cannot_throw(self(_)).
+rval_cannot_throw(ml_mem_addr(_)).
+rval_cannot_throw(ml_self(_)).
% Search through a list of statements, trying to find the first assignment
% to the specified variable. Return the initial value, and a modified list
@@ -865,7 +865,7 @@
% that Statement0 can't modify the variable's value is it safe to go
% on and look for the initial value in Statements0.
VarName = qual(Mod, QualKind, UnqualVarName),
- DataName = qual(Mod, QualKind, var(UnqualVarName)),
+ DataName = qual(Mod, QualKind, mlds_data_var(UnqualVarName)),
\+ statement_contains_var(Statement0, DataName),
\+ (
statement_contains_statement(Statement0, Label),
@@ -882,13 +882,13 @@
find_initial_val_in_statement(Var, Rval, Statement0, Statement) :-
Statement0 = statement(Stmt0, Context),
Statement = statement(Stmt, Context),
- ( Stmt0 = ml_stmt_atomic(assign(var(Var, _Type), Rval0)) ->
+ ( Stmt0 = ml_stmt_atomic(assign(ml_var(Var, _Type), Rval0)) ->
Rval = Rval0,
% Delete the assignment, by replacing it with an empty block.
Stmt = ml_stmt_block([], [])
; Stmt0 = ml_stmt_block(Defns0, SubStatements0) ->
Var = qual(Mod, QualKind, UnqualVarName),
- Data = qual(Mod, QualKind, var(UnqualVarName)),
+ Data = qual(Mod, QualKind, mlds_data_var(UnqualVarName)),
\+ defns_contains_var(Defns0, Data),
find_initial_val_in_statements(Var, Rval,
SubStatements0, SubStatements),
@@ -1003,9 +1003,9 @@
eliminate_var_in_rval(Rval0, Rval, !VarElimInfo) :-
(
- Rval0 = lval(Lval0),
+ Rval0 = ml_lval(Lval0),
VarName = !.VarElimInfo ^ var_name,
- ( Lval0 = var(VarName, _) ->
+ ( Lval0 = ml_var(VarName, _) ->
% We found an rvalue occurrence of the variable -- replace it
% with the rval for the variable's value, and increment the counter
% for the number of occurrences that we have replaced.
@@ -1014,30 +1014,30 @@
!:VarElimInfo = !.VarElimInfo ^ replace_count := Count0 + 1
;
eliminate_var_in_lval(Lval0, Lval, !VarElimInfo),
- Rval = lval(Lval)
+ Rval = ml_lval(Lval)
)
;
- Rval0 = mkword(Tag, ArgRval0),
+ Rval0 = ml_mkword(Tag, ArgRval0),
eliminate_var_in_rval(ArgRval0, ArgRval, !VarElimInfo),
- Rval = mkword(Tag, ArgRval)
+ Rval = ml_mkword(Tag, ArgRval)
;
- Rval0 = const(_),
+ Rval0 = ml_const(_),
Rval = Rval0
;
- Rval0 = unop(Op, ArgRval0),
+ Rval0 = ml_unop(Op, ArgRval0),
eliminate_var_in_rval(ArgRval0, ArgRval, !VarElimInfo),
- Rval = unop(Op, ArgRval)
+ Rval = ml_unop(Op, ArgRval)
;
- Rval0 = binop(Op, Arg1Rval0, Arg2Rval0),
+ Rval0 = ml_binop(Op, Arg1Rval0, Arg2Rval0),
eliminate_var_in_rval(Arg1Rval0, Arg1Rval, !VarElimInfo),
eliminate_var_in_rval(Arg2Rval0, Arg2Rval, !VarElimInfo),
- Rval = binop(Op, Arg1Rval, Arg2Rval)
+ Rval = ml_binop(Op, Arg1Rval, Arg2Rval)
;
- Rval0 = mem_addr(Lval0),
+ Rval0 = ml_mem_addr(Lval0),
eliminate_var_in_lval(Lval0, Lval, !VarElimInfo),
- Rval = mem_addr(Lval)
+ Rval = ml_mem_addr(Lval)
;
- Rval0 = self(_Type),
+ Rval0 = ml_self(_Type),
Rval = Rval0
).
@@ -1052,24 +1052,24 @@
eliminate_var_in_lval(Lval0, Lval, !VarElimInfo) :-
(
- Lval0 = field(MaybeTag, Rval0, FieldId, FieldType, PtrType),
+ Lval0 = ml_field(MaybeTag, Rval0, FieldId, FieldType, PtrType),
eliminate_var_in_rval(Rval0, Rval, !VarElimInfo),
- Lval = field(MaybeTag, Rval, FieldId, FieldType, PtrType)
+ Lval = ml_field(MaybeTag, Rval, FieldId, FieldType, PtrType)
;
- Lval0 = mem_ref(Rval0, Type),
+ Lval0 = ml_mem_ref(Rval0, Type),
eliminate_var_in_rval(Rval0, Rval, !VarElimInfo),
- Lval = mem_ref(Rval, Type)
+ Lval = ml_mem_ref(Rval, Type)
;
- Lval0 = global_var_ref(_Ref),
+ Lval0 = ml_global_var_ref(_Ref),
Lval = Lval0
;
- Lval0 = var(VarName, _Type),
+ Lval0 = ml_var(VarName, _Type),
( VarName = !.VarElimInfo ^ var_name ->
% We found an lvalue occurrence of the variable -- if the variable
% that we are trying to eliminate has its address is taken,
% or is assigned to, or in general if it is used as an lvalue,
% then it's not safe to eliminate it
- !:VarElimInfo = !.VarElimInfo ^ invalidated := yes
+ !VarElimInfo ^ invalidated := yes
;
true
),
@@ -1266,7 +1266,7 @@
(
( Component0 = raw_target_code(_Code, _Attrs)
; Component0 = user_target_code(_Code, _Context, _Attrs)
- ; Component0 = name(_Name)
+ ; Component0 = target_code_name(_Name)
),
Component = Component0
;
Index: compiler/ml_simplify_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_simplify_switch.m,v
retrieving revision 1.27
diff -u -b -r1.27 ml_simplify_switch.m
--- compiler/ml_simplify_switch.m 16 Jan 2009 02:31:24 -0000 1.27
+++ compiler/ml_simplify_switch.m 6 Jun 2009 14:14:33 -0000
@@ -201,7 +201,7 @@
FirstVal, LastVal, NeedRangeCheck) :-
(
Default \= default_is_unreachable,
- Range = range(Min, Max),
+ Range = mlds_switch_range(Min, Max),
TypeRange = Max - Min + 1,
NumCases = list.length(Cases),
NoDefaultDensity = switch_density(NumCases, TypeRange),
@@ -247,7 +247,7 @@
find_first_and_last_case_3(match_value(Rval), !Min, !Max) :-
(
- Rval = const(mlconst_int(Val))
+ Rval = ml_const(mlconst_int(Val))
->
int.min(Val, !Min),
int.max(Val, !Max)
@@ -257,8 +257,8 @@
find_first_and_last_case_3(match_range(MinRval, MaxRval),
!Min, !Max) :-
(
- MinRval = const(mlconst_int(RvalMin)),
- MaxRval = const(mlconst_int(RvalMax))
+ MinRval = ml_const(mlconst_int(RvalMin)),
+ MaxRval = ml_const(mlconst_int(RvalMax))
->
int.min(RvalMin, !Min),
int.max(RvalMax, !Max)
@@ -283,7 +283,7 @@
( FirstVal = 0 ->
Index = Rval
;
- Index = binop(int_sub, Rval, const(mlconst_int(FirstVal)))
+ Index = ml_binop(int_sub, Rval, ml_const(mlconst_int(FirstVal)))
),
% Now generate the jump table.
@@ -322,7 +322,9 @@
(
NeedRangeCheck = yes,
Difference = LastVal - FirstVal,
- InRange = binop(unsigned_le, Index, const(mlconst_int(Difference))),
+ InRange = ml_binop(unsigned_le,
+ Index,
+ ml_const(mlconst_int(Difference))),
Else = yes(statement(ml_stmt_block([], DefaultStatements),
MLDS_Context)),
SwitchBody = statement(ml_stmt_block([], [DoJump | CasesCode]),
@@ -376,7 +378,7 @@
JumpComment = statement(
ml_stmt_atomic(comment("branch to end of dense switch")),
MLDS_Context),
- JumpCode = statement(ml_stmt_goto(label(EndLabel)), MLDS_Context),
+ JumpCode = statement(ml_stmt_goto(goto_label(EndLabel)), MLDS_Context),
Decls = [],
Statements = [LabelComment, LabelCode, CaseStatement,
JumpComment, JumpCode].
@@ -400,7 +402,7 @@
case_labels_map::in, case_labels_map::out) is det.
insert_case_into_map(match_value(Rval), ThisLabel, !CaseLabelsMap) :-
- ( Rval = const(mlconst_int(Val)) ->
+ ( Rval = ml_const(mlconst_int(Val)) ->
map.det_insert(!.CaseLabelsMap, Val, ThisLabel, !:CaseLabelsMap)
;
unexpected(this_file, "insert_case_into_map: non-int case")
@@ -408,8 +410,8 @@
insert_case_into_map(match_range(MinRval, MaxRval), ThisLabel,
!CaseLabelsMap) :-
(
- MinRval = const(mlconst_int(Min)),
- MaxRval = const(mlconst_int(Max))
+ MinRval = ml_const(mlconst_int(Min)),
+ MaxRval = ml_const(mlconst_int(Max))
->
insert_range_into_map(Min, Max, ThisLabel, !CaseLabelsMap)
;
@@ -492,11 +494,11 @@
%
:- func ml_gen_case_match_conds(mlds_case_match_conds, mlds_rval) = mlds_rval.
-ml_gen_case_match_conds([], _) = const(mlconst_false).
+ml_gen_case_match_conds([], _) = ml_const(mlconst_false).
ml_gen_case_match_conds([Cond], SwitchRval) =
ml_gen_case_match_cond(Cond, SwitchRval).
ml_gen_case_match_conds([Cond1, Cond2 | Conds], SwitchRval) =
- binop(logical_or,
+ ml_binop(logical_or,
ml_gen_case_match_cond(Cond1, SwitchRval),
ml_gen_case_match_conds([Cond2 | Conds], SwitchRval)).
@@ -506,11 +508,11 @@
:- func ml_gen_case_match_cond(mlds_case_match_cond, mlds_rval) = mlds_rval.
ml_gen_case_match_cond(match_value(CaseRval), SwitchRval) =
- binop(eq, CaseRval, SwitchRval).
+ ml_binop(eq, CaseRval, SwitchRval).
ml_gen_case_match_cond(match_range(MinRval, MaxRval), SwitchRval) =
- binop(logical_and,
- binop(int_gt, SwitchRval, MinRval),
- binop(int_le, SwitchRval, MaxRval)).
+ ml_binop(logical_and,
+ ml_binop(int_gt, SwitchRval, MinRval),
+ ml_binop(int_le, SwitchRval, MaxRval)).
%-----------------------------------------------------------------------------%
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.38
diff -u -b -r1.38 ml_string_switch.m
--- compiler/ml_string_switch.m 16 Jan 2009 02:31:24 -0000 1.38
+++ compiler/ml_string_switch.m 6 Jun 2009 14:14:54 -0000
@@ -61,7 +61,7 @@
% Compute the value we're going to switch on.
ml_gen_var(!.Info, Var, VarLval),
- VarRval = lval(VarLval),
+ VarRval = ml_lval(VarLval),
% Generate the following local variable declarations:
% int slot;
@@ -72,7 +72,7 @@
string.format("slot_%d", [i(SlotVarSeq)]), no),
SlotVarType = mlds_native_int_type,
SlotVarGCStatement = gc_no_stmt, % never need to trace ints
- SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName), SlotVarType,
+ SlotVarDefn = ml_gen_mlds_var_decl(mlds_data_var(SlotVarName), SlotVarType,
SlotVarGCStatement, MLDS_Context),
ml_gen_var_lval(!.Info, SlotVarName, SlotVarType, SlotVarLval),
@@ -84,13 +84,14 @@
% which are all static constants; it can never point into the heap.
% So the GC never needs to trace it
StringVarGCStatement = gc_no_stmt,
- StringVarDefn = ml_gen_mlds_var_decl(var(StringVarName),
+ StringVarDefn = ml_gen_mlds_var_decl(mlds_data_var(StringVarName),
StringVarType, StringVarGCStatement, MLDS_Context),
ml_gen_var_lval(!.Info, StringVarName, StringVarType, StringVarLval),
% Generate new labels.
ml_gen_new_label(EndLabel, !Info),
- GotoEndStatement = statement(ml_stmt_goto(label(EndLabel)), MLDS_Context),
+ GotoEndStatement =
+ statement(ml_stmt_goto(goto_label(EndLabel)), MLDS_Context),
% Determine how big to make the hash table. Currently we round the number
% of cases up to the nearest power of two, and then double it. This should
@@ -152,17 +153,18 @@
StringTableLval),
% Generate code which does the hash table lookup.
- SwitchStmt0 = ml_stmt_switch(SlotVarType, lval(SlotVarLval),
- range(0, TableSize - 1), SlotsCases, default_is_unreachable),
+ SwitchStmt0 = ml_stmt_switch(SlotVarType, ml_lval(SlotVarLval),
+ mlds_switch_range(0, TableSize - 1), SlotsCases,
+ default_is_unreachable),
ml_simplify_switch(SwitchStmt0, MLDS_Context, SwitchStatement, !Info),
FoundMatchCond =
- binop(logical_and,
- binop(ne,
- lval(StringVarLval),
- const(mlconst_null(StringVarType))),
- binop(str_eq,
- lval(StringVarLval),
+ ml_binop(logical_and,
+ ml_binop(ne,
+ ml_lval(StringVarLval),
+ ml_const(mlconst_null(StringVarType))),
+ ml_binop(str_eq,
+ ml_lval(StringVarLval),
VarRval)
),
FoundMatchCode = statement(
@@ -181,9 +183,9 @@
"lookup the string for this hash slot")), MLDS_Context),
statement(
ml_stmt_atomic(assign(StringVarLval,
- binop(array_index(elem_type_string),
- lval(StringTableLval),
- lval(SlotVarLval)))),
+ ml_binop(array_index(elem_type_string),
+ ml_lval(StringTableLval),
+ ml_lval(SlotVarLval)))),
MLDS_Context),
statement(ml_stmt_atomic(comment("did we find a match?")),
MLDS_Context),
@@ -193,9 +195,9 @@
"no match yet, so get next slot in hash chain")), MLDS_Context),
statement(
ml_stmt_atomic(assign(SlotVarLval,
- binop(array_index(elem_type_int),
- lval(NextSlotsLval),
- lval(SlotVarLval)))),
+ ml_binop(array_index(elem_type_int),
+ ml_lval(NextSlotsLval),
+ ml_lval(SlotVarLval)))),
MLDS_Context)
],
Context),
@@ -205,14 +207,17 @@
statement(ml_stmt_atomic(comment(
"compute the hash value of the input string")), MLDS_Context),
statement(
- ml_stmt_atomic(assign(SlotVarLval, binop(bitwise_and,
- unop(std_unop(hash_string), VarRval),
- const(mlconst_int(HashMask))))),
+ ml_stmt_atomic(assign(SlotVarLval,
+ ml_binop(bitwise_and,
+ ml_unop(std_unop(hash_string), VarRval),
+ ml_const(mlconst_int(HashMask))))),
MLDS_Context),
statement(ml_stmt_atomic(comment("hash chain loop")), MLDS_Context),
statement(
ml_stmt_while(
- binop(int_ge, lval(SlotVarLval), const(mlconst_int(0))),
+ ml_binop(int_ge,
+ ml_lval(SlotVarLval),
+ ml_const(mlconst_int(0))),
LoopBody,
yes), % This is a do...while loop.
MLDS_Context)
@@ -263,7 +268,7 @@
ml_gen_string_hash_slot(Slot, HashSlotMap, CodeModel, MLDS_Context,
init_obj(StringRval), init_obj(NextSlotRval), MLDS_Cases, !Info) :-
( map.search(HashSlotMap, Slot, string_hash_slot(Next, String, Case)) ->
- NextSlotRval = const(mlconst_int(Next)),
+ NextSlotRval = ml_const(mlconst_int(Next)),
Case = tagged_case(TaggedMainConsId, TaggedOtherConsIds, Goal),
expect(unify(TaggedOtherConsIds, []), this_file,
"ml_gen_string_hash_slot: other cons_ids"),
@@ -274,7 +279,7 @@
;
unexpected(this_file, "ml_gen_string_hash_slot: string expected")
),
- StringRval = const(mlconst_string(String)),
+ StringRval = ml_const(mlconst_string(String)),
ml_gen_goal_as_block(CodeModel, Goal, GoalStatement, !Info),
CommentString = "case """ ++ String ++ """",
@@ -282,11 +287,11 @@
MLDS_Context),
CaseStatement = statement(ml_stmt_block([], [Comment, GoalStatement]),
MLDS_Context),
- MLDS_Cases = [mlds_switch_case([match_value(const(mlconst_int(Slot)))],
- CaseStatement)]
+ MLDS_Cases = [mlds_switch_case(
+ [match_value(ml_const(mlconst_int(Slot)))], CaseStatement)]
;
- StringRval = const(mlconst_null(ml_string_type)),
- NextSlotRval = const(mlconst_int(-2)),
+ StringRval = ml_const(mlconst_null(ml_string_type)),
+ NextSlotRval = ml_const(mlconst_int(-2)),
MLDS_Cases = []
).
Index: compiler/ml_switch_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_switch_gen.m,v
retrieving revision 1.38
diff -u -b -r1.38 ml_switch_gen.m
--- compiler/ml_switch_gen.m 16 Jan 2009 02:31:24 -0000 1.38
+++ compiler/ml_switch_gen.m 6 Jun 2009 13:31:14 -0000
@@ -410,7 +410,7 @@
ml_variable_type(!.Info, Var, Type),
ml_gen_type(!.Info, Type, MLDS_Type),
ml_gen_var(!.Info, Var, Lval),
- Rval = lval(Lval),
+ Rval = ml_lval(Lval),
ml_switch_gen_range(!.Info, MLDS_Type, Range),
ml_switch_generate_mlds_cases(Cases, CodeModel, MLDS_Cases, !Info),
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
@@ -431,9 +431,9 @@
switch_util.type_range(ModuleInfo, TypeCategory, Type,
MinRange, MaxRange, _NumValuesInRange)
->
- Range = range(MinRange, MaxRange)
+ Range = mlds_switch_range(MinRange, MaxRange)
;
- Range = range_unknown
+ Range = mlds_switch_range_unknown
).
:- pred ml_switch_generate_mlds_cases(list(tagged_case)::in,
@@ -457,13 +457,13 @@
TaggedMainConsId = tagged_cons_id(_ConsId, Tag),
(
Tag = int_tag(Int),
- Rval = const(mlconst_int(Int))
+ Rval = ml_const(mlconst_int(Int))
;
Tag = string_tag(String),
- Rval = const(mlconst_string(String))
+ Rval = ml_const(mlconst_string(String))
;
Tag = foreign_tag(ForeignLang, ForeignTag),
- Rval = const(mlconst_foreign(ForeignLang, ForeignTag,
+ Rval = ml_const(mlconst_foreign(ForeignLang, ForeignTag,
mlds_native_int_type))
;
( Tag = float_tag(_)
Index: compiler/ml_tag_switch.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tag_switch.m,v
retrieving revision 1.28
diff -u -b -r1.28 ml_tag_switch.m
--- compiler/ml_tag_switch.m 16 Jan 2009 02:31:24 -0000 1.28
+++ compiler/ml_tag_switch.m 6 Jun 2009 13:31:34 -0000
@@ -61,8 +61,8 @@
Decls, Statements, !Info) :-
% Generate the rval for the primary tag.
ml_gen_var(!.Info, Var, VarLval),
- VarRval = lval(VarLval),
- PTagRval = unop(std_unop(tag), VarRval),
+ VarRval = ml_lval(VarLval),
+ PTagRval = ml_unop(std_unop(tag), VarRval),
% Group the cases based on primary tag value, find out how many
% constructors share each primary tag value, and sort the cases so that
@@ -85,7 +85,7 @@
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
% Package up the results into a switch statement.
- Range = range(0, MaxPrimary),
+ Range = mlds_switch_range(0, MaxPrimary),
SwitchStmt0 = ml_stmt_switch(mlds_native_int_type, PTagRval, Range,
MLDS_Cases, Default),
MLDS_Context = mlds_make_context(Context),
@@ -167,7 +167,7 @@
Var, CodeModel, CaseCanFail, Context, Statement, !Info)
)
),
- PrimaryTagRval = const(mlconst_int(PrimaryTag)),
+ PrimaryTagRval = ml_const(mlconst_int(PrimaryTag)),
MLDS_Case = mlds_switch_case([match_value(PrimaryTagRval)], Statement).
:- pred gen_stag_switch(stag_goal_list(tagged_case)::in, int::in,
@@ -181,10 +181,10 @@
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_variable_type(!.Info, Var, VarType),
ml_gen_var(!.Info, Var, VarLval),
- VarRval = lval(VarLval),
+ VarRval = ml_lval(VarLval),
(
StagLocn = sectag_local,
- STagRval = unop(std_unop(unmkbody), VarRval)
+ STagRval = ml_unop(std_unop(unmkbody), VarRval)
;
StagLocn = sectag_remote,
STagRval = ml_gen_secondary_tag_rval(PrimaryTag, VarType, ModuleInfo,
@@ -199,7 +199,7 @@
ml_switch_generate_default(CanFail, CodeModel, Context, Default, !Info),
% Package up the results into a switch statement.
- Range = range_unknown, % XXX could do better
+ Range = mlds_switch_range_unknown, % XXX could do better
SwitchStmt = ml_stmt_switch(mlds_native_int_type, STagRval, Range,
MLDS_Cases, Default),
MLDS_Context = mlds_make_context(Context),
@@ -219,7 +219,7 @@
gen_stag_case(Case, CodeModel, MLDS_Case, !Info) :-
Case = Stag - tagged_case(_MainTaggedConsId, _OtherTaggedConsIds, Goal),
- StagRval = const(mlconst_int(Stag)),
+ StagRval = ml_const(mlconst_int(Stag)),
ml_gen_goal_as_block(CodeModel, Goal, Statement, !Info),
MLDS_Case = mlds_switch_case([match_value(StagRval)], Statement).
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.49
diff -u -b -r1.49 ml_tailcall.m
--- compiler/ml_tailcall.m 16 Jan 2009 02:31:24 -0000 1.49
+++ compiler/ml_tailcall.m 6 Jun 2009 14:15:07 -0000
@@ -369,7 +369,7 @@
:- pred match_return_val(mlds_rval::in, mlds_lval::in) is semidet.
-match_return_val(lval(Lval), Lval) :-
+match_return_val(ml_lval(Lval), Lval) :-
lval_is_local(Lval) = is_local.
:- type is_local
@@ -380,21 +380,21 @@
lval_is_local(Lval) = IsLocal :-
(
- Lval = var(_, _),
+ Lval = ml_var(_, _),
% We just assume it is local. (This assumption is true for the code
% generated by ml_code_gen.m.)
IsLocal = is_local
;
- Lval = field(_Tag, Rval, _Field, _, _),
+ Lval = ml_field(_Tag, Rval, _Field, _, _),
% A field of a local variable is local.
- ( Rval = mem_addr(BaseLval) ->
+ ( Rval = ml_mem_addr(BaseLval) ->
IsLocal = lval_is_local(BaseLval)
;
IsLocal = is_not_local
)
;
- ( Lval = mem_ref(_Rval, _Type)
- ; Lval = global_var_ref(_)
+ ( Lval = ml_mem_ref(_Rval, _Type)
+ ; Lval = ml_global_var_ref(_)
),
IsLocal = is_not_local
).
@@ -431,32 +431,32 @@
check_rval(Rval, Locals) = MayYieldDanglingStackRef :-
(
- Rval = lval(_Lval),
+ Rval = ml_lval(_Lval),
% Passing the _value_ of an lval is fine.
MayYieldDanglingStackRef = will_not_yield_dangling_stack_ref
;
- Rval = mkword(_Tag, SubRval),
+ Rval = ml_mkword(_Tag, SubRval),
MayYieldDanglingStackRef = check_rval(SubRval, Locals)
;
- Rval = const(Const),
+ Rval = ml_const(Const),
MayYieldDanglingStackRef = check_const(Const, Locals)
;
- Rval = unop(_Op, XRval),
+ Rval = ml_unop(_Op, XRval),
MayYieldDanglingStackRef = check_rval(XRval, Locals)
;
- Rval = binop(_Op, XRval, YRval),
+ Rval = ml_binop(_Op, XRval, YRval),
( check_rval(XRval, Locals) = may_yield_dangling_stack_ref ->
MayYieldDanglingStackRef = may_yield_dangling_stack_ref
;
MayYieldDanglingStackRef = check_rval(YRval, Locals)
)
;
- Rval = mem_addr(Lval),
+ Rval = ml_mem_addr(Lval),
% Passing the address of an lval is a problem,
% if that lval names a local variable.
MayYieldDanglingStackRef = check_lval(Lval, Locals)
;
- Rval = self(_),
+ Rval = ml_self(_),
MayYieldDanglingStackRef = may_yield_dangling_stack_ref
).
@@ -467,18 +467,18 @@
check_lval(Lval, Locals) = MayYieldDanglingStackRef :-
(
- Lval = var(Var0, _),
+ Lval = ml_var(Var0, _),
( var_is_local(Var0, Locals) ->
MayYieldDanglingStackRef = may_yield_dangling_stack_ref
;
MayYieldDanglingStackRef = will_not_yield_dangling_stack_ref
)
;
- Lval = field(_MaybeTag, Rval, _FieldId, _, _),
+ Lval = ml_field(_MaybeTag, Rval, _FieldId, _, _),
MayYieldDanglingStackRef = check_rval(Rval, Locals)
;
- ( Lval = mem_ref(_, _)
- ; Lval = global_var_ref(_)
+ ( Lval = ml_mem_ref(_, _)
+ ; Lval = ml_global_var_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
@@ -505,7 +505,7 @@
)
; Const = mlconst_data_addr(DataAddr) ->
DataAddr = data_addr(ModuleName, DataName),
- ( DataName = var(VarName) ->
+ ( DataName = mlds_data_var(VarName) ->
( var_is_local(qual(ModuleName, module_qual, VarName), Locals) ->
MayYieldDanglingStackRef = may_yield_dangling_stack_ref
;
@@ -531,7 +531,7 @@
Var = qual(_ModuleName, _QualKind, VarName),
some [Local] (
locals_member(Local, Locals),
- Local = entity_data(var(VarName))
+ Local = entity_data(mlds_data_var(VarName))
).
% Check whether the specified function is defined locally (i.e. as a
@@ -631,7 +631,7 @@
SubStmt = ml_stmt_call(_CallSig, Func, _This, _Args, _RetVals, CallKind),
CallKind = ordinary_call,
% Check if this call is a directly recursive call.
- Func = const(mlconst_code_addr(CodeAddr)),
+ Func = ml_const(mlconst_code_addr(CodeAddr)),
(
CodeAddr = code_addr_proc(QualProcLabel, _Sig),
MaybeSeqNum = no
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.81
diff -u -b -r1.81 ml_type_gen.m
--- compiler/ml_type_gen.m 5 Jun 2009 04:17:09 -0000 1.81
+++ compiler/ml_type_gen.m 9 Jun 2009 03:41:02 -0000
@@ -257,7 +257,7 @@
:- func ml_gen_enum_value_member(prog_context) = mlds_defn.
ml_gen_enum_value_member(Context) =
- mlds_defn(entity_data(var(mlds_var_name("MR_value", no))),
+ mlds_defn(entity_data(mlds_data_var(mlds_var_name("MR_value", no))),
mlds_make_context(Context),
ml_gen_member_decl_flags,
mlds_data(mlds_native_int_type, no_initializer, gc_no_stmt)).
@@ -272,10 +272,10 @@
map.lookup(ConsTagValues, cons(Name, Arity), TagVal),
(
TagVal = int_tag(Int),
- ConstValue = const(mlconst_int(Int))
+ ConstValue = ml_const(mlconst_int(Int))
;
TagVal = foreign_tag(ForeignLang, ForeignTagValue),
- ConstValue = const(mlconst_foreign(ForeignLang, ForeignTagValue,
+ ConstValue = ml_const(mlconst_foreign(ForeignLang, ForeignTagValue,
mlds_native_int_type))
;
( TagVal = string_tag(_)
@@ -303,7 +303,8 @@
% Generate an MLDS definition for this enumeration constant.
UnqualifiedName = unqualify_name(Name),
- MLDS_Defn = mlds_defn(entity_data(var(mlds_var_name(UnqualifiedName, no))),
+ MLDS_Defn = mlds_defn(
+ entity_data(mlds_data_var(mlds_var_name(UnqualifiedName, no))),
mlds_make_context(Context),
ml_gen_enum_constant_decl_flags,
mlds_data(mlds_native_int_type, init_obj(ConstValue), gc_no_stmt)).
@@ -498,7 +499,7 @@
:- func ml_gen_tag_member(string, prog_context) = mlds_defn.
ml_gen_tag_member(Name, Context) =
- mlds_defn(entity_data(var(mlds_var_name(Name, no))),
+ mlds_defn(entity_data(mlds_data_var(mlds_var_name(Name, no))),
mlds_make_context(Context),
ml_gen_member_decl_flags,
mlds_data(mlds_native_int_type, no_initializer, gc_no_stmt)).
@@ -516,9 +517,9 @@
Ctor = ctor(_ExistQTVars, _Constraints, Name, _Args, _Ctxt),
UnqualifiedName = unqualify_name(Name),
- ConstValue = const(mlconst_int(SecondaryTag)),
+ ConstValue = ml_const(mlconst_int(SecondaryTag)),
MLDS_Defn = mlds_defn(
- entity_data(var(mlds_var_name(UnqualifiedName, no))),
+ entity_data(mlds_data_var(mlds_var_name(UnqualifiedName, no))),
mlds_make_context(Context),
ml_gen_enum_constant_decl_flags,
mlds_data(mlds_native_int_type, init_obj(ConstValue), gc_no_stmt)),
@@ -905,7 +906,7 @@
unexpected(this_file, "gen_init_field: non-data member")
),
(
- EntityName = entity_data(var(VarName0)),
+ EntityName = entity_data(mlds_data_var(VarName0)),
VarName0 = mlds_var_name(Name0, no)
->
Name = Name0,
@@ -926,9 +927,9 @@
RequiresQualifiedParams = no,
QualVarName = qual(ClassQualifier, type_qual, VarName)
),
- Param = lval(var(QualVarName, Type)),
- Field = field(yes(0), self(ClassType),
- named_field(qual(ClassQualifier, type_qual, Name),
+ Param = ml_lval(ml_var(QualVarName, Type)),
+ Field = ml_field(yes(0), ml_self(ClassType),
+ ml_field_named(qual(ClassQualifier, type_qual, Name),
mlds_ptr_type(ClassType)),
% XXX we should use ClassType rather than BaseClassId here.
% But doing so breaks the IL back-end, because then the hack in
@@ -952,9 +953,9 @@
),
Name = "data_tag",
Type = mlds_native_int_type,
- Val = const(mlconst_int(TagVal)),
- Field = field(yes(0), self(ClassType),
- named_field(qual(TagClassQualifier, type_qual, Name),
+ Val = ml_const(mlconst_int(TagVal)),
+ Field = ml_field(yes(0), ml_self(ClassType),
+ ml_field_named(qual(TagClassQualifier, type_qual, Name),
mlds_ptr_type(SecondaryTagClassId)),
Type, ClassType),
Statement = statement(ml_stmt_atomic(assign(Field, Val)), Context).
@@ -998,7 +999,8 @@
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type)
),
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum0),
- MLDS_Defn = ml_gen_mlds_field_decl(var(mlds_var_name(FieldName, no)),
+ MLDS_Defn = ml_gen_mlds_field_decl(
+ mlds_data_var(mlds_var_name(FieldName, no)),
MLDS_Type, mlds_make_context(Context)),
ArgNum = ArgNum0 + 1.
@@ -1152,10 +1154,11 @@
map.lookup(TagValues, cons(QualName, Arity), TagVal),
(
TagVal = int_tag(Int),
- ConstValue = const(mlconst_int(Int))
+ ConstValue = ml_const(mlconst_int(Int))
;
TagVal = foreign_tag(Lang, String),
- ConstValue = const(mlconst_foreign(Lang, String, mlds_native_int_type))
+ ConstValue = ml_const(mlconst_foreign(Lang, String,
+ mlds_native_int_type))
;
( TagVal = string_tag(_)
; TagVal = float_tag(_)
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.129
diff -u -b -r1.129 ml_unify_gen.m
--- compiler/ml_unify_gen.m 21 May 2009 05:57:02 -0000 1.129
+++ compiler/ml_unify_gen.m 6 Jun 2009 14:41:03 -0000
@@ -137,7 +137,8 @@
IsDummyType = is_not_dummy_type,
ml_gen_var(!.Info, TargetVar, TargetLval),
ml_gen_var(!.Info, SourceVar, SourceLval),
- Statement = ml_gen_assign(TargetLval, lval(SourceLval), Context),
+ Statement = ml_gen_assign(TargetLval, ml_lval(SourceLval),
+ Context),
Statements = [Statement]
),
( ml_gen_info_search_const_var_name(!.Info, SourceVar, Name) ->
@@ -156,10 +157,10 @@
),
Decls = []
;
- Unification = simple_test(Var1, Var2),
+ Unification = simple_test(VarA, VarB),
expect(unify(CodeModel, model_semi), this_file,
"ml_gen_unification: simple_test not semidet"),
- ml_variable_type(!.Info, Var1, Type),
+ ml_variable_type(!.Info, VarA, Type),
( Type = builtin_type(builtin_type_string) ->
EqualityOp = str_eq
; Type = builtin_type(builtin_type_float) ->
@@ -167,9 +168,9 @@
;
EqualityOp = eq
),
- ml_gen_var(!.Info, Var1, Var1Lval),
- ml_gen_var(!.Info, Var2, Var2Lval),
- Test = binop(EqualityOp, lval(Var1Lval), lval(Var2Lval)),
+ ml_gen_var(!.Info, VarA, VarALval),
+ ml_gen_var(!.Info, VarB, VarBLval),
+ Test = ml_binop(EqualityOp, ml_lval(VarALval), ml_lval(VarBLval)),
ml_gen_set_success(!.Info, Test, Context, Statement),
Statements = [Statement],
Decls = []
@@ -215,7 +216,8 @@
CanCGC = can_cgc,
ml_gen_var(!.Info, Var, VarLval),
% XXX Avoid strip_tag when we know what tag it will have.
- Delete = delete_object(unop(std_unop(strip_tag), lval(VarLval))),
+ Delete = delete_object(
+ ml_unop(std_unop(strip_tag), ml_lval(VarLval))),
Stmt = ml_stmt_atomic(Delete),
CGC_Statement = statement(Stmt, mlds_make_context(Context)),
Statements0 = Unif_Statements ++ [CGC_Statement]
@@ -403,9 +405,9 @@
( TagVal = 0 ->
TaggedRval = ConstAddrRval
;
- TaggedRval = mkword(TagVal, ConstAddrRval)
+ TaggedRval = ml_mkword(TagVal, ConstAddrRval)
),
- Rval = unop(cast(MLDS_VarType), TaggedRval),
+ Rval = ml_unop(cast(MLDS_VarType), TaggedRval),
Defns = []
;
( Tag = string_tag(_)
@@ -438,87 +440,105 @@
:- pred ml_gen_constant(cons_tag::in, mer_type::in, mlds_rval::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_constant(string_tag(String), _, const(mlconst_string(String)), !Info).
-ml_gen_constant(int_tag(Int), _, const(mlconst_int(Int)), !Info).
-ml_gen_constant(foreign_tag(ForeignLang, ForeignTag), _, Rval, !Info) :-
- Rval = const(mlconst_foreign(ForeignLang, ForeignTag,
- mlds_native_int_type)).
-ml_gen_constant(float_tag(Float), _, const(mlconst_float(Float)), !Info).
-ml_gen_constant(shared_local_tag(Bits1, Num1), VarType, Rval, !Info) :-
+ml_gen_constant(Tag, VarType, Rval, !Info) :-
+ (
+ Tag = string_tag(String),
+ Rval = ml_const(mlconst_string(String))
+ ;
+ Tag = int_tag(Int),
+ Rval = ml_const(mlconst_int(Int))
+ ;
+ Tag = foreign_tag(ForeignLang, ForeignTag),
+ Rval = ml_const(mlconst_foreign(ForeignLang, ForeignTag,
+ mlds_native_int_type))
+ ;
+ Tag = float_tag(Float),
+ Rval = ml_const(mlconst_float(Float))
+ ;
+ Tag = shared_local_tag(Bits1, Num1),
ml_gen_type(!.Info, VarType, MLDS_Type),
- Rval = unop(cast(MLDS_Type), mkword(Bits1,
- unop(std_unop(mkbody), const(mlconst_int(Num1))))).
-
-ml_gen_constant(type_ctor_info_tag(ModuleName0, TypeName, TypeArity),
- VarType, Rval, !Info) :-
+ Rval = ml_unop(cast(MLDS_Type), ml_mkword(Bits1,
+ ml_unop(std_unop(mkbody), ml_const(mlconst_int(Num1)))))
+ ;
+ Tag = type_ctor_info_tag(ModuleName0, TypeName, TypeArity),
ml_gen_type(!.Info, VarType, MLDS_VarType),
ModuleName = fixup_builtin_module(ModuleName0),
MLDS_Module = mercury_module_name_to_mlds(ModuleName),
RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, TypeArity),
DataAddr = data_addr(MLDS_Module,
mlds_rtti(ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info))),
- Rval = unop(cast(MLDS_VarType), const(mlconst_data_addr(DataAddr))).
-
-ml_gen_constant(base_typeclass_info_tag(ModuleName, ClassId, Instance),
- VarType, Rval, !Info) :-
+ Rval = ml_unop(cast(MLDS_VarType),
+ ml_const(mlconst_data_addr(DataAddr)))
+ ;
+ Tag = base_typeclass_info_tag(ModuleName, ClassId, Instance),
ml_gen_type(!.Info, VarType, MLDS_VarType),
MLDS_Module = mercury_module_name_to_mlds(ModuleName),
TCName = generate_class_name(ClassId),
DataAddr = data_addr(MLDS_Module, mlds_rtti(tc_rtti_id(TCName,
type_class_base_typeclass_info(ModuleName, Instance)))),
- Rval = unop(cast(MLDS_VarType), const(mlconst_data_addr(DataAddr))).
-
-ml_gen_constant(tabling_info_tag(PredId, ProcId), VarType, Rval, !Info) :-
+ Rval = ml_unop(cast(MLDS_VarType),
+ ml_const(mlconst_data_addr(DataAddr)))
+ ;
+ Tag = tabling_info_tag(PredId, ProcId),
ml_gen_type(!.Info, VarType, MLDS_VarType),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, PredModule),
DataAddr = data_addr(PredModule,
mlds_tabling_ref(mlds_proc_label(PredLabel, ProcId), tabling_info)),
- Rval = unop(cast(MLDS_VarType), const(mlconst_data_addr(DataAddr))).
-
-ml_gen_constant(deep_profiling_proc_layout_tag(_, _), _, _, !Info) :-
+ Rval = ml_unop(cast(MLDS_VarType),
+ ml_const(mlconst_data_addr(DataAddr)))
+ ;
+ Tag = deep_profiling_proc_layout_tag(_, _),
unexpected(this_file,
- "ml_gen_constant: deep_profiling_proc_layout_tag not yet supported").
-
-ml_gen_constant(table_io_decl_tag(_, _), _, _, !Info) :-
+ "ml_gen_constant: deep_profiling_proc_layout_tag NYI")
+ ;
+ Tag = table_io_decl_tag(_, _),
unexpected(this_file,
- "ml_gen_constant: table_io_decl_tag not yet supported").
-
-ml_gen_constant(reserved_address_tag(ReservedAddr), VarType, Rval, !Info) :-
+ "ml_gen_constant: table_io_decl_tag NYI")
+ ;
+ Tag = reserved_address_tag(ReservedAddr),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
ml_gen_type(!.Info, VarType, MLDS_VarType),
- Rval = ml_gen_reserved_address(ModuleInfo, ReservedAddr, MLDS_VarType).
-
-ml_gen_constant(shared_with_reserved_addresses_tag(_, ThisTag), VarType, Rval,
- !Info) :-
+ Rval = ml_gen_reserved_address(ModuleInfo, ReservedAddr, MLDS_VarType)
+ ;
+ Tag = shared_with_reserved_addresses_tag(_, ThisTag),
% For shared_with_reserved_address, the sharing is only important for
% tag tests, not for constructions, so here we just recurse on the
% real representation.
- ml_gen_constant(ThisTag, VarType, Rval, !Info).
-
-% These tags, which are not (necessarily) constants, are handled
-% in ml_gen_construct and ml_gen_static_const_arg,
-% so we don't need to handle them here.
-
-ml_gen_constant(no_tag, _, _, !Info) :-
- unexpected(this_file, "ml_gen_constant: no_tag").
-ml_gen_constant(single_functor_tag, _, _, !Info) :-
- unexpected(this_file, "ml_gen_constant: single_functor").
-ml_gen_constant(unshared_tag(_), _, _, !Info) :-
- unexpected(this_file, "ml_gen_constant: unshared_tag").
-ml_gen_constant(shared_remote_tag(_, _), _, _, !Info) :-
- unexpected(this_file, "ml_gen_constant: shared_remote_tag").
-ml_gen_constant(pred_closure_tag(_, _, _), _, _, !Info) :-
- unexpected(this_file, "ml_gen_constant: pred_closure_tag").
+ ml_gen_constant(ThisTag, VarType, Rval, !Info)
+ ;
+ % These tags, which are not (necessarily) constants, are handled
+ % in ml_gen_construct and ml_gen_static_const_arg,
+ % so we don't need to handle them here.
+ (
+ Tag = no_tag,
+ unexpected(this_file, "ml_gen_constant: no_tag")
+ ;
+ Tag = single_functor_tag,
+ unexpected(this_file, "ml_gen_constant: single_functor")
+ ;
+ Tag = unshared_tag(_),
+ unexpected(this_file, "ml_gen_constant: unshared_tag")
+ ;
+ Tag = shared_remote_tag(_, _),
+ unexpected(this_file, "ml_gen_constant: shared_remote_tag")
+ ;
+ Tag = pred_closure_tag(_, _, _),
+ unexpected(this_file, "ml_gen_constant: pred_closure_tag")
+ )
+ ).
%-----------------------------------------------------------------------------%
-ml_gen_reserved_address(_, null_pointer, MLDS_Type) =
- const(mlconst_null(MLDS_Type)).
-ml_gen_reserved_address(_, small_pointer(Int), MLDS_Type) =
- unop(cast(MLDS_Type), const(mlconst_int(Int))).
-ml_gen_reserved_address(ModuleInfo, reserved_object(TypeCtor, QualCtorName,
- CtorArity), _Type) = Rval :-
+ml_gen_reserved_address(ModuleInfo, ResAddr, MLDS_Type) = Rval :-
+ (
+ ResAddr = null_pointer,
+ Rval = ml_const(mlconst_null(MLDS_Type))
+ ;
+ ResAddr = small_pointer(Int),
+ Rval = ml_unop(cast(MLDS_Type), ml_const(mlconst_int(Int)))
+ ;
+ ResAddr = reserved_object(TypeCtor, QualCtorName, CtorArity),
(
QualCtorName = qualified(ModuleName, CtorName),
module_info_get_globals(ModuleInfo, Globals),
@@ -528,31 +548,36 @@
MLDS_TypeName = mlds_append_class_qualifier(MLDS_ModuleName,
module_qual, Globals, UnqualTypeName, TypeArity),
Name = ml_format_reserved_object_name(CtorName, CtorArity),
- Rval0 = const(mlconst_data_addr(
- data_addr(MLDS_TypeName, var(Name)))),
+ Rval0 = ml_const(mlconst_data_addr(
+ data_addr(MLDS_TypeName, mlds_data_var(Name)))),
% The MLDS type of the reserved object may be a class derived from
% the base class for this Mercury type. So for some back-ends,
% we need to insert a (down-)cast here to convert from the derived
% class to the base class. In particular, this is needed to avoid
- % compiler warnings in the C code generated by the MLDS->C back-end.
- % But inserting the cast could slow down the generated code for the
- % .NET back-end (where the JIT probably doesn't optimize downcasts).
- %% So we only do it if the back-end requires it.
- %
+ % compiler warnings in the C code generated by the MLDS->C
+ % back-end. But inserting the cast could slow down the generated
+ % code for the .NET back-end (where the JIT probably doesn't
+ % optimize downcasts). So we only do it if the back-end
+ % requires it.
+
globals.get_target(Globals, Target),
- ( target_supports_inheritence(Target) = yes ->
+ SupportsInheritance = target_supports_inheritence(Target),
+ (
+ SupportsInheritance = yes,
Rval = Rval0
;
- MLDS_Type = mlds_ptr_type(mlds_class_type(
+ SupportsInheritance = no,
+ CastMLDS_Type = mlds_ptr_type(mlds_class_type(
qual(MLDS_ModuleName, module_qual, UnqualTypeName),
TypeArity, mlds_class)),
- Rval = unop(cast(MLDS_Type), Rval0)
+ Rval = ml_unop(cast(CastMLDS_Type), Rval0)
)
;
QualCtorName = unqualified(_),
unexpected(this_file,
"unqualified ctor name in reserved_object")
+ )
).
% This should return `yes' iff downcasts are not needed.
@@ -609,7 +634,7 @@
(
MaybeSecondaryTag = yes(SecondaryTag),
HasSecTag = yes,
- SecondaryTagRval0 = const(mlconst_int(SecondaryTag)),
+ SecondaryTagRval0 = ml_const(mlconst_int(SecondaryTag)),
SecondaryTagType0 = mlds_native_int_type,
% With the low-level data representation, all fields -- even the
@@ -618,7 +643,8 @@
globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
(
HighLevelData = no,
- SecondaryTagRval = unop(box(SecondaryTagType0), SecondaryTagRval0),
+ SecondaryTagRval = ml_unop(box(SecondaryTagType0),
+ SecondaryTagRval0),
SecondaryTagType = mlds_generic_type
;
HighLevelData = yes,
@@ -685,7 +711,7 @@
% Compute the number of words to allocate.
list.length(ArgRvals, NumArgs),
- SizeInWordsRval = const(mlconst_int(NumArgs)),
+ SizeInWordsRval = ml_const(mlconst_int(NumArgs)),
% Generate a `new_object' statement to dynamically allocate the memory
% for this term from the heap. The `new_object' statement will also
@@ -768,9 +794,9 @@
TaggedRval = ConstAddrRval
;
MaybeTag = yes(_),
- TaggedRval = mkword(Tag, ConstAddrRval)
+ TaggedRval = ml_mkword(Tag, ConstAddrRval)
),
- Rval = unop(cast(MLDS_Type), TaggedRval),
+ Rval = ml_unop(cast(MLDS_Type), TaggedRval),
AssignStatement = ml_gen_assign(VarLval, Rval, Context),
Decls = StaticArgDefns ++ BoxConstDefns ++ [ConstDefn],
Statements = [AssignStatement]
@@ -807,21 +833,23 @@
), ReusePrimaryTags, DifferentTags),
(
DifferentTags = [],
- Var2Rval = lval(Var2Lval)
+ Var2Rval = ml_lval(Var2Lval)
;
DifferentTags = [ReusePrimaryTag],
% The body operator is slightly more efficient than the strip_tag
% operator so we use it when the old tag is known.
- Var2Rval = mkword(PrimaryTag,
- binop(body, lval(Var2Lval), ml_gen_mktag(ReusePrimaryTag)))
+ Var2Rval = ml_mkword(PrimaryTag,
+ ml_binop(body,
+ ml_lval(Var2Lval),
+ ml_gen_mktag(ReusePrimaryTag)))
;
DifferentTags = [_, _ | _],
- Var2Rval = mkword(PrimaryTag,
- unop(std_unop(strip_tag), lval(Var2Lval)))
+ Var2Rval = ml_mkword(PrimaryTag,
+ ml_unop(std_unop(strip_tag), ml_lval(Var2Lval)))
),
ml_gen_type(!.Info, Type, MLDS_DestType),
- CastVar2Rval = unop(cast(MLDS_DestType), Var2Rval),
+ CastVar2Rval = ml_unop(cast(MLDS_DestType), Var2Rval),
MLDS_Context = mlds_make_context(Context),
AssignStatement = statement(
ml_stmt_atomic(assign_if_in_heap(Var1Lval, CastVar2Rval)),
@@ -852,7 +880,7 @@
MLDS_Context),
IfStatement = statement(
- ml_stmt_if_then_else(lval(Var1Lval), IfBody, yes(IfElse)),
+ ml_stmt_if_then_else(ml_lval(Var1Lval), IfBody, yes(IfElse)),
mlds_make_context(Context)),
Statements = [AssignStatement, IfStatement],
@@ -878,10 +906,10 @@
% in which a predicate fills in a field of such a type after a *recursive*
% call, since recursive calls tend to generate values of recursive (i.e.
% discriminated union) types. -zs
- SourceRval = mem_addr(field(MaybeTag, lval(CellLval),
- offset(const(mlconst_int(Offset))), FieldType, CellType)),
+ SourceRval = ml_mem_addr(ml_field(MaybeTag, ml_lval(CellLval),
+ ml_field_offset(ml_const(mlconst_int(Offset))), FieldType, CellType)),
ml_gen_var(Info, AddrVar, AddrLval),
- CastSourceRval = unop(cast(mlds_ptr_type(ConsArgType)), SourceRval),
+ CastSourceRval = ml_unop(cast(mlds_ptr_type(ConsArgType)), SourceRval),
Assign = ml_gen_assign(AddrLval, CastSourceRval, Context),
ml_gen_field_take_address_assigns(TakeAddrInfos, CellLval, CellType,
MaybeTag, Context, Info, Assigns).
@@ -1077,7 +1105,7 @@
:- func ml_gen_mktag(int) = mlds_rval.
-ml_gen_mktag(Tag) = unop(std_unop(mktag), const(mlconst_int(Tag))).
+ml_gen_mktag(Tag) = ml_unop(std_unop(mktag), ml_const(mlconst_int(Tag))).
:- pred ml_gen_box_or_unbox_const_rval_list(list(mer_type)::in,
list(mer_type)::in, list(mlds_rval)::in, prog_context::in,
@@ -1187,10 +1215,10 @@
% Return as the boxed rval the address of that constant,
% cast to mlds_generic_type.
ml_gen_var_lval(!.Info, ConstName, Type, ConstLval),
- ConstAddrRval = mem_addr(ConstLval),
- BoxedRval = unop(cast(mlds_generic_type), ConstAddrRval)
+ ConstAddrRval = ml_mem_addr(ConstLval),
+ BoxedRval = ml_unop(cast(mlds_generic_type), ConstAddrRval)
;
- BoxedRval = unop(box(Type), Rval),
+ BoxedRval = ml_unop(box(Type), Rval),
ConstDefns = []
).
@@ -1239,7 +1267,7 @@
ml_gen_static_const_addr(Info, Var, Type, ConstAddrRval) :-
ml_lookup_static_const_name(Info, Var, ConstName),
ml_gen_var_lval(Info, ConstName, Type, ConstLval),
- ConstAddrRval = mem_addr(ConstLval).
+ ConstAddrRval = ml_mem_addr(ConstLval).
:- pred ml_cons_name(compilation_target::in, type_ctor::in,
cons_id::in, ctor_name::out) is det.
@@ -1327,7 +1355,7 @@
% Compute the value of the field.
UniMode = ((_LI - RI) -> (_LF - RF)),
( !.TakeAddr = [CurArgNum | !:TakeAddr] ->
- Rval = const(mlconst_null(MLDS_Type)),
+ Rval = ml_const(mlconst_null(MLDS_Type)),
ml_gen_cons_args_2(Vars, Lvals, ArgTypes, ConsArgTypes, UniModes,
FirstOffset, CurArgNum + 1, !.TakeAddr, ModuleInfo, Rvals,
MLDS_Types, TakeAddrInfosTail, !MayUseAtomic, !Info),
@@ -1346,9 +1374,9 @@
check_dummy_type(ModuleInfo, ConsArgType) = is_not_dummy_type
->
ml_gen_box_or_unbox_rval(ArgType, BoxedArgType, native_if_possible,
- lval(Lval), Rval, !Info)
+ ml_lval(Lval), Rval, !Info)
;
- Rval = const(mlconst_null(MLDS_Type))
+ Rval = ml_const(mlconst_null(MLDS_Type))
),
ml_gen_cons_args_2(Vars, Lvals, ArgTypes, ConsArgTypes, UniModes,
FirstOffset, CurArgNum + 1, !.TakeAddr, ModuleInfo, Rvals,
@@ -1382,9 +1410,9 @@
),
ml_gen_type(!.Info, VarType, MLDS_VarType),
- FieldId = offset(const(mlconst_int(Offset))),
+ FieldId = ml_field_offset(ml_const(mlconst_int(Offset))),
MaybePrimaryTag = get_primary_tag(ConsIdTag),
- FieldLval = field(MaybePrimaryTag, lval(VarLval), FieldId,
+ FieldLval = ml_field(MaybePrimaryTag, ml_lval(VarLval), FieldId,
ExtraType, MLDS_VarType),
Statement = ml_gen_assign(FieldLval, ExtraRval, Context),
@@ -1662,7 +1690,7 @@
% With the low-level data representation, we access all fields
% using offsets.
HighLevelData = no,
- FieldId = offset(const(mlconst_int(Offset)))
+ FieldId = ml_field_offset(ml_const(mlconst_int(Offset)))
;
% With the high-level data representation, we always used named fields,
% except for tuple types.
@@ -1673,7 +1701,7 @@
; type_needs_lowlevel_rep(Target, VarType)
)
->
- FieldId = offset(const(mlconst_int(Offset)))
+ FieldId = ml_field_offset(ml_const(mlconst_int(Offset)))
;
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum),
( ConsId = cons(ConsName, ConsArity) ->
@@ -1696,7 +1724,7 @@
ml_gen_type(!.Info, VarType, MLDS_VarType),
ml_gen_type(!.Info, BoxedFieldType, MLDS_BoxedFieldType),
MaybePrimaryTag = get_primary_tag(Tag),
- FieldLval = field(MaybePrimaryTag, lval(VarLval), FieldId,
+ FieldLval = ml_field(MaybePrimaryTag, ml_lval(VarLval), FieldId,
MLDS_BoxedFieldType, MLDS_VarType),
ml_gen_var(!.Info, Arg, ArgLval),
@@ -1739,7 +1767,7 @@
RightMode = top_out
->
ml_gen_box_or_unbox_rval(FieldType, ArgType, native_if_possible,
- lval(FieldLval), FieldRval, !Info),
+ ml_lval(FieldLval), FieldRval, !Info),
Statement = ml_gen_assign(ArgLval, FieldRval, Context),
!:Statements = [Statement | !.Statements]
;
@@ -1748,7 +1776,7 @@
RightMode = top_in
->
ml_gen_box_or_unbox_rval(ArgType, FieldType, native_if_possible,
- lval(ArgLval), ArgRval, !Info),
+ ml_lval(ArgLval), ArgRval, !Info),
Statement = ml_gen_assign(FieldLval, ArgRval, Context),
!:Statements = [Statement | !.Statements]
;
@@ -1825,7 +1853,7 @@
ml_cons_id_to_tag(!.Info, ConsId, Type, Tag),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
TagTestExpression = ml_gen_tag_test_rval(Tag, Type, ModuleInfo,
- lval(VarLval)),
+ ml_lval(VarLval)),
TagTestDecls = [],
TagTestStatements = [].
@@ -1840,18 +1868,18 @@
ml_gen_tag_test_rval(Tag, Type, ModuleInfo, Rval) = TagTestRval :-
(
Tag = string_tag(String),
- TagTestRval = binop(str_eq, Rval, const(mlconst_string(String)))
+ TagTestRval = ml_binop(str_eq, Rval, ml_const(mlconst_string(String)))
;
Tag = float_tag(Float),
- TagTestRval = binop(float_eq, Rval, const(mlconst_float(Float)))
+ TagTestRval = ml_binop(float_eq, Rval, ml_const(mlconst_float(Float)))
;
Tag = int_tag(Int),
- TagTestRval = binop(eq, Rval, const(mlconst_int(Int)))
+ TagTestRval = ml_binop(eq, Rval, ml_const(mlconst_int(Int)))
;
Tag = foreign_tag(ForeignLang, ForeignVal),
- Const = const(mlconst_foreign(ForeignLang, ForeignVal,
+ Const = ml_const(mlconst_foreign(ForeignLang, ForeignVal,
mlds_native_int_type)),
- TagTestRval = binop(eq, Rval, Const)
+ TagTestRval = ml_binop(eq, Rval, Const)
;
( Tag = pred_closure_tag(_, _, _)
; Tag = type_ctor_info_tag(_, _, _)
@@ -1863,48 +1891,48 @@
unexpected(this_file, "ml_gen_tag_test_rval: bad tag")
;
Tag = no_tag,
- TagTestRval = const(mlconst_true)
+ TagTestRval = ml_const(mlconst_true)
;
Tag = single_functor_tag,
- TagTestRval = const(mlconst_true)
+ TagTestRval = ml_const(mlconst_true)
;
Tag = unshared_tag(UnsharedTagNum),
- RvalTag = unop(std_unop(tag), Rval),
- UnsharedTag = unop(std_unop(mktag),
- const(mlconst_int(UnsharedTagNum))),
- TagTestRval = binop(eq, RvalTag, UnsharedTag)
+ RvalTag = ml_unop(std_unop(tag), Rval),
+ UnsharedTag = ml_unop(std_unop(mktag),
+ ml_const(mlconst_int(UnsharedTagNum))),
+ TagTestRval = ml_binop(eq, RvalTag, UnsharedTag)
;
Tag = shared_remote_tag(PrimaryTagNum, SecondaryTagNum),
SecondaryTagField = ml_gen_secondary_tag_rval(PrimaryTagNum, Type,
ModuleInfo, Rval),
- SecondaryTagTestRval = binop(eq, SecondaryTagField,
- const(mlconst_int(SecondaryTagNum))),
+ SecondaryTagTestRval = ml_binop(eq, SecondaryTagField,
+ ml_const(mlconst_int(SecondaryTagNum))),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_int_option(Globals, num_tag_bits, NumTagBits),
( NumTagBits = 0 ->
% No need to test the primary tag.
TagTestRval = SecondaryTagTestRval
;
- RvalPTag = unop(std_unop(tag), Rval),
- PrimaryTagRval = unop(std_unop(mktag),
- const(mlconst_int(PrimaryTagNum))),
- PrimaryTagTestRval = binop(eq, RvalPTag, PrimaryTagRval),
- TagTestRval = binop(logical_and,
+ RvalPTag = ml_unop(std_unop(tag), Rval),
+ PrimaryTagRval = ml_unop(std_unop(mktag),
+ ml_const(mlconst_int(PrimaryTagNum))),
+ PrimaryTagTestRval = ml_binop(eq, RvalPTag, PrimaryTagRval),
+ TagTestRval = ml_binop(logical_and,
PrimaryTagTestRval, SecondaryTagTestRval)
)
;
Tag = shared_local_tag(Bits, Num),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
- TagTestRval = binop(eq, Rval,
- unop(cast(MLDS_Type),
- mkword(Bits,
- unop(std_unop(mkbody), const(mlconst_int(Num))))))
+ TagTestRval = ml_binop(eq, Rval,
+ ml_unop(cast(MLDS_Type),
+ ml_mkword(Bits,
+ ml_unop(std_unop(mkbody), ml_const(mlconst_int(Num))))))
;
Tag = reserved_address_tag(ReservedAddr),
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
ReservedAddrRval = ml_gen_reserved_address(ModuleInfo, ReservedAddr,
MLDS_Type),
- TagTestRval = binop(eq, Rval, ReservedAddrRval)
+ TagTestRval = ml_binop(eq, Rval, ReservedAddrRval)
;
Tag = shared_with_reserved_addresses_tag(ReservedAddrs, ThisTag),
% We first check that the Rval doesn't match any of the ReservedAddrs,
@@ -1939,13 +1967,13 @@
% the secondary tag -- are boxed, and so we need to unbox (i.e. cast)
% it back to the right type here.
SecondaryTagField =
- unop(unbox(mlds_native_int_type),
- lval(field(yes(PrimaryTagVal), Rval,
- offset(const(mlconst_int(0))),
+ ml_unop(unbox(mlds_native_int_type),
+ ml_lval(ml_field(yes(PrimaryTagVal), Rval,
+ ml_field_offset(ml_const(mlconst_int(0))),
mlds_generic_type, MLDS_VarType)))
;
FieldId = ml_gen_hl_tag_field_id(VarType, ModuleInfo),
- SecondaryTagField = lval(field(yes(PrimaryTagVal), Rval,
+ SecondaryTagField = ml_lval(ml_field(yes(PrimaryTagVal), Rval,
FieldId, mlds_native_int_type, MLDS_VarType))
).
@@ -2010,7 +2038,7 @@
FieldQualifier = mlds_append_class_qualifier(ClassQualifier,
ClassQualKind, Globals, ClassName, ClassArity),
QualifiedFieldName = qual(FieldQualifier, type_qual, FieldName),
- FieldId = named_field(QualifiedFieldName, ClassPtrType).
+ FieldId = ml_field_named(QualifiedFieldName, ClassPtrType).
:- func ml_gen_field_id(mer_type, cons_tag, mlds_class_name, arity,
mlds_field_name, globals) = mlds_field_id.
@@ -2039,7 +2067,7 @@
type_qual, Globals, ConsName, ConsArity),
QualifiedFieldName = qual(FieldQualifier, type_qual, FieldName)
),
- FieldId = named_field(QualifiedFieldName, ClassPtrType).
+ FieldId = ml_field_named(QualifiedFieldName, ClassPtrType).
%-----------------------------------------------------------------------------%
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.62
diff -u -b -r1.62 ml_util.m
--- compiler/ml_util.m 16 Jan 2009 02:31:24 -0000 1.62
+++ compiler/ml_util.m 6 Jun 2009 14:05:02 -0000
@@ -216,7 +216,7 @@
( CallKind = tail_call ; CallKind = no_return_call ),
% Check if the callee address is the same as the caller.
- FuncRval = const(mlconst_code_addr(CodeAddr)),
+ FuncRval = ml_const(mlconst_code_addr(CodeAddr)),
(
CodeAddr = code_addr_proc(QualifiedProcLabel, _Sig),
MaybeSeqNum = no
@@ -466,7 +466,7 @@
rval_contains_var(Rval, Name).
target_code_component_contains_var(target_code_output(Lval), Name) :-
lval_contains_var(Lval, Name).
-target_code_component_contains_var(name(EntityName), DataName) :-
+target_code_component_contains_var(target_code_name(EntityName), DataName) :-
EntityName = qual(ModuleName, QualKind, entity_data(UnqualDataName)),
DataName = qual(ModuleName, QualKind, UnqualDataName),
% This is a place where we can succeed.
@@ -599,35 +599,35 @@
maybe_rval_contains_var(yes(Rval), Name) :-
rval_contains_var(Rval, Name).
-rval_contains_var(lval(Lval), Name) :-
+rval_contains_var(ml_lval(Lval), Name) :-
lval_contains_var(Lval, Name).
-rval_contains_var(mkword(_Tag, Rval), Name) :-
+rval_contains_var(ml_mkword(_Tag, Rval), Name) :-
rval_contains_var(Rval, Name).
-rval_contains_var(const(Const), QualDataName) :-
+rval_contains_var(ml_const(Const), QualDataName) :-
Const = mlconst_data_addr(DataAddr),
DataAddr = data_addr(ModuleName, DataName),
QualDataName = qual(ModuleName, _QualKind, DataName),
% this is a place where we can succeed
true.
-rval_contains_var(unop(_Op, Rval), Name) :-
+rval_contains_var(ml_unop(_Op, Rval), Name) :-
rval_contains_var(Rval, Name).
-rval_contains_var(binop(_Op, X, Y), Name) :-
+rval_contains_var(ml_binop(_Op, X, Y), Name) :-
( rval_contains_var(X, Name)
; rval_contains_var(Y, Name)
).
-rval_contains_var(mem_addr(Lval), Name) :-
+rval_contains_var(ml_mem_addr(Lval), Name) :-
lval_contains_var(Lval, Name).
lvals_contains_var(Lvals, Name) :-
list.member(Lval, Lvals),
lval_contains_var(Lval, Name).
-lval_contains_var(field(_MaybeTag, Rval, _FieldId, _, _), Name) :-
+lval_contains_var(ml_field(_MaybeTag, Rval, _FieldId, _, _), Name) :-
rval_contains_var(Rval, Name).
-lval_contains_var(mem_ref(Rval, _Type), Name) :-
+lval_contains_var(ml_mem_ref(Rval, _Type), Name) :-
rval_contains_var(Rval, Name).
-lval_contains_var(var(qual(ModuleName, QualKind, Name), _Type),
- qual(ModuleName, QualKind, var(Name))) :-
+lval_contains_var(ml_var(qual(ModuleName, QualKind, Name), _Type),
+ qual(ModuleName, QualKind, mlds_data_var(Name))) :-
% This is another place where we can succeed.
true.
@@ -681,28 +681,28 @@
% 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, module_qual, mlds_var_name(Name, no)),
- Type)).
+ Rval = ml_lval(ml_var(qual(MLDS_Module, module_qual,
+ mlds_var_name(Name, no)), Type)).
gen_init_array(Conv, List) = init_array(list.map(Conv, List)).
gen_init_maybe(_Type, Conv, yes(X)) = Conv(X).
gen_init_maybe(Type, _Conv, no) = gen_init_null_pointer(Type).
-gen_init_null_pointer(Type) = init_obj(const(mlconst_null(Type))).
+gen_init_null_pointer(Type) = init_obj(ml_const(mlconst_null(Type))).
-gen_init_string(String) = init_obj(const(mlconst_string(String))).
+gen_init_string(String) = init_obj(ml_const(mlconst_string(String))).
-gen_init_int(Int) = init_obj(const(mlconst_int(Int))).
+gen_init_int(Int) = init_obj(ml_const(mlconst_int(Int))).
gen_init_foreign(Lang, String) =
- init_obj(const(mlconst_foreign(Lang, String, mlds_native_int_type))).
+ init_obj(ml_const(mlconst_foreign(Lang, String, mlds_native_int_type))).
-gen_init_bool(no) = init_obj(const(mlconst_false)).
-gen_init_bool(yes) = init_obj(const(mlconst_true)).
+gen_init_bool(no) = init_obj(ml_const(mlconst_false)).
+gen_init_bool(yes) = init_obj(ml_const(mlconst_true)).
gen_init_boxed_int(Int) =
- init_obj(unop(box(mlds_native_int_type), const(mlconst_int(Int)))).
+ init_obj(ml_unop(box(mlds_native_int_type), ml_const(mlconst_int(Int)))).
gen_init_reserved_address(ModuleInfo, ReservedAddress) =
% XXX using `mlds_generic_type' here is probably wrong
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.169
diff -u -b -r1.169 mlds.m
--- compiler/mlds.m 27 May 2009 05:48:37 -0000 1.169
+++ compiler/mlds.m 6 Jun 2009 14:04:40 -0000
@@ -1113,12 +1113,12 @@
%
% Extra info for switches
%
- % The range of possible values which the
- % switch variable might take (if known)
+ % The range of possible values which the switch variable might take
+ % (if known).
:- type mlds_switch_range
- ---> range_unknown
- ; range(range_min::int, range_max::int).
- % From range_min to range_max, inclusive.
+ ---> mlds_switch_range_unknown
+ ; mlds_switch_range(range_min::int, range_max::int).
+ % From range_min to range_max, both inclusive.
% Each switch case consists of the conditions to match against,
% and the statement to execute if the match succeeds.
@@ -1140,7 +1140,7 @@
; match_range(mlds_rval, mlds_rval).
% match_range(Min, Max) matches if the switch value is between
- % Min and Max, inclusive. Note that this should only be used
+ % Min and Max, both inclusive. Note that this should only be used
% if the target supports it; currently the C back-end supports
% this only if you're using the GNU C compiler.
@@ -1160,27 +1160,28 @@
%-----------------------------------------------------------------------------%
%
-% Extra info for labels
+% Extra info for labels.
%
:- type mlds_label == string.
:- type mlds_goto_target
- ---> label(mlds_label) % Branch to the specified label.
+ ---> goto_label(mlds_label)
+ % Branch to the specified label.
- ; break % Branch to just after the end of the
- % immediately enclosing loop or switch,
- % just like a C/C++/Java `break' statement.
+ ; goto_break
+ % Branch to just after the end of the immediately enclosing loop
+ % or switch, just like a C/C++/Java `break' statement.
% Not supported by all target languages.
- ; continue. % Branch to the end of the loop body for the
- % immediately enclosing loop, just like a
- % C/C++/Java/C# `continue' statement.
+ ; goto_continue.
+ % Branch to the end of the loop body for the immediately enclosing
+ % loop, just like a C/C++/Java/C# `continue' statement.
% Not supported by all target languages.
%-----------------------------------------------------------------------------%
%
-% Extra info for calls
+% Extra info for calls.
%
% The `ml_call_kind' type indicates whether a call is a tail call
@@ -1204,7 +1205,7 @@
%-----------------------------------------------------------------------------%
%
-% Extra info for exception handling
+% Extra info for exception handling.
%
% XXX This is tentative -- the current definition may be
@@ -1411,7 +1412,7 @@
; target_code_input(mlds_rval)
; target_code_output(mlds_lval)
- ; name(mlds_qualified_entity_name).
+ ; target_code_name(mlds_qualified_entity_name).
:- type target_code_attributes == list(target_code_attribute).
@@ -1448,10 +1449,11 @@
% An mlds_field_id represents some data within an object.
%
:- type mlds_field_id
- ---> offset(mlds_rval)
+ ---> ml_field_offset(mlds_rval)
% offset(N) represents the field at offset N Words.
- ; named_field(mlds_fully_qualified_name(mlds_field_name), mlds_type).
+ ; ml_field_named(mlds_fully_qualified_name(mlds_field_name),
+ mlds_type).
% named_field(Name, CtorType) represents the field with the
% specified name. The CtorType gives the MLDS type for this
% particular constructor. The type of the object is given by
@@ -1478,7 +1480,7 @@
% Values on the heap or fields of a structure.
- ---> field(
+ ---> ml_field(
% field(Tag, Address, FieldId, FieldType, PtrType):
% Selects a field of a compound term.
@@ -1511,7 +1513,7 @@
% Values somewhere in memory.
% This is the deference operator (e.g. unary `*' in C).
- ; mem_ref(
+ ; ml_mem_ref(
% The rval should have originally come from a mem_addr rval.
% The type is the type of the value being dereferenced.
@@ -1519,7 +1521,7 @@
mlds_type
)
- ; global_var_ref(
+ ; ml_global_var_ref(
% A reference to the value of the global variable in the target
% language with the given name. At least for now, the global
% variable's type must be mlds_generic_type.
@@ -1534,7 +1536,7 @@
% These may be local or they may come from some enclosing scope
% the variable name should be fully qualified.
- ; var(
+ ; ml_var(
mlds_var,
mlds_type
).
@@ -1550,27 +1552,27 @@
% An rval is an expression that represents a value.
%
:- type mlds_rval
- ---> lval(mlds_lval)
+ ---> ml_lval(mlds_lval)
% The value of an `lval' rval is just the value stored in
% the specified lval.
- ; mkword(mlds_tag, mlds_rval)
+ ; ml_mkword(mlds_tag, mlds_rval)
% Given a pointer and a tag, mkword returns a tagged pointer.
%
% (XXX It might be more consistent to make this a binary_op,
% with the tag argument just being an rval, rather than
% having `mkword' be a separate kind of rval.)
- ; const(mlds_rval_const)
+ ; ml_const(mlds_rval_const)
- ; unop(mlds_unary_op, mlds_rval)
+ ; ml_unop(mlds_unary_op, mlds_rval)
- ; binop(binary_op, mlds_rval, mlds_rval)
+ ; ml_binop(binary_op, mlds_rval, mlds_rval)
- ; mem_addr(mlds_lval)
+ ; ml_mem_addr(mlds_lval)
% The address of a variable, etc.
- ; self(mlds_type).
+ ; ml_self(mlds_type).
% The equivalent of the `this' pointer in C++ with the type of the
% object. Note that this rval is valid iff we are targeting an
% object oriented backend and we are in an instance method
@@ -1642,7 +1644,7 @@
:- type mlds_data == mlds_fully_qualified_name(mlds_data_name).
:- type mlds_data_name
- ---> var(mlds_var_name)
+ ---> mlds_data_var(mlds_var_name)
% Ordinary variables.
; mlds_common(int)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.234
diff -u -b -r1.234 mlds_to_c.m
--- compiler/mlds_to_c.m 27 May 2009 05:48:37 -0000 1.234
+++ compiler/mlds_to_c.m 6 Jun 2009 14:26:36 -0000
@@ -1144,8 +1144,9 @@
:- func boxed_name(mlds_entity_name) = mlds_entity_name.
boxed_name(Name) = BoxedName :-
- ( Name = entity_data(var(mlds_var_name(VarName, Seq))) ->
- BoxedName = entity_data(var(mlds_var_name("boxed_" ++ VarName, Seq)))
+ ( Name = entity_data(mlds_data_var(mlds_var_name(VarName, Seq))) ->
+ BoxedName = entity_data(mlds_data_var(
+ mlds_var_name("boxed_" ++ VarName, Seq)))
;
unexpected(this_file, "boxed_name called for non-var argument")
).
@@ -1246,11 +1247,11 @@
io.write_string(Name, !IO),
io.write_string(" ", !IO),
(
- Initializer = init_obj(const(mlconst_int(Value)))
+ Initializer = init_obj(ml_const(mlconst_int(Value)))
->
io.write_int(Value, !IO)
;
- Initializer = init_obj(const(mlconst_foreign(Lang, Value,
+ Initializer = init_obj(ml_const(mlconst_foreign(Lang, Value,
mlds_native_int_type)))
->
expect(unify(Lang, lang_c), this_file,
@@ -1631,7 +1632,7 @@
% We only need GC tracing code for top-level variables,
% not for base classes.
GCStatement = gc_no_stmt,
- MLDS_Defn = mlds_defn(entity_data(var(BaseName)), Context,
+ MLDS_Defn = mlds_defn(entity_data(mlds_data_var(BaseName)), Context,
ml_gen_public_field_decl_flags,
mlds_data(Type, no_initializer, GCStatement)),
BaseNum = BaseNum0 + 1.
@@ -2135,7 +2136,7 @@
:- pred mlds_output_data_name(mlds_data_name::in, io::di, io::uo) is det.
-mlds_output_data_name(var(Name), !IO) :-
+mlds_output_data_name(mlds_data_var(Name), !IO) :-
mlds_output_mangled_name(ml_var_name_to_string(Name), !IO).
mlds_output_data_name(mlds_common(Num), !IO) :-
io.write_string("common_", !IO),
@@ -2604,16 +2605,16 @@
:- pred mlds_output_statement(indent::in, func_info::in, statement::in,
io::di, io::uo) is det.
-mlds_output_statement(Indent, FuncInfo, statement(Statement, Context),
- !IO) :-
+mlds_output_statement(Indent, FuncInfo, statement(Statement, Context), !IO) :-
output_context(Context, !IO),
mlds_output_stmt(Indent, FuncInfo, Statement, Context, !IO).
:- pred mlds_output_stmt(indent::in, func_info::in, mlds_stmt::in,
mlds_context::in, io::di, io::uo) is det.
-mlds_output_stmt(Indent, FuncInfo, ml_stmt_block(Defns, Statements), Context,
- !IO) :-
+mlds_output_stmt(Indent, FuncInfo, Statement, Context, !IO) :-
+ (
+ Statement = ml_stmt_block(Defns, Statements),
mlds_indent(Indent, !IO),
io.write_string("{\n", !IO),
(
@@ -2626,7 +2627,8 @@
list.filter(defn_is_function, Defns, NestedFuncDefns),
(
NestedFuncDefns = [_ | _],
- mlds_output_decls(Indent + 1, ModuleName, NestedFuncDefns, !IO),
+ mlds_output_decls(Indent + 1, ModuleName, NestedFuncDefns,
+ !IO),
io.write_string("\n", !IO)
;
NestedFuncDefns = []
@@ -2639,27 +2641,28 @@
),
mlds_output_statements(Indent + 1, FuncInfo, Statements, !IO),
mlds_indent(Context, Indent, !IO),
- io.write_string("}\n", !IO).
-
-mlds_output_stmt(Indent, FuncInfo, ml_stmt_while(Cond, Statement, no), _,
- !IO) :-
+ io.write_string("}\n", !IO)
+ ;
+ Statement = ml_stmt_while(Cond, LoopStatement, AtLeastOnce),
+ (
+ AtLeastOnce = no,
mlds_indent(Indent, !IO),
io.write_string("while (", !IO),
mlds_output_rval(Cond, !IO),
io.write_string(")\n", !IO),
- mlds_output_statement(Indent + 1, FuncInfo, Statement, !IO).
-mlds_output_stmt(Indent, FuncInfo, ml_stmt_while(Cond, Statement, yes),
- Context, !IO) :-
+ mlds_output_statement(Indent + 1, FuncInfo, LoopStatement, !IO)
+ ;
+ AtLeastOnce = yes,
mlds_indent(Indent, !IO),
io.write_string("do\n", !IO),
- mlds_output_statement(Indent + 1, FuncInfo, Statement, !IO),
+ mlds_output_statement(Indent + 1, FuncInfo, LoopStatement, !IO),
mlds_indent(Context, Indent, !IO),
io.write_string("while (", !IO),
mlds_output_rval(Cond, !IO),
- io.write_string(");\n", !IO).
-
-mlds_output_stmt(Indent, FuncInfo, IfThenElseStmt, Context, !IO) :-
- IfThenElseStmt = ml_stmt_if_then_else(Cond, Then0, MaybeElse),
+ io.write_string(");\n", !IO)
+ )
+ ;
+ Statement = ml_stmt_if_then_else(Cond, Then0, MaybeElse),
% We need to take care to avoid problems caused by the dangling else
% ambiguity.
(
@@ -2671,9 +2674,9 @@
% else
% ...
%
- % we need braces around the inner `if', otherwise they wouldn't parse
- % they way we want them to: C would match the `else' with the inner
- % `if' rather than the outer `if'.
+ % we need braces around the inner `if', otherwise they wouldn't
+ % parse they way we want them to: C would match the `else'
+ % with the inner `if' rather than the outer `if'.
MaybeElse = yes(_),
Then0 = statement(ml_stmt_if_then_else(_, _, no), ThenContext)
@@ -2712,42 +2715,49 @@
mlds_output_statement(Indent + 1, FuncInfo, Else, !IO)
;
MaybeElse = no
- ).
-mlds_output_stmt(Indent, FuncInfo,
- ml_stmt_switch(_Type, Val, _Range, Cases, Default), Context, !IO) :-
+ )
+ ;
+ Statement = ml_stmt_switch(_Type, Val, _Range, Cases, Default),
mlds_indent(Context, Indent, !IO),
io.write_string("switch (", !IO),
mlds_output_rval(Val, !IO),
io.write_string(") {\n", !IO),
- % we put the default case first, so that if it is unreachable,
+ % We put the default case first, so that if it is unreachable,
% it will get merged in with the first case.
- mlds_output_switch_default(Indent + 1, FuncInfo, Context, Default, !IO),
+ mlds_output_switch_default(Indent + 1, FuncInfo, Context, Default,
+ !IO),
list.foldl(mlds_output_switch_case(Indent + 1, FuncInfo, Context),
Cases, !IO),
mlds_indent(Context, Indent, !IO),
- io.write_string("}\n", !IO).
-
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_label(LabelName), _, !IO) :-
- % Note: MLDS allows labels at the end of blocks. C doesn't. Hence we need
- % to insert a semi-colon after the colon to ensure that there is a
- % statement to attach the label to.
+ io.write_string("}\n", !IO)
+ ;
+ Statement = ml_stmt_label(LabelName),
+ % Note: MLDS allows labels at the end of blocks. C doesn't.
+ % Hence we need to insert a semi-colon after the colon to ensure that
+ % there is a statement to attach the label to.
mlds_indent(Indent - 1, !IO),
mlds_output_label_name(LabelName, !IO),
- io.write_string(":;\n", !IO).
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_goto(label(LabelName)), _, !IO) :-
+ io.write_string(":;\n", !IO)
+ ;
+ Statement = ml_stmt_goto(Target),
+ (
+ Target = goto_label(LabelName),
mlds_indent(Indent, !IO),
io.write_string("goto ", !IO),
mlds_output_label_name(LabelName, !IO),
- io.write_string(";\n", !IO).
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_goto(break), _, !IO) :-
+ io.write_string(";\n", !IO)
+ ;
+ Target = goto_break,
mlds_indent(Indent, !IO),
- io.write_string("break;\n", !IO).
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_goto(continue), _, !IO) :-
+ io.write_string("break;\n", !IO)
+ ;
+ Target = goto_continue,
mlds_indent(Indent, !IO),
- io.write_string("continue;\n", !IO).
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_computed_goto(Expr, Labels),
- Context, !IO) :-
+ io.write_string("continue;\n", !IO)
+ )
+ ;
+ Statement = ml_stmt_computed_goto(Expr, Labels),
% XXX For GNU C, we could output potentially more efficient code
% by using an array of labels; this would tell the compiler that
% it didn't need to do any range check.
@@ -2760,17 +2770,16 @@
mlds_indent(Context, Indent + 1, !IO),
io.write_string("default: /*NOTREACHED*/ MR_assert(0);\n", !IO),
mlds_indent(Context, Indent, !IO),
- io.write_string("}\n", !IO).
-
-mlds_output_stmt(Indent, CallerFuncInfo, Call, Context, !IO) :-
- Call = ml_stmt_call(Signature, FuncRval, MaybeObject, CallArgs,
+ io.write_string("}\n", !IO)
+ ;
+ Statement = ml_stmt_call(Signature, FuncRval, MaybeObject, CallArgs,
Results, IsTailCall),
- CallerFuncInfo = func_info(CallerName, CallerSignature),
+ FuncInfo = func_info(CallerName, CallerSignature),
% We need to enclose the generated code inside an extra pair of curly
% braces, in case we generate more than one statement (e.g. because we
- % generate extra statements for profiling or for tail call optimization)
- % and the generated code is e.g. inside an if-then-else.
+ % generate extra statements for profiling or for tail call
+ % optimization) and the generated code is e.g. inside an if-then-else.
mlds_indent(Indent, !IO),
io.write_string("{\n", !IO),
@@ -2784,13 +2793,14 @@
%
% If Results = [], i.e. the function has `void' return type, then this
% would result in code that is not legal ANSI C (although it _is_ legal
- % in GNU C and in C++), so for that case, we put the return statement after
- % the call -- see below.
+ % in GNU C and in C++), so for that case, we put the return statement
+ % after the call -- see below.
%
- % Note that it's only safe to add such a return statement if the calling
- % procedure has the same return types as the callee, or if the calling
- % procedure has no return value. (Calls where the types are different
- % can be marked as tail calls if they are known to never return.)
+ % Note that it's only safe to add such a return statement if the
+ % calling procedure has the same return types as the callee, or if
+ % the calling procedure has no return value. (Calls where the types
+ % are different can be marked as tail calls if they are known
+ % to never return.)
mlds_indent(Context, Indent + 1, !IO),
Signature = mlds_func_signature(_, RetTypes),
@@ -2838,13 +2848,13 @@
mlds_indent(Context, Indent + 1, !IO),
io.write_string("return;\n", !IO)
;
- mlds_maybe_output_time_profile_instr(Context, Indent + 1, CallerName,
- !IO)
+ mlds_maybe_output_time_profile_instr(Context, Indent + 1,
+ CallerName, !IO)
),
mlds_indent(Indent, !IO),
- io.write_string("}\n", !IO).
-
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_return(Results), _, !IO) :-
+ io.write_string("}\n", !IO)
+ ;
+ Statement = ml_stmt_return(Results),
mlds_indent(Indent, !IO),
io.write_string("return", !IO),
(
@@ -2857,9 +2867,9 @@
Results = [_, _ | _],
mlds_output_return_list(Results, mlds_output_rval, !IO)
),
- io.write_string(";\n", !IO).
-
-mlds_output_stmt(Indent, _FuncInfo, ml_stmt_do_commit(Ref), _, !IO) :-
+ io.write_string(";\n", !IO)
+ ;
+ Statement = ml_stmt_do_commit(Ref),
mlds_indent(Indent, !IO),
globals.io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels, !IO),
(
@@ -2869,17 +2879,17 @@
mlds_output_rval(Ref, !IO)
;
GCC_LocalLabels = no,
- % Output "MR_builtin_longjmp(<Ref>, 1)". This is a macro that expands
- % to either the standard longjmp() or the GNU C's __builtin_longjmp().
- % Note that the second argument to GNU C's __builtin_longjmp() *must*
- % be `1'.
+ % Output "MR_builtin_longjmp(<Ref>, 1)". This is a macro that
+ % expands to either the standard longjmp() or the GNU C's
+ % __builtin_longjmp(). Note that the second argument to GNU
+ % C's __builtin_longjmp() *must* be `1'.
io.write_string("MR_builtin_longjmp(", !IO),
mlds_output_rval(Ref, !IO),
io.write_string(", 1)", !IO)
),
- io.write_string(";\n", !IO).
-mlds_output_stmt(Indent, FuncInfo, TryCommitStmt, Context, !IO) :-
- TryCommitStmt = ml_stmt_try_commit(Ref, Stmt0, Handler),
+ io.write_string(";\n", !IO)
+ ;
+ Statement = ml_stmt_try_commit(Ref, Stmt0, Handler),
globals.io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels, !IO),
(
GCC_LocalLabels = yes,
@@ -2926,19 +2936,20 @@
% MR_builtin_setjmp() expands to either the standard setjmp()
% or GNU C's __builtin_setjmp().
%
- % Note that ISO C says that any non-volatile variables that are local
- % to the function containing the setjmp() and which are modified
- % between the setjmp() and the longjmp() become indeterminate after
- % the longjmp(). The MLDS code generator handles that by generating
- % each commit in its own nested function, with the local variables
- % remaining in the containing function. This ensures that none of the
- % variables which get modified between the setjmp() and the longjmp()
- % and which get referenced after the longjmp() are local variables
- % in the function containing the setjmp(), so we don't need to mark
- % them as volatile.
+ % Note that ISO C says that any non-volatile variables that are
+ % local to the function containing the setjmp() and which are
+ % modified between the setjmp() and the longjmp() become
+ % indeterminate after the longjmp(). The MLDS code generator
+ % handles that by generating each commit in its own nested
+ % function, with the local variables remaining in the containing
+ % function. This ensures that none of the variables which get
+ % modified between the setjmp() and the longjmp() and which get
+ % referenced after the longjmp() are local variables in the
+ % function containing the setjmp(), so we don't need to mark them
+ % as volatile.
- % We need to take care to avoid problems caused by the dangling else
- % ambiguity.
+ % We need to take care to avoid problems caused by the
+ % dangling else ambiguity.
( Stmt0 = statement(ml_stmt_if_then_else(_, _, no), Context) ->
Stmt = statement(ml_stmt_block([], [Stmt0]), Context)
;
@@ -2956,6 +2967,7 @@
io.write_string("else\n", !IO),
mlds_output_statement(Indent + 1, FuncInfo, Handler, !IO)
+ )
).
:- pred mlds_output_computed_goto_label(mlds_context::in, int::in,
@@ -2973,7 +2985,7 @@
%-----------------------------------------------------------------------------%
%
-% Extra code for outputting switch statements
+% Extra code for outputting switch statements.
%
:- pred mlds_output_switch_case(indent::in, func_info::in, mlds_context::in,
@@ -2989,36 +3001,42 @@
:- pred mlds_output_case_cond(indent::in, mlds_context::in,
mlds_case_match_cond::in, io::di, io::uo) is det.
-mlds_output_case_cond(Indent, Context, match_value(Val), !IO) :-
+mlds_output_case_cond(Indent, Context, Match, !IO) :-
+ (
+ Match = match_value(Val),
mlds_indent(Context, Indent, !IO),
io.write_string("case ", !IO),
mlds_output_rval(Val, !IO),
- io.write_string(":\n", !IO).
-mlds_output_case_cond(Indent, Context, match_range(Low, High), !IO) :-
+ io.write_string(":\n", !IO)
+ ;
+ Match = match_range(Low, High),
% This uses the GNU C extension `case <Low> ... <High>:'.
mlds_indent(Context, Indent, !IO),
io.write_string("case ", !IO),
mlds_output_rval(Low, !IO),
io.write_string(" ... ", !IO),
mlds_output_rval(High, !IO),
- io.write_string(":\n", !IO).
+ io.write_string(":\n", !IO)
+ ).
:- pred mlds_output_switch_default(indent::in, func_info::in,
mlds_context::in, mlds_switch_default::in, io::di, io::uo) is det.
-mlds_output_switch_default(Indent, _FuncInfo, Context, default_is_unreachable,
- !IO) :-
+mlds_output_switch_default(Indent, FuncInfo, Context, Default, !IO) :-
+ (
+ Default = default_is_unreachable,
mlds_indent(Context, Indent, !IO),
- io.write_string("default: /*NOTREACHED*/ MR_assert(0);\n", !IO).
-mlds_output_switch_default(_Indent, _FuncInfo, _Context, default_do_nothing,
- !IO).
-mlds_output_switch_default(Indent, FuncInfo, Context, default_case(Statement),
- !IO) :-
+ io.write_string("default: /*NOTREACHED*/ MR_assert(0);\n", !IO)
+ ;
+ Default = default_do_nothing
+ ;
+ Default = default_case(Statement),
mlds_indent(Context, Indent, !IO),
io.write_string("default:\n", !IO),
mlds_output_statement(Indent + 1, FuncInfo, Statement, !IO),
mlds_indent(Context, Indent + 1, !IO),
- io.write_string("break;\n", !IO).
+ io.write_string("break;\n", !IO)
+ ).
%-----------------------------------------------------------------------------%
@@ -3114,38 +3132,38 @@
:- pred mlds_output_atomic_stmt(indent::in, func_info::in,
mlds_atomic_statement::in, mlds_context::in, io::di, io::uo) is det.
-mlds_output_atomic_stmt(Indent, _FuncInfo, comment(Comment), _, !IO) :-
+mlds_output_atomic_stmt(Indent, FuncInfo, Statement, Context, !IO) :-
+ (
+ Statement = comment(Comment),
% XXX We should escape any "*/"'s in the Comment. We should also split
% the comment into lines and indent each line appropriately.
mlds_indent(Indent, !IO),
io.write_string("/* ", !IO),
io.write_string(Comment, !IO),
- io.write_string(" */\n", !IO).
-
-mlds_output_atomic_stmt(Indent, _FuncInfo, assign(Lval, Rval), _, !IO) :-
+ io.write_string(" */\n", !IO)
+ ;
+ Statement = assign(Lval, Rval),
mlds_indent(Indent, !IO),
mlds_output_lval(Lval, !IO),
io.write_string(" = ", !IO),
mlds_output_rval(Rval, !IO),
- io.write_string(";\n", !IO).
-
-mlds_output_atomic_stmt(Indent, _FuncInfo, assign_if_in_heap(Lval, Rval), _,
- !IO) :-
+ io.write_string(";\n", !IO)
+ ;
+ Statement = assign_if_in_heap(Lval, Rval),
mlds_indent(Indent, !IO),
io.write_string("MR_assign_if_in_heap(", !IO),
mlds_output_lval(Lval, !IO),
io.write_string(", ", !IO),
mlds_output_rval(Rval, !IO),
- io.write_string(");\n", !IO).
-
-mlds_output_atomic_stmt(Indent, _FuncInfo, delete_object(Rval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Statement = delete_object(Rval),
mlds_indent(Indent, !IO),
io.write_string("MR_free_heap(", !IO),
mlds_output_rval(Rval, !IO),
- io.write_string(");\n", !IO).
-
-mlds_output_atomic_stmt(Indent, FuncInfo, NewObject, Context, !IO) :-
- NewObject = new_object(Target, MaybeTag, _HasSecTag, Type, MaybeSize,
+ io.write_string(");\n", !IO)
+ ;
+ Statement = new_object(Target, MaybeTag, _HasSecTag, Type, MaybeSize,
MaybeCtorName, Args, ArgTypes, MayUseAtomic),
mlds_indent(Indent, !IO),
io.write_string("{\n", !IO),
@@ -3155,15 +3173,15 @@
% preference to an lval that is more expensive to access. This yields
% a speedup of about 0.3%.
- ( Target = var(_, _) ->
- Base = lval(Target)
+ ( Target = ml_var(_, _) ->
+ Base = ls_lval(Target)
;
% It doesn't matter what string we pick for BaseVarName,
% as long as its declaration doesn't hide any of the variables
% inside Args. This is not hard to ensure, since the printed
% forms of the variables inside Args all include "__".
BaseVarName = "base",
- Base = string(BaseVarName),
+ Base = ls_string(BaseVarName),
mlds_indent(Context, Indent + 1, !IO),
mlds_output_type_prefix(Type, !IO),
io.write_string(" ", !IO),
@@ -3180,11 +3198,11 @@
mlds_indent(Context, Indent + 1, !IO),
io.write_string("MR_GC_check();\n", !IO),
% For types which hold RTTI that will be traversed by the collector
- % at GC-time, we need to allocate an extra word at the start, to hold
- % the forwarding pointer. Normally we would just overwrite the first
- % word of the object in the "from" space, but this can't be done for
- % objects which will be referenced during the garbage collection
- % process.
+ % at GC-time, we need to allocate an extra word at the start,
+ % to hold the forwarding pointer. Normally we would just overwrite
+ % the first word of the object in the "from" space, but this
+ % can't be done for objects which will be referenced during
+ % the garbage collection process.
NeedsForwardingSpace = type_needs_forwarding_pointer_space(Type),
(
NeedsForwardingSpace = yes,
@@ -3223,8 +3241,9 @@
;
MaybeTag = no,
Tag = 0,
- % XXX We shouldn't need the cast here, but currently the type that we
- % include in the call to MR_new_object() is not always correct.
+ % XXX We shouldn't need the cast here, but currently the type
+ % that we include in the call to MR_new_object() is not always
+ % correct.
mlds_output_cast(Type, !IO),
EndMkword = ""
),
@@ -3263,41 +3282,40 @@
io.write_string(EndMkword, !IO),
io.write_string(";\n", !IO),
(
- Base = lval(_)
+ Base = ls_lval(_)
;
- Base = string(BaseVarName1),
+ Base = ls_string(BaseVarName1),
mlds_indent(Context, Indent + 1, !IO),
mlds_output_lval(Target, !IO),
io.write_string(" = ", !IO),
io.write_string(BaseVarName1, !IO),
io.write_string(";\n", !IO)
),
- mlds_output_init_args(Args, ArgTypes, Context, 0, Base, Tag, Indent + 1,
- !IO),
+ mlds_output_init_args(Args, ArgTypes, Context, 0, Base, Tag,
+ Indent + 1, !IO),
mlds_indent(Context, Indent, !IO),
- io.write_string("}\n", !IO).
-
-mlds_output_atomic_stmt(Indent, _FuncInfo, gc_check, _, !IO) :-
+ io.write_string("}\n", !IO)
+ ;
+ Statement = gc_check,
mlds_indent(Indent, !IO),
- io.write_string("MR_GC_check();\n", !IO).
-
-mlds_output_atomic_stmt(Indent, _FuncInfo, mark_hp(Lval), _, !IO) :-
+ io.write_string("MR_GC_check();\n", !IO)
+ ;
+ Statement = mark_hp(Lval),
mlds_indent(Indent, !IO),
io.write_string("MR_mark_hp(", !IO),
mlds_output_lval(Lval, !IO),
- io.write_string(");\n", !IO).
-
-mlds_output_atomic_stmt(Indent, _FuncInfo, restore_hp(Rval), _, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Statement = restore_hp(Rval),
mlds_indent(Indent, !IO),
io.write_string("MR_restore_hp(", !IO),
mlds_output_rval(Rval, !IO),
- io.write_string(");\n", !IO).
-
-mlds_output_atomic_stmt(_Indent, _FuncInfo, trail_op(_TrailOp), _, !IO) :-
- sorry(this_file, "trail_ops not implemented").
-
-mlds_output_atomic_stmt(_Indent, _FuncInfo,
- inline_target_code(TargetLang, Components), Context, !IO) :-
+ io.write_string(");\n", !IO)
+ ;
+ Statement = trail_op(_TrailOp),
+ sorry(this_file, "trail_ops not implemented")
+ ;
+ Statement = inline_target_code(TargetLang, Components),
(
TargetLang = ml_target_c,
list.foldl(mlds_output_target_code_component(Context), Components,
@@ -3309,28 +3327,18 @@
; TargetLang = ml_target_java
),
sorry(this_file, "inline_target_code only works for language C")
+ )
+ ;
+ Statement = outline_foreign_proc(_Lang, _Vs, _Lvals, _Code),
+ unexpected(this_file, "outline_foreign_proc is not used in C backend")
).
-mlds_output_atomic_stmt(_Indent, _FuncInfo,
- outline_foreign_proc(_Lang, _Vs, _Lvals, _Code), _Context, !IO) :-
- unexpected(this_file, "outline_foreign_proc is not used in C backend").
-
:- pred mlds_output_target_code_component(mlds_context::in,
target_code_component::in, io::di, io::uo) is det.
- % Note: `name(Name)' target_code_components are used to
- % generate the #define for `MR_PROC_LABEL'.
- % The fact that they're used in a #define means that we can't do
- % an output_context(Context) here, since #line directives
- % aren't allowed inside #defines.
- % Similarly, all the target_code_components except user_target_code
- % can get emitted inside calls to the MR_BOX_FOREIGN_TYPE
- % or MR_UNBOX_FOREIGN_TYPE macros, which means that we can't output
- % the contexts for those either, since #line directives aren't
- % allowed inside macro invocations in standard C
- % (although some compilers, e.g. gcc 3.2, do allow it).
-mlds_output_target_code_component(Context,
- user_target_code(CodeString, MaybeUserContext, _Attrs), !IO) :-
+mlds_output_target_code_component(Context, TargetCode, !IO) :-
+ (
+ TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs),
(
MaybeUserContext = yes(UserContext),
output_context(mlds_make_context(UserContext), !IO)
@@ -3340,19 +3348,35 @@
),
io.write_string(CodeString, !IO),
io.write_string("\n", !IO),
- reset_context(!IO).
-mlds_output_target_code_component(_Context, raw_target_code(CodeString,
- _Attrs), !IO) :-
- io.write_string(CodeString, !IO).
-mlds_output_target_code_component(_Context, target_code_input(Rval), !IO) :-
+ reset_context(!IO)
+ ;
+ TargetCode = raw_target_code(CodeString, _Attrs),
+ io.write_string(CodeString, !IO)
+ ;
+ TargetCode = target_code_input(Rval),
mlds_output_rval(Rval, !IO),
- io.write_string(" ", !IO).
-mlds_output_target_code_component(_Context, target_code_output(Lval), !IO) :-
+ io.write_string(" ", !IO)
+ ;
+ TargetCode = target_code_output(Lval),
mlds_output_lval(Lval, !IO),
- io.write_string(" ", !IO).
-mlds_output_target_code_component(_Context, name(Name), !IO) :-
+ io.write_string(" ", !IO)
+ ;
+ % Note: `target_code_name(Name)' target_code_components are used to
+ % generate the #define for `MR_PROC_LABEL'.
+ % The fact that they're used in a #define means that we can't do
+ % an output_context(Context) here, since #line directives
+ % aren't allowed inside #defines.
+ % Similarly, all the target_code_components except user_target_code
+ % can get emitted inside calls to the MR_BOX_FOREIGN_TYPE
+ % or MR_UNBOX_FOREIGN_TYPE macros, which means that we can't output
+ % the contexts for those either, since #line directives aren't
+ % allowed inside macro invocations in standard C
+ % (although some compilers, e.g. gcc 3.2, do allow it).
+
+ TargetCode = target_code_name(Name),
mlds_output_fully_qualified_name(Name, !IO),
- io.write_string("\n", !IO).
+ io.write_string("\n", !IO)
+ ).
:- func type_needs_forwarding_pointer_space(mlds_type) = bool.
@@ -3388,12 +3412,12 @@
unexpected(this_file, "type_needs_forwarding_pointer_space: unknown_type").
:- type lval_or_string
- ---> lval(mlds_lval)
- ; string(string).
+ ---> ls_lval(mlds_lval)
+ ; ls_string(string).
:- pred mlds_output_init_args(list(mlds_rval)::in, list(mlds_type)::in,
- mlds_context::in, int::in, lval_or_string::in, mlds_tag::in,
- indent::in, io::di, io::uo) is det.
+ mlds_context::in, int::in, lval_or_string::in, mlds_tag::in, indent::in,
+ io::di, io::uo) is det.
mlds_output_init_args([_ | _], [], _, _, _, _, _, !IO) :-
unexpected(this_file, "mlds_output_init_args: length mismatch").
@@ -3427,33 +3451,31 @@
write_lval_or_string(Base, !IO) :-
(
- Base = lval(Target),
+ Base = ls_lval(Target),
mlds_output_lval(Target, !IO)
;
- Base = string(BaseVarName),
+ Base = ls_string(BaseVarName),
io.write_string(BaseVarName, !IO)
).
%-----------------------------------------------------------------------------%
%
-% Code to output expressions
+% Code to output expressions.
%
:- pred mlds_output_lval(mlds_lval::in, io::di, io::uo) is det.
-mlds_output_lval(field(MaybeTag, Rval, offset(OffsetRval),
- FieldType, _ClassType), !IO) :-
+mlds_output_lval(Lval, !IO) :-
+ (
+ Lval = ml_field(MaybeTag, PtrRval, FieldId, FieldType, PtrType),
+ (
+ FieldId = ml_field_offset(OffsetRval),
(
( FieldType = mlds_generic_type
; FieldType = mercury_type(type_variable(_, _), _, _)
)
->
- io.write_string("(", !IO)
- ;
- % The field type for field(_, _, offset(_), _, _) lvals
- % must be something that maps to MR_Box.
- unexpected(this_file, "unexpected field type")
- ),
+ io.write_string("(", !IO),
(
MaybeTag = yes(Tag),
io.write_string("MR_hl_field(", !IO),
@@ -3464,12 +3486,17 @@
io.write_string("MR_hl_mask_field(", !IO),
io.write_string("(MR_Word) ", !IO)
),
- mlds_output_rval(Rval, !IO),
+ mlds_output_rval(PtrRval, !IO),
io.write_string(", ", !IO),
mlds_output_rval(OffsetRval, !IO),
- io.write_string("))", !IO).
-mlds_output_lval(field(MaybeTag, PtrRval, named_field(FieldName, CtorType),
- _FieldType, PtrType), !IO) :-
+ io.write_string("))", !IO)
+ ;
+ % The field type for ml_lval_field(_, _, ml_field_offset(_),
+ % _, _) lvals must be something that maps to MR_Box.
+ unexpected(this_file, "unexpected field type")
+ )
+ ;
+ FieldId = ml_field_named(FieldName, CtorType),
io.write_string("(", !IO),
( MaybeTag = yes(0) ->
( PtrType \= CtorType ->
@@ -3477,7 +3504,7 @@
;
true
),
- ( PtrRval = mem_addr(Lval) ->
+ ( PtrRval = ml_mem_addr(Lval) ->
mlds_output_lval(Lval, !IO),
io.write_string(").", !IO)
;
@@ -3499,14 +3526,20 @@
),
io.write_string("))->", !IO)
),
- mlds_output_fully_qualified(FieldName, mlds_output_mangled_name, !IO).
-mlds_output_lval(mem_ref(Rval, _Type), !IO) :-
+ mlds_output_fully_qualified(FieldName, mlds_output_mangled_name,
+ !IO)
+ )
+ ;
+ Lval = ml_mem_ref(Rval, _Type),
io.write_string("*", !IO),
- mlds_output_bracketed_rval(Rval, !IO).
-mlds_output_lval(global_var_ref(GobalVar), !IO) :-
- io.write_string(global_var_name(GobalVar), !IO).
-mlds_output_lval(var(VarName, _VarType), !IO) :-
- mlds_output_var(VarName, !IO).
+ mlds_output_bracketed_rval(Rval, !IO)
+ ;
+ Lval = ml_global_var_ref(GobalVar),
+ io.write_string(global_var_name(GobalVar), !IO)
+ ;
+ Lval = ml_var(VarName, _VarType),
+ mlds_output_var(VarName, !IO)
+ ).
:- func global_var_name(global_var_ref) = string.
@@ -3536,7 +3569,7 @@
mlds_output_bracketed_lval(Lval, !IO) :-
(
% If it's just a variable name, then we don't need parentheses.
- Lval = var(_, _)
+ Lval = ml_var(_, _)
->
mlds_output_lval(Lval, !IO)
;
@@ -3550,8 +3583,8 @@
mlds_output_bracketed_rval(Rval, !IO) :-
(
% If it's just a variable name, then we don't need parentheses.
- ( Rval = lval(var(_,_))
- ; Rval = const(mlconst_code_addr(_))
+ ( Rval = ml_lval(ml_var(_,_))
+ ; Rval = ml_const(mlconst_code_addr(_))
)
->
mlds_output_rval(Rval, !IO)
@@ -3580,73 +3613,82 @@
:- pred mlds_output_rval(mlds_rval::in, io::di, io::uo) is det.
-mlds_output_rval(lval(Lval), !IO) :-
- mlds_output_lval(Lval, !IO).
-
-% XXX Do we need the commented out code below?
-% mlds_output_rval(lval(Lval), !IO) :-
-% % if a field is used as an rval, then we need to use
-% % the MR_hl_const_field() macro, not the MR_hl_field() macro,
-% % to avoid warnings about discarding const,
-% % and similarly for MR_mask_field.
-% ( Lval = field(MaybeTag, Rval, FieldNum, _, _) ->
-% ( MaybeTag = yes(Tag) ->
-% io.write_string("MR_hl_const_field(", !IO),
-% mlds_output_tag(Tag, !IO),
-% io.write_string(", ", !IO)
-% ;
-% io.write_string("MR_hl_const_mask_field(", !IO)
-% ),
-% mlds_output_rval(Rval, !IO),
-% io.write_string(", ", !IO),
-% mlds_output_rval(FieldNum, !IO),
-% io.write_string(")", !IO)
-% ;
-% mlds_output_lval(Lval, !IO)
-% ).
-
-mlds_output_rval(mkword(Tag, Rval), !IO) :-
+mlds_output_rval(Rval, !IO) :-
+ (
+ Rval = ml_lval(Lval),
+ mlds_output_lval(Lval, !IO)
+ % XXX Do we need the commented out code below?
+ % if a field is used as an rval, then we need to use
+ % the MR_hl_const_field() macro, not the MR_hl_field() macro,
+ % to avoid warnings about discarding const,
+ % and similarly for MR_mask_field.
+ % ( Lval = ml_lval_field(MaybeTag, Rval, FieldNum, _, _) ->
+ % (
+ % MaybeTag = yes(Tag),
+ % io.write_string("MR_hl_const_field(", !IO),
+ % mlds_output_tag(Tag, !IO),
+ % io.write_string(", ", !IO)
+ % ;
+ % MaybeTag = no,
+ % io.write_string("MR_hl_const_mask_field(", !IO)
+ % ),
+ % mlds_output_rval(Rval, !IO),
+ % io.write_string(", ", !IO),
+ % mlds_output_rval(FieldNum, !IO),
+ % io.write_string(")", !IO)
+ % ;
+ % mlds_output_lval(Lval, !IO)
+ % ).
+ ;
+ Rval = ml_mkword(Tag, BaseRval),
io.write_string("MR_mkword(", !IO),
mlds_output_tag(Tag, !IO),
io.write_string(", ", !IO),
- mlds_output_rval(Rval, !IO),
- io.write_string(")", !IO).
-
-mlds_output_rval(const(Const), !IO) :-
- mlds_output_rval_const(Const, !IO).
-
-mlds_output_rval(unop(Op, Rval), !IO) :-
- mlds_output_unop(Op, Rval, !IO).
-
-mlds_output_rval(binop(Op, Rval1, Rval2), !IO) :-
- mlds_output_binop(Op, Rval1, Rval2, !IO).
-
-mlds_output_rval(mem_addr(Lval), !IO) :-
- % XXX are parentheses needed?
+ mlds_output_rval(BaseRval, !IO),
+ io.write_string(")", !IO)
+ ;
+ Rval = ml_const(Const),
+ mlds_output_rval_const(Const, !IO)
+ ;
+ Rval = ml_unop(Op, RvalA),
+ mlds_output_unop(Op, RvalA, !IO)
+ ;
+ Rval = ml_binop(Op, RvalA, RvalB),
+ mlds_output_binop(Op, RvalA, RvalB, !IO)
+ ;
+ Rval = ml_mem_addr(Lval),
+ % XXX Are parentheses needed?
io.write_string("&", !IO),
- mlds_output_lval(Lval, !IO).
-
-mlds_output_rval(self(_), !IO) :-
- io.write_string("this", !IO).
+ mlds_output_lval(Lval, !IO)
+ ;
+ Rval = ml_self(_),
+ io.write_string("this", !IO)
+ ).
:- pred mlds_output_unop(mlds_unary_op::in, mlds_rval::in, io::di, io::uo)
is det.
-mlds_output_unop(cast(Type), Exprn, !IO) :-
- mlds_output_cast_rval(Type, Exprn, !IO).
-mlds_output_unop(box(Type), Exprn, !IO) :-
- mlds_output_boxed_rval(Type, Exprn, !IO).
-mlds_output_unop(unbox(Type), Exprn, !IO) :-
- mlds_output_unboxed_rval(Type, Exprn, !IO).
-mlds_output_unop(std_unop(Unop), Exprn, !IO) :-
- mlds_output_std_unop(Unop, Exprn, !IO).
+mlds_output_unop(Unop, Expr, !IO) :-
+ (
+ Unop = cast(Type),
+ mlds_output_cast_rval(Type, Expr, !IO)
+ ;
+ Unop = box(Type),
+ mlds_output_boxed_rval(Type, Expr, !IO)
+ ;
+ Unop = unbox(Type),
+ mlds_output_unboxed_rval(Type, Expr, !IO)
+ ;
+ Unop = std_unop(StdUnop),
+ mlds_output_std_unop(StdUnop, Expr, !IO)
+ ).
:- pred mlds_output_cast_rval(mlds_type::in, mlds_rval::in, io::di, io::uo)
is det.
-mlds_output_cast_rval(Type, Exprn, !IO) :-
+mlds_output_cast_rval(Type, Expr, !IO) :-
mlds_output_cast(Type, !IO),
- mlds_output_rval(Exprn, !IO).
+ mlds_output_rval(Expr, !IO).
:- pred mlds_output_cast(mlds_type::in, io::di, io::uo) is det.
@@ -3658,31 +3700,31 @@
:- pred mlds_output_boxed_rval(mlds_type::in, mlds_rval::in, io::di, io::uo)
is det.
-mlds_output_boxed_rval(Type, Exprn, !IO) :-
+mlds_output_boxed_rval(Type, Expr, !IO) :-
(
( Type = mlds_generic_type
; Type = mercury_type(_, ctor_cat_variable, _)
)
->
% It already has type MR_Box, so no cast is needed.
- mlds_output_rval(Exprn, !IO)
+ mlds_output_rval(Expr, !IO)
;
- Exprn = unop(cast(OtherType), InnerExprn),
+ Expr = ml_unop(cast(OtherType), InnerExpr),
( Type = OtherType
- ; is_an_address(InnerExprn)
+ ; is_an_address(InnerExpr)
)
->
% Avoid unnecessary double-casting -- strip away the inner cast.
% This is necessary for ANSI/ISO C conformance, to avoid casts
% from pointers to integers in static initializers.
- mlds_output_boxed_rval(Type, InnerExprn, !IO)
+ mlds_output_boxed_rval(Type, InnerExpr, !IO)
;
( Type = mercury_type(builtin_type(builtin_type_float), _, _)
; Type = mlds_native_float_type
)
->
io.write_string("MR_box_float(", !IO),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string(")", !IO)
;
( Type = mercury_type(builtin_type(builtin_type_character), _, _)
@@ -3695,11 +3737,11 @@
% This is done to avoid spurious warnings about "cast from
% integer to pointer of different size" from gcc.
io.write_string("((MR_Box) (MR_Word) (", !IO),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string("))", !IO)
;
io.write_string("((MR_Box) (", !IO),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string("))", !IO)
).
@@ -3708,26 +3750,26 @@
%
:- pred is_an_address(mlds_rval::in) is semidet.
-is_an_address(mkword(_Tag, Expr)) :-
+is_an_address(ml_mkword(_Tag, Expr)) :-
is_an_address(Expr).
-is_an_address(unop(cast(_), Expr)) :-
+is_an_address(ml_unop(cast(_), Expr)) :-
is_an_address(Expr).
-is_an_address(mem_addr(_)).
-is_an_address(const(mlconst_null(_))).
-is_an_address(const(mlconst_code_addr(_))).
-is_an_address(const(mlconst_data_addr(_))).
+is_an_address(ml_mem_addr(_)).
+is_an_address(ml_const(mlconst_null(_))).
+is_an_address(ml_const(mlconst_code_addr(_))).
+is_an_address(ml_const(mlconst_data_addr(_))).
:- pred mlds_output_unboxed_rval(mlds_type::in, mlds_rval::in,
io::di, io::uo) is det.
-mlds_output_unboxed_rval(Type, Exprn, !IO) :-
+mlds_output_unboxed_rval(Type, Expr, !IO) :-
(
( Type = mercury_type(builtin_type(builtin_type_float), _, _)
; Type = mlds_native_float_type
)
->
io.write_string("MR_unbox_float(", !IO),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string(")", !IO)
;
( Type = mercury_type(builtin_type(builtin_type_character), _, _)
@@ -3742,19 +3784,19 @@
io.write_string("(", !IO),
mlds_output_cast(Type, !IO),
io.write_string("(MR_Word) ", !IO),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string(")", !IO)
;
io.write_string("(", !IO),
mlds_output_cast(Type, !IO),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string(")", !IO)
).
:- pred mlds_output_std_unop(builtin_ops.unary_op::in, mlds_rval::in,
io::di, io::uo) is det.
-mlds_output_std_unop(UnaryOp, Exprn, !IO) :-
+mlds_output_std_unop(UnaryOp, Expr, !IO) :-
c_util.unary_prefix_op(UnaryOp, UnaryOpString),
io.write_string(UnaryOpString, !IO),
io.write_string("(", !IO),
@@ -3765,7 +3807,7 @@
;
true
),
- mlds_output_rval(Exprn, !IO),
+ mlds_output_rval(Expr, !IO),
io.write_string(")", !IO).
:- pred mlds_output_binop(binary_op::in, mlds_rval::in, mlds_rval::in,
@@ -3838,47 +3880,60 @@
:- pred mlds_output_rval_const(mlds_rval_const::in, io::di, io::uo) is det.
-mlds_output_rval_const(mlconst_true, !IO) :-
- io.write_string("MR_TRUE", !IO).
-mlds_output_rval_const(mlconst_false, !IO) :-
- io.write_string("MR_FALSE", !IO).
-mlds_output_rval_const(mlconst_int(N), !IO) :-
+mlds_output_rval_const(Const, !IO) :-
+ (
+ Const = mlconst_true,
+ io.write_string("MR_TRUE", !IO)
+ ;
+ Const = mlconst_false,
+ io.write_string("MR_FALSE", !IO)
+ ;
+ Const = mlconst_int(N),
% We need to cast to (MR_Integer) to ensure things like 1 << 32 work
% when `Integer' is 64 bits but `int' is 32 bits.
io.write_string("(MR_Integer) ", !IO),
- io.write_int(N, !IO).
-mlds_output_rval_const(mlconst_foreign(Lang, Value, Type), !IO) :-
+ io.write_int(N, !IO)
+ ;
+ Const = mlconst_foreign(Lang, Value, Type),
expect(unify(Lang, lang_c), this_file,
"output_rval_const - mlconst_foreign for language other than C."),
io.write_string("((", !IO),
mlds_output_type(Type, !IO),
io.write_string(") ", !IO),
io.write_string(Value, !IO),
- io.write_string(")", !IO).
-mlds_output_rval_const(mlconst_float(FloatVal), !IO) :-
- % The cast to (MR_Float) here lets the C compiler do arithmetic in `float'
- % rather than `double' if `MR_Float' is `float' not `double'.
+ io.write_string(")", !IO)
+ ;
+ Const = mlconst_float(FloatVal),
+ % The cast to (MR_Float) here lets the C compiler do arithmetic in
+ % `float' rather than `double' if `MR_Float' is `float' not `double'.
io.write_string("(MR_Float) ", !IO),
- c_util.output_float_literal(FloatVal, !IO).
-mlds_output_rval_const(mlconst_string(String), !IO) :-
+ c_util.output_float_literal(FloatVal, !IO)
+ ;
+ Const = mlconst_string(String),
% The cast avoids the following gcc warning
% "assignment discards qualifiers from pointer target type".
io.write_string("(MR_String) ", !IO),
io.write_string("""", !IO),
c_util.output_quoted_string(String, !IO),
- io.write_string("""", !IO).
-mlds_output_rval_const(mlconst_multi_string(String), !IO) :-
+ io.write_string("""", !IO)
+ ;
+ Const = mlconst_multi_string(String),
io.write_string("""", !IO),
c_util.output_quoted_multi_string(String, !IO),
- io.write_string("""", !IO).
-mlds_output_rval_const(mlconst_named_const(NamedConst), !IO) :-
- io.write_string(NamedConst, !IO).
-mlds_output_rval_const(mlconst_code_addr(CodeAddr), !IO) :-
- mlds_output_code_addr(CodeAddr, !IO).
-mlds_output_rval_const(mlconst_data_addr(DataAddr), !IO) :-
- mlds_output_data_addr(DataAddr, !IO).
-mlds_output_rval_const(mlconst_null(_), !IO) :-
- io.write_string("NULL", !IO).
+ io.write_string("""", !IO)
+ ;
+ Const = mlconst_named_const(NamedConst),
+ io.write_string(NamedConst, !IO)
+ ;
+ Const = mlconst_code_addr(CodeAddr),
+ mlds_output_code_addr(CodeAddr, !IO)
+ ;
+ Const = mlconst_data_addr(DataAddr),
+ mlds_output_data_addr(DataAddr, !IO)
+ ;
+ Const = mlconst_null(_),
+ io.write_string("NULL", !IO)
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.142
diff -u -b -r1.142 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 16 Jan 2009 02:31:25 -0000 1.142
+++ compiler/mlds_to_gcc.m 6 Jun 2009 14:38:11 -0000
@@ -759,7 +759,7 @@
build_field_defn(Defn, ModuleName, GlobalInfo, GCC_FieldDefn),
% Insert the field definition into our field symbol table.
{ Defn = mlds_defn(Name, _, _, _) },
- ( { Name = entity_data(var(FieldName)) } ->
+ ( { Name = entity_data(mlds_data_var(FieldName)) } ->
{ GCC_FieldName = ml_var_name_to_string(FieldName) },
{ FieldTable1 = map__det_insert(FieldTable0,
qual(ModuleName, type_qual, GCC_FieldName),
@@ -1153,7 +1153,7 @@
build_type(Type, initializer_array_size(Initializer),
DefnInfo ^ global_info, GCC_Type),
{ Name = qual(_ModuleName, _QualKind, UnqualName) },
- ( { UnqualName = entity_data(var(VarName0)) } ->
+ ( { UnqualName = entity_data(mlds_data_var(VarName0)) } ->
{ VarName = VarName0 }
;
% var/1 should be the only kind of mlds_data_name for which
@@ -1201,7 +1201,7 @@
build_type(Type, initializer_array_size(Initializer),
GlobalInfo, GCC_Type),
{ Name = qual(_ModuleName, _QualKind, UnqualName) },
- ( { UnqualName = entity_data(var(VarName)) } ->
+ ( { UnqualName = entity_data(mlds_data_var(VarName)) } ->
{ GCC_VarName = ml_var_name_to_string(VarName) },
gcc__build_field_decl(GCC_VarName, GCC_Type, GCC_Defn)
;
@@ -1399,7 +1399,7 @@
% not for base classes.
GCStatement = gc_no_stmt,
MLDS_Defn = mlds_defn(
- entity_data(var(mlds_var_name(BaseName, no))), Context,
+ entity_data(mlds_data_var(mlds_var_name(BaseName, no))), Context,
ml_gen_public_field_decl_flags,
mlds_data(Type, no_initializer, GCStatement)),
BaseNum = BaseNum0 + 1.
@@ -1706,7 +1706,7 @@
ParamTypes0, ParamDecls0, SymbolTable0),
{ Arg = mlds_argument(ArgName, Type, _Statement) },
build_type(Type, GlobalInfo, GCC_Type),
- ( { ArgName = entity_data(var(ArgVarName)) } ->
+ ( { ArgName = entity_data(mlds_data_var(ArgVarName)) } ->
{ GCC_ArgVarName = ml_var_name_to_string(ArgVarName) },
gcc__build_param_decl(GCC_ArgVarName, GCC_Type, ParamDecl),
{ SymbolTable = map__det_insert(SymbolTable0,
@@ -2604,7 +2604,8 @@
:- func build_data_name(mlds_data_name) = string.
-build_data_name(var(Name)) = name_mangle(ml_var_name_to_string(Name)).
+build_data_name(mlds_data_var(Name)) =
+ name_mangle(ml_var_name_to_string(Name)).
build_data_name(mlds_common(Num)) =
string__format("common_%d", [i(Num)]).
build_data_name(mlds_rtti(RttiId0)) = RttiAddrName :-
@@ -2789,7 +2790,7 @@
gcc__gen_end_cond.
gen_stmt(DefnInfo, ml_stmt_switch(Type, Val, Range, Cases, Default), _) -->
build_type(Type, DefnInfo ^ global_info, GCC_Type),
- ( { Range = range(Min, Max) } ->
+ ( { Range = mlds_switch_range(Min, Max) } ->
gcc__build_range_type(GCC_Type, Min, Max, GCC_RangeType)
;
{ GCC_RangeType = GCC_Type }
@@ -2809,13 +2810,13 @@
{ LabelTable = DefnInfo ^ label_table },
{ GCC_Label = map__lookup(LabelTable, LabelName) },
gcc__gen_label(GCC_Label).
-gen_stmt(DefnInfo, ml_stmt_goto(label(LabelName)), _) -->
+gen_stmt(DefnInfo, ml_stmt_goto(goto_label(LabelName)), _) -->
{ LabelTable = DefnInfo ^ label_table },
{ GCC_Label = map__lookup(LabelTable, LabelName) },
gcc__gen_goto(GCC_Label).
-gen_stmt(_DefnInfo, ml_stmt_goto(break), _) -->
+gen_stmt(_DefnInfo, ml_stmt_goto(goto_break), _) -->
gcc__gen_break.
-gen_stmt(_DefnInfo, ml_stmt_goto(continue), _) -->
+gen_stmt(_DefnInfo, ml_stmt_goto(goto_continue), _) -->
% XXX not yet implemented
% but we set target_supports_break_and_continue to no
% for this target, so we shouldn't get any
@@ -2888,13 +2889,13 @@
%
gen_stmt(DefnInfo, ml_stmt_do_commit(Ref), _Context) -->
% generate `__builtin_longjmp(&<Ref>, 1);'
- { Ref = lval(RefLval0) ->
+ { Ref = ml_lval(RefLval0) ->
RefLval = RefLval0
;
unexpected(this_file, "non-lval argument to do_commit")
},
build_call(gcc__longjmp_func_decl,
- [mem_addr(RefLval), const(mlconst_int(1))],
+ [ml_mem_addr(RefLval), ml_const(mlconst_int(1))],
DefnInfo, GCC_CallLongjmp),
gcc__gen_expr_stmt(GCC_CallLongjmp).
gen_stmt(DefnInfo, ml_stmt_try_commit(Ref, Stmt, Handler), _) -->
@@ -2906,7 +2907,7 @@
% else
% <Handler>
%
- build_call(gcc__setjmp_func_decl, [mem_addr(Ref)], DefnInfo,
+ build_call(gcc__setjmp_func_decl, [ml_mem_addr(Ref)], DefnInfo,
GCC_CallSetjmp),
gcc__build_int(0, GCC_Zero),
gcc__build_binop(gcc__eq_expr, gcc__boolean_type_node,
@@ -3115,8 +3116,8 @@
%
( { MaybeSize = yes(SizeInWords) } ->
globals__io_lookup_int_option(bytes_per_word, BytesPerWord),
- { SizeOfWord = const(mlconst_int(BytesPerWord)) },
- { SizeInBytes = binop(int_mul, SizeInWords, SizeOfWord) }
+ { SizeOfWord = ml_const(mlconst_int(BytesPerWord)) },
+ { SizeInBytes = ml_binop(int_mul, SizeInWords, SizeOfWord) }
;
{ sorry(this_file, "new_object with unknown size") }
),
@@ -3212,9 +3213,10 @@
% Currently all fields of new_object instructions are
% represented as MR_Box, so we need to box them if necessary.
%
- { Lval = field(yes(Tag), lval(Target),
- offset(const(mlconst_int(ArgNum))), mlds_generic_type, Type) },
- { Rval = unop(box(ArgType), Arg) },
+ { Lval = ml_field(yes(Tag), ml_lval(Target),
+ ml_field_offset(ml_const(mlconst_int(ArgNum))), mlds_generic_type,
+ Type) },
+ { Rval = ml_unop(box(ArgType), Arg) },
build_lval(Lval, DefnInfo, GCC_Lval),
build_rval(Rval, DefnInfo, GCC_Rval),
gcc__gen_assign(GCC_Lval, GCC_Rval),
@@ -3229,7 +3231,7 @@
:- pred build_lval(mlds_lval, defn_info, gcc__expr, io__state, io__state).
:- mode build_lval(in, in, out, di, uo) is det.
-build_lval(field(MaybeTag, Rval, offset(OffsetRval),
+build_lval(ml_field(MaybeTag, Rval, ml_field_offset(OffsetRval),
FieldType, _ClassType), DefnInfo, GCC_FieldRef) -->
% sanity check (copied from mlds_to_c.m)
(
@@ -3277,7 +3279,7 @@
% deference it
gcc__build_pointer_deref(GCC_FieldPointer, GCC_FieldRef).
-build_lval(field(MaybeTag, PtrRval, named_field(FieldName, CtorType),
+build_lval(ml_field(MaybeTag, PtrRval, ml_field_named(FieldName, CtorType),
_FieldType, _PtrType), DefnInfo, GCC_Expr) -->
% generate the tagged pointer whose field we want to extract
build_rval(PtrRval, DefnInfo, GCC_TaggedPointer),
@@ -3311,14 +3313,14 @@
gcc__build_component_ref(GCC_ObjectRef, GCC_FieldDecl,
GCC_Expr).
-build_lval(mem_ref(PointerRval, _Type), DefnInfo, Expr) -->
+build_lval(ml_mem_ref(PointerRval, _Type), DefnInfo, Expr) -->
build_rval(PointerRval, DefnInfo, PointerExpr),
gcc__build_pointer_deref(PointerExpr, Expr).
-build_lval(global_var_ref(_), _DefnInfo, _Expr) -->
+build_lval(ml_global_var_ref(_), _DefnInfo, _Expr) -->
{ sorry(this_file, "build_lval: global_var_ref NYI") }.
-build_lval(var(qual(ModuleName, QualKind, VarName), _VarType), DefnInfo,
+build_lval(ml_var(qual(ModuleName, QualKind, VarName), _VarType), DefnInfo,
Expr) -->
%
% Look up the variable in the symbol table.
@@ -3327,7 +3329,8 @@
% symbol table. If it's not in either of those,
% we check if its an RTTI enumeration constant.
%
- { Name = qual(ModuleName, QualKind, entity_data(var(VarName))) },
+ { Name = qual(ModuleName, QualKind,
+ entity_data(mlds_data_var(VarName))) },
(
{ map__search(DefnInfo ^ local_vars, Name, LocalVarDecl) }
->
@@ -3353,7 +3356,8 @@
{ VarName = mlds_var_name("dummy_var", _) }
->
% if so, generate an extern declaration for it, and use that.
- { GCC_VarName = build_data_var_name(ModuleName, var(VarName)) },
+ { GCC_VarName = build_data_var_name(ModuleName,
+ mlds_data_var(VarName)) },
{ Type = 'MR_Word' },
gcc__build_extern_var_decl(GCC_VarName, Type, Decl),
{ Expr = gcc__var_expr(Decl) }
@@ -3382,29 +3386,29 @@
:- pred build_rval(mlds_rval, defn_info, gcc__expr, io__state, io__state).
:- mode build_rval(in, in, out, di, uo) is det.
-build_rval(lval(Lval), DefnInfo, Expr) -->
+build_rval(ml_lval(Lval), DefnInfo, Expr) -->
build_lval(Lval, DefnInfo, Expr).
-build_rval(mkword(Tag, Arg), DefnInfo, Expr) -->
+build_rval(ml_mkword(Tag, Arg), DefnInfo, Expr) -->
gcc__build_int(Tag, GCC_Tag),
build_rval(Arg, DefnInfo, GCC_Arg),
gcc__build_binop(gcc__plus_expr, gcc__ptr_type_node,
GCC_Arg, GCC_Tag, Expr).
-build_rval(const(Const), DefnInfo, Expr) -->
+build_rval(ml_const(Const), DefnInfo, Expr) -->
build_rval_const(Const, DefnInfo ^ global_info, Expr).
-build_rval(unop(Op, Rval), DefnInfo, Expr) -->
+build_rval(ml_unop(Op, Rval), DefnInfo, Expr) -->
build_unop(Op, Rval, DefnInfo, Expr).
-build_rval(binop(Op, Rval1, Rval2), DefnInfo, Expr) -->
+build_rval(ml_binop(Op, Rval1, Rval2), DefnInfo, Expr) -->
build_std_binop(Op, Rval1, Rval2, DefnInfo, Expr).
-build_rval(mem_addr(Lval), DefnInfo, AddrExpr) -->
+build_rval(ml_mem_addr(Lval), DefnInfo, AddrExpr) -->
build_lval(Lval, DefnInfo, Expr),
gcc__build_addr_expr(Expr, AddrExpr).
-build_rval(self(_), _DefnInfo, _Expr) -->
+build_rval(ml_self(_), _DefnInfo, _Expr) -->
{ unexpected(this_file, "self rval") }.
:- pred build_unop(mlds_unary_op, mlds_rval, defn_info, gcc__expr,
@@ -3426,11 +3430,11 @@
% This implies that the array must be an lval.
% But we also allow null arrays as a special case;
% boxing a null array results in a null pointer.
- ( { Rval = const(mlconst_null(_)) } ->
- { PtrRval = const(mlconst_null(mlds_generic_type)) },
+ ( { Rval = ml_const(mlconst_null(_)) } ->
+ { PtrRval = ml_const(mlconst_null(mlds_generic_type)) },
build_rval(PtrRval, DefnInfo, GCC_Expr)
- ; { Rval = lval(ArrayLval) } ->
- { PtrRval = mem_addr(ArrayLval) },
+ ; { Rval = ml_lval(ArrayLval) } ->
+ { PtrRval = ml_mem_addr(ArrayLval) },
build_cast_rval(mlds_generic_type, PtrRval, DefnInfo,
GCC_Expr)
;
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.203
diff -u -b -r1.203 mlds_to_il.m
--- compiler/mlds_to_il.m 11 May 2009 04:56:45 -0000 1.203
+++ compiler/mlds_to_il.m 6 Jun 2009 14:28:18 -0000
@@ -548,14 +548,14 @@
:- func rename_rval(mlds_rval) = mlds_rval.
-rename_rval(lval(Lval)) = lval(rename_lval(Lval)).
-rename_rval(mkword(Tag, Rval)) = mkword(Tag, rename_rval(Rval)).
-rename_rval(const(Const)) = const(rename_const(Const)).
-rename_rval(unop(Op, Rval)) = unop(Op, rename_rval(Rval)).
-rename_rval(binop(Op, RvalA, RvalB))
- = binop(Op, rename_rval(RvalA), rename_rval(RvalB)).
-rename_rval(mem_addr(Lval)) = mem_addr(rename_lval(Lval)).
-rename_rval(self(Type)) = self(Type).
+rename_rval(ml_lval(Lval)) = ml_lval(rename_lval(Lval)).
+rename_rval(ml_mkword(Tag, Rval)) = ml_mkword(Tag, rename_rval(Rval)).
+rename_rval(ml_const(Const)) = ml_const(rename_const(Const)).
+rename_rval(ml_unop(Op, Rval)) = ml_unop(Op, rename_rval(Rval)).
+rename_rval(ml_binop(Op, RvalA, RvalB))
+ = ml_binop(Op, rename_rval(RvalA), rename_rval(RvalB)).
+rename_rval(ml_mem_addr(Lval)) = ml_mem_addr(rename_lval(Lval)).
+rename_rval(ml_self(Type)) = ml_self(Type).
:- func rename_const(mlds_rval_const) = mlds_rval_const.
@@ -583,17 +583,17 @@
:- func rename_lval(mlds_lval) = mlds_lval.
-rename_lval(field(Tag, Address, FieldName, FieldType, PtrType))
- = field(Tag, rename_rval(Address),
+rename_lval(ml_field(Tag, Address, FieldName, FieldType, PtrType))
+ = ml_field(Tag, rename_rval(Address),
rename_field_id(FieldName), FieldType, PtrType).
-rename_lval(mem_ref(Rval, Type)) = mem_ref(rename_rval(Rval), Type).
-rename_lval(global_var_ref(Ref)) = global_var_ref(Ref).
-rename_lval(var(Var, Type)) = var(rename_var(Var, Type), Type).
+rename_lval(ml_mem_ref(Rval, Type)) = ml_mem_ref(rename_rval(Rval), Type).
+rename_lval(ml_global_var_ref(Ref)) = ml_global_var_ref(Ref).
+rename_lval(ml_var(Var, Type)) = ml_var(rename_var(Var, Type), Type).
:- func rename_field_id(mlds_field_id) = mlds_field_id.
-rename_field_id(offset(Rval)) = offset(rename_rval(Rval)).
-rename_field_id(named_field(Name, Type)) = named_field(Name, Type).
+rename_field_id(ml_field_offset(Rval)) = ml_field_offset(rename_rval(Rval)).
+rename_field_id(ml_field_named(Name, Type)) = ml_field_named(Name, Type).
:- func rename_initializer(mlds_initializer) = mlds_initializer.
@@ -1346,7 +1346,7 @@
:- func mangle_dataname(mlds_data_name) = string.
-mangle_dataname(var(MLDSVarName))
+mangle_dataname(mlds_data_var(MLDSVarName))
= mangle_mlds_var_name(MLDSVarName).
mangle_dataname(mlds_common(Int))
= string.format("common_%d", [i(Int)]).
@@ -1393,13 +1393,13 @@
% accurate GC in the IL back-end -- the .NET runtime
% system itself provides accurate GC.
GCStatement = gc_no_stmt,
- RV = ml_gen_mlds_var_decl_init(var(VN), RT, no_initializer,
- GCStatement, Context),
- Lval = var(qual(ModuleName, module_qual, VN), RT)
+ RV = ml_gen_mlds_var_decl_init(mlds_data_var(VN), RT,
+ no_initializer, GCStatement, Context),
+ Lval = ml_var(qual(ModuleName, module_qual, VN), RT)
), RetTypes, ReturnVars, 0, _),
EntNameToVarName = (func(EntName) = VarName :-
- ( EntName = entity_data(var(VarName0)) ->
+ ( EntName = entity_data(mlds_data_var(VarName0)) ->
VarName = qual(ModuleName, module_qual, VarName0)
;
unexpected(this_file,
@@ -1409,17 +1409,17 @@
ArgTypes = mlds_get_arg_types(Inputs),
ArgRvals = list.map(
(func(mlds_argument(EntName, Type, _GCStatement)) =
- lval(var(VarName, Type)) :-
+ ml_lval(ml_var(VarName, Type)) :-
VarName = EntNameToVarName(EntName)
), Inputs),
ReturnVarDecls = assoc_list.keys(ReturnVars),
ReturnLvals = assoc_list.values(ReturnVars),
- ReturnRvals = list.map((func(X) = lval(X)), ReturnLvals),
+ ReturnRvals = list.map((func(X) = ml_lval(X)), ReturnLvals),
Signature = mlds_func_signature(ArgTypes, RetTypes),
(
UnqualName = entity_function(PredLabel, ProcId, _MaybeSeq, _PredId),
- CodeRval = const(mlconst_code_addr(code_addr_proc(
+ CodeRval = ml_const(mlconst_code_addr(code_addr_proc(
qual(ModuleName, module_qual, mlds_proc_label(PredLabel, ProcId)),
Signature)))
;
@@ -1474,9 +1474,10 @@
( Initializer = no_initializer ->
true
;
- ( DataName = var(VarName) ->
+ ( DataName = mlds_data_var(VarName) ->
il_info_get_module_name(!.Info, ModuleName),
- Lval = var(qual(ModuleName, module_qual, VarName), MLDSType),
+ Lval = ml_var(qual(ModuleName, module_qual, VarName),
+ MLDSType),
get_load_store_lval_instrs(Lval,
LoadMemRefInstrs, StoreLvalInstrs, !Info),
NameString = mangle_mlds_var_name(VarName)
@@ -1596,7 +1597,7 @@
% single items need to be boxed
maybe_box_initializer(init_obj(Rval), init_obj(NewRval)) :-
rval_to_type(Rval, BoxType),
- NewRval = unop(box(BoxType), Rval).
+ NewRval = ml_unop(box(BoxType), Rval).
% Code to flatten nested intializers.
%
@@ -1702,7 +1703,7 @@
% calls (tail.call), not indirect calls (calli).
\+ (
RotorCLR = yes,
- Function \= const(_)
+ Function \= ml_const(_)
)
->
TailCallInstrs = [tailcall],
@@ -1723,7 +1724,7 @@
),
list.map_foldl(load, Args, ArgsLoadInstrsTrees, !Info),
ArgsLoadInstrs = cord_list_to_cord(ArgsLoadInstrsTrees),
- ( Function = const(Const) ->
+ ( Function = ml_const(Const) ->
FunctionLoadInstrs = empty,
const_rval_to_function(Const, MemberName),
Instrs0 = [call(methoddef(call_conv(no, default),
@@ -1828,7 +1829,7 @@
]).
statement_to_il(statement(GotoLabelStmt, Context), Instrs, !Info) :-
- GotoLabelStmt = ml_stmt_goto(label(Label)),
+ GotoLabelStmt = ml_stmt_goto(goto_label(Label)),
string.format("goto %s", [s(Label)], Comment),
Instrs = from_list([
comment(Comment),
@@ -1836,10 +1837,12 @@
br(label_target(Label))
]).
-statement_to_il(statement(ml_stmt_goto(break), _Context), _Instrs, !Info) :-
+statement_to_il(statement(ml_stmt_goto(goto_break), _Context), _Instrs,
+ !Info) :-
sorry(this_file, "break").
-statement_to_il(statement(ml_stmt_goto(continue), _Context), _Instrs, !Info) :-
+statement_to_il(statement(ml_stmt_goto(goto_continue), _Context), _Instrs,
+ !Info) :-
sorry(this_file, "continue").
statement_to_il(statement(DoCommitStmt, Context), Instrs, !Info) :-
@@ -2092,14 +2095,14 @@
% If the new object is being assigned to private_builtin.dummy_var
% then we need to cast it to il_generic_type.
(
- Target0 = var(qual(MLDS_Module, QualKind, VarName), _),
+ Target0 = ml_var(qual(MLDS_Module, QualKind, VarName), _),
VarName = mlds_var_name("dummy_var", _),
PrivateBuiltin = mercury_private_builtin_module,
MLDS_PrivateBuiltin = mercury_module_name_to_mlds(PrivateBuiltin),
mlds_append_wrapper_class(MLDS_PrivateBuiltin) = MLDS_Module
->
MaybeCastInstrs = singleton(castclass(il_generic_type)),
- Target = var(qual(MLDS_Module, QualKind, VarName),
+ Target = ml_var(qual(MLDS_Module, QualKind, VarName),
mlds_generic_type)
;
MaybeCastInstrs = empty,
@@ -2145,7 +2148,7 @@
(pred(Rval::in, I::out, Arg0::in, Arg::out) is det :-
Arg0 = Index - S0,
I0 = singleton(dup),
- load(const(mlconst_int(Index)), I1, S0, S1),
+ load(ml_const(mlconst_int(Index)), I1, S0, S1),
% XXX the MLDS code generator is meant to be responsible for
% boxing the args, but when compiled with the highlevel_data
@@ -2156,7 +2159,7 @@
( already_boxed(ILRvalType) ->
NewRval = Rval
;
- NewRval = unop(box(RvalType), Rval)
+ NewRval = ml_unop(box(RvalType), Rval)
),
load(NewRval, I2, S1, S),
@@ -2226,7 +2229,7 @@
T = target_code_output(_),
Instrs = empty
;
- T = name(_),
+ T = target_code_name(_),
Instrs = empty
),
Rest = inline_code_to_il_asm(Ts).
@@ -2261,15 +2264,15 @@
get_load_store_lval_instrs(Lval, LoadMemRefInstrs, StoreLvalInstrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
- ( Lval = mem_ref(Rval0, MLDS_Type) ->
+ ( Lval = ml_mem_ref(Rval0, MLDS_Type) ->
load(Rval0, LoadMemRefInstrs, !Info),
SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type),
StoreLvalInstrs = singleton(stind(SimpleType))
- ; Lval = field(_MaybeTag, FieldRval, FieldNum, FieldType, ClassType) ->
+ ; Lval = ml_field(_MaybeTag, FieldRval, FieldNum, FieldType, ClassType) ->
ClassILType = mlds_type_to_ilds_type(DataRep, ClassType),
( ClassILType = il_type(_, '[]'(_, _)) ->
(
- FieldNum = offset(OffsetRval),
+ FieldNum = ml_field_offset(OffsetRval),
FieldILType = mlds_type_to_ilds_simple_type(DataRep,
FieldType),
load(FieldRval, LoadArrayRval, !Info),
@@ -2277,9 +2280,9 @@
LoadMemRefInstrs = LoadArrayRval ++ LoadIndexRval,
StoreLvalInstrs = singleton(stelem(FieldILType))
;
- FieldNum = named_field(_, _),
+ FieldNum = ml_field_named(_, _),
unexpected(this_file,
- "named_field for a type with an array representation.")
+ "ml_field_named for a type with an array representation.")
)
;
get_fieldref(DataRep, FieldNum, FieldType, ClassType, FieldRef,
@@ -2305,10 +2308,10 @@
:- pred load(mlds_rval::in, instr_tree::out, il_info::in, il_info::out) is det.
-load(lval(Lval), Instrs, !Info) :-
+load(ml_lval(Lval), Instrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
(
- Lval = var(Var, VarType),
+ Lval = ml_var(Var, VarType),
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
Instrs = singleton(ldloc(name(MangledVarStr)))
@@ -2321,9 +2324,9 @@
Instrs = singleton(ldsfld(FieldRef))
)
;
- Lval = field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
+ Lval = ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
load(Rval, RvalLoadInstrs, !Info),
- ( FieldNum = offset(OffSet) ->
+ ( FieldNum = ml_field_offset(OffSet) ->
SimpleFieldType = mlds_type_to_ilds_simple_type(DataRep,
FieldType),
load(OffSet, OffSetLoadInstrs, !Info),
@@ -2341,21 +2344,21 @@
OffSetLoadInstrs ++
singleton(LoadInstruction)
;
- Lval = mem_ref(Rval, MLDS_Type),
+ Lval = ml_mem_ref(Rval, MLDS_Type),
SimpleType = mlds_type_to_ilds_simple_type(DataRep, MLDS_Type),
load(Rval, RvalLoadInstrs, !Info),
Instrs = RvalLoadInstrs ++ singleton(ldind(SimpleType))
;
- Lval = global_var_ref(_),
+ Lval = ml_global_var_ref(_),
Instrs = throw_unimplemented("load lval mem_ref")
).
-load(mkword(_Tag, _Rval), Instrs, !Info) :-
+load(ml_mkword(_Tag, _Rval), Instrs, !Info) :-
Instrs = comment_node("unimplemented load rval mkword").
% XXX check these, what should we do about multi strings,
% characters, etc.
-load(const(Const), Instrs, !Info) :-
+load(ml_const(Const), Instrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
% True and false are just the integers 1 and 0.
(
@@ -2396,21 +2399,21 @@
Instrs = singleton(ldnull)
).
-load(unop(Unop, Rval), Instrs, !Info) :-
+load(ml_unop(Unop, Rval), Instrs, !Info) :-
load(Rval, RvalLoadInstrs, !Info),
unaryop_to_il(Unop, Rval, UnOpInstrs, !Info),
Instrs = RvalLoadInstrs ++ UnOpInstrs.
-load(binop(BinOp, R1, R2), Instrs, !Info) :-
+load(ml_binop(BinOp, R1, R2), Instrs, !Info) :-
load(R1, R1LoadInstrs, !Info),
load(R2, R2LoadInstrs, !Info),
binaryop_to_il(BinOp, BinaryOpInstrs, !Info),
Instrs = R1LoadInstrs ++ R2LoadInstrs ++ BinaryOpInstrs.
-load(mem_addr(Lval), Instrs, !Info) :-
+load(ml_mem_addr(Lval), Instrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
(
- Lval = var(Var, VarType),
+ Lval = ml_var(Var, VarType),
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
Instrs = singleton(ldloca(name(MangledVarStr)))
@@ -2423,7 +2426,7 @@
Instrs = singleton(ldsfld(FieldRef))
)
;
- Lval = field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
+ Lval = ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType),
get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs),
load(Rval, RvalLoadInstrs, !Info),
@@ -2432,20 +2435,21 @@
CastClassInstrs ++
singleton(ldflda(FieldRef))
;
- Lval = mem_ref(_, _),
+ Lval = ml_mem_ref(_, _),
% XXX Implement this.
Instrs = throw_unimplemented("load mem_addr lval mem_ref")
;
- Lval = global_var_ref(_),
+ Lval = ml_global_var_ref(_),
Instrs = throw_unimplemented("load mem_addr lval global_var_ref")
).
-load(self(_), singleton(ldarg(index(0))), !Info).
+load(ml_self(_), singleton(ldarg(index(0))), !Info).
:- pred store(mlds_lval::in, instr_tree::out, il_info::in, il_info::out)
is det.
-store(field(_MaybeTag, Rval, FieldNum, FieldType, ClassType), Instrs, !Info) :-
+store(ml_field(_MaybeTag, Rval, FieldNum, FieldType, ClassType), Instrs,
+ !Info) :-
DataRep = !.Info ^ il_data_rep,
get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs),
@@ -2455,15 +2459,15 @@
RvalLoadInstrs ++
singleton(stfld(FieldRef)).
-store(mem_ref(_Rval, _Type), _Instrs, !Info) :-
+store(ml_mem_ref(_Rval, _Type), _Instrs, !Info) :-
% You always need load the reference first, then the value, then stind it.
% There's no swap instruction. Annoying, eh?
unexpected(this_file, "store into mem_ref").
-store(global_var_ref(_), _Instrs, !Info) :-
+store(ml_global_var_ref(_), _Instrs, !Info) :-
unexpected(this_file, "store into global_var_ref").
-store(var(Var, VarType), Instrs, !Info) :-
+store(ml_var(Var, VarType), Instrs, !Info) :-
DataRep = !.Info ^ il_data_rep,
mangle_mlds_var(Var, MangledVarStr),
( is_local(MangledVarStr, !.Info) ->
@@ -2492,7 +2496,7 @@
unaryop_to_il(std_unop(mktag), _, comment_node("mktag (a no-op)"), !Info).
unaryop_to_il(std_unop(tag), _, Instrs, !Info) :-
- load(const(mlconst_int(0)), Instrs, !Info).
+ load(ml_const(mlconst_int(0)), Instrs, !Info).
unaryop_to_il(std_unop(unmktag), _, comment_node("unmktag (a no-op)"), !Info).
unaryop_to_il(std_unop(strip_tag),_,comment_node("strip_tag (a no-op)"),
!Info).
@@ -2538,7 +2542,7 @@
)
;
% Is it a cast from refany?
- SrcRval = lval(_),
+ SrcRval = ml_lval(_),
rval_to_type(SrcRval, SrcType),
SrcILType = mlds_type_to_ilds_type(DataRep, SrcType),
SrcILType = il_type(_, refany)
@@ -2817,14 +2821,14 @@
generate_condition(Rval, Instrs, ElseLabel, !Info) :-
il_info_make_next_label(ElseLabel, !Info),
(
- Rval = binop(eq, Operand1, Operand2)
+ Rval = ml_binop(eq, Operand1, Operand2)
->
load(Operand1, Op1Instr, !Info),
load(Operand2, Op2Instr, !Info),
OpInstr = singleton(bne(unsigned, label_target(ElseLabel))),
Instrs = Op1Instr ++ Op2Instr ++ OpInstr
;
- Rval = binop(ne, Operand1, Operand2)
+ Rval = ml_binop(ne, Operand1, Operand2)
->
load(Operand1, Op1Instr, !Info),
load(Operand2, Op2Instr, !Info),
@@ -3435,7 +3439,8 @@
make_static_fieldref(DataRep, Var, VarType) = FieldRef :-
Var = qual(ModuleName, _QualKind, VarName),
mangle_mlds_var(Var, MangledVarStr),
- mangle_dataname_module(yes(var(VarName)), ModuleName, NewModuleName),
+ mangle_dataname_module(yes(mlds_data_var(VarName)),
+ ModuleName, NewModuleName),
ClassName = mlds_module_name_to_class_name(NewModuleName),
FieldRef = make_fieldref(mlds_type_to_ilds_type(DataRep, VarType),
ClassName, MangledVarStr).
@@ -3497,7 +3502,7 @@
SymName = mlds_module_name_to_sym_name(!.ModuleName),
SymName = qualified(qualified(unqualified("mercury"),
LibModuleName0), wrapper_class_name),
- DataName = var(_),
+ DataName = mlds_data_var(_),
LibModuleName0 = "private_builtin",
CodeString = "__csharp_code"
->
@@ -3511,7 +3516,7 @@
:- pred mangle_dataname(mlds_data_name::in, string::out) is det.
-mangle_dataname(var(MLDSVarName), Name) :-
+mangle_dataname(mlds_data_var(MLDSVarName), Name) :-
Name = mangle_mlds_var_name(MLDSVarName).
mangle_dataname(mlds_common(Int), MangledName) :-
string.format("common_%d", [i(Int)], MangledName).
@@ -3675,14 +3680,14 @@
%
:- pred rval_to_type(mlds_rval::in, mlds_type::out) is det.
-rval_to_type(lval(var(_, Type)), Type).
-rval_to_type(lval(field(_, _, _, Type, _)), Type).
-rval_to_type(lval(mem_ref(_, Type)), Type).
-rval_to_type(lval(global_var_ref(_)), _) :-
+rval_to_type(ml_lval(ml_var(_, Type)), Type).
+rval_to_type(ml_lval(ml_field(_, _, _, Type, _)), Type).
+rval_to_type(ml_lval(ml_mem_ref(_, Type)), Type).
+rval_to_type(ml_lval(ml_global_var_ref(_)), _) :-
sorry(this_file, "rval_to_type: global_var_ref").
-rval_to_type(mkword(_, _), _) :-
+rval_to_type(ml_mkword(_, _), _) :-
unexpected(this_file, "rval_to_type: mkword").
-rval_to_type(unop(Unop, _), Type) :-
+rval_to_type(ml_unop(Unop, _), Type) :-
(
Unop = box(_),
Type = mlds_generic_type
@@ -3697,12 +3702,12 @@
functor(StdUnop, canonicalize, StdUnopStr, _Arity),
sorry(this_file, "rval_to_type: unop: " ++ StdUnopStr)
).
-rval_to_type(binop(_, _, _), _) :-
+rval_to_type(ml_binop(_, _, _), _) :-
sorry(this_file, "rval_to_type: binop").
-rval_to_type(mem_addr(_), _) :-
+rval_to_type(ml_mem_addr(_), _) :-
sorry(this_file, "rval_to_type: mem_addr").
-rval_to_type(self(Type), Type).
-rval_to_type(const(Const), Type) :-
+rval_to_type(ml_self(Type), Type).
+rval_to_type(ml_const(Const), Type) :-
Type = rval_const_to_type(Const).
:- func rval_const_to_type(mlds_rval_const) = mlds_type.
@@ -3796,16 +3801,16 @@
FieldILType = FieldILType0
),
(
- FieldNum = offset(OffsetRval),
+ FieldNum = ml_field_offset(OffsetRval),
ClassName = mlds_type_to_ilds_class_name(DataRep, ClassType),
- ( OffsetRval = const(mlconst_int(Num)) ->
+ ( OffsetRval = ml_const(mlconst_int(Num)) ->
string.format("f%d", [i(Num)], FieldId)
;
sorry(this_file, "offsets for non-mlconst_int rvals")
),
CastClassInstrs = empty
;
- FieldNum = named_field(qual(ModuleName, _, FieldId), _CtorType),
+ FieldNum = ml_field_named(qual(ModuleName, _, FieldId), _CtorType),
% The MLDS doesn't record which qualifiers are class qualifiers
% and which are namespace qualifiers... we first generate
% a name for the CtorClass as if it wasn't nested, and then
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.118
diff -u -b -r1.118 mlds_to_java.m
--- compiler/mlds_to_java.m 5 Jun 2009 04:17:09 -0000 1.118
+++ compiler/mlds_to_java.m 9 Jun 2009 03:41:03 -0000
@@ -187,15 +187,15 @@
%
:- func mlds_lval_type(mlds_lval) = mlds_type.
-mlds_lval_type(var(_, VarType)) = VarType.
-mlds_lval_type(field(_, _, _, FieldType, _)) = FieldType.
-mlds_lval_type(mem_ref(_, PtrType)) =
+mlds_lval_type(ml_var(_, VarType)) = VarType.
+mlds_lval_type(ml_field(_, _, _, FieldType, _)) = FieldType.
+mlds_lval_type(ml_mem_ref(_, PtrType)) =
( PtrType = mlds_ptr_type(Type) ->
Type
;
unexpected(this_file, "mlds_lval_type: mem_ref of non-pointer")
).
-mlds_lval_type(global_var_ref(_)) = _ :-
+mlds_lval_type(ml_global_var_ref(_)) = _ :-
sorry(this_file, "mlds_lval_type: global_var_ref NYI").
% Succeeds iff the Rval represents an integer constant.
@@ -203,7 +203,7 @@
:- pred rval_is_int_const(mlds_rval::in) is semidet.
rval_is_int_const(Rval) :-
- Rval = const(mlconst_int(_)).
+ Rval = ml_const(mlconst_int(_)).
% Succeeds iff the Rval represents an enumeration object in the Java
% backend. We need to check both Rvals that are variables and Rvals
@@ -213,12 +213,12 @@
:- pred rval_is_enum_object(mlds_rval::in) is semidet.
rval_is_enum_object(Rval) :-
- Rval = lval(Lval),
+ Rval = ml_lval(Lval),
(
- Lval = var(_, VarType),
+ Lval = ml_var(_, VarType),
type_is_enum(VarType)
;
- Lval = field(_, _, _, FieldType, _),
+ Lval = ml_field(_, _, _, FieldType, _),
type_is_enum(FieldType)
).
@@ -618,9 +618,9 @@
method_ptrs_in_stmt(ml_stmt_label(_), _, _) :-
unexpected(this_file,
"method_ptrs_in_stmt: labels not supported in Java.").
-method_ptrs_in_stmt(ml_stmt_goto(break), !CodeAddrs).
-method_ptrs_in_stmt(ml_stmt_goto(continue), !CodeAddrs).
-method_ptrs_in_stmt(ml_stmt_goto(label(_)), _, _) :-
+method_ptrs_in_stmt(ml_stmt_goto(goto_break), !CodeAddrs).
+method_ptrs_in_stmt(ml_stmt_goto(goto_continue), !CodeAddrs).
+method_ptrs_in_stmt(ml_stmt_goto(goto_label(_)), _, _) :-
unexpected(this_file,
"method_ptrs_in_stmt: goto label not supported in Java.").
method_ptrs_in_stmt(ml_stmt_computed_goto(_, _), _, _) :-
@@ -721,35 +721,35 @@
:- pred method_ptrs_in_rval(mlds_rval::in, list(mlds_code_addr)::in,
list(mlds_code_addr)::out) is det.
-method_ptrs_in_rval(lval(Lval), !CodeAddrs) :-
+method_ptrs_in_rval(ml_lval(Lval), !CodeAddrs) :-
method_ptrs_in_lval(Lval, !CodeAddrs).
-method_ptrs_in_rval(mkword(_Tag, Rval), !CodeAddrs) :-
+method_ptrs_in_rval(ml_mkword(_Tag, Rval), !CodeAddrs) :-
method_ptrs_in_rval(Rval, !CodeAddrs).
-method_ptrs_in_rval(const(RvalConst), !CodeAddrs) :-
+method_ptrs_in_rval(ml_const(RvalConst), !CodeAddrs) :-
( RvalConst = mlconst_code_addr(CodeAddr) ->
!:CodeAddrs = !.CodeAddrs ++ [CodeAddr]
;
true
).
-method_ptrs_in_rval(unop(_UnaryOp, Rval), !CodeAddrs) :-
+method_ptrs_in_rval(ml_unop(_UnaryOp, Rval), !CodeAddrs) :-
method_ptrs_in_rval(Rval, !CodeAddrs).
-method_ptrs_in_rval(binop(_BinaryOp, Rval1, Rval2), !CodeAddrs) :-
+method_ptrs_in_rval(ml_binop(_BinaryOp, Rval1, Rval2), !CodeAddrs) :-
method_ptrs_in_rval(Rval1, !CodeAddrs),
method_ptrs_in_rval(Rval2, !CodeAddrs).
-method_ptrs_in_rval(mem_addr(_Address), !CodeAddrs).
-method_ptrs_in_rval(self(_Type), !CodeAddrs).
+method_ptrs_in_rval(ml_mem_addr(_Address), !CodeAddrs).
+method_ptrs_in_rval(ml_self(_Type), !CodeAddrs).
:- pred method_ptrs_in_lval(mlds_lval::in, list(mlds_code_addr)::in,
list(mlds_code_addr)::out) is det.
% Here, "_Rval" is the address of a variable so we don't check it.
-method_ptrs_in_lval(mem_ref(_Rval, _Type), !CodeAddrs).
+method_ptrs_in_lval(ml_mem_ref(_Rval, _Type), !CodeAddrs).
% Here, "_Rval" is a pointer to a cell on the heap, and doesn't need
% to be considered.
-method_ptrs_in_lval(field(_MaybeTag, _Rval, _FieldId, _FieldType,
- _PtrType), !CodeAddrs).
-method_ptrs_in_lval(var(_Variable, _Type), !CodeAddrs).
-method_ptrs_in_lval(global_var_ref(_), !CodeAddrs).
+method_ptrs_in_lval(ml_field(_MaybeTag, _Rval, _FieldId, _FieldType, _PtrType),
+ !CodeAddrs).
+method_ptrs_in_lval(ml_var(_Variable, _Type), !CodeAddrs).
+method_ptrs_in_lval(ml_global_var_ref(_), !CodeAddrs).
%-----------------------------------------------------------------------------%
%
@@ -866,7 +866,8 @@
% It will have the argument type java.lang.Object[]
% It will have the return type java.lang.Object
MethodArgVariable = mlds_var_name("args", no),
- MethodArgType = mlds_argument(entity_data(var(MethodArgVariable)),
+ MethodArgType = mlds_argument(
+ entity_data(mlds_data_var(MethodArgVariable)),
mlds_array_type(mlds_generic_type), gc_no_stmt),
MethodRetType = mlds_generic_type,
MethodArgs = [MethodArgType],
@@ -888,8 +889,8 @@
OrigRetTypes = [_, _ | _],
ReturnVarType = mlds_array_type(mlds_generic_type)
),
- ReturnLval = var(ReturnVar, ReturnVarType),
- ReturnEntityName = entity_data(var(ReturnVarName)),
+ ReturnLval = ml_var(ReturnVar, ReturnVarType),
+ ReturnEntityName = entity_data(mlds_data_var(ReturnVarName)),
ReturnDecFlags = ml_gen_local_var_decl_flags,
GCStatement = gc_no_stmt, % The Java back-end does its own GC.
@@ -901,7 +902,7 @@
% Create the call to the original method.
CallArgLabel = qual(ModuleName, module_qual, MethodArgVariable),
generate_call_method_args(OrigArgTypes, CallArgLabel, 0, [], CallArgs),
- CallRval = const(mlconst_code_addr(CodeAddr)),
+ CallRval = ml_const(mlconst_code_addr(CodeAddr)),
% If the original method has a return type of void, then we obviously
% cannot assign its return value to "return_value". Thus, in this
@@ -920,7 +921,7 @@
% Create a return statement that returns the result of the call to the
% original method, boxed as a java.lang.Object.
- ReturnRval = unop(box(ReturnVarType), lval(ReturnLval)),
+ ReturnRval = ml_unop(box(ReturnVarType), ml_lval(ReturnLval)),
Return = ml_stmt_return([ReturnRval]),
ReturnStatement = statement(Return, Context),
@@ -942,10 +943,10 @@
generate_call_method_args([], _, _, Args, Args).
generate_call_method_args([Type | Types], Variable, Counter, Args0, Args) :-
- ArrayRval = lval(var(Variable, mlds_native_int_type)),
- IndexRval = const(mlconst_int(Counter)),
- Rval = binop(array_index(elem_type_generic), ArrayRval, IndexRval),
- UnBoxedRval = unop(unbox(Type), Rval),
+ ArrayRval = ml_lval(ml_var(Variable, mlds_native_int_type)),
+ IndexRval = ml_const(mlconst_int(Counter)),
+ Rval = ml_binop(array_index(elem_type_generic), ArrayRval, IndexRval),
+ UnBoxedRval = ml_unop(unbox(Type), Rval),
Args1 = Args0 ++ [UnBoxedRval],
generate_call_method_args(Types, Variable, Counter + 1, Args1, Args).
@@ -2007,7 +2008,7 @@
:- pred output_data_name(mlds_data_name::in, io::di, io::uo) is det.
-output_data_name(var(VarName), !IO) :-
+output_data_name(mlds_data_var(VarName), !IO) :-
output_mlds_var_name(VarName, !IO).
output_data_name(mlds_common(Num), !IO) :-
io.write_string("common_", !IO),
@@ -2469,7 +2470,7 @@
% The contained statement is reachable iff the while statement is
% reachable and the condition expression is not a constant expression
% whose value is false.
- ( Cond = const(mlconst_false) ->
+ ( Cond = ml_const(mlconst_false) ->
indent_line(Indent, !IO),
io.write_string("{ /* Unreachable code */ }\n", !IO),
ExitMethods = set.make_singleton_set(can_fall_through)
@@ -2560,14 +2561,14 @@
%
output_stmt(_, _, _, ml_stmt_label(_), _, _, _, _) :-
unexpected(this_file, "output_stmt: labels not supported in Java.").
-output_stmt(_, _, _, ml_stmt_goto(label(_)), _, _, _, _) :-
+output_stmt(_, _, _, ml_stmt_goto(goto_label(_)), _, _, _, _) :-
unexpected(this_file, "output_stmt: gotos not supported in Java.").
-output_stmt(Indent, _, _FuncInfo, ml_stmt_goto(break), _Context,
+output_stmt(Indent, _, _FuncInfo, ml_stmt_goto(goto_break), _Context,
ExitMethods, !IO) :-
indent_line(Indent, !IO),
io.write_string("break;\n", !IO),
ExitMethods = set.make_singleton_set(can_break).
-output_stmt(Indent, _, _FuncInfo, ml_stmt_goto(continue), _Context,
+output_stmt(Indent, _, _FuncInfo, ml_stmt_goto(goto_continue), _Context,
ExitMethods, !IO) :-
indent_line(Indent, !IO),
io.write_string("continue;\n", !IO),
@@ -2605,7 +2606,7 @@
%
io.write_string("java.lang.Object [] result = ", !IO)
),
- ( FuncRval = const(mlconst_code_addr(_)) ->
+ ( FuncRval = ml_const(mlconst_code_addr(_)) ->
% This is a standard method call.
(
MaybeObject = yes(Object),
@@ -2817,7 +2818,7 @@
% XXX This is not a sufficient way of testing for a Java
% "constant expression", though determining these accurately
% is a little difficult to do here.
- Cond = const(mlconst_true),
+ Cond = ml_const(mlconst_true),
not set.member(can_break, BlockExitMethods)
->
% Cannot complete normally
@@ -2866,8 +2867,8 @@
remove_dummy_vars(ModuleInfo, [Var | Vars0]) = VarList :-
Vars = remove_dummy_vars(ModuleInfo, Vars0),
(
- Var = lval(Lval),
- Lval = var(_VarName, VarType),
+ Var = ml_lval(Lval),
+ Lval = ml_var(_VarName, VarType),
VarType = mercury_type(ProgDataType, _, _),
check_dummy_type(ModuleInfo, ProgDataType) = is_dummy_type
->
@@ -3152,22 +3153,26 @@
:- pred output_target_code_component(module_info::in, mlds_module_name::in,
mlds_context::in, target_code_component::in, io::di, io::uo) is det.
-output_target_code_component(_, _ModuleName, _Context,
- user_target_code(CodeString, _MaybeUserContext, _Attrs), !IO) :-
+output_target_code_component(ModuleInfo, ModuleName, _Context, TargetCode,
+ !IO) :-
+ (
+ TargetCode = user_target_code(CodeString, _MaybeUserContext, _Attrs),
% XXX Java does not have an equivalent of the C #line preprocessor
% directive. If it did, we should use it here.
- io.write_string(CodeString, !IO).
-output_target_code_component(_, _ModuleName, _Context,
- raw_target_code(CodeString, _Attrs), !IO) :-
- io.write_string(CodeString, !IO).
-output_target_code_component(ModuleInfo, ModuleName, _Context,
- target_code_input(Rval), !IO) :-
- output_rval(ModuleInfo, Rval, ModuleName, !IO).
-output_target_code_component(ModuleInfo, ModuleName, _Context,
- target_code_output(Lval), !IO) :-
- output_lval(ModuleInfo, Lval, ModuleName, !IO).
-output_target_code_component(_, ModuleName, _Context, name(Name), !IO) :-
- output_maybe_qualified_name(Name, ModuleName, !IO).
+ io.write_string(CodeString, !IO)
+ ;
+ TargetCode = raw_target_code(CodeString, _Attrs),
+ io.write_string(CodeString, !IO)
+ ;
+ TargetCode = target_code_input(Rval),
+ output_rval(ModuleInfo, Rval, ModuleName, !IO)
+ ;
+ TargetCode = target_code_output(Lval),
+ output_lval(ModuleInfo, Lval, ModuleName, !IO)
+ ;
+ TargetCode = target_code_name(Name),
+ output_maybe_qualified_name(Name, ModuleName, !IO)
+ ).
%-----------------------------------------------------------------------------%
@@ -3212,12 +3217,15 @@
:- pred output_lval(module_info::in, mlds_lval::in, mlds_module_name::in,
io::di, io::uo) is det.
-output_lval(ModuleInfo,
- field(_MaybeTag, Rval, offset(OffsetRval), FieldType, _),
- ModuleName, !IO) :-
+output_lval(ModuleInfo, Lval, ModuleName, !IO) :-
+ (
+ Lval = ml_field(_MaybeTag, PtrRval, FieldId, FieldType, _),
+ (
+ FieldId = ml_field_offset(OffsetRval),
(
( FieldType = mlds_generic_type
- ; FieldType = mercury_type(type_variable(_, _), _, _))
+ ; FieldType = mercury_type(type_variable(_, _), _, _)
+ )
->
true
;
@@ -3228,14 +3236,12 @@
% XXX We shouldn't need this cast here, but there are cases where
% it is needed and the MLDS doesn't seem to generate it.
io.write_string("((java.lang.Object[]) ", !IO),
- output_rval(ModuleInfo, Rval, ModuleName, !IO),
+ output_rval(ModuleInfo, PtrRval, ModuleName, !IO),
io.write_string(")[", !IO),
output_rval(ModuleInfo, OffsetRval, ModuleName, !IO),
- io.write_string("]", !IO).
-
-output_lval(ModuleInfo,
- field(_, PtrRval, named_field(FieldName, CtorType), _, _),
- ModuleName, !IO) :-
+ io.write_string("]", !IO)
+ ;
+ FieldId = ml_field_named(FieldName, CtorType),
(
FieldName = qual(_, _, UnqualFieldName),
MangledFieldName = name_mangle(UnqualFieldName),
@@ -3246,10 +3252,11 @@
output_bracketed_rval(ModuleInfo, PtrRval, ModuleName, !IO),
io.write_string(".", !IO)
;
- % Otherwise the field we are trying to access may be in a derived
- % class. Objects are manipulated as instances of their base class,
- % so we need to downcast to the derived class to access some fields.
- %
+ % Otherwise the field we are trying to access may be
+ % in a derived class. Objects are manipulated as instances
+ % of their base class, so we need to downcast to the derived
+ % class to access some fields.
+
io.write_string("((", !IO),
output_type(normal_style, CtorType, !IO),
io.write_string(") ", !IO),
@@ -3258,18 +3265,19 @@
io.write_string(").", !IO)
),
FieldName = qual(_, _, UnqualFieldName),
- output_valid_mangled_name(UnqualFieldName, !IO). % the field name
-
-output_lval(ModuleInfo, mem_ref(Rval, _Type), ModuleName, !IO) :-
- output_bracketed_rval(ModuleInfo, Rval, ModuleName, !IO).
-
-output_lval(_ModuleInfo, global_var_ref(_), _ModuleName, !IO) :-
- sorry(this_file, "output_lval: global_var_ref NYI").
-
-output_lval(_, var(qual(ModName, QualKind, Name), _), CurrentModuleName,
- !IO) :-
- QualName = qual(ModName, QualKind, entity_data(var(Name))),
- output_maybe_qualified_name(QualName, CurrentModuleName, !IO).
+ output_valid_mangled_name(UnqualFieldName, !IO)
+ )
+ ;
+ Lval = ml_mem_ref(Rval, _Type),
+ output_bracketed_rval(ModuleInfo, Rval, ModuleName, !IO)
+ ;
+ Lval = ml_global_var_ref(_),
+ sorry(this_file, "output_lval: global_var_ref NYI")
+ ;
+ Lval = ml_var(qual(ModName, QualKind, Name), _),
+ QualName = qual(ModName, QualKind, entity_data(mlds_data_var(Name))),
+ output_maybe_qualified_name(QualName, ModuleName, !IO)
+ ).
:- pred output_mangled_name(string::in, io::di, io::uo) is det.
@@ -3289,7 +3297,7 @@
output_call_rval(ModuleInfo, Rval, ModuleName, !IO) :-
(
- Rval = const(Const),
+ Rval = ml_const(Const),
Const = mlconst_code_addr(CodeAddr)
->
IsCall = yes,
@@ -3304,8 +3312,8 @@
output_bracketed_rval(ModuleInfo, Rval, ModuleName, !IO) :-
(
% If it's just a variable name, then we don't need parentheses.
- ( Rval = lval(var(_,_))
- ; Rval = const(mlconst_code_addr(_))
+ ( Rval = ml_lval(ml_var(_,_))
+ ; Rval = ml_const(mlconst_code_addr(_))
)
->
output_rval(ModuleInfo, Rval, ModuleName, !IO)
@@ -3318,42 +3326,47 @@
:- pred output_rval(module_info::in, mlds_rval::in, mlds_module_name::in,
io::di, io::uo) is det.
-output_rval(ModuleInfo, lval(Lval), ModuleName, !IO) :-
- output_lval(ModuleInfo, Lval, ModuleName, !IO).
-
-output_rval(_, mkword(_, _), _, _, _) :-
- unexpected(this_file, "output_rval: tags not supported in Java").
-
-output_rval(_, const(Const), _, !IO) :-
- output_rval_const(Const, !IO).
-
-output_rval(ModuleInfo, unop(Op, Rval), ModuleName, !IO) :-
- output_unop(ModuleInfo, Op, Rval, ModuleName, !IO).
-
-output_rval(ModuleInfo, binop(Op, Rval1, Rval2), ModuleName, !IO) :-
- output_binop(ModuleInfo, Op, Rval1, Rval2, ModuleName, !IO).
-
-output_rval(_, mem_addr(_Lval), _, !IO) :-
- unexpected(this_file, "output_rval: mem_addr(_) not supported").
-
-output_rval(_, self(_), _, !IO) :-
- io.write_string("this", !IO).
+output_rval(ModuleInfo, Rval, ModuleName, !IO) :-
+ (
+ Rval = ml_lval(Lval),
+ output_lval(ModuleInfo, Lval, ModuleName, !IO)
+ ;
+ Rval = ml_mkword(_, _),
+ unexpected(this_file, "output_rval: tags not supported in Java")
+ ;
+ Rval = ml_const(Const),
+ output_rval_const(Const, !IO)
+ ;
+ Rval = ml_unop(Op, RvalA),
+ output_unop(ModuleInfo, Op, RvalA, ModuleName, !IO)
+ ;
+ Rval = ml_binop(Op, RvalA, RvalB),
+ output_binop(ModuleInfo, Op, RvalA, RvalB, ModuleName, !IO)
+ ;
+ Rval = ml_mem_addr(_Lval),
+ unexpected(this_file, "output_rval: mem_addr(_) not supported")
+ ;
+ Rval = ml_self(_),
+ io.write_string("this", !IO)
+ ).
:- pred output_unop(module_info::in, mlds_unary_op::in, mlds_rval::in,
mlds_module_name::in, io::di, io::uo) is det.
-output_unop(ModuleInfo, cast(Type), Exprn, ModuleName, !IO) :-
+output_unop(ModuleInfo, Unop, Expr, ModuleName, !IO) :-
+ (
+ Unop = cast(Type),
% rtti_to_mlds.m generates casts from int to
% mercury.runtime.PseudoTypeInfo, but for Java
% we need to treat these as constructions, not casts.
% Similarly for conversions from TypeCtorInfo to TypeInfo.
(
Type = mlds_pseudo_type_info_type,
- Exprn = const(mlconst_int(_))
+ Expr = ml_const(mlconst_int(_))
->
maybe_output_comment("cast", !IO),
io.write_string("new mercury.runtime.PseudoTypeInfo(", !IO),
- output_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(")", !IO)
;
( Type = mercury_type(_, ctor_cat_system(cat_system_type_info), _)
@@ -3362,56 +3375,60 @@
->
maybe_output_comment("cast", !IO),
io.write_string("new mercury.runtime.TypeInfo_Struct(", !IO),
- output_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(")", !IO)
;
- output_cast_rval(ModuleInfo, Type, Exprn, ModuleName, !IO)
+ output_cast_rval(ModuleInfo, Type, Expr, ModuleName, !IO)
+ )
+ ;
+ Unop = box(Type),
+ output_boxed_rval(ModuleInfo, Type, Expr, ModuleName, !IO)
+ ;
+ Unop = unbox(Type),
+ output_unboxed_rval(ModuleInfo, Type, Expr, ModuleName, !IO)
+ ;
+ Unop = std_unop(StdUnop),
+ output_std_unop(ModuleInfo, StdUnop, Expr, ModuleName, !IO)
).
-output_unop(ModuleInfo, box(Type), Exprn, ModuleName, !IO) :-
- output_boxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO).
-output_unop(ModuleInfo, unbox(Type), Exprn, ModuleName, !IO) :-
- output_unboxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO).
-output_unop(ModuleInfo, std_unop(Unop), Exprn, ModuleName, !IO) :-
- output_std_unop(ModuleInfo, Unop, Exprn, ModuleName, !IO).
:- pred output_cast_rval(module_info::in, mlds_type::in, mlds_rval::in,
mlds_module_name::in, io::di, io::uo) is det.
-output_cast_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
+output_cast_rval(ModuleInfo, Type, Expr, ModuleName, !IO) :-
io.write_string("(", !IO),
output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
( java_builtin_type(Type, "int", _, _) ->
- output_rval_maybe_with_enum(ModuleInfo, Exprn, ModuleName, !IO)
+ output_rval_maybe_with_enum(ModuleInfo, Expr, ModuleName, !IO)
;
- output_rval(ModuleInfo, Exprn, ModuleName, !IO)
+ output_rval(ModuleInfo, Expr, ModuleName, !IO)
).
:- pred output_boxed_rval(module_info::in, mlds_type::in, mlds_rval::in,
mlds_module_name::in, io::di, io::uo) is det.
-output_boxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
+output_boxed_rval(ModuleInfo, Type, Expr, ModuleName, !IO) :-
( java_builtin_type(Type, _JavaName, JavaBoxedName, _) ->
io.write_string("new ", !IO),
io.write_string(JavaBoxedName, !IO),
io.write_string("(", !IO),
- output_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(")", !IO)
;
io.write_string("((java.lang.Object) (", !IO),
- output_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string("))", !IO)
).
:- pred output_unboxed_rval(module_info::in, mlds_type::in, mlds_rval::in,
mlds_module_name::in, io::di, io::uo) is det.
-output_unboxed_rval(ModuleInfo, Type, Exprn, ModuleName, !IO) :-
+output_unboxed_rval(ModuleInfo, Type, Expr, ModuleName, !IO) :-
( java_builtin_type(Type, _, JavaBoxedName, UnboxMethod) ->
io.write_string("((", !IO),
io.write_string(JavaBoxedName, !IO),
io.write_string(") ", !IO),
- output_bracketed_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_bracketed_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(").", !IO),
io.write_string(UnboxMethod, !IO),
io.write_string("()", !IO)
@@ -3419,7 +3436,7 @@
io.write_string("((", !IO),
output_type(normal_style, Type, !IO),
io.write_string(") ", !IO),
- output_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(")", !IO)
).
@@ -3466,14 +3483,14 @@
% are no-ops, except for `tag', which always returns zero (a tag of zero
% means there's no tag).
%
-output_std_unop(ModuleInfo, UnaryOp, Exprn, ModuleName, !IO) :-
+output_std_unop(ModuleInfo, UnaryOp, Expr, ModuleName, !IO) :-
( UnaryOp = tag ->
io.write_string("/* tag */ 0", !IO)
;
java_unary_prefix_op(UnaryOp, UnaryOpString),
io.write_string(UnaryOpString, !IO),
io.write_string("(", !IO),
- output_rval(ModuleInfo, Exprn, ModuleName, !IO),
+ output_rval(ModuleInfo, Expr, ModuleName, !IO),
io.write_string(")", !IO)
).
@@ -3554,48 +3571,50 @@
:- pred output_rval_const(mlds_rval_const::in, io::di, io::uo) is det.
-output_rval_const(mlconst_true, !IO) :-
- io.write_string("true", !IO).
-
-output_rval_const(mlconst_false, !IO) :-
- io.write_string("false", !IO).
-
-output_rval_const(mlconst_int(N), !IO) :-
- io.write_int(N, !IO).
-
- % XXX Should we parenthesize this?
- %
-output_rval_const(mlconst_foreign(Lang, Value, _Type), !IO) :-
+output_rval_const(Const, !IO) :-
+ (
+ Const = mlconst_true,
+ io.write_string("true", !IO)
+ ;
+ Const = mlconst_false,
+ io.write_string("false", !IO)
+ ;
+ Const = mlconst_int(N),
+ io.write_int(N, !IO)
+ ;
+ Const = mlconst_foreign(Lang, Value, _Type),
expect(unify(Lang, lang_java), this_file,
- "output_rval_const - mlconst_foreign for language other than Java."),
- io.write_string(Value, !IO).
-
-output_rval_const(mlconst_float(FloatVal), !IO) :-
- c_util.output_float_literal(FloatVal, !IO).
-
-output_rval_const(mlconst_string(String), !IO) :-
+ "output_rval_const: language other than Java."),
+ % XXX Should we parenthesize this?
+ io.write_string(Value, !IO)
+ ;
+ Const = mlconst_float(FloatVal),
+ c_util.output_float_literal(FloatVal, !IO)
+ ;
+ Const = mlconst_string(String),
io.write_string("""", !IO),
c_util.output_quoted_string_lang(literal_java, String, !IO),
- io.write_string("""", !IO).
-
-output_rval_const(mlconst_multi_string(String), !IO) :-
+ io.write_string("""", !IO)
+ ;
+ Const = mlconst_multi_string(String),
io.write_string("""", !IO),
c_util.output_quoted_multi_string_lang(literal_java, String, !IO),
- io.write_string("""", !IO).
-
-output_rval_const(mlconst_named_const(NamedConst), !IO) :-
- io.write_string(NamedConst, !IO).
-
-output_rval_const(mlconst_code_addr(CodeAddr), !IO) :-
+ io.write_string("""", !IO)
+ ;
+ Const = mlconst_named_const(NamedConst),
+ io.write_string(NamedConst, !IO)
+ ;
+ Const = mlconst_code_addr(CodeAddr),
IsCall = no,
- mlds_output_code_addr(CodeAddr, IsCall, !IO).
-
-output_rval_const(mlconst_data_addr(DataAddr), !IO) :-
- mlds_output_data_addr(DataAddr, !IO).
-
-output_rval_const(mlconst_null(Type), !IO) :-
+ mlds_output_code_addr(CodeAddr, IsCall, !IO)
+ ;
+ Const = mlconst_data_addr(DataAddr),
+ mlds_output_data_addr(DataAddr, !IO)
+ ;
+ Const = mlconst_null(Type),
Initializer = get_java_type_initializer(Type),
- io.write_string(Initializer, !IO).
+ io.write_string(Initializer, !IO)
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_managed.m,v
retrieving revision 1.49
diff -u -b -r1.49 mlds_to_managed.m
--- compiler/mlds_to_managed.m 31 Dec 2007 10:03:51 -0000 1.49
+++ compiler/mlds_to_managed.m 6 Jun 2009 14:29:28 -0000
@@ -345,7 +345,7 @@
io::di, io::uo) is det.
write_declare_and_assign_local(mlds_argument(Name, Type, _GcCode), !IO) :-
- ( Name = entity_data(var(VarName0)) ->
+ ( Name = entity_data(mlds_data_var(VarName0)) ->
VarName = VarName0
;
unexpected(this_file, "not a variable name")
@@ -377,7 +377,7 @@
:- pred write_assign_local_to_output(mlds_argument::in, io::di, io::uo) is det.
write_assign_local_to_output(mlds_argument(Name, Type, _GcCode), !IO) :-
- ( Name = entity_data(var(VarName0)) ->
+ ( Name = entity_data(mlds_data_var(VarName0)) ->
VarName = VarName0
;
unexpected(this_file, "not a variable name")
@@ -417,13 +417,13 @@
:- pred write_rval(mlds_rval::in, io::di, io::uo) is det.
-write_rval(lval(Lval), !IO) :-
+write_rval(ml_lval(Lval), !IO) :-
write_lval(Lval, !IO).
-write_rval(mkword(_Tag, _Rval), !IO) :-
+write_rval(ml_mkword(_Tag, _Rval), !IO) :-
sorry(this_file, "mkword rval").
-write_rval(const(RvalConst), !IO) :-
+write_rval(ml_const(RvalConst), !IO) :-
write_rval_const(RvalConst, !IO).
-write_rval(unop(Unop, Rval), !IO) :-
+write_rval(ml_unop(Unop, Rval), !IO) :-
(
Unop = std_unop(StdUnop),
c_util.unary_prefix_op(StdUnop, UnopStr)
@@ -442,7 +442,7 @@
;
sorry(this_file, "box or unbox unop")
).
-write_rval(binop(Binop, Rval1, Rval2), !IO) :-
+write_rval(ml_binop(Binop, Rval1, Rval2), !IO) :-
c_util.binop_category_string(Binop, Category, BinopStr),
( Category = int_or_bool_binary_infix_binop ->
io.write_string("(", !IO),
@@ -455,9 +455,9 @@
;
sorry(this_file, "binop rval")
).
-write_rval(mem_addr(_), !IO) :-
+write_rval(ml_mem_addr(_), !IO) :-
sorry(this_file, "mem_addr rval").
-write_rval(self(_), !IO) :-
+write_rval(ml_self(_), !IO) :-
sorry(this_file, "self rval").
:- pred write_rval_const(mlds_rval_const::in, io::di, io::uo) is det.
@@ -504,27 +504,37 @@
:- pred write_lval(mlds_lval::in, io::di, io::uo) is det.
-write_lval(field(_, Rval, named_field(FieldId, _Type), _, _), !IO) :-
+write_lval(Lval, !IO) :-
+ (
+ Lval = ml_field(_, Rval, FieldId, _, _),
+ (
+ FieldId = ml_field_offset(OffSet),
io.write_string("(", !IO),
write_rval(Rval, !IO),
io.write_string(")", !IO),
- io.write_string(".", !IO),
- FieldId = qual(_, _, FieldName),
- io.write_string(FieldName, !IO).
-write_lval(field(_, Rval, offset(OffSet), _, _), !IO) :-
+ io.write_string("[", !IO),
+ write_rval(OffSet, !IO),
+ io.write_string("]", !IO)
+ ;
+ FieldId = ml_field_named(FQFieldName, _Type),
io.write_string("(", !IO),
write_rval(Rval, !IO),
io.write_string(")", !IO),
- io.write_string("[", !IO),
- write_rval(OffSet, !IO),
- io.write_string("]", !IO).
-write_lval(mem_ref(Rval, _), !IO) :-
- write_rval(Rval, !IO).
-write_lval(global_var_ref(_), !IO) :-
- sorry(this_file, "write_lval: global_var_ref NYI").
-write_lval(var(Var, _VarType), !IO) :-
+ io.write_string(".", !IO),
+ FQFieldName = qual(_, _, FieldName),
+ io.write_string(FieldName, !IO)
+ )
+ ;
+ Lval = ml_mem_ref(Rval, _),
+ write_rval(Rval, !IO)
+ ;
+ Lval = ml_global_var_ref(_),
+ sorry(this_file, "write_lval: global_var_ref NYI")
+ ;
+ Lval = ml_var(Var, _VarType),
Var = qual(_, _, VarName),
- write_mlds_var_name_for_parameter(VarName, !IO).
+ write_mlds_var_name_for_parameter(VarName, !IO)
+ ).
:- pred write_defn_decl(mlds_defn::in, io::di, io::uo) is det.
@@ -532,7 +542,7 @@
Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
(
DefnBody = mlds_data(Type, _Initializer, _GCStatement),
- Name = entity_data(var(VarName))
+ Name = entity_data(mlds_data_var(VarName))
->
write_parameter_type(Type, !IO),
io.write_string(" ", !IO),
@@ -559,7 +569,7 @@
write_il_type_as_foreign_type(mlds_type_to_ilds_type(DataRep, Type),
!IO),
io.write_string(" ", !IO),
- ( EntityName = entity_data(var(VarName)) ->
+ ( EntityName = entity_data(mlds_data_var(VarName)) ->
write_mlds_var_name_for_parameter(VarName, !IO)
;
unexpected(this_file, "found a variable in a list")
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.86
diff -u -b -r1.86 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 16 Jan 2009 02:31:26 -0000 1.86
+++ compiler/rtti_to_mlds.m 6 Jun 2009 14:01:28 -0000
@@ -1210,8 +1210,8 @@
->
% rtti_data_to_id/3 does not handle this case
SrcType = mlds_native_int_type,
- Initializer = init_obj(unop(gen_cast(SrcType, DestType),
- const(mlconst_int(VarNum))))
+ Initializer = init_obj(ml_unop(gen_cast(SrcType, DestType),
+ ml_const(mlconst_int(VarNum))))
;
RttiData = rtti_data_base_typeclass_info(TCName, InstanceModuleName,
InstanceString, _)
@@ -1224,8 +1224,8 @@
type_class_base_typeclass_info(
InstanceModuleName, InstanceString))),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
- Rval = const(mlconst_data_addr(DataAddr)),
- Initializer = init_obj(unop(gen_cast(SrcType, DestType), Rval))
+ Rval = ml_const(mlconst_data_addr(DataAddr)),
+ Initializer = init_obj(ml_unop(gen_cast(SrcType, DestType), Rval))
;
rtti_data_to_id(RttiData, RttiId),
Initializer = gen_init_cast_rtti_id(DestType, ModuleName, RttiId)
@@ -1282,7 +1282,7 @@
gen_init_cast_rtti_id(DestType, ModuleName, RttiId) = Initializer :-
SrcType = mlds_rtti_type(item_type(RttiId)),
- Initializer = init_obj(unop(gen_cast(SrcType, DestType),
+ Initializer = init_obj(ml_unop(gen_cast(SrcType, DestType),
gen_rtti_id(ModuleName, RttiId))).
% Generate the MLDS rval for an rtti_id.
@@ -1336,7 +1336,7 @@
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
MLDS_DataName = mlds_rtti(ctor_rtti_id(RttiTypeCtor, RttiName)),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
- Rval = const(mlconst_data_addr(DataAddr)).
+ Rval = ml_const(mlconst_data_addr(DataAddr)).
:- func gen_tc_rtti_name(module_name, tc_name, tc_rtti_name) = mlds_rval.
@@ -1380,7 +1380,7 @@
),
MLDS_DataName = mlds_rtti(tc_rtti_id(TCName, TCRttiName)),
DataAddr = data_addr(MLDS_ModuleName, MLDS_DataName),
- Rval = const(mlconst_data_addr(DataAddr)).
+ Rval = ml_const(mlconst_data_addr(DataAddr)).
:- func mlds_module_name_from_tc_name(tc_name) = mlds_module_name.
@@ -1498,7 +1498,7 @@
% The initializer for the wrapper is just the wrapper function's address,
% converted to mlds_generic_type (by boxing).
- Init = init_obj(unop(box(WrapperFuncType), WrapperFuncRval)).
+ Init = init_obj(ml_unop(box(WrapperFuncType), WrapperFuncRval)).
:- func gen_init_proc_id(module_info, rtti_proc_label) = mlds_initializer.
@@ -1511,14 +1511,14 @@
mlds_proc_label(PredLabel, ProcId)),
Params = ml_gen_proc_params_from_rtti(ModuleInfo, RttiProcId),
Signature = mlds_get_func_signature(Params),
- ProcAddrRval = const(mlconst_code_addr(
+ ProcAddrRval = ml_const(mlconst_code_addr(
code_addr_proc(QualifiedProcLabel, Signature))),
% Convert the procedure address to a generic type. We need to use a
% generic type because since the actual type for the procedure will
% depend on how many type_info parameters it takes, which will depend
% on the type's arity.
- ProcAddrArg = unop(box(mlds_func_type(Params)), ProcAddrRval),
+ ProcAddrArg = ml_unop(box(mlds_func_type(Params)), ProcAddrRval),
Init = init_obj(ProcAddrArg).
:- func gen_init_proc_id_from_univ(module_info, univ) =
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/dir.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/dir.m,v
retrieving revision 1.49
diff -u -b -r1.49 dir.m
--- library/dir.m 5 Jun 2009 05:21:45 -0000 1.49
+++ library/dir.m 9 Jun 2009 04:00:13 -0000
@@ -1189,13 +1189,17 @@
:- pred dir.make_mkdir_res_exists(io.system_error::in,
string::in, io.res::out, io::di, io::uo) is det.
-:- pragma foreign_export("C", dir.make_mkdir_res_exists(in, in, out, di, uo),
+:- pragma foreign_export("C",
+ dir.make_mkdir_res_exists(in, in, out, di, uo),
"ML_make_mkdir_res_exists").
-:- pragma foreign_export("IL", dir.make_mkdir_res_exists(in, in, out, di, uo),
+:- pragma foreign_export("IL",
+ dir.make_mkdir_res_exists(in, in, out, di, uo),
"ML_make_mkdir_res_exists").
-:- pragma foreign_export("Java", dir.make_mkdir_res_exists(in, in, out, di, uo),
+:- pragma foreign_export("Java",
+ dir.make_mkdir_res_exists(in, in, out, di, uo),
"ML_make_mkdir_res_exists").
-:- pragma foreign_export("Erlang", dir.make_mkdir_res_exists(in, in, out, di, uo),
+:- pragma foreign_export("Erlang",
+ dir.make_mkdir_res_exists(in, in, out, di, uo),
"ML_make_mkdir_res_exists").
dir.make_mkdir_res_exists(Error, DirName, Res, !IO) :-
@@ -1224,11 +1228,12 @@
%-----------------------------------------------------------------------------%
dir.foldl2(P, DirName, T, Res, !IO) :-
- dir.foldl2_process_dir(no, P, fixup_dirname(DirName), [], no, no, _, T, Res, !IO).
+ dir.foldl2_process_dir(no, P, fixup_dirname(DirName), [], no,
+ no, _, T, Res, !IO).
dir.recursive_foldl2(P, DirName, FollowLinks, T, Res, !IO) :-
- dir.foldl2_process_dir(no, P, fixup_dirname(DirName), [], yes, FollowLinks, _,
- T, Res, !IO).
+ dir.foldl2_process_dir(no, P, fixup_dirname(DirName), [], yes,
+ FollowLinks, _, T, Res, !IO).
%
% Under windows you cannot list the files of a directory if the directory
@@ -1875,8 +1880,8 @@
io.system_error::out, string::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- dir.read_entry_2(Dir0::in, Dir::out, Status::out, Error::out, FileName::out,
- IO0::di, IO::uo),
+ dir.read_entry_2(Dir0::in, Dir::out, Status::out, Error::out,
+ FileName::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness],
"{
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list