[m-rev.] diff: more style fixes
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu Sep 22 16:29:09 AEST 2005
compiler/llds_out.m:
Some style fixes. Make some predicates into functions, and delete
redundant llds_out__ prefixes to eliminate some excessively long lines.
There are no algorithmic changes.
compiler/opt_debug.m:
compiler/fact_table.m:
Conform to the changes in llds_out.m.
compiler/rtti_out.m:
Conform to the changes in llds_out.m.
Convert to four-space indentation.
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/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/fact_table.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/fact_table.m,v
retrieving revision 1.63
diff -u -r1.63 fact_table.m
--- compiler/fact_table.m 12 Sep 2005 08:20:26 -0000 1.63
+++ compiler/fact_table.m 21 Sep 2005 00:08:32 -0000
@@ -3079,7 +3079,7 @@
get_reg_name(RegNum, RegName) :-
code_util__arg_loc_to_register(RegNum, Lval),
( Lval = reg(RegType, N) ->
- llds_out__reg_to_string(RegType, N, RegName)
+ RegName = llds_out__reg_to_string(RegType, N)
;
error("get_reg_name: lval is not a register")
).
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.258
diff -u -r1.258 llds_out.m
--- compiler/llds_out.m 14 Sep 2005 01:29:09 -0000 1.258
+++ compiler/llds_out.m 21 Sep 2005 00:08:52 -0000
@@ -90,7 +90,7 @@
% Given a boolean that states whether a data item includes code
% addresses or not, return a C string that gives its "const-ness".
%
-:- pred c_data_const_string(globals::in, bool::in, string::out) is det.
+:- func c_data_const_string(globals, bool) = string.
% Return the suffix after do_call_closure_ or do_call_class_method_
% represented by the given variant.
@@ -99,15 +99,15 @@
% Convert an lval to a string description of that lval.
%
-:- pred llds_out__lval_to_string(lval::in, string::out) is semidet.
+:- func lval_to_string(lval) = string is semidet.
% Convert a register to a string description of that register.
%
-:- pred llds_out__reg_to_string(reg_type::in, int::in, string::out) is det.
+:- func reg_to_string(reg_type, int) = string.
% Convert a binary operator to a string description of that operator.
%
-:- pred llds_out__binary_op_to_string(binary_op::in, string::out) is det.
+:- func binary_op_to_string(binary_op) = string.
% Output an instruction and (if the third arg is yes) the comment.
% This predicate is provided for debugging use only.
@@ -131,7 +131,7 @@
% Convert a label to a C string. The boolean controls whether
% a prefix ("mercury__") is added to the string.
%
-:- func llds_out__label_to_c_string(label, bool) = string.
+:- func label_to_c_string(label, bool) = string.
% The following are exported to rtti_out. It may be worthwhile
% to put these in a new module (maybe llds_out_util).
@@ -1251,7 +1251,7 @@
io__write_string("\n", !IO),
output_reset_line_num(!IO)
;
- error("llds_out__output_user_foreign_code: unimplemented: " ++
+ error("output_user_foreign_code: unimplemented: " ++
"foreign code other than C")
).
@@ -1283,7 +1283,7 @@
io__write_string("\n", !IO),
output_reset_line_num(!IO)
;
- error("llds_out__output_user_foreign_code: unexpected: " ++
+ error("output_user_foreign_code: unexpected: " ++
"foreign code other than C")
).
@@ -1635,11 +1635,11 @@
PrintComments = no
),
- llds_out__find_caller_label(Instrs, CallerLabel),
- llds_out__find_cont_labels(Instrs, bintree_set__init, ContLabelSet),
+ find_caller_label(Instrs, CallerLabel),
+ find_cont_labels(Instrs, bintree_set__init, ContLabelSet),
(
EmitCLoops = yes,
- llds_out__find_while_labels(Instrs, bintree_set__init, WhileSet)
+ find_while_labels(Instrs, bintree_set__init, WhileSet)
;
EmitCLoops = no,
WhileSet = bintree_set__init
@@ -1650,11 +1650,11 @@
% Find the entry label for the procedure, for use as the profiling
% "caller label" field in calls within this procedure.
%
-:- pred llds_out__find_caller_label(list(instruction)::in, label::out) is det.
+:- pred find_caller_label(list(instruction)::in, label::out) is det.
-llds_out__find_caller_label([], _) :-
+find_caller_label([], _) :-
error("cannot find caller label").
-llds_out__find_caller_label([Instr0 - _ | Instrs], CallerLabel) :-
+find_caller_label([Instr0 - _ | Instrs], CallerLabel) :-
( Instr0 = label(Label) ->
(
Label = internal(_, _),
@@ -1664,17 +1664,17 @@
CallerLabel = Label
)
;
- llds_out__find_caller_label(Instrs, CallerLabel)
+ find_caller_label(Instrs, CallerLabel)
).
% Locate all the labels which are the continuation labels for calls,
% nondet disjunctions, forks or joins, and store them in ContLabelSet.
%
-:- pred llds_out__find_cont_labels(list(instruction)::in,
+:- pred find_cont_labels(list(instruction)::in,
bintree_set(label)::in, bintree_set(label)::out) is det.
-llds_out__find_cont_labels([], !ContLabelSet).
-llds_out__find_cont_labels([Instr - _ | Instrs], !ContLabelSet) :-
+find_cont_labels([], !ContLabelSet).
+find_cont_labels([Instr - _ | Instrs], !ContLabelSet) :-
(
(
Instr = call(_, label(ContLabel), _, _, _, _)
@@ -1696,11 +1696,11 @@
;
Instr = block(_, _, Block)
->
- llds_out__find_cont_labels(Block, !ContLabelSet)
+ find_cont_labels(Block, !ContLabelSet)
;
true
),
- llds_out__find_cont_labels(Instrs, !ContLabelSet).
+ find_cont_labels(Instrs, !ContLabelSet).
% Locate all the labels which can be profitably turned into
% labels starting while loops. The idea is to do this transform:
@@ -1720,38 +1720,38 @@
%
% The second of these is better if we don't have fast jumps.
%
-:- pred llds_out__find_while_labels(list(instruction)::in,
+:- pred find_while_labels(list(instruction)::in,
bintree_set(label)::in, bintree_set(label)::out) is det.
-llds_out__find_while_labels([], !WhileSet).
-llds_out__find_while_labels([Instr0 - _ | Instrs0], !WhileSet) :-
+find_while_labels([], !WhileSet).
+find_while_labels([Instr0 - _ | Instrs0], !WhileSet) :-
(
Instr0 = label(Label),
- llds_out__is_while_label(Label, Instrs0, Instrs1, 0, UseCount),
+ is_while_label(Label, Instrs0, Instrs1, 0, UseCount),
UseCount > 0
->
bintree_set__insert(!.WhileSet, Label, !:WhileSet),
- llds_out__find_while_labels(Instrs1, !WhileSet)
+ find_while_labels(Instrs1, !WhileSet)
;
- llds_out__find_while_labels(Instrs0, !WhileSet)
+ find_while_labels(Instrs0, !WhileSet)
).
-:- pred llds_out__is_while_label(label::in,
+:- pred is_while_label(label::in,
list(instruction)::in, list(instruction)::out, int::in, int::out) is det.
-llds_out__is_while_label(_, [], [], !Count).
-llds_out__is_while_label(Label, [Instr0 - Comment0 | Instrs0], Instrs,
+is_while_label(_, [], [], !Count).
+is_while_label(Label, [Instr0 - Comment0 | Instrs0], Instrs,
!Count) :-
( Instr0 = label(_) ->
Instrs = [Instr0 - Comment0 | Instrs0]
; Instr0 = goto(label(Label)) ->
!:Count = !.Count + 1,
- llds_out__is_while_label(Label, Instrs0, Instrs, !Count)
+ is_while_label(Label, Instrs0, Instrs, !Count)
; Instr0 = if_val(_, label(Label)) ->
!:Count = !.Count + 1,
- llds_out__is_while_label(Label, Instrs0, Instrs, !Count)
+ is_while_label(Label, Instrs0, Instrs, !Count)
;
- llds_out__is_while_label(Label, Instrs0, Instrs, !Count)
+ is_while_label(Label, Instrs0, Instrs, !Count)
).
%-----------------------------------------------------------------------------%
@@ -2749,7 +2749,7 @@
UnboxedFloat = no,
StaticGroundTerms = yes
->
- llds_out__float_literal_name(FloatVal, FloatName),
+ float_literal_name(FloatVal, FloatName),
FloatLabel = float_label(FloatName),
( decl_set_is_member(FloatLabel, !.DeclSet) ->
true
@@ -2788,7 +2788,7 @@
(
UnboxFloat = no,
StaticGroundTerms = yes,
- llds_out__float_const_binop_expr_name(Op, Rval1, Rval2, FloatName)
+ float_const_binop_expr_name(Op, Rval1, Rval2, FloatName)
->
FloatLabel = float_label(FloatName),
( decl_set_is_member(FloatLabel, !.DeclSet) ->
@@ -2856,13 +2856,13 @@
% if so, return a name for that rval that is suitable for use in a C
% identifier. Different rvals must be given different names.
%
-:- pred llds_out__float_const_expr_name(rval::in, string::out) is semidet.
+:- pred float_const_expr_name(rval::in, string::out) is semidet.
-llds_out__float_const_expr_name(Expr, Name) :-
+float_const_expr_name(Expr, Name) :-
( Expr = const(float_const(Float)) ->
- llds_out__float_literal_name(Float, Name)
+ float_literal_name(Float, Name)
; Expr = binop(Op, Arg1, Arg2) ->
- llds_out__float_const_binop_expr_name(Op, Arg1, Arg2, Name)
+ float_const_binop_expr_name(Op, Arg1, Arg2, Name)
;
fail
).
@@ -2871,13 +2871,13 @@
% expression; if so, return a name for that rval that is suitable for use
% in a C identifier. Different rvals must be given different names.
%
-:- pred llds_out__float_const_binop_expr_name(binary_op::in, rval::in, rval::in,
+:- pred float_const_binop_expr_name(binary_op::in, rval::in, rval::in,
string::out) is semidet.
-llds_out__float_const_binop_expr_name(Op, Arg1, Arg2, Name) :-
- llds_out__float_op_name(Op, OpName),
- llds_out__float_const_expr_name(Arg1, Arg1Name),
- llds_out__float_const_expr_name(Arg2, Arg2Name),
+float_const_binop_expr_name(Op, Arg1, Arg2, Name) :-
+ float_op_name(Op, OpName),
+ float_const_expr_name(Arg1, Arg1Name),
+ float_const_expr_name(Arg2, Arg2Name),
% We use prefix notation (operator, argument, argument) rather than infix,
% to ensure that different rvals get different names.
Name = OpName ++ "_" ++ Arg1Name ++ "_" ++ Arg2Name.
@@ -2886,9 +2886,9 @@
% a name for that rval that is suitable for use in a C identifier.
% Different rvals must be given different names.
%
-:- pred llds_out__float_literal_name(float::in, string::out) is det.
+:- pred float_literal_name(float::in, string::out) is det.
-llds_out__float_literal_name(Float, FloatName) :-
+float_literal_name(Float, FloatName) :-
% The name of the variable is based on the value of the float const, with
% "pt" instead of ".", "plus" instead of "+", and "neg" instead of "-".
FloatName0 = c_util__make_float_literal(Float),
@@ -2900,12 +2900,12 @@
% type is float; bind the output string to a name for that operator
% that is suitable for use in a C identifier
%
-:- pred llds_out__float_op_name(binary_op::in, string::out) is semidet.
+:- pred float_op_name(binary_op::in, string::out) is semidet.
-llds_out__float_op_name(float_plus, "plus").
-llds_out__float_op_name(float_minus, "minus").
-llds_out__float_op_name(float_times, "times").
-llds_out__float_op_name(float_divide, "divide").
+float_op_name(float_plus, "plus").
+float_op_name(float_minus, "minus").
+float_op_name(float_times, "times").
+float_op_name(float_divide, "divide").
%-----------------------------------------------------------------------------%
@@ -3097,10 +3097,9 @@
% for boxed floats, the type is data_ptr (i.e. the type of the boxed value)
% rather than float (the type of the unboxed value).
%
-:- pred llds_out__rval_type_as_arg(rval::in, llds_type::out, io::di, io::uo)
- is det.
+:- pred rval_type_as_arg(rval::in, llds_type::out, io::di, io::uo) is det.
-llds_out__rval_type_as_arg(Rval, ArgType, !IO) :-
+rval_type_as_arg(Rval, ArgType, !IO) :-
llds__rval_type(Rval, Type),
globals__io_lookup_bool_option(unboxed_float, UnboxFloat, !IO),
(
@@ -3564,14 +3563,14 @@
LinkageStr = "static "
).
-c_data_const_string(Globals, InclCodeAddr, ConstStr) :-
+c_data_const_string(Globals, InclCodeAddr) =
(
InclCodeAddr = yes,
globals__have_static_code_addresses(Globals, no)
->
- ConstStr = ""
+ ""
;
- ConstStr = "const "
+ "const "
).
% This predicate outputs the storage class, type and name of the variable
@@ -3590,8 +3589,7 @@
io__write_string(LinkageStr, !IO),
InclCodeAddr = data_name_may_include_non_static_code_address(DataVarName),
- c_data_const_string(Globals, InclCodeAddr, ConstStr),
- io__write_string(ConstStr, !IO),
+ io__write_string(c_data_const_string(Globals, InclCodeAddr), !IO),
io__write_string("struct ", !IO),
output_data_addr(ModuleName, DataVarName, !IO),
@@ -4122,7 +4120,7 @@
:- pred label_as_code_addr_to_string(label::in, string::out) is det.
label_as_code_addr_to_string(Label, Str) :-
- LabelStr = llds_out__label_to_c_string(Label, no),
+ LabelStr = label_to_c_string(Label, no),
IsEntry = label_is_external_to_c_module(Label),
(
IsEntry = yes,
@@ -4195,16 +4193,16 @@
% circumstances, leading to better code.
output_label(Label, !IO) :-
- LabelStr = llds_out__label_to_c_string(Label, yes),
+ LabelStr = label_to_c_string(Label, yes),
io__write_string(LabelStr, !IO).
output_label(Label, AddPrefix, !IO) :-
- LabelStr = llds_out__label_to_c_string(Label, AddPrefix),
+ LabelStr = label_to_c_string(Label, AddPrefix),
io__write_string(LabelStr, !IO).
-llds_out__label_to_c_string(entry(_, ProcLabel), AddPrefix) =
+label_to_c_string(entry(_, ProcLabel), AddPrefix) =
proc_label_to_c_string(ProcLabel, AddPrefix).
-llds_out__label_to_c_string(internal(Num, ProcLabel), AddPrefix) = LabelStr :-
+label_to_c_string(internal(Num, ProcLabel), AddPrefix) = LabelStr :-
ProcLabelStr = proc_label_to_c_string(ProcLabel, AddPrefix),
string__int_to_string(Num, NumStr),
string__append("_i", NumStr, NumSuffix),
@@ -4213,8 +4211,7 @@
:- pred output_reg(reg_type::in, int::in, io::di, io::uo) is det.
output_reg(r, N, !IO) :-
- llds_out__reg_to_string(r, N, RegName),
- io__write_string(RegName, !IO).
+ io__write_string(reg_to_string(r, N), !IO).
output_reg(f, _, !IO) :-
error("Floating point registers not implemented").
@@ -4339,7 +4336,7 @@
(
UnboxFloat = no,
StaticGroundTerms = yes,
- llds_out__float_const_expr_name(Rval, FloatName)
+ float_const_expr_name(Rval, FloatName)
->
(
IsPtr = yes,
@@ -5083,7 +5080,7 @@
error("llds_out.m: invalid binary operator")
).
-llds_out__binary_op_to_string(Op, Name) :-
+binary_op_to_string(Op) = Name :-
( c_util__binary_infix_op(Op, Name0) ->
Name = Name0
;
@@ -5094,32 +5091,23 @@
%-----------------------------------------------------------------------------%
-llds_out__lval_to_string(framevar(N), Description) :-
- string__int_to_string(N, N_String),
- string__append("MR_fv(", N_String, Tmp),
- string__append(Tmp, ")", Description).
-llds_out__lval_to_string(stackvar(N), Description) :-
- string__int_to_string(N, N_String),
- string__append("MR_sv(", N_String, Tmp),
- string__append(Tmp, ")", Description).
-llds_out__lval_to_string(reg(RegType, RegNum), Description) :-
- llds_out__reg_to_string(RegType, RegNum, Reg_String),
- string__append("reg(", Reg_String, Tmp),
- string__append(Tmp, ")", Description).
+lval_to_string(framevar(N)) =
+ "MR_fv(" ++ int_to_string(N) ++ ")".
+lval_to_string(stackvar(N)) =
+ "MR_sv(" ++ int_to_string(N) ++ ")".
+lval_to_string(reg(RegType, RegNum)) =
+ "reg(" ++ reg_to_string(RegType, RegNum) ++ ")".
-llds_out__reg_to_string(r, N, Description) :-
+reg_to_string(r, N) =
( N =< max_real_r_reg ->
- Template = "MR_r%d"
+ "MR_r" ++ int_to_string(N)
; N =< max_virtual_r_reg ->
- Template = "MR_r(%d)"
+ "MR_r(" ++ int_to_string(N) ++ ")"
;
- error("llds_out__reg_to_string: register number too large")
- ),
- string__format(Template, [i(N)], Description).
-llds_out__reg_to_string(f, N, Description) :-
- string__int_to_string(N, N_String),
- string__append("MR_f(", N_String, Tmp),
- string__append(Tmp, ")", Description).
+ func_error("reg_to_string: register number too large")
+ ).
+reg_to_string(f, N) =
+ "MR_f(" ++ int_to_string(N) ++ ")".
:- func max_real_r_reg = int.
:- func max_virtual_r_reg = int.
@@ -5147,10 +5135,10 @@
:- pred gather_labels_from_c_modules(list(comp_gen_c_module)::in,
list(label)::in, list(label)::out) is det.
-gather_labels_from_c_modules([], Labels, Labels).
-gather_labels_from_c_modules([Module | Modules], Labels0, Labels) :-
- gather_labels_from_c_module(Module, Labels0, Labels1),
- gather_labels_from_c_modules(Modules, Labels1, Labels).
+gather_labels_from_c_modules([], !Labels).
+gather_labels_from_c_modules([Module | Modules], !Labels) :-
+ gather_labels_from_c_module(Module, !Labels),
+ gather_labels_from_c_modules(Modules, !Labels).
:- pred gather_labels_from_c_module(comp_gen_c_module::in,
list(label)::in, list(label)::out) is det.
@@ -5163,21 +5151,21 @@
gather_labels_from_c_procs([], Labels, Labels).
gather_labels_from_c_procs([c_procedure(_, _, _, Instrs, _, _, _) | Procs],
- Labels0, Labels) :-
- gather_labels_from_instrs(Instrs, Labels0, Labels1),
- gather_labels_from_c_procs(Procs, Labels1, Labels).
+ !Labels) :-
+ gather_labels_from_instrs(Instrs, !Labels),
+ gather_labels_from_c_procs(Procs, !Labels).
:- pred gather_labels_from_instrs(list(instruction)::in,
list(label)::in, list(label)::out) is det.
-gather_labels_from_instrs([], Labels, Labels).
-gather_labels_from_instrs([Instr | Instrs], Labels0, Labels) :-
+gather_labels_from_instrs([], !Labels).
+gather_labels_from_instrs([Instr | Instrs], !Labels) :-
( Instr = label(Label) - _ ->
- Labels1 = [Label | Labels0]
+ !:Labels = [Label | !.Labels]
;
- Labels1 = Labels0
+ true
),
- gather_labels_from_instrs(Instrs, Labels1, Labels).
+ gather_labels_from_instrs(Instrs, !Labels).
%-----------------------------------------------------------------------------%
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.157
diff -u -r1.157 opt_debug.m
--- compiler/opt_debug.m 14 Sep 2005 01:29:09 -0000 1.157
+++ compiler/opt_debug.m 21 Sep 2005 00:09:40 -0000
@@ -501,8 +501,8 @@
dump_unop(hash_string) = "hash_string".
dump_unop(bitwise_complement) = "bitwise_complement".
-dump_binop(Op) = Str :-
- llds_out__binary_op_to_string(Op, Str).
+dump_binop(Op) =
+ llds_out__binary_op_to_string(Op).
dump_maybe_rvals([], _) = "".
dump_maybe_rvals([MR | MRs], N) = Str :-
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.54
diff -u -r1.54 rtti_out.m
--- compiler/rtti_out.m 30 Mar 2005 00:50:21 -0000 1.54
+++ compiler/rtti_out.m 21 Sep 2005 00:19:23 -0000
@@ -1,4 +1,6 @@
%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
@@ -30,55 +32,65 @@
:- import_module io.
:- import_module list.
- % Output a C expression holding the address of the C name of
- % the specified rtti_data, preceded by the string in the first
- % argument (that string will usually be a C cast).
+ % Output a C expression holding the address of the C name of the specified
+ % rtti_data, preceded by the string in the first argument (that string will
+ % usually be a C cast).
+ %
:- pred output_cast_addr_of_rtti_data(string::in, rtti_data::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
- % Output a C expression holding the address of the C name of
- % the specified rtti_data.
+ % Output a C expression holding the address of the C name of
+ % the specified rtti_data.
+ %
:- pred output_addr_of_rtti_data(rtti_data::in, io::di, io::uo) is det.
- % Output a C declaration for the rtti_datas.
+ % Output a C declaration for the rtti_datas.
+ %
:- pred output_rtti_data_decl_list(list(rtti_data)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
- % Output a C declaration for the rtti_data.
+ % Output a C declaration for the rtti_data.
+ %
:- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
- % Output a C definition for the rtti_data.
+ % Output a C definition for the rtti_data.
+ %
:- pred output_rtti_data_defn(rtti_data::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
- % Output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
- % to initialize the rtti_data if necessary.
+ % Output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro)
+ % to initialize the rtti_data if necessary.
+ %
:- pred rtti_out__init_rtti_data_if_nec(rtti_data::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
- % Output C code (e.g. a call to MR_register_type_ctor_info())
- % to register the rtti_data in the type tables, if it represents a data
- % structure that should be so registered. The bool should be the value
- % of the --split-c-files option; it governs whether the rtti_data is
- % declared in the generated code or not.
+ % Output C code (e.g. a call to MR_register_type_ctor_info()) to register
+ % the rtti_data in the type tables, if it represents a data structure
+ % that should be so registered. The bool should be the value of the
+ % --split-c-files option; it governs whether the rtti_data is declared
+ % in the generated code or not.
+ %
:- pred rtti_out__register_rtti_data_if_nec(rtti_data::in, bool::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
- % Output the C name of the rtti_data specified by the given rtti_id.
+ % Output the C name of the rtti_data specified by the given rtti_id.
+ %
:- pred output_rtti_id(rtti_id::in, io::di, io::uo) is det.
- % Output the C storage class, C type, and C name of the rtti_data
- % specified by the given rtti_id for use in a declaration or
- % definition. The bool should be `yes' iff it is for a definition.
+ % Output the C storage class, C type, and C name of the rtti_data
+ % specified by the given rtti_id for use in a declaration or
+ % definition. The bool should be `yes' iff it is for a definition.
+ %
:- pred output_rtti_id_storage_type_name(rtti_id::in, bool::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
- % Output the C storage class, C type, and C name of the rtti_data
- % specified by the given rtti_id for use in a declaration or
- % definition. The bool should be `yes' iff it is for a definition.
+ % Output the C storage class, C type, and C name of the rtti_data
+ % specified by the given rtti_id for use in a declaration or
+ % definition. The bool should be `yes' iff it is for a definition.
+ %
:- pred output_rtti_id_storage_type_name_no_decl(rtti_id::in, bool::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
:- implementation.
@@ -113,1425 +125,1364 @@
%-----------------------------------------------------------------------------%
output_rtti_data_defn(type_info(TypeInfo), !DeclSet, !IO) :-
- output_type_info_defn(TypeInfo, !DeclSet, !IO).
+ output_type_info_defn(TypeInfo, !DeclSet, !IO).
output_rtti_data_defn(pseudo_type_info(PseudoTypeInfo), !DeclSet, !IO) :-
- output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO).
+ output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO).
output_rtti_data_defn(type_ctor_info(TypeCtorData), !DeclSet, !IO) :-
- output_type_ctor_data_defn(TypeCtorData, !DeclSet, !IO).
+ output_type_ctor_data_defn(TypeCtorData, !DeclSet, !IO).
output_rtti_data_defn(base_typeclass_info(TCName, InstanceModuleName,
- InstanceString, BaseTypeClassInfo), !DeclSet, !IO) :-
- output_base_typeclass_info_defn(TCName, InstanceModuleName,
- InstanceString, BaseTypeClassInfo, !DeclSet, !IO).
+ InstanceString, BaseTypeClassInfo), !DeclSet, !IO) :-
+ output_base_typeclass_info_defn(TCName, InstanceModuleName,
+ InstanceString, BaseTypeClassInfo, !DeclSet, !IO).
output_rtti_data_defn(type_class_decl(TCDecl), !DeclSet, !IO) :-
- output_type_class_decl_defn(TCDecl, !DeclSet, !IO).
+ output_type_class_decl_defn(TCDecl, !DeclSet, !IO).
output_rtti_data_defn(type_class_instance(InstanceDecl), !DeclSet, !IO) :-
- output_type_class_instance_defn(InstanceDecl, !DeclSet, !IO).
+ output_type_class_instance_defn(InstanceDecl, !DeclSet, !IO).
output_rtti_data_defn(aditi_proc_info(ProcLabel, InputTypeInfo,
- OutputTypeInfo), !DeclSet, !IO) :-
- output_aditi_proc_info_defn(ProcLabel, InputTypeInfo, OutputTypeInfo,
- !DeclSet, !IO).
+ OutputTypeInfo), !DeclSet, !IO) :-
+ output_aditi_proc_info_defn(ProcLabel, InputTypeInfo, OutputTypeInfo,
+ !DeclSet, !IO).
%-----------------------------------------------------------------------------%
:- pred output_aditi_proc_info_defn(rtti_proc_label::in,
- rtti_type_info::in, rtti_type_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ rtti_type_info::in, rtti_type_info::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_aditi_proc_info_defn(ProcLabel, InputTypeInfo, OutputTypeInfo,
- !DeclSet, !IO) :-
- output_type_info_defn(InputTypeInfo, !DeclSet, !IO),
- output_type_info_defn(OutputTypeInfo, !DeclSet, !IO),
- CodeAddr = make_code_addr(ProcLabel),
- output_code_addr_decls(CodeAddr, !DeclSet, !IO),
-
- output_rtti_id_storage_type_name(aditi_rtti_id(ProcLabel), yes,
- !DeclSet, !IO),
- io__write_string(" = {\n\t(MR_Code *) ", !IO),
- output_static_code_addr(CodeAddr, !IO),
- io__write_string(",\n\t", !IO),
- io__write_string("""", !IO),
- c_util__output_quoted_string(
- proc_label_to_c_string(make_proc_label_from_rtti(ProcLabel), no),
- !IO),
- io__write_string(""",\n\t", !IO),
- output_cast_addr_of_rtti_data("(MR_TypeInfo) ",
- type_info(InputTypeInfo), !IO),
- io__write_string(",\n\t", !IO),
- output_cast_addr_of_rtti_data("(MR_TypeInfo) ",
- type_info(OutputTypeInfo), !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(
- represent_determinism(ProcLabel ^ proc_interface_detism),
- !IO),
- io__write_string("\n};\n", !IO).
+ !DeclSet, !IO) :-
+ output_type_info_defn(InputTypeInfo, !DeclSet, !IO),
+ output_type_info_defn(OutputTypeInfo, !DeclSet, !IO),
+ CodeAddr = make_code_addr(ProcLabel),
+ output_code_addr_decls(CodeAddr, !DeclSet, !IO),
+
+ output_rtti_id_storage_type_name(aditi_rtti_id(ProcLabel), yes,
+ !DeclSet, !IO),
+ io__write_string(" = {\n\t(MR_Code *) ", !IO),
+ output_static_code_addr(CodeAddr, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string("""", !IO),
+ c_util__output_quoted_string(
+ proc_label_to_c_string(make_proc_label_from_rtti(ProcLabel), no), !IO),
+ io__write_string(""",\n\t", !IO),
+ output_cast_addr_of_rtti_data("(MR_TypeInfo) ", type_info(InputTypeInfo),
+ !IO),
+ io__write_string(",\n\t", !IO),
+ output_cast_addr_of_rtti_data("(MR_TypeInfo) ", type_info(OutputTypeInfo),
+ !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(represent_determinism(ProcLabel ^ proc_interface_detism),
+ !IO),
+ io__write_string("\n};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_base_typeclass_info_defn(tc_name::in, module_name::in,
- string::in, base_typeclass_info::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ string::in, base_typeclass_info::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_base_typeclass_info_defn(TCName, InstanceModuleName, InstanceString,
- base_typeclass_info(N1, N2, N3, N4, N5, Methods),
- !DeclSet, !IO) :-
- CodeAddrs = list__map(make_code_addr, Methods),
- list__foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO),
- io__write_string("\n", !IO),
- RttiId = tc_rtti_id(TCName,
- base_typeclass_info(InstanceModuleName, InstanceString)),
- output_rtti_id_storage_type_name(RttiId, yes, !DeclSet, !IO),
- % XXX It would be nice to avoid generating redundant declarations
- % of base_typeclass_infos, but currently we don't.
- io__write_string(" = {\n\t(MR_Code *) ", !IO),
- io__write_list([N1, N2, N3, N4, N5],
- ",\n\t(MR_Code *) ", io__write_int, !IO),
- io__write_string(",\n\t", !IO),
- io__write_list(CodeAddrs, ",\n\t", output_static_code_addr, !IO),
- io__write_string("\n};\n", !IO).
+ base_typeclass_info(N1, N2, N3, N4, N5, Methods), !DeclSet, !IO) :-
+ CodeAddrs = list__map(make_code_addr, Methods),
+ list__foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO),
+ io__write_string("\n", !IO),
+ RttiId = tc_rtti_id(TCName,
+ base_typeclass_info(InstanceModuleName, InstanceString)),
+ output_rtti_id_storage_type_name(RttiId, yes, !DeclSet, !IO),
+ % XXX It would be nice to avoid generating redundant declarations
+ % of base_typeclass_infos, but currently we don't.
+ io__write_string(" = {\n\t(MR_Code *) ", !IO),
+ io__write_list([N1, N2, N3, N4, N5], ",\n\t(MR_Code *) ", io__write_int,
+ !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_list(CodeAddrs, ",\n\t", output_static_code_addr, !IO),
+ io__write_string("\n};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_type_class_decl_defn(tc_decl::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_type_class_decl_defn(TCDecl, !DeclSet, !IO) :-
- TCDecl = tc_decl(TCId, Version, Supers),
- TCId = tc_id(TCName, TVarNames, MethodIds),
- TCName = tc_name(ModuleSymName, ClassName, Arity),
-
- TCIdVarNamesRttiName = type_class_id_var_names,
- TCIdVarNamesRttiId = tc_rtti_id(TCName, TCIdVarNamesRttiName),
- TCIdMethodIdsRttiName = type_class_id_method_ids,
- TCIdMethodIdsRttiId = tc_rtti_id(TCName, TCIdMethodIdsRttiName),
- TCIdRttiName = type_class_id,
- TCIdRttiId = tc_rtti_id(TCName, TCIdRttiName),
- TCDeclSupersRttiName = type_class_decl_supers,
- TCDeclSupersRttiId = tc_rtti_id(TCName, TCDeclSupersRttiName),
- TCDeclRttiName = type_class_decl,
- TCDeclRttiId = tc_rtti_id(TCName, TCDeclRttiName),
-
- (
- TVarNames = []
- ;
- TVarNames = [_ | _],
- output_generic_rtti_data_defn_start(TCIdVarNamesRttiId,
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- list__foldl(output_type_class_id_tvar_name, TVarNames, !IO),
- io__write_string("};\n", !IO)
- ),
-
- (
- MethodIds = []
- ;
- MethodIds = [_ | _],
- output_generic_rtti_data_defn_start(TCIdMethodIdsRttiId,
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- list__foldl(output_type_class_id_method_id, MethodIds, !IO),
- io__write_string("};\n", !IO)
- ),
-
- list__length(TVarNames, NumTVarNames),
- list__length(MethodIds, NumMethodIds),
- output_generic_rtti_data_defn_start(TCIdRttiId, !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- mdbcomp__prim_data__sym_name_to_string(ModuleSymName, ModuleName),
- c_util__output_quoted_string(ModuleName, !IO),
- io__write_string(""",\n\t""", !IO),
- c_util__output_quoted_string(ClassName, !IO),
- io__write_string(""",\n\t", !IO),
- io__write_int(Arity, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(NumTVarNames, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(NumMethodIds, !IO),
- io__write_string(",\n\t", !IO),
- (
- TVarNames = [],
- io__write_string("NULL", !IO)
- ;
- TVarNames = [_ | _],
- output_rtti_id(TCIdVarNamesRttiId, !IO)
- ),
- io__write_string(",\n\t", !IO),
- (
- MethodIds = [],
- io__write_string("NULL", !IO)
- ;
- MethodIds = [_ | _],
- output_rtti_id(TCIdMethodIdsRttiId, !IO)
- ),
- io__write_string("\n};\n", !IO),
-
- (
- Supers = []
- ;
- Supers = [_ | _],
- list__map_foldl3(output_type_class_constraint(
- make_tc_decl_super_id(TCName)), Supers, SuperIds,
- counter__init(1), _, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(TCDeclSupersRttiId,
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
- SuperIds, !IO),
- io__write_string("};\n", !IO)
- ),
-
- list__length(Supers, NumSupers),
- output_generic_rtti_data_defn_start(TCDeclRttiId, !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_rtti_id(TCIdRttiId, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(Version, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(NumSupers, !IO),
- io__write_string(",\n\t", !IO),
- (
- Supers = [],
- io__write_string("NULL", !IO)
- ;
- Supers = [_ | _],
- output_rtti_id(TCDeclSupersRttiId, !IO)
- ),
- io__write_string("\n};\n", !IO).
+ TCDecl = tc_decl(TCId, Version, Supers),
+ TCId = tc_id(TCName, TVarNames, MethodIds),
+ TCName = tc_name(ModuleSymName, ClassName, Arity),
+
+ TCIdVarNamesRttiName = type_class_id_var_names,
+ TCIdVarNamesRttiId = tc_rtti_id(TCName, TCIdVarNamesRttiName),
+ TCIdMethodIdsRttiName = type_class_id_method_ids,
+ TCIdMethodIdsRttiId = tc_rtti_id(TCName, TCIdMethodIdsRttiName),
+ TCIdRttiName = type_class_id,
+ TCIdRttiId = tc_rtti_id(TCName, TCIdRttiName),
+ TCDeclSupersRttiName = type_class_decl_supers,
+ TCDeclSupersRttiId = tc_rtti_id(TCName, TCDeclSupersRttiName),
+ TCDeclRttiName = type_class_decl,
+ TCDeclRttiId = tc_rtti_id(TCName, TCDeclRttiName),
+ (
+ TVarNames = []
+ ;
+ TVarNames = [_ | _],
+ output_generic_rtti_data_defn_start(TCIdVarNamesRttiId,
+ !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ list__foldl(output_type_class_id_tvar_name, TVarNames, !IO),
+ io__write_string("};\n", !IO)
+ ),
+ (
+ MethodIds = []
+ ;
+ MethodIds = [_ | _],
+ output_generic_rtti_data_defn_start(TCIdMethodIdsRttiId,
+ !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ list__foldl(output_type_class_id_method_id, MethodIds, !IO),
+ io__write_string("};\n", !IO)
+ ),
+ list__length(TVarNames, NumTVarNames),
+ list__length(MethodIds, NumMethodIds),
+ output_generic_rtti_data_defn_start(TCIdRttiId, !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ mdbcomp__prim_data__sym_name_to_string(ModuleSymName, ModuleName),
+ c_util__output_quoted_string(ModuleName, !IO),
+ io__write_string(""",\n\t""", !IO),
+ c_util__output_quoted_string(ClassName, !IO),
+ io__write_string(""",\n\t", !IO),
+ io__write_int(Arity, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumTVarNames, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumMethodIds, !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ TVarNames = [],
+ io__write_string("NULL", !IO)
+ ;
+ TVarNames = [_ | _],
+ output_rtti_id(TCIdVarNamesRttiId, !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ (
+ MethodIds = [],
+ io__write_string("NULL", !IO)
+ ;
+ MethodIds = [_ | _],
+ output_rtti_id(TCIdMethodIdsRttiId, !IO)
+ ),
+ io__write_string("\n};\n", !IO),
+ (
+ Supers = []
+ ;
+ Supers = [_ | _],
+ list__map_foldl3(output_type_class_constraint(
+ make_tc_decl_super_id(TCName)), Supers, SuperIds,
+ counter__init(1), _, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(TCDeclSupersRttiId, !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
+ SuperIds, !IO),
+ io__write_string("};\n", !IO)
+ ),
+ list__length(Supers, NumSupers),
+ output_generic_rtti_data_defn_start(TCDeclRttiId, !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_rtti_id(TCIdRttiId, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(Version, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumSupers, !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ Supers = [],
+ io__write_string("NULL", !IO)
+ ;
+ Supers = [_ | _],
+ output_rtti_id(TCDeclSupersRttiId, !IO)
+ ),
+ io__write_string("\n};\n", !IO).
:- pred output_type_class_id_tvar_name(string::in, io::di, io::uo) is det.
output_type_class_id_tvar_name(TVarName, !IO) :-
- io__write_string("\t""", !IO),
- c_util__output_quoted_string(TVarName, !IO),
- io__write_string(""",\n", !IO).
+ io__write_string("\t""", !IO),
+ c_util__output_quoted_string(TVarName, !IO),
+ io__write_string(""",\n", !IO).
:- pred output_type_class_id_method_id(tc_method_id::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_type_class_id_method_id(MethodId, !IO) :-
- MethodId = tc_method_id(MethodName, MethodArity, PredOrFunc),
- io__write_string("\t{ """, !IO),
- c_util__output_quoted_string(MethodName, !IO),
- io__write_string(""", ", !IO),
- io__write_int(MethodArity, !IO),
- io__write_string(", ", !IO),
- output_pred_or_func(PredOrFunc, !IO),
- io__write_string(" },\n", !IO).
+ MethodId = tc_method_id(MethodName, MethodArity, PredOrFunc),
+ io__write_string("\t{ """, !IO),
+ c_util__output_quoted_string(MethodName, !IO),
+ io__write_string(""", ", !IO),
+ io__write_int(MethodArity, !IO),
+ io__write_string(", ", !IO),
+ output_pred_or_func(PredOrFunc, !IO),
+ io__write_string(" },\n", !IO).
:- pred make_tc_decl_super_id(tc_name::in, int::in, int::in, rtti_id::out)
- is det.
+ is det.
make_tc_decl_super_id(TCName, Ordinal, NumTypes, RttiId) :-
- RttiId = tc_rtti_id(TCName, type_class_decl_super(Ordinal, NumTypes)).
+ RttiId = tc_rtti_id(TCName, type_class_decl_super(Ordinal, NumTypes)).
%-----------------------------------------------------------------------------%
:- pred output_type_class_instance_defn(tc_instance::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_class_instance_defn(Instance, !DeclSet, !IO) :-
- Instance = tc_instance(TCName, TCTypes, NumTypeVars, Constraints,
- _MethodProcLabels),
- list__foldl2(output_maybe_pseudo_type_info_defn, TCTypes,
- !DeclSet, !IO),
- TCTypeRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data,
- TCTypes),
- TCInstanceTypesRttiId = tc_rtti_id(TCName,
- type_class_instance_tc_type_vector(TCTypes)),
- output_generic_rtti_data_defn_start(TCInstanceTypesRttiId,
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TCTypeRttiDatas,
- !IO),
- io__write_string("};\n", !IO),
- TCInstanceConstraintsRttiId = tc_rtti_id(TCName,
- type_class_instance_constraints(TCTypes)),
- (
- Constraints = []
- ;
- Constraints = [_ | _],
- list__map_foldl3(output_type_class_constraint(
- make_tc_instance_constraint_id(TCName, TCTypes)),
- Constraints, ConstraintIds, counter__init(1), _,
- !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- TCInstanceConstraintsRttiId, !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
- ConstraintIds, !IO),
- io__write_string("};\n", !IO)
- ),
-% TCInstanceMethodsRttiId = tc_rtti_id(
-% type_class_instance_methods(TCName, TCTypes)),
-% (
-% MethodProcLabels = []
-% ;
-% MethodProcLabels = [_ | _],
-% MethodCodeAddrs = list__map(make_code_addr, MethodProcLabels),
-% list__foldl2(output_code_addr_decls, MethodCodeAddrs,
-% !DeclSet, !IO),
-% output_generic_rtti_data_defn_start(TCInstanceMethodsRttiId,
-% !DeclSet, !IO),
-% io__write_string(" = {\n", !IO),
-% list__foldl(output_code_addr_in_list, MethodCodeAddrs, !IO),
-% io__write_string("};\n", !IO)
-% ),
- TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
- output_rtti_id_decls(TCDeclRttiId, "", "", 0, _, !DeclSet, !IO),
- TCInstanceRttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)),
- output_generic_rtti_data_defn_start(TCInstanceRttiId, !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_rtti_id(TCDeclRttiId, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(NumTypeVars, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(list__length(Constraints), !IO),
- io__write_string(",\n\t", !IO),
- output_rtti_id(TCInstanceTypesRttiId, !IO),
- io__write_string(",\n\t", !IO),
- (
- Constraints = [],
- io__write_string("NULL", !IO)
- ;
- Constraints = [_ | _],
- output_rtti_id(TCInstanceConstraintsRttiId, !IO)
- ),
-% io__write_string(",\n\t", !IO),
-% (
-% MethodProcLabels = [],
-% io__write_string("NULL", !IO)
-% ;
-% MethodProcLabels = [_ | _],
-% io__write_string("&", !IO),
-% output_rtti_id(TCInstanceMethodsRttiId, !IO)
-% ),
- io__write_string("\n};\n", !IO).
+ Instance = tc_instance(TCName, TCTypes, NumTypeVars, Constraints,
+ _MethodProcLabels),
+ list__foldl2(output_maybe_pseudo_type_info_defn, TCTypes, !DeclSet, !IO),
+ TCTypeRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, TCTypes),
+ TCInstanceTypesRttiId = tc_rtti_id(TCName,
+ type_class_instance_tc_type_vector(TCTypes)),
+ output_generic_rtti_data_defn_start(TCInstanceTypesRttiId, !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TCTypeRttiDatas,
+ !IO),
+ io__write_string("};\n", !IO),
+ TCInstanceConstraintsRttiId = tc_rtti_id(TCName,
+ type_class_instance_constraints(TCTypes)),
+ (
+ Constraints = []
+ ;
+ Constraints = [_ | _],
+ list__map_foldl3(output_type_class_constraint(
+ make_tc_instance_constraint_id(TCName, TCTypes)),
+ Constraints, ConstraintIds, counter__init(1), _, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(TCInstanceConstraintsRttiId,
+ !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
+ ConstraintIds, !IO),
+ io__write_string("};\n", !IO)
+ ),
+% TCInstanceMethodsRttiId = tc_rtti_id(
+% type_class_instance_methods(TCName, TCTypes)),
+% (
+% MethodProcLabels = []
+% ;
+% MethodProcLabels = [_ | _],
+% MethodCodeAddrs = list__map(make_code_addr, MethodProcLabels),
+% list__foldl2(output_code_addr_decls, MethodCodeAddrs,
+% !DeclSet, !IO),
+% output_generic_rtti_data_defn_start(TCInstanceMethodsRttiId,
+% !DeclSet, !IO),
+% io__write_string(" = {\n", !IO),
+% list__foldl(output_code_addr_in_list, MethodCodeAddrs, !IO),
+% io__write_string("};\n", !IO)
+% ),
+ TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
+ output_rtti_id_decls(TCDeclRttiId, "", "", 0, _, !DeclSet, !IO),
+ TCInstanceRttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)),
+ output_generic_rtti_data_defn_start(TCInstanceRttiId, !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_rtti_id(TCDeclRttiId, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumTypeVars, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(list__length(Constraints), !IO),
+ io__write_string(",\n\t", !IO),
+ output_rtti_id(TCInstanceTypesRttiId, !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ Constraints = [],
+ io__write_string("NULL", !IO)
+ ;
+ Constraints = [_ | _],
+ output_rtti_id(TCInstanceConstraintsRttiId, !IO)
+ ),
+% io__write_string(",\n\t", !IO),
+% (
+% MethodProcLabels = [],
+% io__write_string("NULL", !IO)
+% ;
+% MethodProcLabels = [_ | _],
+% io__write_string("&", !IO),
+% output_rtti_id(TCInstanceMethodsRttiId, !IO)
+% ),
+ io__write_string("\n};\n", !IO).
:- pred make_tc_instance_constraint_id(tc_name::in, list(tc_type)::in,
- int::in, int::in, rtti_id::out) is det.
+ int::in, int::in, rtti_id::out) is det.
make_tc_instance_constraint_id(TCName, TCTypes, Ordinal, NumTypes, RttiId) :-
- RttiId = tc_rtti_id(TCName,
- type_class_instance_constraint(TCTypes, Ordinal, NumTypes)).
+ RttiId = tc_rtti_id(TCName,
+ type_class_instance_constraint(TCTypes, Ordinal, NumTypes)).
:- pred output_code_addr_in_list(code_addr::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_code_addr_in_list(CodeAddr, !IO) :-
- io__write_string("\t", !IO),
- output_static_code_addr(CodeAddr, !IO),
- io__write_string(",\n", !IO).
+ io__write_string("\t", !IO),
+ output_static_code_addr(CodeAddr, !IO),
+ io__write_string(",\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_type_class_constraint(
- pred(int, int, rtti_id)::in(pred(in, in, out) is det),
- tc_constraint::in, rtti_id::out, counter::in, counter::out,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ pred(int, int, rtti_id)::in(pred(in, in, out) is det),
+ tc_constraint::in, rtti_id::out, counter::in, counter::out,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_class_constraint(MakeRttiId, Constraint, TCDeclSuperRttiId,
- !Counter, !DeclSet, !IO) :-
- Constraint = tc_constraint(TCName, Types),
- list__length(Types, NumTypes),
- counter__allocate(TCNum, !Counter),
- MakeRttiId(TCNum, NumTypes, TCDeclSuperRttiId),
- TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
- output_generic_rtti_data_decl(TCDeclRttiId, !DeclSet, !IO),
- list__foldl2(output_maybe_pseudo_type_info_defn, Types, !DeclSet, !IO),
- TypeRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Types),
- output_generic_rtti_data_defn_start(TCDeclSuperRttiId, !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_rtti_id(TCDeclRttiId, !IO),
- io__write_string(",\n\t{\n", !IO),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TypeRttiDatas,
- !IO),
- io__write_string("\t}\n};\n", !IO).
+ !Counter, !DeclSet, !IO) :-
+ Constraint = tc_constraint(TCName, Types),
+ list__length(Types, NumTypes),
+ counter__allocate(TCNum, !Counter),
+ MakeRttiId(TCNum, NumTypes, TCDeclSuperRttiId),
+ TCDeclRttiId = tc_rtti_id(TCName, type_class_decl),
+ output_generic_rtti_data_decl(TCDeclRttiId, !DeclSet, !IO),
+ list__foldl2(output_maybe_pseudo_type_info_defn, Types, !DeclSet, !IO),
+ TypeRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Types),
+ output_generic_rtti_data_defn_start(TCDeclSuperRttiId, !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_rtti_id(TCDeclRttiId, !IO),
+ io__write_string(",\n\t{\n", !IO),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TypeRttiDatas, !IO),
+ io__write_string("\t}\n};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_maybe_pseudo_type_info_or_self_defn(
- rtti_maybe_pseudo_type_info_or_self::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ rtti_maybe_pseudo_type_info_or_self::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_maybe_pseudo_type_info_or_self_defn(plain(TypeInfo),
- !DeclSet, !IO) :-
- output_type_info_defn(TypeInfo, !DeclSet, !IO).
+ !DeclSet, !IO) :-
+ output_type_info_defn(TypeInfo, !DeclSet, !IO).
output_maybe_pseudo_type_info_or_self_defn(pseudo(PseudoTypeInfo),
- !DeclSet, !IO) :-
- output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO).
+ !DeclSet, !IO) :-
+ output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO).
output_maybe_pseudo_type_info_or_self_defn(self, !DeclSet, !IO).
:- pred output_maybe_pseudo_type_info_defn(rtti_maybe_pseudo_type_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_maybe_pseudo_type_info_defn(plain(TypeInfo), !DeclSet, !IO) :-
- output_type_info_defn(TypeInfo, !DeclSet, !IO).
+ output_type_info_defn(TypeInfo, !DeclSet, !IO).
output_maybe_pseudo_type_info_defn(pseudo(PseudoTypeInfo), !DeclSet, !IO) :-
- output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO).
+ output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO).
:- pred output_type_info_defn(rtti_type_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_info_defn(TypeInfo, !DeclSet, !IO) :-
- (
- rtti_data_to_id(type_info(TypeInfo), RttiId),
- DataAddr = rtti_addr(RttiId),
- decl_set_is_member(data_addr(DataAddr), !.DeclSet)
- ->
- true
- ;
- do_output_type_info_defn(TypeInfo, !DeclSet, !IO)
- ).
+ (
+ rtti_data_to_id(type_info(TypeInfo), RttiId),
+ DataAddr = rtti_addr(RttiId),
+ decl_set_is_member(data_addr(DataAddr), !.DeclSet)
+ ->
+ true
+ ;
+ do_output_type_info_defn(TypeInfo, !DeclSet, !IO)
+ ).
:- pred do_output_type_info_defn(rtti_type_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
do_output_type_info_defn(TypeInfo, !DeclSet, !IO) :-
- TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
- TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO).
+ TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
+ TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO).
do_output_type_info_defn(TypeInfo, !DeclSet, !IO) :-
- TypeInfo = plain_type_info(RttiTypeCtor, Args),
- TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
- ArgRttiDatas = list__map(type_info_to_rtti_data, Args),
- output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, type_info(TypeInfo)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
- io__write_string(",\n{", !IO),
- output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas, !IO),
- io__write_string("}};\n", !IO).
+ TypeInfo = plain_type_info(RttiTypeCtor, Args),
+ TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
+ ArgRttiDatas = list__map(type_info_to_rtti_data, Args),
+ output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, type_info(TypeInfo)), !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
+ io__write_string(",\n{", !IO),
+ output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas, !IO),
+ io__write_string("}};\n", !IO).
do_output_type_info_defn(TypeInfo, !DeclSet, !IO) :-
- TypeInfo = var_arity_type_info(RttiVarArityId, Args),
- RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId),
- TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
- ArgRttiDatas = list__map(type_info_to_rtti_data, Args),
- output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, type_info(TypeInfo)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
- io__write_string(",\n\t", !IO),
- list__length(Args, Arity),
- io__write_int(Arity, !IO),
- io__write_string(",\n{", !IO),
- output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas, !IO),
- io__write_string("}};\n", !IO).
+ TypeInfo = var_arity_type_info(RttiVarArityId, Args),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId),
+ TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
+ ArgRttiDatas = list__map(type_info_to_rtti_data, Args),
+ output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, type_info(TypeInfo)), !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
+ io__write_string(",\n\t", !IO),
+ list__length(Args, Arity),
+ io__write_int(Arity, !IO),
+ io__write_string(",\n{", !IO),
+ output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas, !IO),
+ io__write_string("}};\n", !IO).
:- pred output_pseudo_type_info_defn(rtti_pseudo_type_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :-
- (
- PseudoTypeInfo = type_var(_)
- ->
- true
- ;
- rtti_data_to_id(pseudo_type_info(PseudoTypeInfo), RttiId),
- DataAddr = rtti_addr(RttiId),
- decl_set_is_member(data_addr(DataAddr), !.DeclSet)
- ->
- true
- ;
- do_output_pseudo_type_info_defn(PseudoTypeInfo,
- !DeclSet, !IO)
- ).
+ (
+ PseudoTypeInfo = type_var(_)
+ ->
+ true
+ ;
+ rtti_data_to_id(pseudo_type_info(PseudoTypeInfo), RttiId),
+ DataAddr = rtti_addr(RttiId),
+ decl_set_is_member(data_addr(DataAddr), !.DeclSet)
+ ->
+ true
+ ;
+ do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO)
+ ).
:- pred do_output_pseudo_type_info_defn(rtti_pseudo_type_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :-
- PseudoTypeInfo = plain_arity_zero_pseudo_type_info(RttiTypeCtor),
- TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO).
+ PseudoTypeInfo = plain_arity_zero_pseudo_type_info(RttiTypeCtor),
+ TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO).
do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :-
- PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args),
- TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
- ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args),
- output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, pseudo_type_info(PseudoTypeInfo)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
- io__write_string(",\n{", !IO),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ",
- ArgRttiDatas, !IO),
- io__write_string("}};\n", !IO).
+ PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args),
+ TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
+ ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args),
+ output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, pseudo_type_info(PseudoTypeInfo)),
+ !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
+ io__write_string(",\n{", !IO),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas, !IO),
+ io__write_string("}};\n", !IO).
do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :-
- PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args),
- RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId),
- TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
- ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args),
- output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, pseudo_type_info(PseudoTypeInfo)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t&", !IO),
- output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
- io__write_string(",\n\t", !IO),
- list__length(Args, Arity),
- io__write_int(Arity, !IO),
- io__write_string(",\n{", !IO),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ",
- ArgRttiDatas, !IO),
- io__write_string("}};\n", !IO).
+ PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args),
+ RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId),
+ TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO),
+ ArgRttiDatas = list__map(maybe_pseudo_type_info_to_rtti_data, Args),
+ output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, pseudo_type_info(PseudoTypeInfo)),
+ !DeclSet, !IO),
+ io__write_string(" = {\n\t&", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
+ io__write_string(",\n\t", !IO),
+ list__length(Args, Arity),
+ io__write_int(Arity, !IO),
+ io__write_string(",\n{", !IO),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas, !IO),
+ io__write_string("}};\n", !IO).
do_output_pseudo_type_info_defn(type_var(_), !DeclSet, !IO).
:- pred output_type_ctor_arg_defns_and_decls(list(rtti_data)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO) :-
- % We must output the definitions of the rtti_datas of the argument
- % typeinfos and/or pseudo-typeinfos, because they may contain other
- % typeinfos and/or pseudo-typeinfos nested within them. However,
- % zero arity typeinfos and pseudo-typeinfos have empty definitions,
- % yet the type_ctor_info they refer to still must be declared.
- % This is why both calls below are needed.
- list__foldl2(output_rtti_data_defn, ArgRttiDatas, !DeclSet, !IO),
- output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _,
- !DeclSet, !IO).
+ % We must output the definitions of the rtti_datas of the argument
+ % typeinfos and/or pseudo-typeinfos, because they may contain other
+ % typeinfos and/or pseudo-typeinfos nested within them. However,
+ % zero arity typeinfos and pseudo-typeinfos have empty definitions,
+ % yet the type_ctor_info they refer to still must be declared.
+ % This is why both calls below are needed.
+ list__foldl2(output_rtti_data_defn, ArgRttiDatas, !DeclSet, !IO),
+ output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _, !DeclSet, !IO).
%-----------------------------------------------------------------------------%
:- pred output_type_ctor_data_defn(type_ctor_data::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_data_defn(TypeCtorData, !DeclSet, !IO) :-
- RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
- TypeCtorData = type_ctor_data(Version, Module, TypeName, TypeArity,
- UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
- output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails,
- MaybeFunctorsName, MaybeLayoutName, !DeclSet, !IO),
- det_univ_to_type(UnifyUniv, UnifyProcLabel),
- UnifyCodeAddr = make_code_addr(UnifyProcLabel),
- det_univ_to_type(CompareUniv, CompareProcLabel),
- CompareCodeAddr = make_code_addr(CompareProcLabel),
- CodeAddrs = [UnifyCodeAddr, CompareCodeAddr],
- list__foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- !DeclSet, !IO),
- io__write_string(" = {\n\t", !IO),
- io__write_int(TypeArity, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(Version, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(type_ctor_details_num_ptags(TypeCtorDetails), !IO),
- io__write_string(",\n\t", !IO),
- rtti__type_ctor_rep_to_string(TypeCtorData, CtorRepStr),
- io__write_string(CtorRepStr, !IO),
- io__write_string(",\n\t", !IO),
- output_static_code_addr(UnifyCodeAddr, !IO),
- io__write_string(",\n\t", !IO),
- output_static_code_addr(CompareCodeAddr, !IO),
- io__write_string(",\n\t""", !IO),
- mdbcomp__prim_data__sym_name_to_string(Module, ModuleName),
- c_util__output_quoted_string(ModuleName, !IO),
- io__write_string(""",\n\t""", !IO),
- c_util__output_quoted_string(TypeName, !IO),
- io__write_string(""",\n\t", !IO),
- (
- MaybeFunctorsName = yes(FunctorsName),
- FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, FunctorsName),
- io__write_string("{ ", !IO),
- output_cast_addr_of_rtti_id("(void *)", FunctorsRttiId, !IO),
- io__write_string(" }", !IO)
- ;
- MaybeFunctorsName = no,
- io__write_string("{ 0 }", !IO)
- ),
- io__write_string(",\n\t", !IO),
- (
- MaybeLayoutName = yes(LayoutName),
- LayoutRttiId = ctor_rtti_id(RttiTypeCtor, LayoutName),
- io__write_string("{ ", !IO),
- output_cast_addr_of_rtti_id("(void *)", LayoutRttiId, !IO),
- io__write_string(" }", !IO)
- ;
- MaybeLayoutName = no,
- io__write_string("{ 0 }", !IO)
- ),
- io__write_string(",\n\t", !IO),
- io__write_int(type_ctor_details_num_functors(TypeCtorDetails), !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(encode_type_ctor_flags(Flags), !IO),
+ RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
+ TypeCtorData = type_ctor_data(Version, Module, TypeName, TypeArity,
+ UnifyUniv, CompareUniv, Flags, TypeCtorDetails),
+ output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails,
+ MaybeFunctorsName, MaybeLayoutName, !DeclSet, !IO),
+ det_univ_to_type(UnifyUniv, UnifyProcLabel),
+ UnifyCodeAddr = make_code_addr(UnifyProcLabel),
+ det_univ_to_type(CompareUniv, CompareProcLabel),
+ CompareCodeAddr = make_code_addr(CompareProcLabel),
+ CodeAddrs = [UnifyCodeAddr, CompareCodeAddr],
+ list__foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, type_ctor_info), !DeclSet, !IO),
+ io__write_string(" = {\n\t", !IO),
+ io__write_int(TypeArity, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(Version, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(type_ctor_details_num_ptags(TypeCtorDetails), !IO),
+ io__write_string(",\n\t", !IO),
+ rtti__type_ctor_rep_to_string(TypeCtorData, CtorRepStr),
+ io__write_string(CtorRepStr, !IO),
+ io__write_string(",\n\t", !IO),
+ output_static_code_addr(UnifyCodeAddr, !IO),
+ io__write_string(",\n\t", !IO),
+ output_static_code_addr(CompareCodeAddr, !IO),
+ io__write_string(",\n\t""", !IO),
+ mdbcomp__prim_data__sym_name_to_string(Module, ModuleName),
+ c_util__output_quoted_string(ModuleName, !IO),
+ io__write_string(""",\n\t""", !IO),
+ c_util__output_quoted_string(TypeName, !IO),
+ io__write_string(""",\n\t", !IO),
+ (
+ MaybeFunctorsName = yes(FunctorsName),
+ FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, FunctorsName),
+ io__write_string("{ ", !IO),
+ output_cast_addr_of_rtti_id("(void *)", FunctorsRttiId, !IO),
+ io__write_string(" }", !IO)
+ ;
+ MaybeFunctorsName = no,
+ io__write_string("{ 0 }", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ (
+ MaybeLayoutName = yes(LayoutName),
+ LayoutRttiId = ctor_rtti_id(RttiTypeCtor, LayoutName),
+ io__write_string("{ ", !IO),
+ output_cast_addr_of_rtti_id("(void *)", LayoutRttiId, !IO),
+ io__write_string(" }", !IO)
+ ;
+ MaybeLayoutName = no,
+ io__write_string("{ 0 }", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ io__write_int(type_ctor_details_num_functors(TypeCtorDetails), !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(encode_type_ctor_flags(Flags), !IO),
% This code is commented out while the corresponding fields of the
% MR_TypeCtorInfo_Struct type are commented out.
%
-% io__write_string(",\n\t"),
-% (
-% { MaybeHashCons = yes(HashConsDataAddr) },
-% io__write_string("&"),
-% output_ctor_rtti_id(RttiTypeCtor, HashConsDataAddr)
-% ;
-% { MaybeHashCons = no },
-% io__write_string("NULL")
-% ),
-% io__write_string(",\n\t"),
-% output_maybe_static_code_addr(Prettyprinter),
- io__write_string("\n};\n", !IO).
+% io__write_string(",\n\t"),
+% (
+% { MaybeHashCons = yes(HashConsDataAddr) },
+% io__write_string("&"),
+% output_ctor_rtti_id(RttiTypeCtor, HashConsDataAddr)
+% ;
+% { MaybeHashCons = no },
+% io__write_string("NULL")
+% ),
+% io__write_string(",\n\t"),
+% output_maybe_static_code_addr(Prettyprinter),
+ io__write_string("\n};\n", !IO).
:- pred output_type_ctor_details_defn(rtti_type_ctor::in,
- type_ctor_details::in,
- maybe(ctor_rtti_name)::out, maybe(ctor_rtti_name)::out,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ type_ctor_details::in,
+ maybe(ctor_rtti_name)::out, maybe(ctor_rtti_name)::out,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails,
- MaybeFunctorsName, MaybeLayoutName, !DeclSet, !IO) :-
- (
- TypeCtorDetails = enum(_, EnumFunctors, EnumByRep,
- EnumByName),
- list__foldl2(output_enum_functor_defn(RttiTypeCtor),
- EnumFunctors, !DeclSet, !IO),
- output_enum_value_ordered_table(RttiTypeCtor, EnumByRep,
- !DeclSet, !IO),
- output_enum_name_ordered_table(RttiTypeCtor, EnumByName,
- !DeclSet, !IO),
- MaybeLayoutName = yes(enum_value_ordered_table),
- MaybeFunctorsName = yes(enum_name_ordered_table)
- ;
- TypeCtorDetails = du(_, DuFunctors, DuByRep, DuByName),
- list__foldl2(output_du_functor_defn(RttiTypeCtor), DuFunctors,
- !DeclSet, !IO),
- output_du_ptag_ordered_table(RttiTypeCtor, DuByRep,
- !DeclSet, !IO),
- output_du_name_ordered_table(RttiTypeCtor, DuByName,
- !DeclSet, !IO),
- MaybeLayoutName = yes(du_ptag_ordered_table),
- MaybeFunctorsName = yes(du_name_ordered_table)
- ;
- TypeCtorDetails = reserved(_, MaybeResFunctors, ResFunctors,
- DuByRep, MaybeResByName),
- list__foldl2(output_maybe_res_functor_defn(RttiTypeCtor),
- MaybeResFunctors, !DeclSet, !IO),
- output_res_value_ordered_table(RttiTypeCtor, ResFunctors,
- DuByRep, !DeclSet, !IO),
- output_res_name_ordered_table(RttiTypeCtor, MaybeResByName,
- !DeclSet, !IO),
- MaybeLayoutName = yes(res_value_ordered_table),
- MaybeFunctorsName = yes(res_name_ordered_table)
- ;
- TypeCtorDetails = notag(_, NotagFunctor),
- output_notag_functor_defn(RttiTypeCtor, NotagFunctor,
- !DeclSet, !IO),
- MaybeLayoutName = yes(notag_functor_desc),
- MaybeFunctorsName = yes(notag_functor_desc)
- ;
- TypeCtorDetails = eqv(EqvType),
- output_maybe_pseudo_type_info_defn(EqvType, !DeclSet, !IO),
- TypeData = maybe_pseudo_type_info_to_rtti_data(EqvType),
- output_rtti_data_decls(TypeData, "", "", 0, _,
- !DeclSet, !IO),
- (
- EqvType = plain(TypeInfo),
- LayoutName = type_info(TypeInfo)
- ;
- EqvType = pseudo(PseudoTypeInfo),
- LayoutName = pseudo_type_info(PseudoTypeInfo)
- ),
- MaybeLayoutName = yes(LayoutName),
- MaybeFunctorsName = no
- ;
- TypeCtorDetails = builtin(_),
- MaybeLayoutName = no,
- MaybeFunctorsName = no
- ;
- TypeCtorDetails = impl_artifact(_),
- MaybeLayoutName = no,
- MaybeFunctorsName = no
- ;
- TypeCtorDetails = foreign(_),
- MaybeLayoutName = no,
- MaybeFunctorsName = no
- ).
+ MaybeFunctorsName, MaybeLayoutName, !DeclSet, !IO) :-
+ (
+ TypeCtorDetails = enum(_, EnumFunctors, EnumByRep, EnumByName),
+ list__foldl2(output_enum_functor_defn(RttiTypeCtor), EnumFunctors,
+ !DeclSet, !IO),
+ output_enum_value_ordered_table(RttiTypeCtor, EnumByRep,
+ !DeclSet, !IO),
+ output_enum_name_ordered_table(RttiTypeCtor, EnumByName,
+ !DeclSet, !IO),
+ MaybeLayoutName = yes(enum_value_ordered_table),
+ MaybeFunctorsName = yes(enum_name_ordered_table)
+ ;
+ TypeCtorDetails = du(_, DuFunctors, DuByRep, DuByName),
+ list__foldl2(output_du_functor_defn(RttiTypeCtor), DuFunctors,
+ !DeclSet, !IO),
+ output_du_ptag_ordered_table(RttiTypeCtor, DuByRep, !DeclSet, !IO),
+ output_du_name_ordered_table(RttiTypeCtor, DuByName, !DeclSet, !IO),
+ MaybeLayoutName = yes(du_ptag_ordered_table),
+ MaybeFunctorsName = yes(du_name_ordered_table)
+ ;
+ TypeCtorDetails = reserved(_, MaybeResFunctors, ResFunctors,
+ DuByRep, MaybeResByName),
+ list__foldl2(output_maybe_res_functor_defn(RttiTypeCtor),
+ MaybeResFunctors, !DeclSet, !IO),
+ output_res_value_ordered_table(RttiTypeCtor, ResFunctors, DuByRep,
+ !DeclSet, !IO),
+ output_res_name_ordered_table(RttiTypeCtor, MaybeResByName,
+ !DeclSet, !IO),
+ MaybeLayoutName = yes(res_value_ordered_table),
+ MaybeFunctorsName = yes(res_name_ordered_table)
+ ;
+ TypeCtorDetails = notag(_, NotagFunctor),
+ output_notag_functor_defn(RttiTypeCtor, NotagFunctor,
+ !DeclSet, !IO),
+ MaybeLayoutName = yes(notag_functor_desc),
+ MaybeFunctorsName = yes(notag_functor_desc)
+ ;
+ TypeCtorDetails = eqv(EqvType),
+ output_maybe_pseudo_type_info_defn(EqvType, !DeclSet, !IO),
+ TypeData = maybe_pseudo_type_info_to_rtti_data(EqvType),
+ output_rtti_data_decls(TypeData, "", "", 0, _, !DeclSet, !IO),
+ (
+ EqvType = plain(TypeInfo),
+ LayoutName = type_info(TypeInfo)
+ ;
+ EqvType = pseudo(PseudoTypeInfo),
+ LayoutName = pseudo_type_info(PseudoTypeInfo)
+ ),
+ MaybeLayoutName = yes(LayoutName),
+ MaybeFunctorsName = no
+ ;
+ TypeCtorDetails = builtin(_),
+ MaybeLayoutName = no,
+ MaybeFunctorsName = no
+ ;
+ TypeCtorDetails = impl_artifact(_),
+ MaybeLayoutName = no,
+ MaybeFunctorsName = no
+ ;
+ TypeCtorDetails = foreign(_),
+ MaybeLayoutName = no,
+ MaybeFunctorsName = no
+ ).
%-----------------------------------------------------------------------------%
:- pred output_enum_functor_defn(rtti_type_ctor::in, enum_functor::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_enum_functor_defn(RttiTypeCtor, EnumFunctor, !DeclSet, !IO) :-
- EnumFunctor = enum_functor(FunctorName, Ordinal),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, enum_functor_desc(Ordinal)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- c_util__output_quoted_string(FunctorName, !IO),
- io__write_string(""",\n\t", !IO),
- io__write_int(Ordinal, !IO),
- io__write_string("\n};\n", !IO).
+ EnumFunctor = enum_functor(FunctorName, Ordinal),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, enum_functor_desc(Ordinal)), !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ c_util__output_quoted_string(FunctorName, !IO),
+ io__write_string(""",\n\t", !IO),
+ io__write_int(Ordinal, !IO),
+ io__write_string("\n};\n", !IO).
:- pred output_notag_functor_defn(rtti_type_ctor::in, notag_functor::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_notag_functor_defn(RttiTypeCtor, NotagFunctor, !DeclSet, !IO) :-
- NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName),
- output_maybe_pseudo_type_info_defn(ArgType, !DeclSet, !IO),
- ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType),
- output_rtti_data_decls(ArgTypeData, "", "", 0, _, !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, notag_functor_desc),
- !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- c_util__output_quoted_string(FunctorName, !IO),
- io__write_string(""",\n\t", !IO),
- (
- ArgType = plain(ArgTypeInfo),
- output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
- type_info(ArgTypeInfo), !IO)
- ;
- ArgType = pseudo(ArgPseudoTypeInfo),
- % We need to cast the argument to MR_PseudoTypeInfo in case
- % it turns out to be a small integer, not a pointer.
- output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
- pseudo_type_info(ArgPseudoTypeInfo), !IO)
- ),
- io__write_string(",\n\t", !IO),
- (
- MaybeArgName = yes(ArgName),
- io__write_string("""", !IO),
- io__write_string(ArgName, !IO),
- io__write_string("""", !IO)
- ;
- MaybeArgName = no,
- io__write_string("NULL", !IO)
- ),
- io__write_string("\n};\n", !IO).
+ NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName),
+ output_maybe_pseudo_type_info_defn(ArgType, !DeclSet, !IO),
+ ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType),
+ output_rtti_data_decls(ArgTypeData, "", "", 0, _, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, notag_functor_desc), !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ c_util__output_quoted_string(FunctorName, !IO),
+ io__write_string(""",\n\t", !IO),
+ (
+ ArgType = plain(ArgTypeInfo),
+ output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
+ type_info(ArgTypeInfo), !IO)
+ ;
+ ArgType = pseudo(ArgPseudoTypeInfo),
+ % We need to cast the argument to MR_PseudoTypeInfo in case
+ % it turns out to be a small integer, not a pointer.
+ output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ",
+ pseudo_type_info(ArgPseudoTypeInfo), !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ (
+ MaybeArgName = yes(ArgName),
+ io__write_string("""", !IO),
+ io__write_string(ArgName, !IO),
+ io__write_string("""", !IO)
+ ;
+ MaybeArgName = no,
+ io__write_string("NULL", !IO)
+ ),
+ io__write_string("\n};\n", !IO).
:- pred output_du_functor_defn(rtti_type_ctor::in, du_functor::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_functor_defn(RttiTypeCtor, DuFunctor, !DeclSet, !IO) :-
- DuFunctor = du_functor(FunctorName, OrigArity, Ordinal, Rep,
- ArgInfos, MaybeExistInfo),
- ArgTypes = list__map(du_arg_info_type, ArgInfos),
- MaybeArgNames = list__map(du_arg_info_name, ArgInfos),
- ArgNames = list__filter_map(project_yes, MaybeArgNames),
- (
- ArgInfos = [_ | _],
- output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes,
- !DeclSet, !IO)
- ;
- ArgInfos = []
- ),
- (
- ArgNames = [_ | _],
- output_du_arg_names(RttiTypeCtor, Ordinal, MaybeArgNames,
- !DeclSet, !IO)
- ;
- ArgNames = []
- ),
- (
- MaybeExistInfo = yes(ExistInfo),
- output_exist_info(RttiTypeCtor, Ordinal, ExistInfo,
- !DeclSet, !IO)
- ;
- MaybeExistInfo = no
- ),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, du_functor_desc(Ordinal)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- c_util__output_quoted_string(FunctorName, !IO),
- io__write_string(""",\n\t", !IO),
- io__write_int(OrigArity, !IO),
- io__write_string(",\n\t", !IO),
- ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes),
- io__write_int(ContainsVarBitVector, !IO),
- io__write_string(",\n\t", !IO),
- (
- Rep = du_ll_rep(Ptag, SectagAndLocn)
- ;
- Rep = du_hl_rep(_),
- error("output_du_functor_defn: du_hl_rep")
- ),
- (
- SectagAndLocn = sectag_none,
- Locn = "MR_SECTAG_NONE",
- Stag = -1
- ;
- SectagAndLocn = sectag_local(Stag),
- Locn = "MR_SECTAG_LOCAL"
- ;
- SectagAndLocn = sectag_remote(Stag),
- Locn = "MR_SECTAG_REMOTE"
- ),
- io__write_string(Locn, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(Ptag, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(Stag, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(Ordinal, !IO),
- io__write_string(",\n\t", !IO),
- io__write_string("(MR_PseudoTypeInfo *) ", !IO), % cast away const
- (
- ArgInfos = [_ | _],
- output_addr_of_ctor_rtti_id(RttiTypeCtor, field_types(Ordinal),
- !IO)
- ;
- ArgInfos = [],
- io__write_string("NULL", !IO)
- ),
- io__write_string(",\n\t", !IO),
- (
- ArgNames = [_ | _],
- output_addr_of_ctor_rtti_id(RttiTypeCtor, field_names(Ordinal),
- !IO)
- ;
- ArgNames = [],
- io__write_string("NULL", !IO)
- ),
- io__write_string(",\n\t", !IO),
- (
- MaybeExistInfo = yes(_),
- output_addr_of_ctor_rtti_id(RttiTypeCtor, exist_info(Ordinal),
- !IO)
- ;
- MaybeExistInfo = no,
- io__write_string("NULL", !IO)
- ),
- io__write_string("\n};\n", !IO).
+ DuFunctor = du_functor(FunctorName, OrigArity, Ordinal, Rep,
+ ArgInfos, MaybeExistInfo),
+ ArgTypes = list__map(du_arg_info_type, ArgInfos),
+ MaybeArgNames = list__map(du_arg_info_name, ArgInfos),
+ ArgNames = list__filter_map(project_yes, MaybeArgNames),
+ (
+ ArgInfos = [_ | _],
+ output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes, !DeclSet, !IO)
+ ;
+ ArgInfos = []
+ ),
+ (
+ ArgNames = [_ | _],
+ output_du_arg_names(RttiTypeCtor, Ordinal, MaybeArgNames,
+ !DeclSet, !IO)
+ ;
+ ArgNames = []
+ ),
+ (
+ MaybeExistInfo = yes(ExistInfo),
+ output_exist_info(RttiTypeCtor, Ordinal, ExistInfo, !DeclSet, !IO)
+ ;
+ MaybeExistInfo = no
+ ),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, du_functor_desc(Ordinal)), !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ c_util__output_quoted_string(FunctorName, !IO),
+ io__write_string(""",\n\t", !IO),
+ io__write_int(OrigArity, !IO),
+ io__write_string(",\n\t", !IO),
+ ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes),
+ io__write_int(ContainsVarBitVector, !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ Rep = du_ll_rep(Ptag, SectagAndLocn)
+ ;
+ Rep = du_hl_rep(_),
+ error("output_du_functor_defn: du_hl_rep")
+ ),
+ (
+ SectagAndLocn = sectag_none,
+ Locn = "MR_SECTAG_NONE",
+ Stag = -1
+ ;
+ SectagAndLocn = sectag_local(Stag),
+ Locn = "MR_SECTAG_LOCAL"
+ ;
+ SectagAndLocn = sectag_remote(Stag),
+ Locn = "MR_SECTAG_REMOTE"
+ ),
+ io__write_string(Locn, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(Ptag, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(Stag, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(Ordinal, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string("(MR_PseudoTypeInfo *) ", !IO), % cast away const
+ (
+ ArgInfos = [_ | _],
+ output_addr_of_ctor_rtti_id(RttiTypeCtor, field_types(Ordinal), !IO)
+ ;
+ ArgInfos = [],
+ io__write_string("NULL", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ (
+ ArgNames = [_ | _],
+ output_addr_of_ctor_rtti_id(RttiTypeCtor, field_names(Ordinal), !IO)
+ ;
+ ArgNames = [],
+ io__write_string("NULL", !IO)
+ ),
+ io__write_string(",\n\t", !IO),
+ (
+ MaybeExistInfo = yes(_),
+ output_addr_of_ctor_rtti_id(RttiTypeCtor, exist_info(Ordinal), !IO)
+ ;
+ MaybeExistInfo = no,
+ io__write_string("NULL", !IO)
+ ),
+ io__write_string("\n};\n", !IO).
:- pred output_res_functor_defn(rtti_type_ctor::in, reserved_functor::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_res_functor_defn(RttiTypeCtor, ResFunctor, !DeclSet, !IO) :-
- ResFunctor = reserved_functor(FunctorName, Ordinal, Rep),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, res_functor_desc(Ordinal)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- c_util__output_quoted_string(FunctorName, !IO),
- io__write_string(""",\n\t", !IO),
- io__write_int(Ordinal, !IO),
- io__write_string(",\n\t", !IO),
- io__write_string("(void *) ", !IO),
- (
- Rep = null_pointer,
- io__write_string("NULL", !IO)
- ;
- Rep = small_pointer(SmallPtr),
- io__write_int(SmallPtr, !IO)
- ;
- Rep = reserved_object(_, _, _),
- error("output_res_functor_defn: reserved object")
- ),
- io__write_string("\n};\n", !IO).
+ ResFunctor = reserved_functor(FunctorName, Ordinal, Rep),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, res_functor_desc(Ordinal)), !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ c_util__output_quoted_string(FunctorName, !IO),
+ io__write_string(""",\n\t", !IO),
+ io__write_int(Ordinal, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string("(void *) ", !IO),
+ (
+ Rep = null_pointer,
+ io__write_string("NULL", !IO)
+ ;
+ Rep = small_pointer(SmallPtr),
+ io__write_int(SmallPtr, !IO)
+ ;
+ Rep = reserved_object(_, _, _),
+ error("output_res_functor_defn: reserved object")
+ ),
+ io__write_string("\n};\n", !IO).
:- pred output_maybe_res_functor_defn(rtti_type_ctor::in,
- maybe_reserved_functor::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ maybe_reserved_functor::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_maybe_res_functor_defn(RttiTypeCtor, MaybeResFunctor, !DeclSet, !IO) :-
- (
- MaybeResFunctor = res_func(ResFunctor),
- output_res_functor_defn(RttiTypeCtor, ResFunctor,
- !DeclSet, !IO)
- ;
- MaybeResFunctor = du_func(DuFunctor),
- output_du_functor_defn(RttiTypeCtor, DuFunctor,
- !DeclSet, !IO)
- ).
+ (
+ MaybeResFunctor = res_func(ResFunctor),
+ output_res_functor_defn(RttiTypeCtor, ResFunctor, !DeclSet, !IO)
+ ;
+ MaybeResFunctor = du_func(DuFunctor),
+ output_du_functor_defn(RttiTypeCtor, DuFunctor, !DeclSet, !IO)
+ ).
%-----------------------------------------------------------------------------%
:- pred output_exist_locns_array(rtti_type_ctor::in, int::in,
- list(exist_typeinfo_locn)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ list(exist_typeinfo_locn)::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_exist_locns_array(RttiTypeCtor, Ordinal, Locns, !DeclSet, !IO) :-
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, exist_locns(Ordinal)),
- !DeclSet, !IO),
- (
- % ANSI/ISO C doesn't allow empty arrays, so
- % place a dummy value in the array if necessary.
- Locns = []
- ->
- io__write_string("= { {0, 0} };\n", !IO)
- ;
- io__write_string(" = {\n", !IO),
- output_exist_locns(Locns, !IO),
- io__write_string("};\n", !IO)
- ).
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, exist_locns(Ordinal)), !DeclSet, !IO),
+ (
+ % ANSI/ISO C doesn't allow empty arrays, so
+ % place a dummy value in the array if necessary.
+ Locns = []
+ ->
+ io__write_string("= { {0, 0} };\n", !IO)
+ ;
+ io__write_string(" = {\n", !IO),
+ output_exist_locns(Locns, !IO),
+ io__write_string("};\n", !IO)
+ ).
:- pred make_exist_tc_constr_id(rtti_type_ctor::in, int::in,
- int::in, int::in, rtti_id::out) is det.
+ int::in, int::in, rtti_id::out) is det.
make_exist_tc_constr_id(RttiTypeCtor, Ordinal, TCNum, Arity, RttiId) :-
- RttiName = exist_tc_constr(Ordinal, TCNum, Arity),
- RttiId = ctor_rtti_id(RttiTypeCtor, RttiName).
+ RttiName = exist_tc_constr(Ordinal, TCNum, Arity),
+ RttiId = ctor_rtti_id(RttiTypeCtor, RttiName).
:- pred output_exist_constraints_data(rtti_type_ctor::in, int::in,
- list(tc_constraint)::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ list(tc_constraint)::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_exist_constraints_data(RttiTypeCtor, Ordinal, Constraints, !DeclSet,
- !IO) :-
- list__map_foldl3(output_type_class_constraint(
- make_exist_tc_constr_id(RttiTypeCtor, Ordinal)), Constraints,
- ConstraintIds, counter__init(1), _, !DeclSet, !IO),
- RttiId = ctor_rtti_id(RttiTypeCtor, exist_tc_constrs(Ordinal)),
- output_generic_rtti_data_defn_start(RttiId, !DeclSet, !IO),
- io__write_string(" = {\n\t", !IO),
- output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ",
- ConstraintIds, !IO),
- io__write_string("\n};\n", !IO).
+ !IO) :-
+ list__map_foldl3(output_type_class_constraint(
+ make_exist_tc_constr_id(RttiTypeCtor, Ordinal)), Constraints,
+ ConstraintIds, counter__init(1), _, !DeclSet, !IO),
+ RttiId = ctor_rtti_id(RttiTypeCtor, exist_tc_constrs(Ordinal)),
+ output_generic_rtti_data_defn_start(RttiId, !DeclSet, !IO),
+ io__write_string(" = {\n\t", !IO),
+ output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ", ConstraintIds,
+ !IO),
+ io__write_string("\n};\n", !IO).
:- pred output_exist_info(rtti_type_ctor::in, int::in, exist_info::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_exist_info(RttiTypeCtor, Ordinal, ExistInfo, !DeclSet, !IO) :-
- ExistInfo = exist_info(Plain, InTci, Constraints, Locns),
- output_exist_locns_array(RttiTypeCtor, Ordinal, Locns,
- !DeclSet, !IO),
- (
- Constraints = [_ | _],
- output_exist_constraints_data(RttiTypeCtor, Ordinal,
- Constraints, !DeclSet, !IO)
- ;
- Constraints = []
- ),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, exist_info(Ordinal)),
- !DeclSet, !IO),
- io__write_string(" = {\n\t", !IO),
- io__write_int(Plain, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(InTci, !IO),
- io__write_string(",\n\t", !IO),
- list__length(Constraints, Tci),
- io__write_int(Tci, !IO),
- io__write_string(",\n\t", !IO),
- output_ctor_rtti_id(RttiTypeCtor, exist_locns(Ordinal), !IO),
- io__write_string(",\n\t", !IO),
- (
- Constraints = [_ | _],
- output_ctor_rtti_id(RttiTypeCtor, exist_tc_constrs(Ordinal),
- !IO)
- ;
- Constraints = []
- ),
- io__write_string("\n};\n", !IO).
+ ExistInfo = exist_info(Plain, InTci, Constraints, Locns),
+ output_exist_locns_array(RttiTypeCtor, Ordinal, Locns,
+ !DeclSet, !IO),
+ (
+ Constraints = [_ | _],
+ output_exist_constraints_data(RttiTypeCtor, Ordinal, Constraints,
+ !DeclSet, !IO)
+ ;
+ Constraints = []
+ ),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, exist_info(Ordinal)), !DeclSet, !IO),
+ io__write_string(" = {\n\t", !IO),
+ io__write_int(Plain, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(InTci, !IO),
+ io__write_string(",\n\t", !IO),
+ list__length(Constraints, Tci),
+ io__write_int(Tci, !IO),
+ io__write_string(",\n\t", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, exist_locns(Ordinal), !IO),
+ io__write_string(",\n\t", !IO),
+ (
+ Constraints = [_ | _],
+ output_ctor_rtti_id(RttiTypeCtor, exist_tc_constrs(Ordinal), !IO)
+ ;
+ Constraints = []
+ ),
+ io__write_string("\n};\n", !IO).
:- pred output_du_arg_types(rtti_type_ctor::in, int::in,
- list(rtti_maybe_pseudo_type_info_or_self)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ list(rtti_maybe_pseudo_type_info_or_self)::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes, !DeclSet, !IO) :-
- list__foldl2(output_maybe_pseudo_type_info_or_self_defn, ArgTypes,
- !DeclSet, !IO),
- ArgTypeDatas = list__map(maybe_pseudo_type_info_or_self_to_rtti_data,
- ArgTypes),
- output_rtti_datas_decls(ArgTypeDatas, "", "", 0, _,
- !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, field_types(Ordinal)),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- require(list__is_not_empty(ArgTypes),
- "output_du_arg_types: empty list"),
- output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ",
- ArgTypeDatas, !IO),
- io__write_string("};\n", !IO).
+ list__foldl2(output_maybe_pseudo_type_info_or_self_defn, ArgTypes,
+ !DeclSet, !IO),
+ ArgTypeDatas = list__map(maybe_pseudo_type_info_or_self_to_rtti_data,
+ ArgTypes),
+ output_rtti_datas_decls(ArgTypeDatas, "", "", 0, _, !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, field_types(Ordinal)), !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ require(list__is_not_empty(ArgTypes), "output_du_arg_types: empty list"),
+ output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgTypeDatas, !IO),
+ io__write_string("};\n", !IO).
:- pred output_du_arg_names(rtti_type_ctor::in, int::in,
- list(maybe(string))::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ list(maybe(string))::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_du_arg_names(RttiTypeCtor, Ordinal, MaybeNames, !DeclSet, !IO) :-
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, field_names(Ordinal)),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- require(list__is_not_empty(MaybeNames),
- "output_du_arg_names: empty list"),
- output_maybe_quoted_strings(MaybeNames, !IO),
- io__write_string("};\n", !IO).
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, field_names(Ordinal)), !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ require(list__is_not_empty(MaybeNames), "output_du_arg_names: empty list"),
+ output_maybe_quoted_strings(MaybeNames, !IO),
+ io__write_string("};\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_enum_value_ordered_table(rtti_type_ctor::in,
- map(int, enum_functor)::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ map(int, enum_functor)::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_enum_value_ordered_table(RttiTypeCtor, FunctorMap, !DeclSet, !IO) :-
- Functors = map__values(FunctorMap),
- FunctorRttiNames = list__map(enum_functor_rtti_name, Functors),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, enum_value_ordered_table),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
- io__write_string("};\n", !IO).
+ Functors = map__values(FunctorMap),
+ FunctorRttiNames = list__map(enum_functor_rtti_name, Functors),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, enum_value_ordered_table), !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
+ io__write_string("};\n", !IO).
:- pred output_enum_name_ordered_table(rtti_type_ctor::in,
- map(string, enum_functor)::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ map(string, enum_functor)::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_enum_name_ordered_table(RttiTypeCtor, FunctorMap, !DeclSet, !IO) :-
- Functors = map__values(FunctorMap),
- FunctorRttiNames = list__map(enum_functor_rtti_name, Functors),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, enum_name_ordered_table),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
- io__write_string("};\n", !IO).
+ Functors = map__values(FunctorMap),
+ FunctorRttiNames = list__map(enum_functor_rtti_name, Functors),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, enum_name_ordered_table), !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
+ io__write_string("};\n", !IO).
:- pred output_du_name_ordered_table(rtti_type_ctor::in,
- map(string, map(int, du_functor))::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ map(string, map(int, du_functor))::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_du_name_ordered_table(RttiTypeCtor, NameArityMap, !DeclSet, !IO) :-
- map__values(NameArityMap, ArityMaps),
- list__map(map__values, ArityMaps, FunctorLists),
- list__condense(FunctorLists, Functors),
- FunctorRttiNames = list__map(du_functor_rtti_name, Functors),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, du_name_ordered_table),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
- io__write_string("};\n", !IO).
+ map__values(NameArityMap, ArityMaps),
+ list__map(map__values, ArityMaps, FunctorLists),
+ list__condense(FunctorLists, Functors),
+ FunctorRttiNames = list__map(du_functor_rtti_name, Functors),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, du_name_ordered_table),
+ !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO),
+ io__write_string("};\n", !IO).
:- pred output_du_stag_ordered_table(rtti_type_ctor::in,
- pair(int, sectag_table)::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ pair(int, sectag_table)::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_du_stag_ordered_table(RttiTypeCtor, Ptag - SectagTable, !DeclSet,
- !IO) :-
- SectagTable = sectag_table(_SectagLocn, _NumSharers, SectagMap),
- map__values(SectagMap, SectagFunctors),
- FunctorNames = list__map(du_functor_rtti_name, SectagFunctors),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, du_stag_ordered_table(Ptag)),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorNames, !IO),
- io__write_string("\n};\n", !IO).
+ !IO) :-
+ SectagTable = sectag_table(_SectagLocn, _NumSharers, SectagMap),
+ map__values(SectagMap, SectagFunctors),
+ FunctorNames = list__map(du_functor_rtti_name, SectagFunctors),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, du_stag_ordered_table(Ptag)),
+ !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorNames, !IO),
+ io__write_string("\n};\n", !IO).
:- pred output_du_ptag_ordered_table(rtti_type_ctor::in,
- map(int, sectag_table)::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ map(int, sectag_table)::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_du_ptag_ordered_table(RttiTypeCtor, PtagMap, !DeclSet, !IO) :-
- map__to_assoc_list(PtagMap, PtagList),
- list__foldl2(output_du_stag_ordered_table(RttiTypeCtor), PtagList,
- !DeclSet, !IO),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, du_ptag_ordered_table),
- !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- ( PtagList = [1 - _ | _] ->
- % Output a dummy ptag definition for the
- % reserved tag first.
- output_dummy_ptag_layout_defn(!IO),
- FirstPtag = 1
- ; PtagList = [0 - _ | _] ->
- FirstPtag = 0
- ;
- error("output_dummy_ptag_layout_defn: bad ptag list")
- ),
- output_du_ptag_ordered_table_body(RttiTypeCtor, PtagList, FirstPtag,
- !IO),
- io__write_string("\n};\n", !IO).
+ map__to_assoc_list(PtagMap, PtagList),
+ list__foldl2(output_du_stag_ordered_table(RttiTypeCtor), PtagList,
+ !DeclSet, !IO),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, du_ptag_ordered_table), !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ ( PtagList = [1 - _ | _] ->
+ % Output a dummy ptag definition for the reserved tag first.
+ output_dummy_ptag_layout_defn(!IO),
+ FirstPtag = 1
+ ; PtagList = [0 - _ | _] ->
+ FirstPtag = 0
+ ;
+ error("output_dummy_ptag_layout_defn: bad ptag list")
+ ),
+ output_du_ptag_ordered_table_body(RttiTypeCtor, PtagList, FirstPtag, !IO),
+ io__write_string("\n};\n", !IO).
:- pred output_du_ptag_ordered_table_body(rtti_type_ctor::in,
- assoc_list(int, sectag_table)::in, int::in, io::di, io::uo) is det.
+ assoc_list(int, sectag_table)::in, int::in, io::di, io::uo) is det.
output_du_ptag_ordered_table_body(_RttiTypeCtor, [], _CurPtag, !IO).
output_du_ptag_ordered_table_body(RttiTypeCtor,
- [Ptag - SectagTable | PtagTail], CurPtag, !IO) :-
- require(unify(Ptag, CurPtag),
- "output_du_ptag_ordered_table_body: ptag mismatch"),
- SectagTable = sectag_table(SectagLocn, NumSharers, _SectagMap),
- io__write_string("\t{ ", !IO),
- io__write_int(NumSharers, !IO),
- io__write_string(", ", !IO),
- rtti__sectag_locn_to_string(SectagLocn, LocnStr),
- io__write_string(LocnStr, !IO),
- io__write_string(",\n\t", !IO),
- output_ctor_rtti_id(RttiTypeCtor, du_stag_ordered_table(Ptag), !IO),
- ( PtagTail = [] ->
- io__write_string(" }\n", !IO)
- ;
- io__write_string(" },\n", !IO),
- output_du_ptag_ordered_table_body(RttiTypeCtor, PtagTail,
- CurPtag + 1, !IO)
- ).
-
- % Output a `dummy' ptag layout, for use by tags that aren't *real*
- % tags, such as the tag reserved when --reserve-tag is on.
- %
- % XXX Note that if one of these dummy ptag definitions is actually
- % accessed by the Mercury runtime, the result will be undefined.
- % This should be fixed by adding a MR_SECTAG_DUMMY and handling it
- % gracefully.
+ [Ptag - SectagTable | PtagTail], CurPtag, !IO) :-
+ require(unify(Ptag, CurPtag),
+ "output_du_ptag_ordered_table_body: ptag mismatch"),
+ SectagTable = sectag_table(SectagLocn, NumSharers, _SectagMap),
+ io__write_string("\t{ ", !IO),
+ io__write_int(NumSharers, !IO),
+ io__write_string(", ", !IO),
+ rtti__sectag_locn_to_string(SectagLocn, LocnStr),
+ io__write_string(LocnStr, !IO),
+ io__write_string(",\n\t", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, du_stag_ordered_table(Ptag), !IO),
+ (
+ PtagTail = [],
+ io__write_string(" }\n", !IO)
+ ;
+ PtagTail = [_ | _],
+ io__write_string(" },\n", !IO),
+ output_du_ptag_ordered_table_body(RttiTypeCtor, PtagTail,
+ CurPtag + 1, !IO)
+ ).
+
+ % Output a `dummy' ptag layout, for use by tags that aren't *real* tags,
+ % such as the tag reserved when --reserve-tag is on.
+ %
+ % XXX Note that if one of these dummy ptag definitions is actually accessed
+ % by the Mercury runtime, the result will be undefined. This should be
+ % fixed by adding a MR_SECTAG_DUMMY and handling it gracefully.
+ %
:- pred output_dummy_ptag_layout_defn(io::di, io::uo) is det.
output_dummy_ptag_layout_defn(!IO) :-
- io__write_string("\t{ 0, MR_SECTAG_VARIABLE, NULL },\n", !IO).
+ io__write_string("\t{ 0, MR_SECTAG_VARIABLE, NULL },\n", !IO).
:- pred output_res_addr_functors(rtti_type_ctor::in,
- reserved_functor::in, io::di, io::uo) is det.
+ reserved_functor::in, io::di, io::uo) is det.
output_res_addr_functors(RttiTypeCtor, ResFunctor, !IO) :-
- output_ctor_rtti_id(RttiTypeCtor, res_functor_rtti_name(ResFunctor),
- !IO),
- io__write_string(",\n", !IO).
+ output_ctor_rtti_id(RttiTypeCtor, res_functor_rtti_name(ResFunctor), !IO),
+ io__write_string(",\n", !IO).
:- pred output_res_value_ordered_table(rtti_type_ctor::in,
- list(reserved_functor)::in, map(int, sectag_table)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ list(reserved_functor)::in, map(int, sectag_table)::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_res_value_ordered_table(RttiTypeCtor, ResFunctors, DuPtagTable,
- !DeclSet, !IO) :-
- ResFunctorReps = list__map(res_addr_rep, ResFunctors),
- list__filter(res_addr_is_numeric, ResFunctorReps,
- NumericResFunctorReps, SymbolicResFunctorReps),
- list__length(NumericResFunctorReps, NumNumericResFunctorReps),
- list__length(SymbolicResFunctorReps, NumSymbolicResFunctorReps),
- require(unify(NumSymbolicResFunctorReps, 0),
- "output_res_value_ordered_table: symbolic functors"),
-
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, res_addr_functors), !DeclSet, !IO),
- io__write_string(" = {\n", !IO),
- list__foldl(output_res_addr_functors(RttiTypeCtor), ResFunctors, !IO),
- io__write_string("};\n", !IO),
-
- output_du_ptag_ordered_table(RttiTypeCtor, DuPtagTable, !DeclSet, !IO),
-
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, res_value_ordered_table),
- !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- io__write_int(NumNumericResFunctorReps, !IO),
- io__write_string(",\n\t", !IO),
- io__write_int(NumSymbolicResFunctorReps, !IO),
- io__write_string(",\n\t", !IO),
- io__write_string("NULL", !IO),
- io__write_string(",\n\t", !IO),
- output_ctor_rtti_id(RttiTypeCtor, res_addr_functors, !IO),
- io__write_string(",\n\t", !IO),
- output_ctor_rtti_id(RttiTypeCtor, du_ptag_ordered_table, !IO),
- io__write_string("\n};\n", !IO).
+ !DeclSet, !IO) :-
+ ResFunctorReps = list__map(res_addr_rep, ResFunctors),
+ list__filter(res_addr_is_numeric, ResFunctorReps,
+ NumericResFunctorReps, SymbolicResFunctorReps),
+ list__length(NumericResFunctorReps, NumNumericResFunctorReps),
+ list__length(SymbolicResFunctorReps, NumSymbolicResFunctorReps),
+ require(unify(NumSymbolicResFunctorReps, 0),
+ "output_res_value_ordered_table: symbolic functors"),
+
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, res_addr_functors), !DeclSet, !IO),
+ io__write_string(" = {\n", !IO),
+ list__foldl(output_res_addr_functors(RttiTypeCtor), ResFunctors, !IO),
+ io__write_string("};\n", !IO),
+
+ output_du_ptag_ordered_table(RttiTypeCtor, DuPtagTable, !DeclSet, !IO),
+
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, res_value_ordered_table), !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ io__write_int(NumNumericResFunctorReps, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_int(NumSymbolicResFunctorReps, !IO),
+ io__write_string(",\n\t", !IO),
+ io__write_string("NULL", !IO),
+ io__write_string(",\n\t", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, res_addr_functors, !IO),
+ io__write_string(",\n\t", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, du_ptag_ordered_table, !IO),
+ io__write_string("\n};\n", !IO).
:- pred output_res_name_ordered_table(rtti_type_ctor::in,
- map(string, map(int, maybe_reserved_functor))::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ map(string, map(int, maybe_reserved_functor))::in,
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_res_name_ordered_table(RttiTypeCtor, NameArityMap, !DeclSet, !IO) :-
- map__values(NameArityMap, ArityMaps),
- list__map(map__values, ArityMaps, FunctorLists),
- list__condense(FunctorLists, Functors),
- output_generic_rtti_data_defn_start(
- ctor_rtti_id(RttiTypeCtor, res_name_ordered_table),
- !DeclSet, !IO),
- io__write_string(" = {\n\t""", !IO),
- list__foldl(output_res_name_ordered_table_element(RttiTypeCtor),
- Functors, !IO),
- io__write_string("\n};\n", !IO).
+ map__values(NameArityMap, ArityMaps),
+ list__map(map__values, ArityMaps, FunctorLists),
+ list__condense(FunctorLists, Functors),
+ output_generic_rtti_data_defn_start(
+ ctor_rtti_id(RttiTypeCtor, res_name_ordered_table), !DeclSet, !IO),
+ io__write_string(" = {\n\t""", !IO),
+ list__foldl(output_res_name_ordered_table_element(RttiTypeCtor), Functors,
+ !IO),
+ io__write_string("\n};\n", !IO).
:- pred output_res_name_ordered_table_element(rtti_type_ctor::in,
- maybe_reserved_functor::in, io::di, io::uo) is det.
+ maybe_reserved_functor::in, io::di, io::uo) is det.
output_res_name_ordered_table_element(RttiTypeCtor, MaybeResFunctor, !IO) :-
- io__write_string("\t{ """, !IO),
- (
- MaybeResFunctor = res_func(ResFunctor),
- Name = ResFunctor ^ res_name,
- io__write_string(Name, !IO),
- io__write_string(""", ", !IO),
- io__write_string("0, ", !IO),
- io__write_string("MR_TRUE, ", !IO)
- ;
- MaybeResFunctor = du_func(DuFunctor),
- Name = DuFunctor ^ du_name,
- Arity = DuFunctor ^ du_orig_arity,
- io__write_string(Name, !IO),
- io__write_string(""", ", !IO),
- io__write_int(Arity, !IO),
- io__write_string(", ", !IO),
- io__write_string("MR_FALSE, ", !IO)
- ),
- RttiName = maybe_res_functor_rtti_name(MaybeResFunctor),
- output_ctor_rtti_id(RttiTypeCtor, RttiName, !IO),
- io__write_string(" },\n", !IO).
+ io__write_string("\t{ """, !IO),
+ (
+ MaybeResFunctor = res_func(ResFunctor),
+ Name = ResFunctor ^ res_name,
+ io__write_string(Name, !IO),
+ io__write_string(""", ", !IO),
+ io__write_string("0, ", !IO),
+ io__write_string("MR_TRUE, ", !IO)
+ ;
+ MaybeResFunctor = du_func(DuFunctor),
+ Name = DuFunctor ^ du_name,
+ Arity = DuFunctor ^ du_orig_arity,
+ io__write_string(Name, !IO),
+ io__write_string(""", ", !IO),
+ io__write_int(Arity, !IO),
+ io__write_string(", ", !IO),
+ io__write_string("MR_FALSE, ", !IO)
+ ),
+ RttiName = maybe_res_functor_rtti_name(MaybeResFunctor),
+ output_ctor_rtti_id(RttiTypeCtor, RttiName, !IO),
+ io__write_string(" },\n", !IO).
%-----------------------------------------------------------------------------%
:- func make_code_addr(rtti_proc_label) = code_addr.
make_code_addr(ProcLabel) = CodeAddr :-
- code_util__make_entry_label_from_rtti(ProcLabel, no, CodeAddr).
+ code_util__make_entry_label_from_rtti(ProcLabel, no, CodeAddr).
:- pred output_reserved_address(reserved_address::in, io::di, io::uo) is det.
output_reserved_address(null_pointer, !IO) :-
- io__write_string("NULL", !IO).
+ io__write_string("NULL", !IO).
output_reserved_address(small_pointer(Val), !IO) :-
- io__write_string("(const void *) ", !IO),
- io__write_int(Val, !IO).
+ io__write_string("(const void *) ", !IO),
+ io__write_int(Val, !IO).
output_reserved_address(reserved_object(_, _, _), !IO) :-
- % These should only be used for the MLDS back-end
- unexpected(this_file, "reserved_object").
+ % These should only be used for the MLDS back-end.
+ unexpected(this_file, "reserved_object").
%-----------------------------------------------------------------------------%
-:- type data_group --->
- data_group(
- data_c_type :: string,
- data_is_array :: bool,
- data_linkage :: linkage
- ).
+:- type data_group
+ ---> data_group(
+ data_c_type :: string,
+ data_is_array :: bool,
+ data_linkage :: linkage
+ ).
output_rtti_data_decl_list(RttiDatas, !DeclSet, !IO) :-
- classify_rtti_datas_to_decl(RttiDatas, multi_map__init, GroupMap),
- multi_map__to_assoc_list(GroupMap, GroupList),
- list__foldl2(output_rtti_data_decl_group, GroupList, !DeclSet, !IO).
+ classify_rtti_datas_to_decl(RttiDatas, multi_map__init, GroupMap),
+ multi_map__to_assoc_list(GroupMap, GroupList),
+ list__foldl2(output_rtti_data_decl_group, GroupList, !DeclSet, !IO).
:- pred classify_rtti_datas_to_decl(list(rtti_data)::in,
- multi_map(data_group, rtti_id)::in,
- multi_map(data_group, rtti_id)::out) is det.
+ multi_map(data_group, rtti_id)::in,
+ multi_map(data_group, rtti_id)::out) is det.
classify_rtti_datas_to_decl([], !GroupMap).
classify_rtti_datas_to_decl([RttiData | RttiDatas], !GroupMap) :-
- ( RttiData = pseudo_type_info(type_var(_)) ->
- % These just get represented as integers,
- % so we don't need to declare them.
- % Also rtti_data_to_name/3 does not handle this case.
- true
- ;
- rtti_data_to_id(RttiData, RttiId),
- rtti_id_c_type(RttiId, CType, IsArray),
- rtti_id_linkage(RttiId, Linkage),
- Group = data_group(CType, IsArray, Linkage),
- multi_map__set(!.GroupMap, Group, RttiId, !:GroupMap)
- ),
- classify_rtti_datas_to_decl(RttiDatas, !GroupMap).
+ ( RttiData = pseudo_type_info(type_var(_)) ->
+ % These just get represented as integers, so we don't need to declare
+ % them. Also rtti_data_to_name/3 does not handle this case.
+ true
+ ;
+ rtti_data_to_id(RttiData, RttiId),
+ rtti_id_c_type(RttiId, CType, IsArray),
+ rtti_id_linkage(RttiId, Linkage),
+ Group = data_group(CType, IsArray, Linkage),
+ multi_map__set(!.GroupMap, Group, RttiId, !:GroupMap)
+ ),
+ classify_rtti_datas_to_decl(RttiDatas, !GroupMap).
:- pred output_rtti_data_decl_group(pair(data_group, list(rtti_id))::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_group(Group - RttiIds, !DeclSet, !IO) :-
- % ChunkSize should be as large as possible to reduce the size of the
- % file being generated, but small enough not to overload the fixed
- % limits of our target C compilers.
- ChunkSize = 10,
- % The process of creating the multi_map reverses the order of rtti_ids,
- % we now undo this reversal.
- list__chunk(list__reverse(RttiIds), ChunkSize, RttiIdChunks),
- list__foldl2(output_rtti_data_decl_chunk(Group), RttiIdChunks,
- !DeclSet, !IO).
+ % ChunkSize should be as large as possible to reduce the size of the
+ % file being generated, but small enough not to overload the fixed
+ % limits of our target C compilers.
+ ChunkSize = 10,
+ % The process of creating the multi_map reverses the order of rtti_ids,
+ % we now undo this reversal.
+ list__chunk(list__reverse(RttiIds), ChunkSize, RttiIdChunks),
+ list__foldl2(output_rtti_data_decl_chunk(Group), RttiIdChunks,
+ !DeclSet, !IO).
:- pred output_rtti_data_decl_chunk(data_group::in, list(rtti_id)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_chunk(Group, RttiIds, !DeclSet, !IO) :-
- (
- % Pick a representative RttiId. All the operations we perform
- % on it below would have the same result regardless of which
- % one we picked.
- RttiIds = [RttiId | _]
- ;
- RttiIds = [],
- error("output_rtti_data_decl_group: empty list")
- ),
- Group = data_group(CType, IsArray, Linkage),
-
- io__nl(!IO),
- output_rtti_type_decl(RttiId, !DeclSet, !IO),
- globals__io_get_globals(Globals, !IO),
- LinkageStr = c_data_linkage_string(Globals, Linkage, yes, no),
- InclCodeAddr = rtti_id_would_include_code_addr(RttiId),
- c_data_const_string(Globals, InclCodeAddr, ConstStr),
-
- io__write_string(LinkageStr, !IO),
- io__write_string(ConstStr, !IO),
- c_util__output_quoted_string(CType, !IO),
- io__nl(!IO),
+ (
+ % Pick a representative RttiId. All the operations we perform on it
+ % below would have the same result regardless of which one we picked.
+ RttiIds = [RttiId | _]
+ ;
+ RttiIds = [],
+ error("output_rtti_data_decl_group: empty list")
+ ),
+ Group = data_group(CType, IsArray, Linkage),
+
+ io__nl(!IO),
+ output_rtti_type_decl(RttiId, !DeclSet, !IO),
+ globals__io_get_globals(Globals, !IO),
+ LinkageStr = c_data_linkage_string(Globals, Linkage, yes, no),
+ InclCodeAddr = rtti_id_would_include_code_addr(RttiId),
+
+ io__write_string(LinkageStr, !IO),
+ io__write_string(c_data_const_string(Globals, InclCodeAddr), !IO),
+ c_util__output_quoted_string(CType, !IO),
+ io__nl(!IO),
- output_rtti_data_decl_chunk_entries(IsArray, RttiIds,
- !DeclSet, !IO).
+ output_rtti_data_decl_chunk_entries(IsArray, RttiIds, !DeclSet, !IO).
:- pred output_rtti_data_decl_chunk_entries(bool::in, list(rtti_id)::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_rtti_data_decl_chunk_entries(_IsArray, [], !DeclSet, !IO) :-
- error("output_rtti_data_decl_chunk_entries: empty list").
+ error("output_rtti_data_decl_chunk_entries: empty list").
output_rtti_data_decl_chunk_entries(IsArray, [RttiId | RttiIds],
- !DeclSet, !IO) :-
- DataAddr = rtti_addr(RttiId),
- decl_set_insert(data_addr(DataAddr), !DeclSet),
- io__write_string("\t", !IO),
- output_rtti_id(RttiId, !IO),
- (
- IsArray = yes,
- io__write_string("[]", !IO)
- ;
- IsArray = no
- ),
- (
- RttiIds = [_ | _],
- io__write_string(",\n", !IO),
- output_rtti_data_decl_chunk_entries(IsArray, RttiIds,
- !DeclSet, !IO)
- ;
- RttiIds = [],
- io__write_string(";\n", !IO)
- ).
+ !DeclSet, !IO) :-
+ DataAddr = rtti_addr(RttiId),
+ decl_set_insert(data_addr(DataAddr), !DeclSet),
+ io__write_string("\t", !IO),
+ output_rtti_id(RttiId, !IO),
+ (
+ IsArray = yes,
+ io__write_string("[]", !IO)
+ ;
+ IsArray = no
+ ),
+ (
+ RttiIds = [_ | _],
+ io__write_string(",\n", !IO),
+ output_rtti_data_decl_chunk_entries(IsArray, RttiIds, !DeclSet, !IO)
+ ;
+ RttiIds = [],
+ io__write_string(";\n", !IO)
+ ).
%-----------------------------------------------------------------------------%
output_rtti_data_decl(RttiData, !DeclSet, !IO) :-
- ( RttiData = pseudo_type_info(type_var(_)) ->
- % These just get represented as integers,
- % so we don't need to declare them.
- % Also rtti_data_to_name/3 does not handle this case.
- true
- ;
- rtti_data_to_id(RttiData, RttiId),
- output_generic_rtti_data_decl(RttiId, !DeclSet, !IO)
- ).
+ ( RttiData = pseudo_type_info(type_var(_)) ->
+ % These just get represented as integers, so we don't need to declare
+ % them. Also rtti_data_to_name/3 does not handle this case.
+ true
+ ;
+ rtti_data_to_id(RttiData, RttiId),
+ output_generic_rtti_data_decl(RttiId, !DeclSet, !IO)
+ ).
%-----------------------------------------------------------------------------%
:- pred output_generic_rtti_data_decl(rtti_id::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_generic_rtti_data_decl(RttiId, !DeclSet, !IO) :-
- output_rtti_id_storage_type_name(RttiId, no, !DeclSet, !IO),
- io__write_string(";\n", !IO),
- DataAddr = rtti_addr(RttiId),
- decl_set_insert(data_addr(DataAddr), !DeclSet).
+ output_rtti_id_storage_type_name(RttiId, no, !DeclSet, !IO),
+ io__write_string(";\n", !IO),
+ DataAddr = rtti_addr(RttiId),
+ decl_set_insert(data_addr(DataAddr), !DeclSet).
:- pred output_generic_rtti_data_defn_start(rtti_id::in,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ decl_set::in, decl_set::out, io::di, io::uo) is det.
output_generic_rtti_data_defn_start(RttiId, !DeclSet, !IO) :-
- io__write_string("\n", !IO),
- output_rtti_id_storage_type_name(RttiId, yes, !DeclSet, !IO),
- DataAddr = rtti_addr(RttiId),
- decl_set_insert(data_addr(DataAddr), !DeclSet).
+ io__write_string("\n", !IO),
+ output_rtti_id_storage_type_name(RttiId, yes, !DeclSet, !IO),
+ DataAddr = rtti_addr(RttiId),
+ decl_set_insert(data_addr(DataAddr), !DeclSet).
output_rtti_id_storage_type_name_no_decl(RttiId, BeingDefined, !IO) :-
- decl_set_init(DeclSet0),
- output_rtti_id_storage_type_name(RttiId, BeingDefined, DeclSet0, _,
- !IO).
+ decl_set_init(DeclSet0),
+ output_rtti_id_storage_type_name(RttiId, BeingDefined, DeclSet0, _, !IO).
output_rtti_id_storage_type_name(RttiId, BeingDefined, !DeclSet, !IO) :-
- output_rtti_type_decl(RttiId, !DeclSet, !IO),
- rtti_id_linkage(RttiId, Linkage),
- globals__io_get_globals(Globals, !IO),
- LinkageStr = c_data_linkage_string(Globals, Linkage, yes,
- BeingDefined),
- io__write_string(LinkageStr, !IO),
-
- InclCodeAddr = rtti_id_would_include_code_addr(RttiId),
- c_data_const_string(Globals, InclCodeAddr, ConstStr),
- io__write_string(ConstStr, !IO),
-
- rtti_id_c_type(RttiId, CType, IsArray),
- c_util__output_quoted_string(CType, !IO),
- io__write_string(" ", !IO),
- output_rtti_id(RttiId, !IO),
- (
- IsArray = yes,
- io__write_string("[]", !IO)
- ;
- IsArray = no
- ).
-
- % Each type_info and pseudo_type_info may have a different C type,
- % depending on what kind of type_info or pseudo_type_info it is,
- % and also on its arity. We need to declare that C type here.
-
+ output_rtti_type_decl(RttiId, !DeclSet, !IO),
+ rtti_id_linkage(RttiId, Linkage),
+ globals__io_get_globals(Globals, !IO),
+ LinkageStr = c_data_linkage_string(Globals, Linkage, yes, BeingDefined),
+ io__write_string(LinkageStr, !IO),
+
+ InclCodeAddr = rtti_id_would_include_code_addr(RttiId),
+ io__write_string(c_data_const_string(Globals, InclCodeAddr), !IO),
+
+ rtti_id_c_type(RttiId, CType, IsArray),
+ c_util__output_quoted_string(CType, !IO),
+ io__write_string(" ", !IO),
+ output_rtti_id(RttiId, !IO),
+ (
+ IsArray = yes,
+ io__write_string("[]", !IO)
+ ;
+ IsArray = no
+ ).
+
+ % Each type_info and pseudo_type_info may have a different C type,
+ % depending on what kind of type_info or pseudo_type_info it is,
+ % and also on its arity. We need to declare that C type here.
+ %
:- pred output_rtti_type_decl(rtti_id::in, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_rtti_type_decl(RttiId, !DeclSet, !IO) :-
- (
- RttiId = ctor_rtti_id(_, RttiName),
- rtti_type_ctor_template_arity(RttiName, Arity),
- Arity > max_always_declared_arity_type_ctor
- ->
- DeclId = type_info_like_struct(Arity),
- ( decl_set_is_member(DeclId, !.DeclSet) ->
- true
- ;
- Template =
+ (
+ RttiId = ctor_rtti_id(_, RttiName),
+ rtti_type_ctor_template_arity(RttiName, Arity),
+ Arity > max_always_declared_arity_type_ctor
+ ->
+ DeclId = type_info_like_struct(Arity),
+ ( decl_set_is_member(DeclId, !.DeclSet) ->
+ true
+ ;
+ Template =
"#ifndef MR_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY_%d_GUARD
#define MR_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY_%d_GUARD
MR_DECLARE_ALL_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY(%d);
#endif
",
- io__format(Template, [i(Arity), i(Arity), i(Arity)],
- !IO),
- decl_set_insert(DeclId, !DeclSet)
- )
- ;
- RttiId = tc_rtti_id(_, TCRttiName),
- rtti_type_class_constraint_template_arity(TCRttiName, Arity),
- Arity > max_always_declared_arity_type_class_constraint
- ->
- DeclId = typeclass_constraint_struct(Arity),
- ( decl_set_is_member(DeclId, !.DeclSet) ->
- true
- ;
- Template =
+ io__format(Template, [i(Arity), i(Arity), i(Arity)], !IO),
+ decl_set_insert(DeclId, !DeclSet)
+ )
+ ;
+ RttiId = tc_rtti_id(_, TCRttiName),
+ rtti_type_class_constraint_template_arity(TCRttiName, Arity),
+ Arity > max_always_declared_arity_type_class_constraint
+ ->
+ DeclId = typeclass_constraint_struct(Arity),
+ ( decl_set_is_member(DeclId, !.DeclSet) ->
+ true
+ ;
+ Template =
"#ifndef MR_TYPECLASS_CONSTRAINT_STRUCT_%d_GUARD
#define MR_TYPECLASS_CONSTRAINT_STRUCT_%d_GUARD
MR_DEFINE_TYPECLASS_CONSTRAINT_STRUCT(MR_TypeClassConstraint_%d, %d);
#endif
",
- io__format(Template, [i(Arity), i(Arity), i(Arity),
- i(Arity)], !IO),
- decl_set_insert(DeclId, !DeclSet)
- )
- ;
- true
- ).
+ io__format(Template, [i(Arity), i(Arity), i(Arity), i(Arity)],
+ !IO),
+ decl_set_insert(DeclId, !DeclSet)
+ )
+ ;
+ true
+ ).
:- pred rtti_type_ctor_template_arity(ctor_rtti_name::in, int::out) is semidet.
rtti_type_ctor_template_arity(RttiName, NumArgTypes) :-
- RttiName = type_info(TypeInfo),
- (
- TypeInfo = plain_type_info(_, ArgTypes)
- ;
- TypeInfo = var_arity_type_info(_, ArgTypes)
- ),
- NumArgTypes = list__length(ArgTypes).
+ RttiName = type_info(TypeInfo),
+ (
+ TypeInfo = plain_type_info(_, ArgTypes)
+ ;
+ TypeInfo = var_arity_type_info(_, ArgTypes)
+ ),
+ NumArgTypes = list__length(ArgTypes).
rtti_type_ctor_template_arity(RttiName, NumArgTypes) :-
- RttiName = pseudo_type_info(PseudoTypeInfo),
- (
- PseudoTypeInfo = plain_pseudo_type_info(_, ArgTypes)
- ;
- PseudoTypeInfo = var_arity_pseudo_type_info(_, ArgTypes)
- ),
- NumArgTypes = list__length(ArgTypes).
+ RttiName = pseudo_type_info(PseudoTypeInfo),
+ (
+ PseudoTypeInfo = plain_pseudo_type_info(_, ArgTypes)
+ ;
+ PseudoTypeInfo = var_arity_pseudo_type_info(_, ArgTypes)
+ ),
+ NumArgTypes = list__length(ArgTypes).
:- func max_always_declared_arity_type_ctor = int.
max_always_declared_arity_type_ctor = 20.
:- pred rtti_type_class_constraint_template_arity(tc_rtti_name::in, int::out)
- is semidet.
+ is semidet.
rtti_type_class_constraint_template_arity(TCRttiName, Arity) :-
- TCRttiName = type_class_decl_super(_, Arity).
+ TCRttiName = type_class_decl_super(_, Arity).
rtti_type_class_constraint_template_arity(TCRttiName, Arity) :-
- TCRttiName = type_class_instance_constraint(_, _, Arity).
+ TCRttiName = type_class_instance_constraint(_, _, Arity).
:- func max_always_declared_arity_type_class_constraint = int.
@@ -1540,361 +1491,341 @@
%-----------------------------------------------------------------------------%
rtti_out__init_rtti_data_if_nec(Data, !IO) :-
- (
- Data = type_ctor_info(TypeCtorData)
- ->
- RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
- io__write_string("\tMR_INIT_TYPE_CTOR_INFO(\n\t\t", !IO),
- output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
- io__write_string(",\n\t\t", !IO),
- RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity),
- ModuleNameString = sym_name_mangle(ModuleName),
- string__append(ModuleNameString, "__", UnderscoresModule),
- (
- string__append(UnderscoresModule, _, TypeName)
- ->
- true
- ;
- io__write_string(UnderscoresModule, !IO)
- ),
- MangledTypeName = name_mangle(TypeName),
- io__write_string(MangledTypeName, !IO),
- io__write_string("_", !IO),
- io__write_int(Arity, !IO),
- io__write_string("_0);\n", !IO)
- ;
- Data = base_typeclass_info(TCName, _ModuleName, ClassArity,
- base_typeclass_info(_N1, _N2, _N3, _N4, _N5,
- Methods))
- ->
- io__write_string("#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO),
- % the field number for the first method is 5,
- % since the methods are stored after N1 .. N5,
- % and fields are numbered from 0.
- FirstFieldNum = 5,
- CodeAddrs = list__map(make_code_addr, Methods),
- output_init_method_pointers(FirstFieldNum, CodeAddrs,
- TCName, ClassArity, !IO),
- io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n",
- !IO)
- ;
- Data = type_class_instance(_)
- ->
- io__write_string("#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO),
- io__write_string("#error ""type_class_instance " ++
- "not yet supported without static code addresses""\n",
- !IO),
- io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n",
- !IO)
- ;
- Data = aditi_proc_info(ProcLabel, _, _)
- ->
- io__write_string("\tMR_INIT_ADITI_PROC_INFO(", !IO),
- rtti_data_to_id(Data, DataId),
- rtti__id_to_c_identifier(DataId, CId),
- io__write_string(CId, !IO),
- io__write_string(", ", !IO),
- output_code_addr(make_code_addr(ProcLabel), !IO),
- io__write_string(");\n", !IO)
- ;
- true
- ).
+ (
+ Data = type_ctor_info(TypeCtorData)
+ ->
+ RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
+ io__write_string("\tMR_INIT_TYPE_CTOR_INFO(\n\t\t", !IO),
+ output_ctor_rtti_id(RttiTypeCtor, type_ctor_info, !IO),
+ io__write_string(",\n\t\t", !IO),
+ RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity),
+ ModuleNameString = sym_name_mangle(ModuleName),
+ string__append(ModuleNameString, "__", UnderscoresModule),
+ ( string__append(UnderscoresModule, _, TypeName) ->
+ true
+ ;
+ io__write_string(UnderscoresModule, !IO)
+ ),
+ MangledTypeName = name_mangle(TypeName),
+ io__write_string(MangledTypeName, !IO),
+ io__write_string("_", !IO),
+ io__write_int(Arity, !IO),
+ io__write_string("_0);\n", !IO)
+ ;
+ Data = base_typeclass_info(TCName, _ModuleName, ClassArity,
+ base_typeclass_info(_N1, _N2, _N3, _N4, _N5, Methods))
+ ->
+ io__write_string("#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO),
+ % The field number for the first method is 5, since the methods are
+ % stored after N1 .. N5, and fields are numbered from 0.
+ FirstFieldNum = 5,
+ CodeAddrs = list__map(make_code_addr, Methods),
+ output_init_method_pointers(FirstFieldNum, CodeAddrs,
+ TCName, ClassArity, !IO),
+ io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n", !IO)
+ ;
+ Data = type_class_instance(_)
+ ->
+ io__write_string("#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO),
+ io__write_string("#error ""type_class_instance " ++
+ "not yet supported without static code addresses""\n", !IO),
+ io__write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n", !IO)
+ ;
+ Data = aditi_proc_info(ProcLabel, _, _)
+ ->
+ io__write_string("\tMR_INIT_ADITI_PROC_INFO(", !IO),
+ rtti_data_to_id(Data, DataId),
+ rtti__id_to_c_identifier(DataId, CId),
+ io__write_string(CId, !IO),
+ io__write_string(", ", !IO),
+ output_code_addr(make_code_addr(ProcLabel), !IO),
+ io__write_string(");\n", !IO)
+ ;
+ true
+ ).
rtti_out__register_rtti_data_if_nec(Data, SplitFiles, !IO) :-
- (
- Data = type_ctor_info(TypeCtorData)
- ->
- RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
- RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
- io__write_string("\t{\n\t", !IO),
- (
- SplitFiles = yes,
- output_rtti_id_storage_type_name_no_decl(RttiId, no,
- !IO),
- io__write_string(";\n", !IO)
- ;
- SplitFiles = no
- ),
- io__write_string("\tMR_register_type_ctor_info(\n\t\t&", !IO),
- output_rtti_id(RttiId, !IO),
- io__write_string(");\n\t}\n", !IO)
- ;
- Data = type_class_decl(TCDecl)
- ->
- TCDecl = tc_decl(TCId, _, _),
- TCId = tc_id(TCName, _, _),
- RttiId = tc_rtti_id(TCName, type_class_decl),
- io__write_string("\t{\n\t", !IO),
- (
- SplitFiles = yes,
- output_rtti_id_storage_type_name_no_decl(RttiId, no,
- !IO),
- io__write_string(";\n", !IO)
- ;
- SplitFiles = no
- ),
- io__write_string("\tMR_register_type_class_decl(\n\t\t&", !IO),
- output_rtti_id(RttiId, !IO),
- io__write_string(");\n\t}\n", !IO)
- ;
- Data = type_class_instance(TCInstance)
- ->
- TCInstance = tc_instance(TCName, TCTypes, _, _, _),
- RttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)),
- io__write_string("\t{\n\t", !IO),
- (
- SplitFiles = yes,
- output_rtti_id_storage_type_name_no_decl(RttiId, no,
- !IO),
- io__write_string(";\n", !IO)
- ;
- SplitFiles = no
- ),
- io__write_string("\tMR_register_type_class_instance(\n\t\t&",
- !IO),
- output_rtti_id(RttiId, !IO),
- io__write_string(");\n\t}\n", !IO)
- ;
- true
- ).
-
+ ( Data = type_ctor_info(TypeCtorData) ->
+ RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData),
+ RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_info),
+ io__write_string("\t{\n\t", !IO),
+ (
+ SplitFiles = yes,
+ output_rtti_id_storage_type_name_no_decl(RttiId, no, !IO),
+ io__write_string(";\n", !IO)
+ ;
+ SplitFiles = no
+ ),
+ io__write_string("\tMR_register_type_ctor_info(\n\t\t&", !IO),
+ output_rtti_id(RttiId, !IO),
+ io__write_string(");\n\t}\n", !IO)
+ ; Data = type_class_decl(TCDecl) ->
+ TCDecl = tc_decl(TCId, _, _),
+ TCId = tc_id(TCName, _, _),
+ RttiId = tc_rtti_id(TCName, type_class_decl),
+ io__write_string("\t{\n\t", !IO),
+ (
+ SplitFiles = yes,
+ output_rtti_id_storage_type_name_no_decl(RttiId, no,
+ !IO),
+ io__write_string(";\n", !IO)
+ ;
+ SplitFiles = no
+ ),
+ io__write_string("\tMR_register_type_class_decl(\n\t\t&", !IO),
+ output_rtti_id(RttiId, !IO),
+ io__write_string(");\n\t}\n", !IO)
+ ; Data = type_class_instance(TCInstance) ->
+ TCInstance = tc_instance(TCName, TCTypes, _, _, _),
+ RttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)),
+ io__write_string("\t{\n\t", !IO),
+ (
+ SplitFiles = yes,
+ output_rtti_id_storage_type_name_no_decl(RttiId, no,
+ !IO),
+ io__write_string(";\n", !IO)
+ ;
+ SplitFiles = no
+ ),
+ io__write_string("\tMR_register_type_class_instance(\n\t\t&",
+ !IO),
+ output_rtti_id(RttiId, !IO),
+ io__write_string(");\n\t}\n", !IO)
+ ;
+ true
+ ).
:- pred output_init_method_pointers(int::in, list(code_addr)::in, tc_name::in,
- string::in, io::di, io::uo) is det.
+ string::in, io::di, io::uo) is det.
output_init_method_pointers(_, [], _, _, !IO).
output_init_method_pointers(FieldNum, [Arg | Args], TCName, InstanceStr,
- !IO) :-
- io__write_string("\t\t", !IO),
- io__write_string("MR_field(MR_mktag(0), ", !IO),
- output_base_typeclass_info_name(TCName, InstanceStr, !IO),
- io__format(", %d) =\n\t\t\t", [i(FieldNum)], !IO),
- output_code_addr(Arg, !IO),
- io__write_string(";\n", !IO),
- output_init_method_pointers(FieldNum + 1, Args, TCName, InstanceStr,
- !IO).
+ !IO) :-
+ io__write_string("\t\t", !IO),
+ io__write_string("MR_field(MR_mktag(0), ", !IO),
+ output_base_typeclass_info_name(TCName, InstanceStr, !IO),
+ io__format(", %d) =\n\t\t\t", [i(FieldNum)], !IO),
+ output_code_addr(Arg, !IO),
+ io__write_string(";\n", !IO),
+ output_init_method_pointers(FieldNum + 1, Args, TCName, InstanceStr, !IO).
%-----------------------------------------------------------------------------%
:- pred output_rtti_datas_decls(list(rtti_data)::in,
- string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_rtti_datas_decls([], _, _, !N, !DeclSet, !IO).
output_rtti_datas_decls([RttiData | RttiDatas], FirstIndent, LaterIndent,
- !N, !DeclSet, !IO) :-
- output_rtti_data_decls(RttiData, FirstIndent, LaterIndent,
- !N, !DeclSet, !IO),
- output_rtti_datas_decls(RttiDatas, FirstIndent, LaterIndent,
- !N, !DeclSet, !IO).
+ !N, !DeclSet, !IO) :-
+ output_rtti_data_decls(RttiData, FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO),
+ output_rtti_datas_decls(RttiDatas, FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO).
:- pred output_rtti_data_decls(rtti_data::in,
- string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ string::in, string::in, int::in, int::out, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_rtti_data_decls(RttiData, FirstIndent, LaterIndent,
- !N, !DeclSet, !IO) :-
- ( RttiData = pseudo_type_info(type_var(_)) ->
- % These just get represented as integers,
- % so we don't need to declare them.
- % Also rtti_data_to_name/3 does not handle this case.
- true
- ;
- rtti_data_to_id(RttiData, RttiId),
- output_rtti_id_decls(RttiId, FirstIndent, LaterIndent,
- !N, !DeclSet, !IO)
- ).
+ !N, !DeclSet, !IO) :-
+ ( RttiData = pseudo_type_info(type_var(_)) ->
+ % These just get represented as integers, so we don't need to declare
+ % them. Also rtti_data_to_name/3 does not handle this case.
+ true
+ ;
+ rtti_data_to_id(RttiData, RttiId),
+ output_rtti_id_decls(RttiId, FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO)
+ ).
:- pred output_rtti_id_decls(rtti_id::in, string::in, string::in,
- int::in, int::out, decl_set::in, decl_set::out,
- io::di, io::uo) is det.
+ int::in, int::out, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
output_rtti_id_decls(RttiId, FirstIndent, LaterIndent, !N, !DeclSet, !IO) :-
- output_data_addr_decls(rtti_addr(RttiId), FirstIndent, LaterIndent,
- !N, !DeclSet, !IO).
+ output_data_addr_decls(rtti_addr(RttiId), FirstIndent, LaterIndent,
+ !N, !DeclSet, !IO).
:- pred output_cast_addr_of_rtti_ids(string::in, list(rtti_id)::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_cast_addr_of_rtti_ids(_, [], !IO) :-
- io__write_string(
- "\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO),
- io__write_string("\t0\n", !IO).
+ io__write_string(
+ "\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO),
+ io__write_string("\t0\n", !IO).
output_cast_addr_of_rtti_ids(Cast, [TCRttiName | TCRttiNames], !IO) :-
- io__write_string("\t", !IO),
- io__write_list([TCRttiName | TCRttiNames], ",\n\t",
- output_cast_addr_of_rtti_id(Cast), !IO),
- io__write_string("\n", !IO).
+ io__write_string("\t", !IO),
+ io__write_list([TCRttiName | TCRttiNames], ",\n\t",
+ output_cast_addr_of_rtti_id(Cast), !IO),
+ io__write_string("\n", !IO).
:- pred output_addr_of_ctor_rtti_names(rtti_type_ctor::in,
- list(ctor_rtti_name)::in, io::di, io::uo) is det.
+ list(ctor_rtti_name)::in, io::di, io::uo) is det.
output_addr_of_ctor_rtti_names(_, [], !IO).
output_addr_of_ctor_rtti_names(RttiTypeCtor, [RttiName | RttiNames], !IO) :-
- io__write_string("\t", !IO),
- io__write_list([RttiName | RttiNames], ",\n\t",
- output_addr_of_ctor_rtti_id(RttiTypeCtor), !IO),
- io__write_string("\n", !IO).
+ io__write_string("\t", !IO),
+ io__write_list([RttiName | RttiNames], ",\n\t",
+ output_addr_of_ctor_rtti_id(RttiTypeCtor), !IO),
+ io__write_string("\n", !IO).
:- pred output_cast_addr_of_rtti_datas(string::in, list(rtti_data)::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_cast_addr_of_rtti_datas(_, [], !IO) :-
- io__write_string(
- "\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO),
- io__write_string("\t0\n", !IO).
+ io__write_string(
+ "\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO),
+ io__write_string("\t0\n", !IO).
output_cast_addr_of_rtti_datas(Cast, [RttiData | RttiDatas], !IO) :-
- io__write_string("\t", !IO),
- io__write_list([RttiData | RttiDatas], ",\n\t",
- output_cast_addr_of_rtti_data(Cast), !IO),
- io__write_string("\n", !IO).
+ io__write_string("\t", !IO),
+ io__write_list([RttiData | RttiDatas], ",\n\t",
+ output_cast_addr_of_rtti_data(Cast), !IO),
+ io__write_string("\n", !IO).
:- pred output_addr_of_rtti_datas(list(rtti_data)::in, io::di, io::uo) is det.
output_addr_of_rtti_datas([], !IO).
output_addr_of_rtti_datas([RttiData | RttiDatas], !IO) :-
- io__write_string("\t", !IO),
- io__write_list([RttiData | RttiDatas], ",\n\t",
- output_addr_of_rtti_data, !IO),
- io__write_string("\n", !IO).
+ io__write_string("\t", !IO),
+ io__write_list([RttiData | RttiDatas], ",\n\t", output_addr_of_rtti_data,
+ !IO),
+ io__write_string("\n", !IO).
output_cast_addr_of_rtti_data(Cast, RttiData, !IO) :-
- io__write_string(Cast, !IO),
- output_addr_of_rtti_data(RttiData, !IO).
+ io__write_string(Cast, !IO),
+ output_addr_of_rtti_data(RttiData, !IO).
output_addr_of_rtti_data(RttiData, !IO) :-
- ( RttiData = pseudo_type_info(type_var(VarNum)) ->
- % rtti_data_to_name/3 does not handle this case
- io__write_int(VarNum, !IO)
- ;
- rtti_data_to_id(RttiData, RttiId),
- output_addr_of_rtti_id(RttiId, !IO)
- ).
+ ( RttiData = pseudo_type_info(type_var(VarNum)) ->
+ % rtti_data_to_name/3 does not handle this case
+ io__write_int(VarNum, !IO)
+ ;
+ rtti_data_to_id(RttiData, RttiId),
+ output_addr_of_rtti_id(RttiId, !IO)
+ ).
:- pred output_cast_addr_of_rtti_id(string::in, rtti_id::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_cast_addr_of_rtti_id(Cast, RttiId, !IO) :-
- io__write_string(Cast, !IO),
- output_addr_of_rtti_id(RttiId, !IO).
+ io__write_string(Cast, !IO),
+ output_addr_of_rtti_id(RttiId, !IO).
:- pred output_addr_of_rtti_id(rtti_id::in, io::di, io::uo) is det.
output_addr_of_rtti_id(RttiId, !IO) :-
- %
- % If the RttiName is not an array, then we need to use `&'
- % to take its address
- %
- ( RttiId = ctor_rtti_id(_, pseudo_type_info(type_var(VarNum))) ->
- io__write_int(VarNum, !IO)
- ; rtti_id_has_array_type(RttiId) = yes ->
- output_rtti_id(RttiId, !IO)
- ;
- io__write_string("&", !IO),
- output_rtti_id(RttiId, !IO)
- ).
+ % If the RttiName is not an array, then we need to use `&'
+ % to take its address.
+ ( RttiId = ctor_rtti_id(_, pseudo_type_info(type_var(VarNum))) ->
+ io__write_int(VarNum, !IO)
+ ; rtti_id_has_array_type(RttiId) = yes ->
+ output_rtti_id(RttiId, !IO)
+ ;
+ io__write_string("&", !IO),
+ output_rtti_id(RttiId, !IO)
+ ).
:- pred output_addr_of_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_addr_of_ctor_rtti_id(RttiTypeCtor, RttiName, !IO) :-
- output_addr_of_rtti_id(ctor_rtti_id(RttiTypeCtor, RttiName), !IO).
+ output_addr_of_rtti_id(ctor_rtti_id(RttiTypeCtor, RttiName), !IO).
output_rtti_id(RttiId, !IO) :-
- io__write_string(mercury_data_prefix, !IO),
- rtti__id_to_c_identifier(RttiId, Str),
- io__write_string(Str, !IO).
+ io__write_string(mercury_data_prefix, !IO),
+ rtti__id_to_c_identifier(RttiId, Str),
+ io__write_string(Str, !IO).
:- pred output_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_ctor_rtti_id(RttiTypeCtor, RttiName, !IO) :-
- output_rtti_id(ctor_rtti_id(RttiTypeCtor, RttiName), !IO).
+ output_rtti_id(ctor_rtti_id(RttiTypeCtor, RttiName), !IO).
%-----------------------------------------------------------------------------%
:- pred output_maybe_quoted_string(maybe(string)::in, io::di, io::uo) is det.
output_maybe_quoted_string(MaybeName, !IO) :-
- (
- MaybeName = yes(Name),
- io__write_string("""", !IO),
- c_util__output_quoted_string(Name, !IO),
- io__write_string("""", !IO)
- ;
- MaybeName = no,
- io__write_string("NULL", !IO)
- ).
+ (
+ MaybeName = yes(Name),
+ io__write_string("""", !IO),
+ c_util__output_quoted_string(Name, !IO),
+ io__write_string("""", !IO)
+ ;
+ MaybeName = no,
+ io__write_string("NULL", !IO)
+ ).
:- pred output_maybe_quoted_strings(list(maybe(string))::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_maybe_quoted_strings(MaybeNames, !IO) :-
- io__write_string("\t", !IO),
- io__write_list(MaybeNames, ",\n\t", output_maybe_quoted_string, !IO),
- io__write_string("\n", !IO).
+ io__write_string("\t", !IO),
+ io__write_list(MaybeNames, ",\n\t", output_maybe_quoted_string, !IO),
+ io__write_string("\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_exist_locn(exist_typeinfo_locn::in, io::di, io::uo) is det.
output_exist_locn(Locn, !IO) :-
- (
- Locn = plain_typeinfo(SlotInCell),
- io__write_string("{ ", !IO),
- io__write_int(SlotInCell, !IO),
- io__write_string(", -1 }", !IO)
- ;
- Locn = typeinfo_in_tci(SlotInCell, SlotInTci),
- io__write_string("{ ", !IO),
- io__write_int(SlotInCell, !IO),
- io__write_string(", ", !IO),
- io__write_int(SlotInTci, !IO),
- io__write_string(" }", !IO)
- ).
+ (
+ Locn = plain_typeinfo(SlotInCell),
+ io__write_string("{ ", !IO),
+ io__write_int(SlotInCell, !IO),
+ io__write_string(", -1 }", !IO)
+ ;
+ Locn = typeinfo_in_tci(SlotInCell, SlotInTci),
+ io__write_string("{ ", !IO),
+ io__write_int(SlotInCell, !IO),
+ io__write_string(", ", !IO),
+ io__write_int(SlotInTci, !IO),
+ io__write_string(" }", !IO)
+ ).
:- pred output_exist_locns(list(exist_typeinfo_locn)::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_exist_locns(Locns, !IO) :-
- io__write_string("\t", !IO),
- io__write_list(Locns, ",\n\t", output_exist_locn, !IO),
- io__write_string("\n", !IO).
+ io__write_string("\t", !IO),
+ io__write_list(Locns, ",\n\t", output_exist_locn, !IO),
+ io__write_string("\n", !IO).
:- pred output_maybe_static_code_addr(maybe(code_addr)::in,
- io::di, io::uo) is det.
+ io::di, io::uo) is det.
output_maybe_static_code_addr(yes(CodeAddr), !IO) :-
- output_static_code_addr(CodeAddr, !IO).
+ output_static_code_addr(CodeAddr, !IO).
output_maybe_static_code_addr(no, !IO) :-
- io__write_string("NULL", !IO).
+ io__write_string("NULL", !IO).
:- pred output_static_code_addr(code_addr::in, io::di, io::uo) is det.
output_static_code_addr(CodeAddr, !IO) :-
- io__write_string("MR_MAYBE_STATIC_CODE(", !IO),
- output_code_addr(CodeAddr, !IO),
- io__write_string(")", !IO).
+ io__write_string("MR_MAYBE_STATIC_CODE(", !IO),
+ output_code_addr(CodeAddr, !IO),
+ io__write_string(")", !IO).
%-----------------------------------------------------------------------------%
:- pred rtti_id_linkage(rtti_id::in, linkage::out) is det.
rtti_id_linkage(RttiId, Linkage) :-
- (
- % ANSI/ISO C doesn't allow forward declarations
- % of static data with incomplete types (in this
- % case array types without an explicit array
- % size), so make the declarations extern.
- yes = rtti_id_has_array_type(RttiId)
- ->
- Linkage = extern
- ;
- Exported = rtti_id_is_exported(RttiId),
- ( Exported = yes, Linkage = extern
- ; Exported = no, Linkage = static
- )
- ).
+ (
+ % ANSI/ISO C doesn't allow forward declarations of static data
+ % with incomplete types (in this case array types without an explicit
+ % array size), so make the declarations extern.
+ yes = rtti_id_has_array_type(RttiId)
+ ->
+ Linkage = extern
+ ;
+ Exported = rtti_id_is_exported(RttiId),
+ ( Exported = yes, Linkage = extern
+ ; Exported = no, Linkage = static
+ )
+ ).
%-----------------------------------------------------------------------------%
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/aditi
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/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
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/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/odbc
cvs diff: Diffing extras/posix
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/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
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
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/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
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 tests
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/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
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: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list