[m-rev.] for review: typeclass support in Erlang backend
Peter Wang
wangp at students.csse.unimelb.edu.au
Thu May 24 11:20:20 AEST 2007
Estimated hours taken: 30
Branches: main
Add initial support for typeclasses in the Erlang backend.
Fix some bugs in the Erlang backend. Most of these are related to the
optimisation that does away with unused and dummy arguments. We cannot drop
those arguments for higher order functions, and we must materialise any
references to dummy arguments if they appear for some reason, e.g. in
contexts where they can't be dropped.
compiler/elds.m:
Extend the ELDS for Erlang functions that, when called, return
structures containing RTTI data.
Collapse the representations of plain calls, higher order calls and
calls to builtins so they share a single function symbol.
Add references to RTTI data as a new type of ELDS expression.
Simplify the implementation of join_exprs, whic also works better if
one of the expressions to be joined could be an empty elds_block.
Add some more helper predicates.
compiler/elds_to_erlang.m:
Generate to code of standard modules to mercury__<module>.erl files,
rather than <module>.erl.
Output RTTI function definitions and export them to other modules.
Fix a bug where opt_imported predicates were being qualified with their
declaring module, even though the code was being generated in the
current module.
Quote more atoms which are spelt the same as Erlang keywords.
Conform to other changes in the ELDS.
compiler/erl_call_gen.m:
Generate code for class method calls.
Materialise variables of dummy types if they appear in the argument
lists of calls.
Fix bugs in which arguments of dummy types were being dropped from
the argument lists of higher order procedure calls.
Refactor some code which was duplicated between plain calls, higher
order calls and class method calls.
compiler/erl_code_gen.m:
Fix some cases where references to unbound variables would show up
after `erroneous' goals.
Generate code for promise_purity and barrier scopes goals.
compiler/erl_code_util.m:
Add a parameter to erl_gen_arg_list to control whether dummy and
unused arguments should be discarded when dividing call arguments
into inputs and outputs.
Add erl_gen_arg_list_arg_modes which can be used instead of
erl_gen_arg_list_arg_modes when only arg_modes are available
(instead of modes).
Add erl_base_typeclass_info_method_offset which returns the offset
into the typeclass_info tuple of the first typeclass method.
Conform to changes in the ELDS.
compiler/erl_rtti.m:
New module to generate ELDS functions that return RTTI data structures.
Currently we only generate functions for base_typeclass_infos.
compiler/erl_backend.m:
Include erl_rtti.
compiler/erl_unify_gen.m:
Ignore assignment unifications between variables of dummy types.
Handle construction of partially instantiated data structures
by assigning free variables to `false' before the construction.
Handle construction of type ctor infos (incomplete due to missing
RTTI function definitions), base typeclass infos and type infos and
typeclass infos.
Handle dummy arguments properly when creating higher order terms.
compiler/instmap.m:
Fix an assumption in `var_is_bound_in_instmap_delta' that the instmap
and instmap_delta that it is passed are reachable. It used to succeed
for unreachable instmaps (deltas) implying that the variable was bound.
In some cases this resulted in Erlang code not binding some variables
that it should have when `erroneous' code was reached.
The only other user of `var_is_bound_in_instmap_delta' is the dependent
parallel conjunction transformation. Currently `erroneous' goals are
not allowed in parallel conjunctions anyway.
compiler/mercury_compile.m:
Call the code to generate ELDS function definitions for RTTI data.
compiler/notes/compiler_design.html:
Mention erl_rtti.m.
s/mlds_to_rtti/rtti_to_mlds/ in a spot.
Index: compiler/elds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds.m,v
retrieving revision 1.3
diff -u -r1.3 elds.m
--- compiler/elds.m 18 May 2007 06:04:23 -0000 1.3
+++ compiler/elds.m 24 May 2007 01:04:30 -0000
@@ -22,12 +22,14 @@
:- module erl_backend.elds.
:- interface.
+:- import_module backend_libs.rtti.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
+:- import_module bool.
:- import_module char.
:- import_module list.
:- import_module maybe.
@@ -49,7 +51,10 @@
elds_funcs :: list(elds_defn),
% Definitions of foreign exported functions.
- elds_fe_funcs :: list(elds_foreign_export_defn)
+ elds_fe_funcs :: list(elds_foreign_export_defn),
+
+ % Definitions of functions which return RTTI data.
+ elds_rtti_funcs :: list(elds_rtti_defn)
).
% Function definition.
@@ -70,6 +75,31 @@
fe_defn_clause :: elds_clause
).
+ % Function which returns RTTI data when called.
+ %
+:- type elds_rtti_defn
+ ---> elds_rtti_defn(
+ rtti_defn_id :: elds_rtti_id,
+ rtti_defn_exported :: bool,
+ rtti_defn_varset :: prog_varset,
+ rtti_defn_clause :: elds_clause
+ ).
+
+ % The types of RTTI which we can generate ELDS functions for.
+ %
+:- type elds_rtti_id
+ ---> elds_rtti_type_ctor_id(
+ module_name,
+ string,
+ arity
+ )
+ ; elds_rtti_base_typeclass_id(
+ tc_name, % identifies the type class
+ module_name, % module containing instance decl.
+ string % encodes the names and arities of the
+ % types in the instance declaration
+ ).
+
:- type elds_clause
---> elds_clause(
clause_pattern :: list(elds_term),
@@ -97,21 +127,19 @@
; elds_unop(elds_unop, elds_expr)
; elds_binop(elds_binop, elds_expr, elds_expr)
- % A normal call.
- % proc(Expr, ...)
+ % A normal call to a procedure, a higher order call, or a call to a
+ % builtin.
%
- ; elds_call(pred_proc_id, list(elds_expr))
-
- % A higher order call.
+ % proc(Expr, ...)
% Proc(Expr, ...)
+ % builtin(Expr, ...)
%
- ; elds_call_ho(elds_expr, list(elds_expr))
+ ; elds_call(elds_call_target, list(elds_expr))
- % A call to a Erlang builtin.
- % builtin(Expr, ...)
+ % A call to a function returning RTTI information.
%
- ; elds_call_builtin(string, list(elds_expr))
-
+ ; elds_rtti_ref(elds_rtti_id)
+
% fun(Args, ...) -> Expr end
% (We only use single clause functions.)
%
@@ -175,6 +203,11 @@
% XXX we should use insts (or some other method) to restrict expressions in
% tuples to be terms, if the tuple is going to be used in a pattern.
+:- type elds_call_target
+ ---> elds_call_plain(pred_proc_id)
+ ; elds_call_ho(elds_expr)
+ ; elds_call_builtin(string).
+
:- type elds_case
---> elds_case(elds_term, elds_expr).
@@ -231,6 +264,11 @@
%
:- func elds_commit_marker = elds_expr.
+:- func elds_call_builtin(string, list(elds_expr)) = elds_expr.
+:- func elds_call_element(prog_var, int) = elds_expr.
+
+:- func var_eq_false(prog_var) = elds_expr.
+
:- func term_from_var(prog_var) = elds_term.
:- func terms_from_vars(prog_vars) = list(elds_term).
@@ -289,6 +327,15 @@
elds_commit_marker = elds_term(elds_atom_raw("MERCURY_COMMIT")).
+elds_call_builtin(FunName, Exprs) =
+ elds_call(elds_call_builtin(FunName), Exprs).
+
+% Arguments are flipped from the Erlang for currying.
+elds_call_element(Var, Index) = elds_call_builtin("element",
+ [elds_term(elds_int(Index)), expr_from_var(Var)]).
+
+var_eq_false(Var) = elds_eq(expr_from_var(Var), elds_term(elds_false)).
+
term_from_var(Var) = elds_var(Var).
terms_from_vars(Vars) = list.map(term_from_var, Vars).
@@ -308,21 +355,21 @@
).
join_exprs(ExprA, ExprB) = Expr :-
- (
- ExprA = elds_block(ExprsA),
- ExprB = elds_block(ExprsB)
- ->
- Expr = elds_block(ExprsA ++ ExprsB)
+ ( ExprA = elds_block(As0) ->
+ As = As0
;
- ExprB = elds_block(ExprsB)
- ->
- Expr = elds_block([ExprA | ExprsB])
+ As = [ExprA]
+ ),
+ ( ExprB = elds_block(Bs0) ->
+ Bs = Bs0
;
- ExprA = elds_block(ExprsA)
- ->
- Expr = elds_block(ExprsA ++ [ExprB])
+ Bs = [ExprB]
+ ),
+ AsBs = As ++ Bs,
+ ( AsBs = [SingleExpr] ->
+ Expr = SingleExpr
;
- Expr = elds_block([ExprA, ExprB])
+ Expr = elds_block(AsBs)
).
maybe_join_exprs(ExprA, yes(ExprB)) = join_exprs(ExprA, ExprB).
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.3
diff -u -r1.3 elds_to_erlang.m
--- compiler/elds_to_erlang.m 18 May 2007 06:04:23 -0000 1.3
+++ compiler/elds_to_erlang.m 24 May 2007 01:04:30 -0000
@@ -68,11 +68,11 @@
%-----------------------------------------------------------------------------%
output_elds(ModuleInfo, ELDS, !IO) :-
- ELDS = elds(ModuleName, _, _, _),
%
% The Erlang interactive shell doesn't like "." in filenames so we use "__"
% instead.
%
+ ModuleName = erlang_module_name(ELDS ^ elds_name),
module_name_to_file_name_sep(ModuleName, "__", ".erl", yes,
SourceFileName, !IO),
output_to_file(SourceFileName, output_erl_file(ModuleInfo, ELDS,
@@ -82,7 +82,8 @@
io::di, io::uo) is det.
output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
- ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns),
+ ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns,
+ RttiDefns),
% Output intro.
library.version(Version),
@@ -102,9 +103,11 @@
io.write_string(").\n", !IO),
io.write_string("-export([", !IO),
- list.foldl2(output_export_ann(ModuleInfo), ProcDefns, no, NeedComma, !IO),
- list.foldl2(output_foreign_export_ann, ForeignExportDefns, NeedComma, _,
- !IO),
+ list.foldl2(output_export_ann(ModuleInfo), ProcDefns, no, NeedComma0, !IO),
+ list.foldl2(output_foreign_export_ann, ForeignExportDefns,
+ NeedComma0, NeedComma1, !IO),
+ list.foldl2(output_rtti_export_ann(ModuleInfo), RttiDefns,
+ NeedComma1, _NeedComma, !IO),
io.write_string("]).\n", !IO),
% Useful for debugging.
@@ -116,7 +119,8 @@
% Output function definitions.
list.foldl(output_defn(ModuleInfo), ProcDefns, !IO),
list.foldl(output_foreign_export_defn(ModuleInfo), ForeignExportDefns,
- !IO).
+ !IO),
+ list.foldl(output_rtti_defn(ModuleInfo), RttiDefns, !IO).
%-----------------------------------------------------------------------------%
@@ -152,6 +156,23 @@
io.write_char('/', !IO),
io.write_int(elds_clause_arity(Clause), !IO).
+:- pred output_rtti_export_ann(module_info::in, elds_rtti_defn::in,
+ bool::in, bool::out, io::di, io::uo) is det.
+
+output_rtti_export_ann(ModuleInfo, ForeignExportDefn, !NeedComma, !IO) :-
+ ForeignExportDefn = elds_rtti_defn(RttiId, IsExported, _VarSet, _Clause),
+ (
+ IsExported = yes,
+ maybe_write_comma(!.NeedComma, !IO),
+ nl_indent_line(1, !IO),
+ output_rtti_id(ModuleInfo, RttiId, !IO),
+ io.write_char('/', !IO),
+ io.write_int(0, !IO),
+ !:NeedComma = yes
+ ;
+ IsExported = no
+ ).
+
:- pred output_foreign_body_code(foreign_body_code::in, io::di, io::uo) is det.
output_foreign_body_code(foreign_body_code(_Lang, Code, _Context), !IO) :-
@@ -175,6 +196,15 @@
output_atom(Name, !IO),
output_toplevel_clause(ModuleInfo, VarSet, Clause, !IO).
+:- pred output_rtti_defn(module_info::in, elds_rtti_defn::in, io::di, io::uo)
+ is det.
+
+output_rtti_defn(ModuleInfo, RttiDefn, !IO) :-
+ RttiDefn = elds_rtti_defn(RttiId, _IsExported, VarSet, Clause),
+ io.nl(!IO),
+ output_rtti_id(ModuleInfo, RttiId, !IO),
+ output_toplevel_clause(ModuleInfo, VarSet, Clause, !IO).
+
:- pred output_toplevel_clause(module_info::in, prog_varset::in,
elds_clause::in, io::di, io::uo) is det.
@@ -237,7 +267,10 @@
output_expr(ModuleInfo, VarSet, Indent, Expr, !IO) :-
(
- Expr = elds_block(Exprs),
+ Expr = elds_block([]),
+ unexpected(this_file, "output_expr: empty elds_block")
+ ;
+ Expr = elds_block(Exprs @ [_ | _]),
io.write_string("(begin", !IO),
nl_indent_line(Indent + 1, !IO),
output_exprs_with_nl(ModuleInfo, VarSet, Indent + 1, Exprs, !IO),
@@ -261,14 +294,15 @@
output_elds_binop(Binop, !IO),
output_expr(ModuleInfo, VarSet, Indent, ExprB, !IO)
;
+ Expr = elds_call(CallTarget, Args),
(
- Expr = elds_call(PredProcId, Args),
+ CallTarget = elds_call_plain(PredProcId),
output_pred_proc_id(ModuleInfo, PredProcId, !IO)
;
- Expr = elds_call_ho(Closure, Args),
+ CallTarget = elds_call_ho(Closure),
output_expr(ModuleInfo, VarSet, Indent, Closure, !IO)
;
- Expr = elds_call_builtin(FunName, Args),
+ CallTarget = elds_call_builtin(FunName),
output_atom(FunName, !IO)
),
io.write_string("(", !IO),
@@ -317,6 +351,18 @@
output_expr(ModuleInfo, VarSet, Indent, ExprA, !IO),
io.write_string(")", !IO)
;
+ Expr = elds_rtti_ref(RttiId),
+ (
+ RttiId = elds_rtti_type_ctor_id(_, _, _),
+ % XXX we don't yet generate functions for type ctors so don't
+ % make calls to them
+ output_atom(string(RttiId), !IO)
+ ;
+ RttiId = elds_rtti_base_typeclass_id(_, _, _),
+ output_rtti_id(ModuleInfo, RttiId, !IO),
+ io.write_string("()", !IO)
+ )
+ ;
Expr = elds_foreign_code(Code),
nl(!IO),
io.write_string(Code, !IO),
@@ -446,6 +492,8 @@
output_var_string(String, !IO) :-
% XXX this assumes all Mercury variable names are a subset of Erlang
% variable names
+ % However, the compiler can produce some illegal variable names
+ % which we should mangle e.g. TypeClassInfo_for_+_8
io.write_string(String, !IO),
space(!IO).
@@ -463,6 +511,37 @@
),
output_atom(Name, !IO).
+:- pred output_rtti_id(module_info::in, elds_rtti_id::in, io::di, io::uo)
+ is det.
+
+output_rtti_id(ModuleInfo, RttiId, !IO) :-
+ module_info_get_name(ModuleInfo, CurModuleName),
+ (
+ RttiId = elds_rtti_type_ctor_id(ModuleName, String, Arity),
+ % The only things with an empty module name should be the builtins.
+ ( ModuleName = unqualified("") ->
+ InstanceModule = mercury_public_builtin_module
+ ;
+ InstanceModule = ModuleName
+ ),
+ Atom = "TypeCtorInfo_" ++ String ++ "_" ++ string.from_int(Arity)
+ ;
+ RttiId = elds_rtti_base_typeclass_id(TCName, InstanceModule,
+ InstanceStr),
+ TCName = tc_name(ClassModuleName, ClassName, ClassArity),
+ QClassName = qualified(ClassModuleName, ClassName),
+ QClassNameStr = sym_name_to_string_sep(QClassName, "__"),
+ Atom = string.append_list(["BaseTypeclassInfo_", QClassNameStr,
+ "__arity", string.from_int(ClassArity), "__", InstanceStr])
+ ),
+ (if CurModuleName \= InstanceModule then
+ output_atom(erlang_module_name_to_str(InstanceModule), !IO),
+ io.write_char(':', !IO)
+ else
+ true
+ ),
+ output_atom(Atom, !IO).
+
%-----------------------------------------------------------------------------%
:- pred erlang_proc_name(module_info::in, pred_proc_id::in,
@@ -492,7 +571,10 @@
erlang_nonspecial_proc_name(ThisModule, PredModule, PredName, PredOrFunc,
PredArity, ProcId, PredIsImported, MaybeExtModule, ProcNameStr) :-
- ( ThisModule \= PredModule ->
+ (
+ % XXX not completely sure this is right
+ PredIsImported = yes
+ ->
MaybeExtModule = yes(erlang_module_name_to_str(PredModule))
;
MaybeExtModule = no
@@ -574,17 +656,21 @@
:- func erlang_module_name_to_str(module_name) = string.
-erlang_module_name_to_str(ModuleName) = Str :-
+erlang_module_name_to_str(ModuleName) =
+ sym_name_to_string_sep(erlang_module_name(ModuleName), "__").
+
+:- func erlang_module_name(module_name) = module_name.
+
+erlang_module_name(ModuleName) =
% To avoid namespace collisions between Mercury standard modules and
% Erlang standard modules, we pretend the Mercury standard modules are
% in a "mercury" supermodule.
%
(if mercury_std_library_module_name(ModuleName) then
- Mod = add_outermost_qualifier("mercury", ModuleName)
+ add_outermost_qualifier("mercury", ModuleName)
else
- Mod = ModuleName
- ),
- Str = sym_name_to_string_sep(Mod, "__").
+ ModuleName
+ ).
%-----------------------------------------------------------------------------%
@@ -606,20 +692,33 @@
:- pred requires_atom_quoting(string::in) is semidet.
+requires_atom_quoting("after").
requires_atom_quoting("and").
requires_atom_quoting("andalso").
requires_atom_quoting("band").
+requires_atom_quoting("begin").
requires_atom_quoting("bnot").
requires_atom_quoting("bor").
requires_atom_quoting("bsl").
requires_atom_quoting("bsr").
requires_atom_quoting("bxor").
+requires_atom_quoting("case").
+requires_atom_quoting("catch").
+requires_atom_quoting("cond").
requires_atom_quoting("div").
+requires_atom_quoting("end").
+requires_atom_quoting("fun").
+requires_atom_quoting("if").
+requires_atom_quoting("let").
requires_atom_quoting("not").
+requires_atom_quoting("of").
requires_atom_quoting("or").
requires_atom_quoting("orelse").
requires_atom_quoting("query").
+requires_atom_quoting("receive").
requires_atom_quoting("rem").
+requires_atom_quoting("try").
+requires_atom_quoting("when").
requires_atom_quoting("xor").
%-----------------------------------------------------------------------------%
Index: compiler/erl_backend.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_backend.m,v
retrieving revision 1.1
diff -u -r1.1 erl_backend.m
--- compiler/erl_backend.m 15 May 2007 02:38:20 -0000 1.1
+++ compiler/erl_backend.m 24 May 2007 01:04:30 -0000
@@ -28,6 +28,7 @@
:- include_module erl_call_gen.
:- include_module erl_unify_gen.
:- include_module erl_code_util.
+:- include_module erl_rtti.
:- include_module elds_to_erlang.
Index: compiler/erl_call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_call_gen.m,v
retrieving revision 1.3
diff -u -r1.3 erl_call_gen.m
--- compiler/erl_call_gen.m 18 May 2007 06:04:23 -0000 1.3
+++ compiler/erl_call_gen.m 24 May 2007 01:04:30 -0000
@@ -48,6 +48,16 @@
:- inst higher_order
---> higher_order(ground, ground, ground, ground).
+ % Generate ELDS code for a class method call.
+ %
+:- pred erl_gen_class_method_call(generic_call::in(class_method),
+ prog_vars::in, list(mer_mode)::in, determinism::in, prog_context::in,
+ maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+:- inst class_method
+ ---> class_method(ground, ground, ground, ground).
+
% Generate ELDS code for a call to a builtin procedure.
%
:- pred erl_gen_builtin(pred_id::in, proc_id::in, prog_vars::in,
@@ -68,6 +78,17 @@
elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
%-----------------------------------------------------------------------------%
+
+ % erl_make_call(CodeModel, CallTarget, InputVars, OutputVars,
+ % MaybeSuccessExpr, Statement)
+ %
+ % Low-level procedure to create an expression that makes a call.
+ %
+:- pred erl_make_call(code_model::in, elds_call_target::in,
+ prog_vars::in, prog_vars::in, maybe(elds_expr)::in,
+ elds_expr::out) is det.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -77,6 +98,7 @@
:- import_module hlds.hlds_module.
:- import_module libs.compiler_util.
+:- import_module int.
:- import_module pair.
%-----------------------------------------------------------------------------%
@@ -93,27 +115,41 @@
pred_info_get_arg_types(PredInfo, CalleeTypes),
proc_info_get_argmodes(ProcInfo, ArgModes),
- erl_gen_arg_list(ModuleInfo, ArgVars, CalleeTypes, ArgModes,
- InputVars, OutputVars),
- PPId = proc(PredId, ProcId),
- NormalCallExpr = elds_call(PPId, exprs_from_vars(InputVars)),
+ erl_gen_arg_list(ModuleInfo, opt_dummy_args,
+ ArgVars, CalleeTypes, ArgModes, InputVars, OutputVars),
+
+ CallTarget = elds_call_plain(proc(PredId, ProcId)),
+ erl_make_call(CodeModel, CallTarget, InputVars, OutputVars,
+ MaybeSuccessExpr, DoCall),
+ materialise_dummies_before_expr(!.Info, InputVars, DoCall, Statement).
+
+%-----------------------------------------------------------------------------%
+
+erl_make_call(CodeModel, CallTarget, InputVars, OutputVars, MaybeSuccessExpr,
+ Statement) :-
+ InputExprs = exprs_from_vars(InputVars),
(
CodeModel = model_det,
- make_det_call(NormalCallExpr, OutputVars, MaybeSuccessExpr, Statement)
+ make_det_call(CallTarget, InputExprs, OutputVars, MaybeSuccessExpr,
+ Statement)
;
CodeModel = model_semi,
SuccessExpr = det_expr(MaybeSuccessExpr),
- make_semidet_call(NormalCallExpr, OutputVars, SuccessExpr, Statement)
+ make_semidet_call(CallTarget, InputExprs, OutputVars, SuccessExpr,
+ Statement)
;
CodeModel = model_non,
SuccessExpr = det_expr(MaybeSuccessExpr),
- make_nondet_call(PPId, InputVars, OutputVars, SuccessExpr, Statement)
+ make_nondet_call(CallTarget, InputExprs, OutputVars, SuccessExpr,
+ Statement)
).
-:- pred make_det_call(elds_expr::in, prog_vars::in, maybe(elds_expr)::in,
- elds_expr::out) is det.
+:- pred make_det_call(elds_call_target::in, list(elds_expr)::in, prog_vars::in,
+ maybe(elds_expr)::in, elds_expr::out) is det.
-make_det_call(Expr, OutputVars, MaybeSuccessExpr, Statement) :-
+make_det_call(CallTarget, InputExprs, OutputVars, MaybeSuccessExpr,
+ Statement) :-
+ CallExpr = elds_call(CallTarget, InputExprs),
(
OutputVars = [],
(if
@@ -122,9 +158,9 @@
)
then
% Preserve tail calls.
- Statement = Expr
+ Statement = CallExpr
else
- Statement = maybe_join_exprs(Expr, MaybeSuccessExpr)
+ Statement = maybe_join_exprs(CallExpr, MaybeSuccessExpr)
)
;
OutputVars = [_ | _],
@@ -133,17 +169,18 @@
MaybeSuccessExpr = yes(UnpackTerm)
then
% Preserve tail calls.
- Statement = Expr
+ Statement = CallExpr
else
- AssignCall = elds_eq(UnpackTerm, Expr),
+ AssignCall = elds_eq(UnpackTerm, CallExpr),
Statement = maybe_join_exprs(AssignCall, MaybeSuccessExpr)
)
).
-:- pred make_semidet_call(elds_expr::in, prog_vars::in, elds_expr::in,
- elds_expr::out) is det.
+:- pred make_semidet_call(elds_call_target::in, list(elds_expr)::in,
+ prog_vars::in, elds_expr::in, elds_expr::out) is det.
-make_semidet_call(CallExpr, OutputVars, SuccessExpr, Statement) :-
+make_semidet_call(CallTarget, InputExprs, OutputVars, SuccessExpr, Statement) :-
+ CallExpr = elds_call(CallTarget, InputExprs),
UnpackTerm = elds_tuple(exprs_from_vars(OutputVars)),
(if
SuccessExpr = elds_term(UnpackTerm)
@@ -161,18 +198,20 @@
FalseCase = elds_case(elds_anon_var, elds_term(elds_fail))
).
-:- pred make_nondet_call(pred_proc_id::in, prog_vars::in, prog_vars::in,
- elds_expr::in, elds_expr::out) is det.
+:- pred make_nondet_call(elds_call_target::in, list(elds_expr)::in,
+ prog_vars::in, elds_expr::in, elds_expr::out) is det.
-make_nondet_call(PredProcId, InputVars, OutputVars, SuccessCont0, Statement) :-
+make_nondet_call(CallTarget, InputExprs, OutputVars, SuccessCont0,
+ Statement) :-
%
- % Proc(InputVars, ...,
+ % Proc(InputExprs, ...,
% fun(OutputVars, ...) ->
% SuccessCont0
% end)
%
(if
- SuccessCont0 = elds_call_ho(SuccessCont1, exprs_from_vars(OutputVars))
+ SuccessCont0 = elds_call(elds_call_ho(SuccessCont1),
+ exprs_from_vars(OutputVars))
then
% Avoid an unnecessary closure.
SuccessCont = SuccessCont1
@@ -180,8 +219,32 @@
SuccessCont = elds_fun(elds_clause(terms_from_vars(OutputVars),
SuccessCont0))
),
- Statement = elds_call(PredProcId,
- exprs_from_vars(InputVars) ++ [SuccessCont]).
+ Statement = elds_call(CallTarget, InputExprs ++ [SuccessCont]).
+
+%-----------------------------------------------------------------------------%
+
+ % materialise_dummies_before_expr(Info, Vars, Expr0, Expr)
+ %
+ % Materialise any variables in Vars which are of dummy types (hence proably
+ % don't exist) before evaluating Expr0. We arbitrarily assign dummy
+ % variables to `false', hence variables in Vars must either not exist or
+ % already be bound to `false'.
+ %
+:- pred materialise_dummies_before_expr(erl_gen_info::in, prog_vars::in,
+ elds_expr::in, elds_expr::out) is det.
+
+materialise_dummies_before_expr(Info, Vars, Expr0, Expr) :-
+ list.filter_map(assign_false_if_dummy(Info), Vars, AssignDummyVars),
+ Expr = join_exprs(elds_block(AssignDummyVars), Expr0).
+
+:- pred assign_false_if_dummy(erl_gen_info::in, prog_var::in, elds_expr::out)
+ is semidet.
+
+assign_false_if_dummy(Info, Var, AssignFalse) :-
+ erl_gen_info_get_module_info(Info, ModuleInfo),
+ erl_variable_type(Info, Var, VarType),
+ is_dummy_argument_type(ModuleInfo, VarType),
+ AssignFalse = var_eq_false(Var).
%-----------------------------------------------------------------------------%
%
@@ -192,36 +255,81 @@
_Context, MaybeSuccessExpr, Statement, !Info) :-
GenericCall = higher_order(ClosureVar, _, _, _),
+ % Separate input and output arguments for the call.
+ % We do not optimise away dummy and unused arguments when calling higher
+ % order procedures. The underlying first-order procedure may have the
+ % arguments optimised away, but the closure created around it retains dummy
+ % arguments.
erl_gen_info_get_module_info(!.Info, ModuleInfo),
erl_variable_types(!.Info, ArgVars, ArgTypes),
- erl_gen_arg_list(ModuleInfo, ArgVars, ArgTypes, Modes,
+ erl_gen_arg_list(ModuleInfo, no_opt_dummy_args, ArgVars, ArgTypes, Modes,
InputVars, OutputVars),
- ClosureVarExpr = expr_from_var(ClosureVar),
- InputVarsExprs = exprs_from_vars(InputVars),
- NormalCallExpr = elds_call_ho(ClosureVarExpr, InputVarsExprs),
+ determinism_to_code_model(Detism, CallCodeModel),
+ CallTarget = elds_call_ho(expr_from_var(ClosureVar)),
+ erl_make_call(CallCodeModel, CallTarget, InputVars, OutputVars,
+ MaybeSuccessExpr, DoCall),
+
+ % The callee function is responsible for materialising dummy output
+ % variables.
+ materialise_dummies_before_expr(!.Info, InputVars, DoCall, Statement).
+
+%-----------------------------------------------------------------------------%
+
+erl_gen_class_method_call(GenericCall, ArgVars, Modes, Detism,
+ _Context, MaybeSuccessExpr, Statement, !Info) :-
+ GenericCall = class_method(TCIVar, MethodNum, _ClassId, _CallId),
+
+ % A class method looks like this:
+ %
+ % class_method(TypeClassInfo, Inputs, ..., [SuccessCont]) ->
+ % BaseTypeClassInfo = element(<n>, TypeClassInfo),
+ % MethodWrapper = element(<m>, BaseTypeClassInfo),
+ % MethodWrapper(TypeClassInfo, Inputs, ..., [SuccessCont]).
+ %
+ % MethodWrapper is NOT the used-defined method implementation itself, but a
+ % wrapper around it. We have to be careful as the wrappers accept and
+ % return dummy values, but the actual method implementations optimise those
+ % away, as well as unneeded typeinfo and typeclass info arguments, etc.
+
+ erl_gen_info_new_named_var("BaseTypeClassInfo", BaseTCIVar, !Info),
+ erl_gen_info_new_named_var("MethodWrapper", MethodWrapperVar, !Info),
+ BaseTCIVarExpr = expr_from_var(BaseTCIVar),
+ MethodWrapperVarExpr = expr_from_var(MethodWrapperVar),
+ % Separate input and output arguments for the call to the wrapper.
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_variable_types(!.Info, ArgVars, ArgTypes),
+ erl_gen_arg_list(ModuleInfo, no_opt_dummy_args, ArgVars, ArgTypes, Modes,
+ CallInputVars, CallOutputVars),
+
+ % Extract the base_typeclass_info from the typeclass_info.
+ % Erlang's `element' builtin counts from 1.
+ BaseTypeclassInfoFieldId = 1,
+ ExtractBaseTypeclassInfo = elds_eq(BaseTCIVarExpr,
+ elds_call_element(TCIVar, BaseTypeclassInfoFieldId)),
+
+ % Extract the method from the base_typeclass_info.
+ MethodFieldNum = 1 + MethodNum + erl_base_typeclass_info_method_offset,
+ ExtractMethodWrapper = elds_eq(MethodWrapperVarExpr,
+ elds_call_element(BaseTCIVar, MethodFieldNum)),
+
+ % Call the method wrapper, putting the typeclass info in front
+ % of the argument list.
determinism_to_code_model(Detism, CallCodeModel),
- (
- CallCodeModel = model_det,
- make_det_call(NormalCallExpr, OutputVars, MaybeSuccessExpr, Statement)
- ;
- CallCodeModel = model_semi,
- SuccessExpr = det_expr(MaybeSuccessExpr),
- make_semidet_call(NormalCallExpr, OutputVars, SuccessExpr, Statement)
- ;
- CallCodeModel = model_non,
- %
- % Proc(InputVars, ...,
- % fun(OutputVars, ...) ->
- % SuccessCont0
- % end)
- %
- SuccessCont = elds_fun(elds_clause(terms_from_vars(OutputVars),
- det_expr(MaybeSuccessExpr))),
- Statement = elds_call_ho(ClosureVarExpr,
- InputVarsExprs ++ [SuccessCont])
- ).
+ CallTarget = elds_call_ho(MethodWrapperVarExpr),
+ erl_make_call(CallCodeModel, CallTarget, [TCIVar | CallInputVars],
+ CallOutputVars, MaybeSuccessExpr, DoCall),
+
+ ExtractAndCall = join_exprs(ExtractBaseTypeclassInfo,
+ join_exprs(ExtractMethodWrapper, DoCall)),
+
+ % The callee function is responsible for materialising dummy output
+ % variables.
+ materialise_dummies_before_expr(!.Info, CallInputVars, ExtractAndCall,
+ Statement).
+
+%-----------------------------------------------------------------------------%
erl_gen_cast(_Context, ArgVars, MaybeSuccessExpr, Statement, !Info) :-
erl_variable_types(!.Info, ArgVars, ArgTypes),
@@ -266,8 +374,8 @@
CodeModel = model_det,
(
SimpleCode = assign(Lval, SimpleExpr),
- % XXX We need to avoid generating assignments to dummy variables
- % introduced for types such as io.state.
+ % XXX do we need to avoid generating assignments to dummy variables
+ % introduced for types such as io.state here?
Rval = erl_gen_simple_expr(SimpleExpr),
Assign = elds.elds_eq(elds.expr_from_var(Lval), Rval),
Statement = maybe_join_exprs(Assign, MaybeSuccessExpr)
@@ -439,8 +547,8 @@
% Separate the foreign call arguments into inputs and outputs.
erl_gen_info_get_module_info(!.Info, ModuleInfo),
list.map2(foreign_arg_type_mode, ForeignArgs, ArgTypes, ArgModes),
- erl_gen_arg_list(ModuleInfo, ForeignArgs, ArgTypes, ArgModes,
- InputForeignArgs, OutputForeignArgs),
+ erl_gen_arg_list(ModuleInfo, opt_dummy_args, ForeignArgs, ArgTypes,
+ ArgModes, InputForeignArgs, OutputForeignArgs),
% Get the variables involved in the call and their fixed names.
InputVars = list.map(foreign_arg_var, InputForeignArgs),
@@ -482,15 +590,8 @@
InnerFunStatement)),
% Call the inner function with the input variables.
- CallInner = elds_call_ho(InnerFun, exprs_from_vars(InputVars)),
- (
- CodeModel = model_det,
- make_det_call(CallInner, OutputVars, MaybeSuccessExpr, Statement)
- ;
- CodeModel = model_semi,
- SuccessExpr = det_expr(MaybeSuccessExpr),
- make_semidet_call(CallInner, OutputVars, SuccessExpr, Statement)
- )
+ erl_make_call(CodeModel, elds_call_ho(InnerFun), InputVars, OutputVars,
+ MaybeSuccessExpr, Statement)
;
PragmaImpl = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
sorry(this_file, "erl_gen_goal_expr: fc_impl_model_non")
Index: compiler/erl_code_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_gen.m,v
retrieving revision 1.3
diff -u -r1.3 erl_code_gen.m
--- compiler/erl_code_gen.m 18 May 2007 06:04:23 -0000 1.3
+++ compiler/erl_code_gen.m 24 May 2007 01:04:30 -0000
@@ -81,7 +81,10 @@
erl_gen_preds(ModuleInfo, ProcDefns, !IO),
filter_erlang_foreigns(ModuleInfo, ForeignBodies, PragmaExports, !IO),
erl_gen_foreign_exports(ProcDefns, PragmaExports, ForeignExportDefns),
- ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns).
+ % RTTI function definitions are added later by rtti_data_list_to_elds.
+ RttiDefns = [],
+ ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns,
+ RttiDefns).
:- pred filter_erlang_foreigns(module_info::in, list(foreign_body_code)::out,
list(pragma_exported_proc)::out, io::di, io::uo) is det.
@@ -237,6 +240,7 @@
elds_clause::out, erl_gen_info::in, erl_gen_info::out) is det.
erl_gen_proc_body(CodeModel, InstMap0, Goal, ProcClause, !Info) :-
+ Goal = hlds_goal(_, GoalInfo),
erl_gen_info_get_input_vars(!.Info, InputVars),
erl_gen_info_get_output_vars(!.Info, OutputVars),
OutputVarsExprs = exprs_from_vars(OutputVars),
@@ -244,11 +248,18 @@
( CodeModel = model_det
; CodeModel = model_semi
),
+ InputVarsTerms = terms_from_vars(InputVars),
%
% On success, the procedure returns a tuple of its output variables.
- %
- InputVarsTerms = terms_from_vars(InputVars),
- SuccessExpr = elds_term(elds_tuple(OutputVarsExprs))
+ %
+ goal_info_get_determinism(GoalInfo, Detism),
+ ( Detism = detism_erroneous ->
+ % This procedure can't succeed.
+ MaybeSuccessExpr = no
+ ;
+ SuccessExpr = elds_term(elds_tuple(OutputVarsExprs)),
+ MaybeSuccessExpr = yes(SuccessExpr)
+ )
;
CodeModel = model_non,
%
@@ -258,9 +269,11 @@
%
erl_gen_info_new_named_var("SucceedHeadVar", SucceedVar, !Info),
InputVarsTerms = terms_from_vars(InputVars ++ [SucceedVar]),
- SuccessExpr = elds_call_ho(expr_from_var(SucceedVar), OutputVarsExprs)
+ SuccessExpr = elds_call(elds_call_ho(expr_from_var(SucceedVar)),
+ OutputVarsExprs),
+ MaybeSuccessExpr = yes(SuccessExpr)
),
- erl_gen_goal(CodeModel, InstMap0, Goal, yes(SuccessExpr), Statement,
+ erl_gen_goal(CodeModel, InstMap0, Goal, MaybeSuccessExpr, Statement,
!Info),
ProcClause = elds_clause(InputVarsTerms, Statement).
@@ -431,12 +444,6 @@
ScopeReason = promise_solutions(_, _),
sorry(this_file, "promise_solutions scope in erlang code generator")
;
- ScopeReason = promise_purity(_, _),
- sorry(this_file, "promise_purity scope in erlang code generator")
- ;
- ScopeReason = barrier(_),
- sorry(this_file, "barrier scope in erlang code generator")
- ;
ScopeReason = trace_goal(_, _, _, _, _),
sorry(this_file, "trace_goal scope in erlang code generator")
;
@@ -444,7 +451,10 @@
erl_gen_commit(Goal, CodeModel, InstMap, Context,
MaybeSuccessExpr, Statement, !Info)
;
- ScopeReason = from_ground_term(_),
+ ( ScopeReason = promise_purity(_, _)
+ ; ScopeReason = barrier(_)
+ ; ScopeReason = from_ground_term(_)
+ ),
Goal = hlds_goal(GoalExpr, _),
erl_gen_goal_expr(GoalExpr, CodeModel, InstMap, Context,
MaybeSuccessExpr, Statement, !Info)
@@ -483,7 +493,8 @@
Context, MaybeSuccessExpr, Statement, !Info)
;
GenericCall = class_method(_, _, _, _),
- sorry(this_file, "class methods calls in erlang backend")
+ erl_gen_class_method_call(GenericCall, Vars, Modes, Detism,
+ Context, MaybeSuccessExpr, Statement, !Info)
;
GenericCall = event_call(_),
sorry(this_file, "event_calls in erlang backend")
@@ -588,7 +599,8 @@
ClosureFun = elds_fun(elds_clause(ClosureArgsTerms, SuccessExpr0)),
% ``SuccessClosure(ClosureArgs, ...)''
- CallClosure = elds_call_ho(ClosureVarExpr, ClosureArgsExprs),
+ CallClosure = elds_call(elds_call_ho(ClosureVarExpr),
+ ClosureArgsExprs),
MaybeMakeClosure = yes(MakeClosure),
MaybeSuccessExpr = yes(CallClosure)
@@ -881,8 +893,8 @@
goal_info_get_determinism(FirstGoalInfo, FirstDeterminism),
( determinism_components(FirstDeterminism, _, at_most_zero) ->
% the `Rest' code is unreachable
- erl_gen_goal(CodeModel, InstMap0, First, MaybeSuccessExpr,
- Statement, !Info)
+ % There is no success expression in this case.
+ erl_gen_goal(CodeModel, InstMap0, First, no, Statement, !Info)
;
determinism_to_code_model(FirstDeterminism, FirstCodeModel),
update_instmap(First, InstMap0, InstMap1),
@@ -951,7 +963,7 @@
erl_gen_info_new_named_var("SucceedConj", SucceedVar, !Info),
SucceedVarExpr = expr_from_var(SucceedVar),
MakeSucceed = elds_eq(SucceedVarExpr, SucceedFunc),
- CallSucceed = elds_call_ho(SucceedVarExpr,
+ CallSucceed = elds_call(elds_call_ho(SucceedVarExpr),
exprs_from_vars(NonLocals)),
% Generate the code for First, such that it calls the success
@@ -1112,7 +1124,7 @@
% ``Name(Vars, ...) -> PredProcId(Vars, ...)''
varset.new_vars(varset.init, Arity, Vars, VarSet),
Clause = elds_clause(terms_from_vars(Vars),
- elds_call(PredProcId, exprs_from_vars(Vars))),
+ elds_call(elds_call_plain(PredProcId), exprs_from_vars(Vars))),
ForeignExportDefn = elds_foreign_export_defn(Name, VarSet, Clause)
;
unexpected(this_file,
Index: compiler/erl_code_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_code_util.m,v
retrieving revision 1.3
diff -u -r1.3 erl_code_util.m
--- compiler/erl_code_util.m 18 May 2007 06:04:23 -0000 1.3
+++ compiler/erl_code_util.m 24 May 2007 01:04:30 -0000
@@ -80,11 +80,26 @@
% Various utility routines used for ELDS code generation
%
+:- type opt_dummy_args
+ ---> opt_dummy_args
+ ; no_opt_dummy_args.
+
+ % erl_gen_arg_list(ModuleInfo, OptDummyArgs, Vars, VarTypes, VarModes,
+ % InputVars, OutputVars)
+ %
% Separate procedure call arguments into inputs and output variables.
- % Dummy types are ignored.
+ % If OptDummyArgs is `opt_dummy_args' then variables which are of dummy
+ % types or have argument mode `top_unused' will be ignored, i.e. not appear
+ % in either InputVars or OutputVars.
+ %
+:- pred erl_gen_arg_list(module_info::in, opt_dummy_args::in,
+ list(T)::in, list(mer_type)::in, list(mer_mode)::in,
+ list(T)::out, list(T)::out) is det.
+
+ % As above but takes arg_modes instead of mer_modes.
%
-:- pred erl_gen_arg_list(module_info::in, list(T)::in,
- list(mer_type)::in, list(mer_mode)::in,
+:- pred erl_gen_arg_list_arg_modes(module_info::in, opt_dummy_args::in,
+ list(T)::in, list(mer_type)::in, list(arg_mode)::in,
list(T)::out, list(T)::out) is det.
% Return the set of variables non-local to a goal which are bound
@@ -130,6 +145,9 @@
:- func erl_expr_size(elds_expr) = int.
%-----------------------------------------------------------------------------%
+
+:- func erl_base_typeclass_info_method_offset = int.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -177,8 +195,8 @@
proc_info_get_vartypes(ProcInfo, VarTypes),
proc_info_get_argmodes(ProcInfo, HeadModes),
pred_info_get_arg_types(PredInfo, HeadTypes),
- erl_gen_arg_list(ModuleInfo, HeadVars, HeadTypes, HeadModes,
- InputVars, OutputVars),
+ erl_gen_arg_list(ModuleInfo, opt_dummy_args,
+ HeadVars, HeadTypes, HeadModes, InputVars, OutputVars),
Info = erl_gen_info(
ModuleInfo,
PredId,
@@ -237,23 +255,30 @@
% XXX arg_info.partition_* does a similar thing but returns sets instead
% of lists
%
-erl_gen_arg_list(ModuleInfo, VarNames, ArgTypes, Modes, Inputs, Outputs) :-
+erl_gen_arg_list(ModuleInfo, OptDummyArgs, VarNames, ArgTypes, Modes,
+ Inputs, Outputs) :-
+ modes_to_arg_modes(ModuleInfo, Modes, ArgTypes, ArgModes),
+ erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
+ VarNames, ArgTypes, ArgModes, Inputs, Outputs).
+
+erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
+ VarNames, ArgTypes, ArgModes, Inputs, Outputs) :-
(
VarNames = [],
ArgTypes = [],
- Modes = []
+ ArgModes = []
->
Inputs = [],
Outputs = []
;
VarNames = [VarName | VarNames1],
ArgTypes = [ArgType | ArgTypes1],
- Modes = [Mode | Modes1]
+ ArgModes = [ArgMode | ArgModes1]
->
- erl_gen_arg_list(ModuleInfo, VarNames1, ArgTypes1,
- Modes1, Inputs1, Outputs1),
- mode_to_arg_mode(ModuleInfo, Mode, ArgType, ArgMode),
+ erl_gen_arg_list_arg_modes(ModuleInfo, OptDummyArgs,
+ VarNames1, ArgTypes1, ArgModes1, Inputs1, Outputs1),
(
+ OptDummyArgs = opt_dummy_args,
( is_dummy_argument_type(ModuleInfo, ArgType)
; ArgMode = top_unused
)
@@ -274,7 +299,7 @@
Outputs = [VarName | Outputs1]
)
;
- unexpected(this_file, "erl_gen_arg_list: length mismatch")
+ unexpected(this_file, "erl_gen_arg_list_arg_modes: length mismatch")
).
%-----------------------------------------------------------------------------%
@@ -294,14 +319,11 @@
Statement = Statement0
else
% We arbitrarily assign all the variables to the atom `false'.
- Assigments = list.map(assign_false, set.to_sorted_list(NotBound)),
- Statement = join_exprs(elds_block(Assigments), Statement0)
+ NotBoundList = set.to_sorted_list(NotBound),
+ Assignments = list.map(var_eq_false, NotBoundList),
+ Statement = join_exprs(elds_block(Assignments), Statement0)
).
-:- func assign_false(prog_var) = elds_expr.
-
-assign_false(Var) = elds_eq(expr_from_var(Var), elds_term(elds_false)).
-
%-----------------------------------------------------------------------------%
erl_create_renaming(Vars, Subst, !Info) :-
@@ -338,18 +360,10 @@
erl_rename_vars_in_expr(Subn, ExprB0, ExprB),
Expr = elds_binop(Op, ExprA, ExprB)
;
- Expr0 = elds_call(PredProcId, Exprs0),
- erl_rename_vars_in_exprs(Subn, Exprs0, Exprs),
- Expr = elds_call(PredProcId, Exprs)
- ;
- Expr0 = elds_call_ho(ExprA0, ExprsB0),
- erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
+ Expr0 = elds_call(CallTarget0, ExprsB0),
+ erl_rename_vars_in_call_target(Subn, CallTarget0, CallTarget),
erl_rename_vars_in_exprs(Subn, ExprsB0, ExprsB),
- Expr = elds_call_ho(ExprA, ExprsB)
- ;
- Expr0 = elds_call_builtin(Atom, ExprsA0),
- erl_rename_vars_in_exprs(Subn, ExprsA0, ExprsA),
- Expr = elds_call_builtin(Atom, ExprsA)
+ Expr = elds_call(CallTarget, ExprsB)
;
Expr0 = elds_fun(Clause0),
erl_rename_vars_in_clause(Subn, Clause0, Clause),
@@ -370,7 +384,9 @@
erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
Expr = elds_throw(ExprA)
;
- Expr0 = elds_foreign_code(_),
+ ( Expr0 = elds_rtti_ref(_)
+ ; Expr0 = elds_foreign_code(_)
+ ),
Expr = Expr0
).
@@ -405,6 +421,21 @@
Term = elds_var(Var)
).
+:- pred erl_rename_vars_in_call_target(prog_var_renaming::in,
+ elds_call_target::in, elds_call_target::out) is det.
+
+erl_rename_vars_in_call_target(Subn, Target0, Target) :-
+ (
+ ( Target0 = elds_call_plain(_)
+ ; Target0 = elds_call_builtin(_)
+ ),
+ Target = Target0
+ ;
+ Target0 = elds_call_ho(Expr0),
+ erl_rename_vars_in_expr(Subn, Expr0, Expr),
+ Target = elds_call_ho(Expr)
+ ).
+
:- pred erl_rename_vars_in_clause(prog_var_renaming::in,
elds_clause::in, elds_clause::out) is det.
@@ -462,14 +493,8 @@
Expr = elds_binop(_Op, ExprA, ExprB),
Size = erl_expr_size(ExprA) + erl_expr_size(ExprB)
;
- Expr = elds_call(_PredProcId, Exprs),
- Size = 1 + erl_exprs_size(Exprs)
- ;
- Expr = elds_call_ho(ExprA, ExprsB),
- Size = 1 + erl_expr_size(ExprA) + erl_exprs_size(ExprsB)
- ;
- Expr = elds_call_builtin(_Atom, ExprsA),
- Size = 1 + erl_exprs_size(ExprsA)
+ Expr = elds_call(CallTarget, Exprs),
+ Size = erl_call_target_size(CallTarget) + erl_exprs_size(Exprs)
;
Expr = elds_fun(elds_clause(Terms, ExprA)),
Size = 1 + erl_terms_size(Terms) + erl_expr_size(ExprA)
@@ -486,6 +511,9 @@
Expr = elds_throw(ExprA),
Size = 1 + erl_expr_size(ExprA)
;
+ Expr = elds_rtti_ref(_),
+ Size = 1
+ ;
Expr = elds_foreign_code(_),
% Arbitrary number.
Size = 10000
@@ -515,6 +543,12 @@
Size = 1 + erl_exprs_size(Exprs)
).
+:- func erl_call_target_size(elds_call_target) = int.
+
+erl_call_target_size(elds_call_plain(_)) = 1.
+erl_call_target_size(elds_call_builtin(_)) = 1.
+erl_call_target_size(elds_call_ho(Expr)) = erl_expr_size(Expr).
+
:- func erl_cases_size(list(elds_case)) = int.
erl_cases_size(Cases) = 1 + sum(list.map(erl_case_size, Cases)).
@@ -531,6 +565,26 @@
%-----------------------------------------------------------------------------%
+ % This function returns the offset to add to the method number
+ % for a type class method to get its field number within the
+ % base_typeclass_info.
+ % field 0 is num_extra
+ % field 1 is num_constraints
+ % field 2 is num_superclasses
+ % field 3 is class_arity
+ % field 4 is num_methods
+ % field 5 is the 1st method
+ % field 6 is the 2nd method
+ % etc.
+ % (See the base_typeclass_info type in rtti.m or the
+ % description in notes/type_class_transformation.html for
+ % more information about the layout of base_typeclass_infos.)
+ % Hence the offset is 4.
+ %
+erl_base_typeclass_info_method_offset = 4.
+
+%-----------------------------------------------------------------------------%
+
:- func this_file = string.
this_file = "erl_code_util.m".
Index: compiler/erl_rtti.m
===================================================================
RCS file: compiler/erl_rtti.m
diff -N compiler/erl_rtti.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/erl_rtti.m 24 May 2007 01:04:30 -0000
@@ -0,0 +1,201 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2007 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.
+%-----------------------------------------------------------------------------%
+%
+% File: erl_rtti.m.
+% Main author: wangp.
+%
+% This module converts from the back-end-independent RTTI data structures into
+% ELDS function definitions.
+%
+% XXX currently we only do enough to allow type classes to work
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.erl_rtti.
+:- interface.
+
+:- import_module backend_libs.rtti.
+:- import_module erl_backend.elds.
+:- import_module hlds.hlds_module.
+
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+:- pred rtti_data_list_to_elds(module_info::in, list(rtti_data)::in,
+ list(elds_rtti_defn)::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module erl_backend.erl_call_gen.
+:- import_module erl_backend.erl_code_util.
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_rtti.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.prog_data.
+
+:- import_module bool.
+:- import_module int.
+:- import_module maybe.
+:- import_module svvarset.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+rtti_data_list_to_elds(ModuleInfo, RttiDatas, RttiDefns) :-
+ list.map(rtti_data_to_elds(ModuleInfo), RttiDatas, RttiDefns0),
+ RttiDefns = list.condense(RttiDefns0).
+
+:- pred rtti_data_to_elds(module_info::in, rtti_data::in,
+ list(elds_rtti_defn)::out) is det.
+
+rtti_data_to_elds(ModuleInfo, RttiData, [RttiDefn]) :-
+ RttiData = rtti_data_base_typeclass_info(TCName, InstanceModule,
+ InstanceStr, BaseTypeClassInfo),
+ BaseTypeClassInfo = base_typeclass_info(N1, N2, N3, N4, N5, Methods),
+ NumExtra = BaseTypeClassInfo ^ num_extra,
+ list.map_foldl(erl_gen_method_wrapper(ModuleInfo, NumExtra), Methods,
+ MethodWrappers, varset.init, VarSet),
+ BaseTypeClassInfoData = elds_tuple([
+ elds_term(elds_int(N1)),
+ elds_term(elds_int(N2)),
+ elds_term(elds_int(N3)),
+ elds_term(elds_int(N4)),
+ elds_term(elds_int(N5))
+ | MethodWrappers
+ ]),
+ RttiId = elds_rtti_base_typeclass_id(TCName, InstanceModule, InstanceStr),
+ IsExported = yes,
+ RttiDefn = elds_rtti_defn(RttiId, IsExported, VarSet,
+ elds_clause([], elds_term(BaseTypeClassInfoData))).
+
+rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
+ RttiData = rtti_data_type_info(_TypeInfo).
+rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
+ RttiData = rtti_data_pseudo_type_info(_PseudoTypeInfo).
+rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
+ RttiData = rtti_data_type_class_decl(_TCDecl).
+rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
+ RttiData = rtti_data_type_class_instance(_Instance).
+rtti_data_to_elds(_ModuleInfo, RttiData, []) :-
+ RttiData = rtti_data_type_ctor_info(_TypeCtorData).
+
+%-----------------------------------------------------------------------------%
+
+:- pred erl_gen_method_wrapper(module_info::in, int::in, rtti_proc_label::in,
+ elds_expr::out, prog_varset::in, prog_varset::out) is det.
+
+erl_gen_method_wrapper(ModuleInfo, NumExtra, RttiProcId, WrapperFun,
+ !VarSet) :-
+ PredId = RttiProcId ^ pred_id,
+ ProcId = RttiProcId ^ proc_id,
+ Arity = RttiProcId ^ proc_arity,
+ ArgTypes = RttiProcId ^ proc_arg_types,
+ ArgModes = RttiProcId ^ proc_arg_modes,
+ Detism = RttiProcId ^ proc_interface_detism,
+
+ % We can't store the address of the typeclass method directly in the
+ % base_typeclass_info; instead, we need to generate a wrapper function
+ % that extracts the NumExtra parameters it needs from the typeclass_info,
+ % and store the address of that wrapper function in the
+ % base_typeclass_info.
+ %
+ % Note that this means there are two levels of wrappers: the wrapper that
+ % we generate here calls the procedure introduced by check_typeclass.m,
+ % and that in turn calls the user's procedure.
+ %
+ % A det wrapper looks like:
+ %
+ % fun(TypeClassInfo, W1, W2, ...) ->
+ % /* extract NumExtra parameters from TypeClassInfo */
+ % E2 = element(2, TypeClassInfo),
+ % E3 = element(3, TypeClassInfo),
+ % ...
+ % {Y1, Y2, ...} = actual_method(TypeClassInfo,
+ % E2, E3, ..., W1, W2, ...),
+ % {Y1, Y2, ...} /* may have additional outputs */
+ % end
+ %
+
+ svvarset.new_named_var("TypeClassInfo", TCIVar, !VarSet),
+ svvarset.new_vars(Arity, Ws, !VarSet),
+
+ % Make the ``E<n> = element(<n>, TypeClassInfo)'' expressions.
+ list.map2_foldl(extract_extra_arg(TCIVar), 1 .. NumExtra,
+ ExtraVars, ExtractExtras, !VarSet),
+
+ % Figure out the input and output variables for the call to the actual
+ % method implementation.
+ ExtraVarsWs = ExtraVars ++ Ws,
+ erl_gen_arg_list_arg_modes(ModuleInfo, opt_dummy_args,
+ ExtraVarsWs, ArgTypes, ArgModes, CallInputArgs, CallOutputArgs),
+
+ % Figure out the input variables and output variables for this wrapper
+ % function.
+ erl_gen_arg_list_arg_modes(ModuleInfo, no_opt_dummy_args,
+ ExtraVarsWs, ArgTypes, ArgModes,
+ WrapperInputVarsPlusExtras, WrapperOutputVars),
+ WrapperInputVars = list.delete_elems(WrapperInputVarsPlusExtras, ExtraVars),
+
+ determinism_to_code_model(Detism, CodeModel),
+ WrapperOutputVarsExprs = exprs_from_vars(WrapperOutputVars),
+ (
+ ( CodeModel = model_det
+ ; CodeModel = model_semi
+ ),
+ AllWrapperInputVars = [TCIVar | WrapperInputVars],
+ % On success we return a tuple of the output arguments of the call.
+ SuccessExpr0 = elds_term(elds_tuple(WrapperOutputVarsExprs))
+ ;
+ CodeModel = model_non,
+ % model_non wrappers need an additional argument which is the success
+ % continuation. On success we call the success continuation with the
+ % output arguments of the call.
+ svvarset.new_named_var("Succeed", SucceedVar, !VarSet),
+ AllWrapperInputVars = [TCIVar | WrapperInputVars] ++ [SucceedVar],
+ SuccessExpr0 = elds_call(elds_call_ho(expr_from_var(SucceedVar)),
+ WrapperOutputVarsExprs)
+ ),
+
+ % Any variables which are outputs of the wrapper function but not of the
+ % method need to be materialised by the wrapper.
+ DummyOutputVars = list.delete_elems(WrapperOutputVars, CallOutputArgs),
+ MaterialiseDummyOutputVars = list.map(var_eq_false, DummyOutputVars),
+ SuccessExpr = join_exprs(elds_block(MaterialiseDummyOutputVars),
+ SuccessExpr0),
+
+ % Make the call to the underlying method implementation.
+ CallTarget = elds_call_plain(proc(PredId, ProcId)),
+ erl_make_call(CodeModel, CallTarget, CallInputArgs,
+ CallOutputArgs, yes(SuccessExpr), DoCall),
+
+ WrapperFun = elds_fun(elds_clause(terms_from_vars(AllWrapperInputVars),
+ join_exprs(elds_block(ExtractExtras), DoCall))).
+
+:- pred extract_extra_arg(prog_var::in, int::in, prog_var::out, elds_expr::out,
+ prog_varset::in, prog_varset::out) is det.
+
+extract_extra_arg(TCIVar, Index, Var, ExtractStatement, !VarSet) :-
+ svvarset.new_named_var("Extra", Var, !VarSet),
+ % Erlang's `element' builtin counts from 1.
+ ExtractStatement = elds_eq(expr_from_var(Var),
+ elds_call_element(TCIVar, 1 + Index)).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "erl_rtti.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module erl_rtti.
+%-----------------------------------------------------------------------------%
Index: compiler/erl_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/erl_unify_gen.m,v
retrieving revision 1.3
diff -u -r1.3 erl_unify_gen.m
--- compiler/erl_unify_gen.m 18 May 2007 06:04:24 -0000 1.3
+++ compiler/erl_unify_gen.m 24 May 2007 01:04:30 -0000
@@ -58,15 +58,21 @@
:- implementation.
+:- import_module backend_libs.rtti.
+:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
+:- import_module erl_backend.erl_call_gen.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module libs.compiler_util.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_util.
:- import_module int.
:- import_module list.
+:- import_module pair.
+:- import_module set.
:- import_module string.
%-----------------------------------------------------------------------------%
@@ -112,8 +118,16 @@
expect(unify(MaybeSizeProfInfo, no), this_file,
"erl_code_gen: term size profiling not yet supported")
),
- erl_gen_construct(Var, ConsId, Args, ArgModes, Context, Construct, !Info),
- Statement = maybe_join_exprs(Construct, MaybeSuccessExpr).
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_variable_type(!.Info, Var, VarType),
+ ( is_dummy_argument_type(ModuleInfo, VarType) ->
+ Statement = expr_or_void(MaybeSuccessExpr)
+ ;
+ erl_variable_types(!.Info, Args, ArgTypes),
+ erl_gen_construct(Var, ConsId, Args, ArgTypes, ArgModes, Context,
+ Construct, !Info),
+ Statement = maybe_join_exprs(Construct, MaybeSuccessExpr)
+ ).
erl_gen_unification(Unification, _CodeModel, Context, MaybeSuccessExpr,
Statement, !Info) :-
@@ -137,12 +151,39 @@
%-----------------------------------------------------------------------------%
:- pred erl_gen_construct(prog_var::in, cons_id::in, prog_vars::in,
- list(uni_mode)::in, prog_context::in, elds_expr::out,
+ list(mer_type)::in, list(uni_mode)::in, prog_context::in, elds_expr::out,
erl_gen_info::in, erl_gen_info::out) is det.
-erl_gen_construct(Var, ConsId, Args, _ArgModes, _Context, Statement, !Info) :-
+erl_gen_construct(Var, ConsId, Args, ArgTypes, UniModes, _Context, Statement,
+ !Info) :-
cons_id_to_expr(ConsId, Args, RHS, !Info),
- Statement = elds_eq(expr_from_var(Var), RHS).
+ Construct = elds_eq(expr_from_var(Var), RHS),
+ %
+ % If there are any free variables in Args, assign them to false first.
+ % i.e. we are constructing a partially instantiated data structure.
+ %
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ AssignFreeVars = list.filter_map_corresponding3(
+ assign_free_var(ModuleInfo), Args, ArgTypes, UniModes),
+ (
+ AssignFreeVars = [],
+ Statement = Construct
+ ;
+ AssignFreeVars = [_ | _],
+ Statement = join_exprs(elds_block(AssignFreeVars), Construct)
+ ).
+
+:- func assign_free_var(module_info, prog_var, mer_type, uni_mode) = elds_expr
+ is semidet.
+
+assign_free_var(ModuleInfo, Var, ArgType, UniMode) = var_eq_false(Var) :-
+ UniMode = ((_LI - RI) -> (_LF - RF)),
+ not (
+ mode_to_arg_mode(ModuleInfo, (RI -> RF), ArgType, top_in),
+ not is_dummy_argument_type(ModuleInfo, ArgType)
+ % XXX ml_unify_gen also checks if ConsArgType is dummy type,
+ % do we need to do the same?
+ ).
%-----------------------------------------------------------------------------%
@@ -217,13 +258,29 @@
ConsId = pred_const(ShroudedPredProcId, lambda_normal),
pred_const_to_closure(ShroudedPredProcId, Args, Expr, !Info)
;
- ( ConsId = type_ctor_info_const(_, _, _)
- ; ConsId = base_typeclass_info_const(_, _, _, _)
- ; ConsId = type_info_cell_constructor(_)
+ ConsId = type_ctor_info_const(ModuleName, TypeCtor, Arity),
+ RttiId = elds_rtti_type_ctor_id(ModuleName, TypeCtor, Arity),
+ Expr = elds_rtti_ref(RttiId)
+ ;
+ ConsId = base_typeclass_info_const(InstanceModule,
+ class_id(ClassName, Arity), _Instance, InstanceStr),
+ ( sym_name_get_module_name(ClassName, ClassModuleName0) ->
+ ClassModuleName = ClassModuleName0
+ ;
+ unexpected(this_file, "cons_id_to_expr: class has no module name")
+ ),
+ ClassNameStr = unqualify_name(ClassName),
+ TCName = tc_name(ClassModuleName, ClassNameStr, Arity),
+ RttiId = elds_rtti_base_typeclass_id(TCName, InstanceModule,
+ InstanceStr),
+ Expr = elds_rtti_ref(RttiId)
+ ;
+ ( ConsId = type_info_cell_constructor(_TypeCtor)
; ConsId = typeclass_info_cell_constructor
),
- % XXX RTTI not implemented for Erlang backend yet.
- Expr = elds_term(elds_atom_raw("todo_some_rtti_thing"))
+ % This represents type_infos and typeclass_infos as undistinguished
+ % tuples, so the layout will be the same as corresponding arrays in C.
+ Expr = elds_term(elds_tuple(exprs_from_vars(Args)))
;
( ConsId = tabling_info_const(_)
; ConsId = deep_profiling_proc_layout(_)
@@ -236,7 +293,7 @@
:- pred pred_const_to_closure(shrouded_pred_proc_id::in, prog_vars::in,
elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
-pred_const_to_closure(ShroudedPredProcId, Args, FunExpr, !Info) :-
+pred_const_to_closure(ShroudedPredProcId, CurriedArgs, FunExpr, !Info) :-
erl_gen_info_get_module_info(!.Info, ModuleInfo),
PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
@@ -245,34 +302,52 @@
proc_info_interface_code_model(ProcInfo, CodeModel),
% Create extra variables needed to complete the call to the procedure.
- NumExtraVars = list.length(CalleeTypes) - list.length(Args),
+ NumExtraVars = list.length(CalleeTypes) - list.length(CurriedArgs),
erl_gen_info_new_vars(NumExtraVars, AllExtraVars, !Info),
- % Keep only the extra variables which are going to be input arguments.
- erl_gen_arg_list(ModuleInfo, Args ++ AllExtraVars, CalleeTypes,
- ArgModes, AllInputVars, OutputVars),
- InputExtraVars = list.delete_elems(AllExtraVars, OutputVars),
+ % Separate the argument lists into inputs and outputs twice: once ignore
+ % dummy and unused arguments, and once keeping them. Dummy arguments must
+ % not be dropped in the closure's function signature, and dummy outputs
+ % must be present in the return value. However, the underlying procedure
+ % won't accept dummy arguments and won't return dummy values.
+
+ CurriedAndExtraArgs = CurriedArgs ++ AllExtraVars,
+
+ erl_gen_arg_list(ModuleInfo, opt_dummy_args, CurriedAndExtraArgs,
+ CalleeTypes, ArgModes, CallInputVars, CallOutputVars),
+
+ erl_gen_arg_list(ModuleInfo, no_opt_dummy_args, CurriedAndExtraArgs,
+ CalleeTypes, ArgModes, _InputVarsInclDummy, OutputVarsInclDummy),
+ InputExtraVars = list.delete_elems(AllExtraVars, OutputVarsInclDummy),
+ OutputVarsInclDummyExprs = exprs_from_vars(OutputVarsInclDummy),
(
( CodeModel = model_det
; CodeModel = model_semi
),
- InputTerms = terms_from_vars(InputExtraVars),
- CallArgs = exprs_from_vars(AllInputVars)
+ ClosureInputArgs = InputExtraVars,
+ SuccessExpr0 = elds_term(elds_tuple(OutputVarsInclDummyExprs))
;
CodeModel = model_non,
% One more extra variable is needed for the success continuation for
% model_non procedures.
erl_gen_info_new_named_var("Succeed", SucceedVar, !Info),
- InputTerms = terms_from_vars(InputExtraVars ++ [SucceedVar]),
- CallArgs = exprs_from_vars(AllInputVars ++ [SucceedVar])
+ ClosureInputArgs = InputExtraVars ++ [SucceedVar],
+ SuccessExpr0 = elds_call(elds_call_ho(expr_from_var(SucceedVar)),
+ OutputVarsInclDummyExprs)
),
- % FunExpr = ``fun(InputTerms, ...) -> Proc(CallArgs, ...) end''
- % where InputTerms are part of CallArgs.
- %
- FunExpr = elds_fun(elds_clause(InputTerms, Call)),
- Call = elds_call(PredProcId, CallArgs).
+ DummyOutputVars = list.delete_elems(OutputVarsInclDummy, CallOutputVars),
+ MaterialiseDummyOutputs = list.map(var_eq_false, DummyOutputVars),
+ SuccessExpr = join_exprs(elds_block(MaterialiseDummyOutputs),
+ SuccessExpr0),
+
+ % Make the call to the underlying procedure.
+ CallTarget = elds_call_plain(PredProcId),
+ erl_make_call(CodeModel, CallTarget, CallInputVars, CallOutputVars,
+ yes(SuccessExpr), DoCall),
+
+ FunExpr = elds_fun(elds_clause(terms_from_vars(ClosureInputArgs), DoCall)).
%-----------------------------------------------------------------------------%
Index: compiler/instmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/instmap.m,v
retrieving revision 1.56
diff -u -r1.56 instmap.m
--- compiler/instmap.m 5 Feb 2007 03:12:52 -0000 1.56
+++ compiler/instmap.m 24 May 2007 01:04:30 -0000
@@ -311,7 +311,8 @@
% InstMapDelta, Var)
%
% Succeed if Var is a variable bound between InstMap and
- % InstMap+InstMapDelta.
+ % InstMap+InstMapDelta. Fails if either InstMap or InstMapDelta are
+ % unreachable.
%
:- pred var_is_bound_in_instmap_delta(module_info::in, instmap::in,
instmap_delta::in, prog_var::in) is semidet.
@@ -1228,6 +1229,8 @@
inst_is_any(ModuleInfo, Inst).
var_is_bound_in_instmap_delta(ModuleInfo, InstMap, InstMapDelta, Var) :-
+ instmap.is_reachable(InstMap),
+ instmap_delta_is_reachable(InstMapDelta),
instmap.lookup_var(InstMap, Var, OldVarInst),
inst_is_free(ModuleInfo, OldVarInst),
instmap_delta_search_var(InstMapDelta, Var, VarInst),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.435
diff -u -r1.435 mercury_compile.m
--- compiler/mercury_compile.m 23 May 2007 00:17:17 -0000 1.435
+++ compiler/mercury_compile.m 24 May 2007 01:04:30 -0000
@@ -149,6 +149,7 @@
:- import_module erl_backend.elds.
:- import_module erl_backend.elds_to_erlang.
:- import_module erl_backend.erl_code_gen.
+:- import_module erl_backend.erl_rtti.
% miscellaneous compiler modules
:- import_module check_hlds.goal_path.
@@ -1698,7 +1699,7 @@
FactTableBaseFiles = []
;
Target = target_erlang,
- erlang_backend(!HLDS, ELDS, !DumpInfo, !IO),
+ erlang_backend(!.HLDS, ELDS, !DumpInfo, !IO),
elds_to_erlang(!.HLDS, ELDS, !IO),
FactTableBaseFiles = []
),
@@ -5186,11 +5187,27 @@
% Erlang backend
%
-:- pred erlang_backend(module_info::in, module_info::out, elds::out,
+:- pred erlang_backend(module_info::in, elds::out,
dump_info::in, dump_info::out, io::di, io::uo) is det.
-erlang_backend(!HLDS, ELDS, !DumpInfo, !IO) :-
- erl_code_gen(!.HLDS, ELDS, !IO).
+erlang_backend(HLDS, ELDS, !DumpInfo, !IO) :-
+ erl_code_gen(HLDS, ELDS0, !IO),
+
+ % Generate the representations for various data structures
+ % used for type classes.
+ type_ctor_info.generate_rtti(HLDS, TypeCtorRttiData),
+ generate_base_typeclass_info_rtti(HLDS, OldTypeClassInfoRttiData),
+ globals.io_lookup_bool_option(new_type_class_rtti, NewTypeClassRtti, !IO),
+ generate_type_class_info_rtti(HLDS, NewTypeClassRtti,
+ NewTypeClassInfoRttiData),
+ list.append(OldTypeClassInfoRttiData, NewTypeClassInfoRttiData,
+ TypeClassInfoRttiData),
+ RttiDatas = TypeCtorRttiData ++ TypeClassInfoRttiData,
+
+ ELDS0 = elds(ModuleName, ForeignBodies, Defns, FEDefns, RttiDefns0),
+ rtti_data_list_to_elds(HLDS, RttiDatas, RttiDefns),
+ ELDS = elds(ModuleName, ForeignBodies, Defns, FEDefns,
+ RttiDefns0 ++ RttiDefns).
:- pred elds_to_erlang(module_info::in, elds::in, io::di, io::uo) is det.
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.128
diff -u -r1.128 compiler_design.html
--- compiler/notes/compiler_design.html 15 May 2007 02:38:22 -0000 1.128
+++ compiler/notes/compiler_design.html 24 May 2007 01:04:30 -0000
@@ -1497,7 +1497,7 @@
the RTTI data structures defined in rtti.m and pseudo_type_info.m
(those four modules are in the backend_libs.m package, since they
are shared with the LLDS back-end)
- and then mlds_to_rtti.m converts these to MLDS.
+ and then rtti_to_mlds.m converts these to MLDS.
</ul>
<h4> 5b. MLDS transformations </h4>
@@ -1609,6 +1609,8 @@
</ul>
The module erl_code_util.m provides utility routines for
ELDS code generation.
+<li> erl_rtti.m converts RTTI data structures defined in rtti.m into
+ ELDS functions which return the same information when called.
</ul>
<h4> 6d. ELDS output </h4>
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list