[m-rev.] for review: initial erlang code generator
Peter Wang
wangp at students.csse.unimelb.edu.au
Mon May 14 14:02:13 AEST 2007
Estimated hours taken: 50
Branches: main
Initial version of a HLDS->Erlang code generator. Currently det and semidet
code is supported. The code generator converts HLDS data structures into a
new ELDS data structure, which is an internal representation of Erlang code.
Then the ELDS data structure is printed out into concrete Erlang syntax.
compiler/elds.m:
compiler/elds_to_erlang.m:
compiler/erl_backend.m:
compiler/erl_call_gen.m:
compiler/erl_code_gen.m:
compiler/erl_code_util.m:
compiler/erl_unify_gen.m:
New files.
compiler/Mercury.options:
Add --no-warn-unused-imports for erl_backend package.
compiler/top_level.m:
compiler/mercury_compile.m:
Import the Erlang backend and call it for --target erlang.
compiler/modules.m:
Add module_name_to_file_name_sep which is like module_name_to_file_name
but allows modules to be qualified with a string other than ".".
library/array.m:
library/bitmap.m:
library/io.m:
Add Erlang foreign_type declarations for array(T),
bitmap and io.system_error.
Index: compiler/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/Mercury.options,v
retrieving revision 1.27
diff -u -r1.27 Mercury.options
--- compiler/Mercury.options 2 May 2007 06:08:49 -0000 1.27
+++ compiler/Mercury.options 14 May 2007 04:00:50 -0000
@@ -31,6 +31,7 @@
MCFLAGS-make.module_target = --no-ansi-c
MCFLAGS-make.program_target = --no-ansi-c
+MCFLAGS-erl_backend = --no-warn-unused-imports
MCFLAGS-hlds = --no-warn-unused-imports
MCFLAGS-ll_backend = --no-warn-unused-imports
MCFLAGS-make = --no-warn-unused-imports
Index: compiler/elds.m
===================================================================
RCS file: compiler/elds.m
diff -N compiler/elds.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/elds.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,222 @@
+%-----------------------------------------------------------------------------%
+% 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: elds.m.
+% Main author: wangp.
+%
+% ELDS - The Erlang Data Structure.
+%
+% This module defines the ELDS data structure itself.
+% The ELDS is an intermediate data structure used in compilation;
+% we compile Mercury source -> parse tree -> HLDS -> ELDS -> target (Erlang).
+% The ELDS uses the same types for variables and procedure ids as the HLDS
+% so as not the clutter the ELDS code generator with conversions between types.
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.elds.
+:- interface.
+
+:- import_module hlds.hlds_pred.
+:- import_module mdbcomp.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.prog_data.
+
+:- import_module char.
+:- import_module list.
+:- import_module maybe.
+
+%-----------------------------------------------------------------------------%
+
+%
+% The type `elds' is the actual ELDS.
+%
+:- type elds
+ ---> elds(
+ % The original Mercury module name.
+ elds_name :: module_name,
+
+ % Definitions of functions in the module.
+ elds_funcs :: list(elds_defn)
+ ).
+
+ % Function definition.
+ %
+:- type elds_defn
+ ---> elds_defn(
+ defn_proc_id :: pred_proc_id,
+ defn_arity :: int,
+ defn_varset :: prog_varset,
+ defn_clause :: elds_clause
+ ).
+
+:- type elds_clause
+ ---> elds_clause(
+ clause_pattern :: list(elds_term),
+ clause_expr :: elds_expr
+ ).
+
+:- type elds_expr
+ ---> elds_block(list(elds_expr))
+ ; elds_term(elds_term)
+ ; elds_eq(elds_expr, elds_expr) % `='
+ ; elds_unop(elds_unop, elds_expr)
+ ; elds_binop(elds_binop, elds_expr, elds_expr)
+ ; elds_call(pred_proc_id, list(elds_expr)) % input args
+ ; elds_call_ho(elds_expr, list(elds_expr)) % input args
+ ; elds_fun(elds_clause)
+ ; elds_case_expr(elds_expr, list(elds_case)).
+
+:- type elds_term
+ ---> elds_char(char)
+ ; elds_int(int)
+ ; elds_float(float)
+ ; elds_string(string)
+ ; elds_atom_raw(string)
+ ; elds_atom(sym_name)
+ ; elds_tuple(list(elds_expr))
+ ; elds_var(prog_var)
+ ; elds_anon_var.
+
+% 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_case
+ ---> elds_case(elds_term, elds_expr).
+
+:- type elds_unop
+ ---> plus
+ ; minus
+ ; bnot
+ ; logical_not.
+
+:- type elds_binop
+ ---> mul
+ ; float_div
+ ; int_div
+ ; (rem)
+ ; band
+ %; and % *not* short circuiting
+ ; add
+ ; sub
+ ; bor
+ ; bxor
+ ; bsl
+ ; bsr
+ %; or
+ %; xor
+ %; plus_plus
+ %; minus_minus
+ %; (==) % *only* useful when comparing floats with integers
+ %; (/=)
+ ; (=<)
+ ; (<)
+ ; (>=)
+ ; (>)
+ ; (=:=)
+ ; (=/=)
+ ; andalso % short circuiting
+ ; orelse % short circuiting
+ .
+
+%-----------------------------------------------------------------------------%
+
+ % Some useful constants.
+ %
+:- func elds_true = elds_term.
+:- func elds_false = elds_term.
+:- func elds_fail = elds_term.
+:- func elds_empty_tuple = elds_term.
+
+:- func term_from_var(prog_var) = elds_term.
+:- func terms_from_vars(prog_vars) = list(elds_term).
+:- func expr_from_var(prog_var) = elds_expr.
+:- func exprs_from_vars(prog_vars) = list(elds_expr).
+
+ % Convert an expression to a term, aborting on failure.
+ %
+:- func expr_to_term(elds_expr) = elds_term.
+
+ % Join two expressions into one block expression, flattening any nested
+ % blocks.
+ %
+:- func join_exprs(elds_expr, elds_expr) = elds_expr.
+
+ % maybe_join_exprs(ExprA, MaybeExprB)
+ %
+ % Join ExprA and ExprB as above if MaybeExprB = `yes(ExprB)',
+ % otherwise return ExprA.
+ %
+:- func maybe_join_exprs(elds_expr, maybe(elds_expr)) = elds_expr.
+
+ % expr_or_void(MaybeExpr)
+ %
+ % Return `E' if MaybeExpr unifies with `yes(E)', or any constant expression
+ % if MaybeExpr unifies with `no'. MaybeExpr should only be `no' if value
+ % that an expression evaluates to doesn't matter.
+ %
+:- func expr_or_void(maybe(elds_expr)) = elds_expr.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module libs.compiler_util.
+
+%-----------------------------------------------------------------------------%
+
+elds_true = elds_atom_raw("true").
+elds_false = elds_atom_raw("false").
+elds_fail = elds_atom_raw("fail").
+elds_empty_tuple = elds_tuple([]).
+
+term_from_var(Var) = elds_var(Var).
+terms_from_vars(Vars) = list.map(term_from_var, Vars).
+
+expr_from_var(Var) = elds_term(elds_var(Var)).
+exprs_from_vars(Vars) = list.map(expr_from_var, Vars).
+
+expr_to_term(Expr) = Term :-
+ ( Expr = elds_term(Term0) ->
+ Term = Term0
+ ;
+ unexpected(this_file, "unable to convert elds_expr to elds_term")
+ ).
+
+join_exprs(ExprA, ExprB) = Expr :-
+ (
+ ExprA = elds_block(ExprsA),
+ ExprB = elds_block(ExprsB)
+ ->
+ Expr = elds_block(ExprsA ++ ExprsB)
+ ;
+ ExprB = elds_block(ExprsB)
+ ->
+ Expr = elds_block([ExprA | ExprsB])
+ ;
+ ExprA = elds_block(ExprsA)
+ ->
+ Expr = elds_block(ExprsA ++ [ExprB])
+ ;
+ Expr = elds_block([ExprA, ExprB])
+ ).
+
+maybe_join_exprs(ExprA, yes(ExprB)) = join_exprs(ExprA, ExprB).
+maybe_join_exprs(Expr, no) = Expr.
+
+expr_or_void(yes(Expr)) = Expr.
+expr_or_void(no) = elds_term(elds_atom_raw("void")).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "elds.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: compiler/elds_to_erlang.m
diff -N compiler/elds_to_erlang.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/elds_to_erlang.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,669 @@
+%-----------------------------------------------------------------------------%
+% 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: elds_to_erlang.m.
+% Main authors: wangp.
+%
+% Convert ELDS to Erlang code.
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.elds_to_erlang.
+:- interface.
+
+:- import_module erl_backend.elds.
+:- import_module hlds.hlds_module.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+ % output_elds(ELDS, !IO):
+ %
+ % Output Erlang code to the appropriate .erl file. The file names are
+ % determined by the module name.
+ %
+:- pred output_elds(module_info::in, elds::in, io::di, io::uo) is det.
+
+ % Output a Erlang function definition to the current output stream.
+ % This is exported for debugging purposes.
+ %
+:- pred output_defn(module_info::in, elds_defn::in, io::di, io::uo)
+ is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module backend_libs.rtti.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_rtti.
+:- import_module hlds.passes_aux.
+:- import_module hlds.special_pred.
+:- import_module libs.compiler_util.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.modules.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_util.
+
+:- import_module bool.
+:- import_module char.
+:- import_module int.
+:- import_module library.
+:- import_module list.
+:- import_module maybe.
+:- import_module pair.
+:- import_module string.
+:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+output_elds(ModuleInfo, ELDS, !IO) :-
+ ELDS = elds(ModuleName, _),
+ %
+ % The Erlang interactive shell doesn't like "." in filenames so we use "__"
+ % instead.
+ %
+ module_name_to_file_name_sep(ModuleName, "__", ".erl", yes,
+ SourceFileName, !IO),
+ output_to_file(SourceFileName, output_erl_file(ModuleInfo, ELDS,
+ SourceFileName), !IO).
+
+:- pred output_erl_file(module_info::in, elds::in, string::in,
+ io::di, io::uo) is det.
+
+output_erl_file(ModuleInfo, elds(ModuleName, Defns), SourceFileName, !IO) :-
+ % Output intro.
+ library.version(Version),
+ io.write_strings([
+ "%\n",
+ "% Automatically generated from `", SourceFileName, "'\n",
+ "% by the Mercury compiler,\n",
+ "% version ", Version, ".\n",
+ "% Do not edit.\n",
+ "%\n",
+ "\n"
+ ], !IO),
+
+ % Write module annotations.
+ io.write_string("-module(", !IO),
+ io.write_string(sym_name_to_string_sep(ModuleName, "__"), !IO),
+ io.write_string(").\n", !IO),
+
+ io.write_string("-export([", !IO),
+ output_exports(ModuleInfo, Defns, no, !IO),
+ io.write_string("]).\n", !IO),
+
+ % Useful for debugging.
+ io.write_string("% -compile(export_all).\n", !IO),
+
+ list.foldl(output_defn(ModuleInfo), Defns, !IO).
+
+:- pred output_exports(module_info::in, list(elds_defn)::in, bool::in,
+ io::di, io::uo) is det.
+
+output_exports(_ModuleInfo, [], _NeedComma, !IO).
+output_exports(ModuleInfo, [Defn | Defns], NeedComma, !IO) :-
+ Defn = elds_defn(PredProcId, Arity, _, _),
+ PredProcId = proc(PredId, _ProcId),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ IsExported = status_is_exported(ImportStatus),
+ (
+ IsExported = yes,
+ (
+ NeedComma = yes,
+ io.write_char(',', !IO)
+ ;
+ NeedComma = no
+ ),
+ nl_indent_line(1, !IO),
+ output_pred_proc_id(ModuleInfo, PredProcId, !IO),
+ io.write_char('/', !IO),
+ io.write_int(Arity, !IO),
+ output_exports(ModuleInfo, Defns, yes, !IO)
+ ;
+ IsExported = no,
+ output_exports(ModuleInfo, Defns, NeedComma, !IO)
+ ).
+
+output_defn(ModuleInfo, Defn, !IO) :-
+ Defn = elds_defn(PredProcId, _Arity, VarSet, Clause),
+ io.nl(!IO),
+ output_pred_proc_id(ModuleInfo, PredProcId, !IO),
+ Indent = 0,
+ output_clause(ModuleInfo, VarSet, Indent, Clause, !IO),
+ io.write_string(".\n", !IO).
+
+:- pred output_clause(module_info::in, prog_varset::in, indent::in,
+ elds_clause::in, io::di, io::uo) is det.
+
+output_clause(ModuleInfo, VarSet, Indent, Clause, !IO) :-
+ Clause = elds_clause(Pattern, Expr),
+ io.write_string("(", !IO),
+ io.write_list(Pattern, ", ",
+ output_term(ModuleInfo, VarSet, Indent), !IO),
+ io.write_string(") -> ", !IO),
+ output_expr(ModuleInfo, VarSet, Indent + 1, Expr, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output expressions
+%
+
+:- pred output_exprs_with_nl(module_info::in, prog_varset::in,
+ indent::in, list(elds_expr)::in, io::di, io::uo) is det.
+
+output_exprs_with_nl(_ModuleInfo, _VarSet, _Indent, [], !IO).
+output_exprs_with_nl(ModuleInfo, VarSet, Indent, [Expr | Exprs], !IO) :-
+ output_expr(ModuleInfo, VarSet, Indent, Expr, !IO),
+ (
+ Exprs = []
+ ;
+ Exprs = [_ | _],
+ io.write_char(',', !IO),
+ nl_indent_line(Indent, !IO),
+ output_exprs_with_nl(ModuleInfo, VarSet, Indent, Exprs, !IO)
+ ).
+
+:- pred output_exprs(module_info::in, prog_varset::in, indent::in,
+ list(elds_expr)::in, io::di, io::uo) is det.
+
+output_exprs(ModuleInfo, VarSet, Indent, Exprs, !IO) :-
+ io.write_list(Exprs, ", ",
+ output_expr(ModuleInfo, VarSet, Indent), !IO).
+
+:- pred output_expr(module_info::in, prog_varset::in, indent::in,
+ elds_expr::in, io::di, io::uo) is det.
+
+output_expr(ModuleInfo, VarSet, Indent, Expr, !IO) :-
+ (
+ Expr = elds_block(Exprs),
+ nl_indent_line(Indent, !IO),
+ io.write_string("(begin", !IO),
+ nl_indent_line(Indent + 1, !IO),
+ output_exprs_with_nl(ModuleInfo, VarSet, Indent + 1, Exprs, !IO),
+ nl_indent_line(Indent, !IO),
+ io.write_string("end)", !IO)
+ ;
+ Expr = elds_term(Term),
+ output_term(ModuleInfo, VarSet, Indent, Term, !IO)
+ ;
+ Expr = elds_eq(ExprA, ExprB),
+ output_expr(ModuleInfo, VarSet, Indent, ExprA, !IO),
+ io.write_string("= ", !IO),
+ output_expr(ModuleInfo, VarSet, Indent, ExprB, !IO)
+ ;
+ Expr = elds_unop(Unop, ExprA),
+ io.write_string(elds_unop_to_string(Unop), !IO),
+ output_expr(ModuleInfo, VarSet, Indent, ExprA, !IO)
+ ;
+ Expr = elds_binop(Binop, ExprA, ExprB),
+ output_expr(ModuleInfo, VarSet, Indent, ExprA, !IO),
+ output_elds_binop(Binop, !IO),
+ output_expr(ModuleInfo, VarSet, Indent, ExprB, !IO)
+ ;
+ Expr = elds_call(PredProcId, Args),
+ output_pred_proc_id(ModuleInfo, PredProcId, !IO),
+ io.write_string("(", !IO),
+ output_exprs(ModuleInfo, VarSet, Indent, Args, !IO),
+ io.write_string(") ", !IO)
+ ;
+ Expr = elds_call_ho(Closure, Args),
+ output_expr(ModuleInfo, VarSet, Indent, Closure, !IO),
+ io.write_string("(", !IO),
+ output_exprs(ModuleInfo, VarSet, Indent, Args, !IO),
+ io.write_string(") ", !IO)
+ ;
+ Expr = elds_fun(Clause),
+ io.write_string("fun", !IO),
+ output_clause(ModuleInfo, VarSet, Indent, Clause, !IO),
+ io.write_string("end ", !IO)
+ ;
+ Expr = elds_case_expr(ExprA, Cases),
+ io.write_string("(case ", !IO),
+ nl_indent_line(Indent + 1, !IO),
+ output_expr(ModuleInfo, VarSet, Indent + 1, ExprA, !IO),
+ nl_indent_line(Indent, !IO),
+ io.write_string("of ", !IO),
+ io.write_list(Cases, "; ",
+ output_case(ModuleInfo, VarSet, Indent + 1), !IO),
+ nl_indent_line(Indent, !IO),
+ io.write_string("end)", !IO)
+ ).
+
+:- pred output_case(module_info::in, prog_varset::in, indent::in,
+ elds_case::in, io::di, io::uo) is det.
+
+output_case(ModuleInfo, VarSet, Indent, elds_case(Pattern, Expr), !IO) :-
+ nl_indent_line(Indent, !IO),
+ output_term(ModuleInfo, VarSet, Indent, Pattern, !IO),
+ io.write_string("->", !IO),
+ nl_indent_line(Indent + 1, !IO),
+ output_expr(ModuleInfo, VarSet, Indent + 1, Expr, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_term(module_info::in, prog_varset::in, indent::in,
+ elds_term::in, io::di, io::uo) is det.
+
+output_term(ModuleInfo, VarSet, Indent, Term, !IO) :-
+ (
+ Term = elds_int(Int),
+ io.write_int(Int, !IO),
+ space(!IO)
+ ;
+ Term = elds_float(Float),
+ io.write_float(Float, !IO),
+ space(!IO)
+ ;
+ Term = elds_string(String),
+ io.write_char('"', !IO),
+ write_with_escaping(in_string, String, !IO),
+ io.write_char('"', !IO),
+ space(!IO)
+ ;
+ Term = elds_char(Char),
+ Int = char.to_int(Char),
+ (if char.is_alnum(Char) then
+ io.write_char('$', !IO),
+ io.write_char(Char, !IO)
+ else if escape(Esc, Int) then
+ io.write_char('$', !IO),
+ io.write_string(Esc, !IO)
+ else
+ io.write_int(Int, !IO)
+ ),
+ space(!IO)
+ ;
+ Term = elds_atom_raw(Atom),
+ output_atom(Atom, !IO),
+ space(!IO)
+ ;
+ Term = elds_atom(SymName),
+ output_atom(unqualify_name(SymName), !IO),
+ space(!IO)
+ ;
+ Term = elds_tuple(Args),
+ output_tuple(ModuleInfo, VarSet, Indent, Args, !IO)
+ ;
+ Term = elds_var(Var),
+ output_var(VarSet, Var, !IO)
+ ;
+ Term = elds_anon_var,
+ io.write_string("_ ", !IO)
+ ).
+
+:- pred output_tuple(module_info::in, prog_varset::in, indent::in,
+ list(elds_expr)::in, io::di, io::uo) is det.
+
+output_tuple(ModuleInfo, VarSet, Indent, Args, !IO) :-
+ % Treat lists and tuples specially.
+ (
+ Args = [elds_term(elds_atom(SymName))],
+ unqualify_name(SymName) = "[]"
+ ->
+ io.write_string("[] ", !IO)
+ ;
+ Args = [elds_term(elds_atom(SymName)), A, B],
+ unqualify_name(SymName) = "[|]"
+ ->
+ io.write_char('[', !IO),
+ output_expr(ModuleInfo, VarSet, Indent, A, !IO),
+ io.write_string("| ", !IO),
+ output_expr(ModuleInfo, VarSet, Indent, B, !IO),
+ io.write_string("] ", !IO)
+ ;
+ Args = [elds_tuple | Args1]
+ ->
+ io.write_char('{', !IO),
+ output_exprs(ModuleInfo, VarSet, Indent, Args1, !IO),
+ io.write_char('}', !IO)
+ ;
+ io.write_char('{', !IO),
+ output_exprs(ModuleInfo, VarSet, Indent, Args, !IO),
+ io.write_char('}', !IO)
+ ).
+
+:- func elds_tuple = elds_expr.
+elds_tuple = elds_term(elds_atom(unqualified("{}"))).
+
+:- pred output_var(prog_varset::in, prog_var::in, io::di, io::uo) is det.
+
+output_var(VarSet, Var, !IO) :-
+ varset.lookup_name(VarSet, Var, VarName),
+ term.var_to_int(Var, VarNumber),
+ % XXX this assumes all Mercury variable names are a subset of Erlang
+ % variable names
+ io.write_string(VarName, !IO),
+ io.write_char('_', !IO),
+ io.write_int(VarNumber, !IO),
+ space(!IO).
+
+:- pred output_pred_proc_id(module_info::in, pred_proc_id::in,
+ io::di, io::uo) is det.
+
+output_pred_proc_id(ModuleInfo, PredProcId, !IO) :-
+ erlang_proc_name(ModuleInfo, PredProcId, MaybeExtModule, Name),
+ (
+ MaybeExtModule = yes(ExtModule),
+ output_atom(ExtModule, !IO),
+ io.write_char(':', !IO)
+ ;
+ MaybeExtModule = no
+ ),
+ output_atom(Name, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred erlang_proc_name(module_info::in, pred_proc_id::in,
+ maybe(string)::out, string::out) is det.
+
+erlang_proc_name(ModuleInfo, PredProcId, MaybeExtModule, ProcNameStr) :-
+ PredProcId = proc(PredId, ProcId),
+ RttiProcName = make_rtti_proc_label(ModuleInfo, PredId, ProcId),
+ RttiProcName = rtti_proc_label(PredOrFunc, ThisModule, PredModule,
+ PredName, PredArity, _ArgTypes, _PredId, _ProcId,
+ _HeadVarsWithNames, _ArgModes, _Detism,
+ PredIsImported, _PredIsPseudoImported,
+ Origin, _ProcIsExported, _ProcIsImported),
+
+ ( Origin = origin_special_pred(SpecialPred) ->
+ erlang_special_proc_name(ThisModule, PredName, ProcId, SpecialPred,
+ MaybeExtModule, ProcNameStr)
+ ;
+ erlang_nonspecial_proc_name(ThisModule, PredModule, PredName,
+ PredOrFunc, PredArity, ProcId, PredIsImported,
+ MaybeExtModule, ProcNameStr)
+ ).
+
+:- pred erlang_nonspecial_proc_name(sym_name::in, sym_name::in, string::in,
+ pred_or_func::in, arity::in, proc_id::in, bool::in,
+ maybe(string)::out, string::out) is det.
+
+erlang_nonspecial_proc_name(ThisModule, PredModule, PredName, PredOrFunc,
+ PredArity, ProcId, PredIsImported, MaybeExtModule, ProcNameStr) :-
+ ( ThisModule \= PredModule ->
+ MaybeExtModule = yes(erlang_module_name_to_str(PredModule))
+ ;
+ MaybeExtModule = no
+ ),
+
+ (
+ PredOrFunc = pf_predicate,
+ Suffix = "p",
+ OrigArity = PredArity
+ ;
+ PredOrFunc = pf_function,
+ Suffix = "f",
+ OrigArity = PredArity - 1
+ ),
+
+ PredLabelStr0 = PredName ++ "_" ++ string.from_int(OrigArity) ++
+ "_" ++ Suffix,
+ (
+ % Work out which module supplies the code for the predicate.
+ ThisModule \= PredModule,
+ PredIsImported = no
+ ->
+ % This predicate is a specialized version of a pred from a `.opt' file.
+ PredLabelStr = PredLabelStr0 ++ "_in__" ++
+ erlang_module_name_to_str(PredModule)
+ ;
+ % The predicate was declared in the same module that it is defined in.
+ PredLabelStr = PredLabelStr0
+ ),
+
+ proc_id_to_int(ProcId, ModeNum),
+ ProcNameStr = PredLabelStr ++ "_" ++ string.from_int(ModeNum).
+
+:- pred erlang_special_proc_name(sym_name::in, string::in, proc_id::in,
+ special_pred::in, maybe(string)::out, string::out) is det.
+
+erlang_special_proc_name(ThisModule, PredName, ProcId, SpecialPred - TypeCtor,
+ MaybeExtModule, ProcNameStr) :-
+ (
+ % All type_ctors other than tuples here should be module qualified,
+ % since builtin types are handled separately in polymorphism.m.
+ TypeCtor = type_ctor(TypeCtorSymName, TypeArity),
+ (
+ TypeCtorSymName = unqualified(TypeName),
+ type_ctor_is_tuple(TypeCtor),
+ TypeModule = mercury_public_builtin_module
+ ;
+ TypeCtorSymName = qualified(TypeModule, TypeName)
+ )
+ ->
+ ProcNameStr0 = PredName ++ "__",
+ TypeModuleStr = erlang_module_name_to_str(TypeModule),
+ (
+ ThisModule \= TypeModule,
+ SpecialPred = spec_pred_unify,
+ \+ hlds_pred.in_in_unification_proc_id(ProcId)
+ ->
+ % This is a locally-defined instance of a unification procedure
+ % for a type defined in some other module.
+ ProcNameStr1 = ProcNameStr0 ++ TypeModuleStr,
+ MaybeExtModule = no
+ ;
+ % The module declaring the type is the same as the module
+ % defining this special pred.
+ ProcNameStr1 = ProcNameStr0,
+ ( TypeModule \= ThisModule ->
+ MaybeExtModule = yes(TypeModuleStr)
+ ;
+ MaybeExtModule = no
+ )
+ ),
+ ProcNameStr = ProcNameStr1 ++ TypeName ++ "_" ++
+ string.from_int(TypeArity)
+ ;
+ unexpected(this_file,
+ "erlang_special_proc_name: cannot make label for special pred " ++
+ PredName)
+ ).
+
+:- func erlang_module_name_to_str(module_name) = string.
+
+erlang_module_name_to_str(ModuleName) = Str :-
+ % 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)
+ else
+ Mod = ModuleName
+ ),
+ Str = sym_name_to_string_sep(Mod, "__").
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_atom(string::in, io::di, io::uo) is det.
+
+output_atom(String, !IO) :-
+ (if
+ string.index(String, 0, FirstChar),
+ char.is_lower(FirstChar),
+ string.is_all_alnum_or_underscore(String),
+ not requires_atom_quoting(String)
+ then
+ io.write_string(String, !IO)
+ else
+ io.write_char('\'', !IO),
+ write_with_escaping(in_atom, String, !IO),
+ io.write_char('\'', !IO)
+ ).
+
+:- pred requires_atom_quoting(string::in) is semidet.
+
+requires_atom_quoting("and").
+requires_atom_quoting("andalso").
+requires_atom_quoting("band").
+requires_atom_quoting("bnot").
+requires_atom_quoting("bor").
+requires_atom_quoting("bsl").
+requires_atom_quoting("bsr").
+requires_atom_quoting("bxor").
+requires_atom_quoting("div").
+requires_atom_quoting("not").
+requires_atom_quoting("or").
+requires_atom_quoting("orelse").
+requires_atom_quoting("rem").
+requires_atom_quoting("xor").
+
+%-----------------------------------------------------------------------------%
+
+:- func elds_unop_to_string(elds_unop) = string.
+
+elds_unop_to_string(plus) = "+".
+elds_unop_to_string(minus) = "-".
+elds_unop_to_string(bnot) = "bnot ".
+elds_unop_to_string(logical_not) = "not ".
+
+:- pred output_elds_binop(elds_binop::in, io::di, io::uo) is det.
+
+output_elds_binop(Binop, !IO) :-
+ io.write_string(elds_binop_to_string(Binop), !IO),
+ space(!IO).
+
+:- func elds_binop_to_string(elds_binop) = string.
+
+elds_binop_to_string(mul) = "*".
+elds_binop_to_string(float_div) = "/".
+elds_binop_to_string(int_div) = "div".
+elds_binop_to_string(rem) = "rem".
+elds_binop_to_string(band) = "band".
+elds_binop_to_string(add) = "+".
+elds_binop_to_string(sub) = "-".
+elds_binop_to_string(bor) = "bor".
+elds_binop_to_string(bxor) = "bxor".
+elds_binop_to_string(bsl) = "bsl".
+elds_binop_to_string(bsr) = "bsr".
+elds_binop_to_string(=<) = "=<".
+elds_binop_to_string(<) = "<".
+elds_binop_to_string(>=) = ">=".
+elds_binop_to_string(>) = ">".
+elds_binop_to_string(=:=) = "=:=".
+elds_binop_to_string(=/=) = "=/=".
+elds_binop_to_string(andalso) = "andalso".
+elds_binop_to_string(orelse) = "orelse".
+
+%-----------------------------------------------------------------------------%
+
+:- type string_or_atom
+ ---> in_string
+ ; in_atom.
+
+:- pred write_with_escaping(string_or_atom::in, string::in, io::di, io::uo)
+ is det.
+
+write_with_escaping(StringOrAtom, String, !IO) :-
+ string.foldl(write_with_escaping_2(StringOrAtom), String, !IO).
+
+:- pred write_with_escaping_2(string_or_atom::in, char::in, io::di, io::uo)
+ is det.
+
+write_with_escaping_2(StringOrAtom, Char, !IO) :-
+ char.to_int(Char, Int),
+ (
+ ( 32 =< Int, Int =< 126
+ ; Char = '\'', StringOrAtom = in_string
+ ; Char = '"', StringOrAtom = in_atom
+ )
+ ->
+ io.write_char(Char, !IO)
+ ;
+ escape(Esc, Int)
+ ->
+ io.write_string(Esc, !IO)
+ ;
+ string.int_to_base_string(Int, 8, OctalString),
+ io.write_char('\\', !IO),
+ io.write_string(OctalString, !IO)
+ ).
+
+:- pred escape(string, int).
+:- mode escape(out, in) is semidet.
+
+escape("\\b", 8).
+escape("\\d", 127).
+escape("\\e", 27).
+escape("\\f", 12).
+escape("\\n", 10).
+escape("\\r", 13).
+escape("\\s", 32).
+escape("\\t", 9).
+escape("\\v", 11).
+escape("\\^a", 1).
+escape("\\^b", 2).
+escape("\\^c", 3).
+escape("\\^d", 4).
+escape("\\^e", 5).
+escape("\\^f", 6).
+escape("\\^g", 7).
+% escape("\\^h", 8). % alternative exists
+% escape("\\^i", 9).
+% escape("\\^j", 10).
+% escape("\\^k", 11).
+% escape("\\^l", 12).
+% escape("\\^m", 13).
+escape("\\^n", 14).
+escape("\\^o", 15).
+escape("\\^p", 16).
+escape("\\^q", 17).
+escape("\\^r", 18).
+escape("\\^s", 19).
+escape("\\^t", 20).
+escape("\\^u", 21).
+escape("\\^v", 22).
+escape("\\^w", 23).
+escape("\\^x", 24).
+escape("\\^y", 25).
+escape("\\^z", 26).
+escape("\\'", 39).
+escape("\\\"", 94).
+escape("\\\\", 92).
+
+%-----------------------------------------------------------------------------%
+
+:- type indent == int.
+
+:- pred nl_indent_line(indent::in, io::di, io::uo) is det.
+
+nl_indent_line(N, !IO) :-
+ io.nl(!IO),
+ indent_line(N, !IO).
+
+:- pred indent_line(indent::in, io::di, io::uo) is det.
+
+indent_line(N, !IO) :-
+ ( N =< 0 ->
+ true
+ ;
+ io.write_string(" ", !IO),
+ indent_line(N - 1, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred space(io::di, io::uo) is det.
+
+space(!IO) :-
+ io.write_char(' ', !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "elds_to_erlang.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/erl_backend.m
===================================================================
RCS file: compiler/erl_backend.m
diff -N compiler/erl_backend.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/erl_backend.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,43 @@
+%-----------------------------------------------------------------------------%
+% 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.
+%-----------------------------------------------------------------------------%
+%
+% The Erlang back-end.
+%
+% This package includes
+% - the ELDS data structure, which is an abstract
+% representation of a subset of the Erlang language;
+% - the ELDS code generator, which converts HLDS to ELDS;
+% - the Erlang back-end which writes out the ELDS as Erlang code.
+%
+:- module erl_backend.
+:- interface.
+
+:- import_module hlds.
+:- import_module parse_tree.
+
+%-----------------------------------------------------------------------------%
+
+:- include_module elds.
+
+:- include_module erl_code_gen.
+ :- include_module erl_call_gen.
+ :- include_module erl_unify_gen.
+:- include_module erl_code_util.
+
+:- include_module elds_to_erlang.
+
+:- implementation.
+
+:- import_module backend_libs.
+:- import_module check_hlds.
+:- import_module libs.
+:- import_module mdbcomp.
+
+:- end_module erl_backend.
+
+%-----------------------------------------------------------------------------%
Index: compiler/erl_call_gen.m
===================================================================
RCS file: compiler/erl_call_gen.m
diff -N compiler/erl_call_gen.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/erl_call_gen.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,349 @@
+%-----------------------------------------------------------------------------%
+% 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_call_gen.m.
+% Main author: wangp.
+%
+% This module is part of the ELDS code generator. It handles code generation
+% of procedures calls, calls to builtins, and other closely related stuff.
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.erl_call_gen.
+:- interface.
+
+:- import_module erl_backend.elds.
+:- import_module erl_backend.erl_code_util.
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module maybe.
+
+%-----------------------------------------------------------------------------%
+
+ % erl_gen_call(PredId, ProcId, ArgNames, ArgTypes,
+ % CodeModel, Context, SuccessExpr, Statement, !Info):
+ %
+ % Generate ELDS code for an HLDS procedure call.
+ %
+:- pred erl_gen_call(pred_id::in, proc_id::in, prog_vars::in,
+ list(mer_type)::in, code_model::in, prog_context::in, maybe(elds_expr)::in,
+ elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+ % Generate ELDS code for a higher order call.
+ %
+:- pred erl_gen_higher_order_call(generic_call::in(higher_order),
+ 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 higher_order
+ ---> higher_order(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,
+ code_model::in, prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+ % Generate ELDS code for a cast. The list of argument variables
+ % must have only two elements, the input and the output.
+ %
+:- pred erl_gen_cast(prog_context::in, prog_vars::in, maybe(elds_expr)::in,
+ elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module backend_libs.builtin_ops.
+:- import_module check_hlds.type_util.
+:- import_module hlds.hlds_module.
+:- import_module libs.compiler_util.
+
+:- import_module term.
+
+%-----------------------------------------------------------------------------%
+%
+% Code for procedure calls
+%
+
+erl_gen_call(PredId, ProcId, ArgVars, _ActualArgTypes,
+ CodeModel, _Context, MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+
+ % Compute the callee's Mercury argument types and modes.
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
+ pred_info_get_arg_types(PredInfo, CalleeTypes),
+ proc_info_get_argmodes(ProcInfo, ArgModes),
+
+ erl_gen_arg_list(ModuleInfo, ArgVars, CalleeTypes, ArgModes,
+ InputVars, OutputVars),
+ CallExpr = elds_call(proc(PredId, ProcId), elds.exprs_from_vars(InputVars)),
+
+ (
+ CodeModel = model_det,
+ make_det_call(CallExpr, OutputVars, MaybeSuccessExpr, Statement)
+ ;
+ CodeModel = model_semi,
+ make_semidet_call(CallExpr, OutputVars, MaybeSuccessExpr, Statement)
+ ;
+ CodeModel = model_non,
+ sorry(this_file, "model_non code in Erlang backend")
+ ).
+
+:- pred make_det_call(elds_expr::in, prog_vars::in, maybe(elds_expr)::in,
+ elds_expr::out) is det.
+
+make_det_call(Expr, OutputVars, MaybeSuccessExpr, Statement) :-
+ (
+ OutputVars = [],
+ (if
+ ( MaybeSuccessExpr = yes(elds_term(elds_empty_tuple))
+ ; MaybeSuccessExpr = no
+ )
+ then
+ % Preserve tail calls.
+ Statement = Expr
+ else
+ Statement = maybe_join_exprs(Expr, MaybeSuccessExpr)
+ )
+ ;
+ OutputVars = [_ | _],
+ UnpackTerm = elds_term(elds_tuple(elds.exprs_from_vars(OutputVars))),
+ (if
+ MaybeSuccessExpr = yes(UnpackTerm)
+ then
+ % Preserve tail calls.
+ Statement = Expr
+ else
+ AssignCall = elds_eq(UnpackTerm, Expr),
+ Statement = maybe_join_exprs(AssignCall, MaybeSuccessExpr)
+ )
+ ).
+
+:- pred make_semidet_call(elds_expr::in, prog_vars::in, maybe(elds_expr)::in,
+ elds_expr::out) is det.
+
+make_semidet_call(CallExpr, OutputVars, MaybeSuccessExpr, Statement) :-
+ (
+ MaybeSuccessExpr = yes(SuccessExpr),
+ UnpackTerm = elds_tuple(exprs_from_vars(OutputVars)),
+ (if
+ MaybeSuccessExpr = yes(elds_term(UnpackTerm))
+ then
+ % Avoid unnecessary unpacking.
+ Statement = CallExpr
+ else
+ % case CallExpr of
+ % {OutputVars, ...} -> SuccessExpr ;
+ % _ -> fail
+ % end
+ %
+ Statement = elds_case_expr(CallExpr, [TrueCase, FalseCase]),
+ TrueCase = elds_case(UnpackTerm, SuccessExpr),
+ FalseCase = elds_case(elds_anon_var, elds_term(elds_fail))
+ )
+ ;
+ MaybeSuccessExpr = no,
+ unexpected(this_file,
+ "make_semidet_call: no success expression for semidet call")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for generic calls
+%
+
+erl_gen_higher_order_call(GenericCall, ArgVars, Modes, Detism,
+ _Context, MaybeSuccessExpr, Statement, !Info) :-
+ GenericCall = higher_order(ClosureVar, _, _, _),
+
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_variable_types(!.Info, ArgVars, ArgTypes),
+ erl_gen_arg_list(ModuleInfo, ArgVars, ArgTypes, Modes,
+ InputVars, OutputVars),
+ CallExpr = elds_call_ho(elds.expr_from_var(ClosureVar),
+ elds.exprs_from_vars(InputVars)),
+
+ determinism_to_code_model(Detism, CallCodeModel),
+ (
+ CallCodeModel = model_det,
+ make_det_call(CallExpr, OutputVars, MaybeSuccessExpr, Statement)
+ ;
+ CallCodeModel = model_semi,
+ make_semidet_call(CallExpr, OutputVars, MaybeSuccessExpr, Statement)
+ ;
+ CallCodeModel = model_non,
+ sorry(this_file, "model_non code in Erlang backend")
+ ).
+
+erl_gen_cast(_Context, ArgVars, MaybeSuccessExpr, Statement, !Info) :-
+ erl_variable_types(!.Info, ArgVars, ArgTypes),
+ (
+ ArgVars = [SrcVar, DestVar],
+ ArgTypes = [_SrcType, DestType]
+ ->
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ ( is_dummy_argument_type(ModuleInfo, DestType) ->
+ Statement = expr_or_void(MaybeSuccessExpr)
+ ;
+ % XXX this doesn't do anything yet
+ Assign = elds_eq(expr_from_var(DestVar), expr_from_var(SrcVar)),
+ Statement = maybe_join_exprs(Assign, MaybeSuccessExpr)
+ )
+ ;
+ unexpected(this_file, "erl_gen_cast: wrong number of args for cast")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for builtins
+%
+
+ % XXX many of the "standard" builtins in builtin_ops.m do not apply to the
+ % Erlang back-end.
+ %
+erl_gen_builtin(PredId, ProcId, ArgVars, CodeModel, _Context,
+ MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ ModuleName = predicate_module(ModuleInfo, PredId),
+ PredName = predicate_name(ModuleInfo, PredId),
+ (
+ builtin_ops.translate_builtin(ModuleName, PredName,
+ ProcId, ArgVars, SimpleCode0)
+ ->
+ SimpleCode = SimpleCode0
+ ;
+ unexpected(this_file, "erl_gen_builtin: unknown builtin predicate")
+ ),
+ (
+ CodeModel = model_det,
+ (
+ SimpleCode = assign(Lval, SimpleExpr),
+ % XXX We need to avoid generating assignments to dummy variables
+ % introduced for types such as io.state.
+ Rval = erl_gen_simple_expr(SimpleExpr),
+ Assign = elds.elds_eq(elds.expr_from_var(Lval), Rval),
+ Statement = maybe_join_exprs(Assign, MaybeSuccessExpr)
+ ;
+ SimpleCode = ref_assign(_AddrLval, _ValueLval),
+ unexpected(this_file, "ref_assign not supported in Erlang backend")
+ ;
+ SimpleCode = test(_),
+ unexpected(this_file, "malformed model_det builtin predicate")
+ ;
+ SimpleCode = noop(_),
+ Statement = expr_or_void(MaybeSuccessExpr)
+ )
+ ;
+ CodeModel = model_semi,
+ (
+ SimpleCode = test(SimpleTest),
+ TestRval = erl_gen_simple_expr(SimpleTest),
+ % Unlike Mercury procedures, the builtin tests return true and
+ % false instead of {} and fail.
+ Statement = elds_case_expr(TestRval, [TrueCase, FalseCase]),
+ TrueCase = elds_case(elds_true, expr_or_void(MaybeSuccessExpr)),
+ FalseCase = elds_case(elds_false, elds_term(elds_fail))
+ ;
+ SimpleCode = ref_assign(_, _),
+ unexpected(this_file, "malformed model_semi builtin predicate")
+ ;
+ SimpleCode = assign(_, _),
+ unexpected(this_file, "malformed model_semi builtin predicate")
+ ;
+ SimpleCode = noop(_),
+ unexpected(this_file, "malformed model_semi builtin predicate")
+ )
+ ;
+ CodeModel = model_non,
+ unexpected(this_file, "model_non builtin predicate")
+ ).
+
+:- func erl_gen_simple_expr(simple_expr(prog_var)) = elds_expr.
+
+erl_gen_simple_expr(leaf(Var)) = elds.expr_from_var(Var).
+erl_gen_simple_expr(int_const(Int)) = elds_term(elds_int(Int)).
+erl_gen_simple_expr(float_const(Float)) = elds_term(elds_float(Float)).
+erl_gen_simple_expr(unary(_Op, _Expr)) = _ :-
+ sorry(this_file, "erl_gen_simple_expr: unary op").
+erl_gen_simple_expr(binary(StdOp, Expr1, Expr2)) = Expr :-
+ ( std_binop_to_elds(StdOp, Op) ->
+ SimpleExpr1 = erl_gen_simple_expr(Expr1),
+ SimpleExpr2 = erl_gen_simple_expr(Expr2),
+ Expr = elds_binop(Op, SimpleExpr1, SimpleExpr2)
+ ;
+ sorry(this_file, "builtin not supported on erlang target")
+ ).
+
+:- pred std_unop_to_elds(unary_op::in, elds_unop::out) is semidet.
+
+std_unop_to_elds(mktag, _) :- fail.
+std_unop_to_elds(tag, _) :- fail.
+std_unop_to_elds(unmktag, _) :- fail.
+std_unop_to_elds(strip_tag, _) :- fail.
+std_unop_to_elds(mkbody, _) :- fail.
+std_unop_to_elds(unmkbody, _) :- fail.
+std_unop_to_elds(hash_string, _) :- fail.
+std_unop_to_elds(bitwise_complement, elds.bnot).
+std_unop_to_elds(logical_not, elds.logical_not).
+
+:- pred std_binop_to_elds(binary_op::in, elds_binop::out) is semidet.
+
+std_binop_to_elds(int_add, elds.add).
+std_binop_to_elds(int_sub, elds.sub).
+std_binop_to_elds(int_mul, elds.mul).
+std_binop_to_elds(int_div, elds.int_div).
+std_binop_to_elds(int_mod, elds.(rem)).
+std_binop_to_elds(unchecked_left_shift, elds.bsl).
+std_binop_to_elds(unchecked_right_shift, elds.bsr).
+std_binop_to_elds(bitwise_and, elds.band).
+std_binop_to_elds(bitwise_or, elds.bor).
+std_binop_to_elds(bitwise_xor, elds.bxor).
+std_binop_to_elds(logical_and, elds.andalso).
+std_binop_to_elds(logical_or, elds.orelse).
+std_binop_to_elds(eq, elds.(=:=)).
+std_binop_to_elds(ne, elds.(=/=)).
+std_binop_to_elds(body, _) :- fail.
+std_binop_to_elds(array_index(_), _) :- fail.
+std_binop_to_elds(str_eq, elds.(=:=)).
+std_binop_to_elds(str_ne, elds.(=/=)).
+std_binop_to_elds(str_lt, elds.(<)).
+std_binop_to_elds(str_gt, elds.(>)).
+std_binop_to_elds(str_le, elds.(=<)).
+std_binop_to_elds(str_ge, elds.(>=)).
+std_binop_to_elds(int_lt, elds.(<)).
+std_binop_to_elds(int_gt, elds.(>)).
+std_binop_to_elds(int_le, elds.(=<)).
+std_binop_to_elds(int_ge, elds.(>=)).
+std_binop_to_elds(unsigned_le, _) :- fail.
+std_binop_to_elds(float_plus, elds.add).
+std_binop_to_elds(float_minus, elds.sub).
+std_binop_to_elds(float_times, elds.mul).
+std_binop_to_elds(float_divide, elds.float_div).
+std_binop_to_elds(float_eq, elds.(=:=)).
+std_binop_to_elds(float_ne, elds.(=/=)).
+std_binop_to_elds(float_lt, elds.(<)).
+std_binop_to_elds(float_gt, elds.(>)).
+std_binop_to_elds(float_le, elds.(=<)).
+std_binop_to_elds(float_ge, elds.(>=)).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "erl_call_gen.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module erl_call_gen.
+%-----------------------------------------------------------------------------%
Index: compiler/erl_code_gen.m
===================================================================
RCS file: compiler/erl_code_gen.m
diff -N compiler/erl_code_gen.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/erl_code_gen.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,791 @@
+%-----------------------------------------------------------------------------%
+% 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_code_gen.m.
+% Main author: wangp.
+%
+% ELDS code generation -- convert from HLDS to ELDS.
+%
+% XXX more documentation to come later
+%
+% For now, the notation `Foo [[ Bar ]]' means to generate the code for
+% expression `Foo', ultimately evaluating to the value `Bar' on success.
+% Code which can fail currently always evaluates to the atom `fail' (this will
+% be changed to improve the code generated for disjuncts, which should rather
+% evaluate to an expression representing the rest of the disjunction on
+% failure).
+%
+% TODO: (this is incomplete)
+% - nondet code
+% - contexts are ignored at the moment
+% - RTTI
+% - many scope types not yet supported
+% - foreign code
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.erl_code_gen.
+:- interface.
+
+:- import_module erl_backend.elds.
+:- import_module erl_backend.erl_code_util.
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_module.
+:- import_module parse_tree.prog_data.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+ % Generate Erlang code for an entire module.
+ %
+:- pred erl_code_gen(module_info::in, elds::out, io::di, io::uo) is det.
+
+ % erl_gen_wrap_goal(OuterCodeModel, InnerCodeModel, Context,
+ % Statement0, Statement):
+ %
+ % OuterCodeModel is the code model expected by the context in which a goal
+ % is called. InnerCodeModel is the code model which the goal actually has.
+ % This predicate converts the code generated for the goal using
+ % InnerCodeModel into code that uses the calling convention appropriate
+ % for OuterCodeModel.
+ %
+:- pred erl_gen_wrap_goal(code_model::in, code_model::in, prog_context::in,
+ elds_expr::in, elds_expr::out, erl_gen_info::in, erl_gen_info::out)
+ is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module erl_backend.erl_call_gen.
+:- import_module erl_backend.erl_unify_gen.
+:- import_module hlds.code_model.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.instmap.
+:- import_module hlds.passes_aux.
+:- import_module hlds.pred_table.
+:- import_module libs.compiler_util.
+
+:- import_module list.
+:- import_module map.
+:- import_module maybe.
+:- import_module require.
+:- import_module set.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+erl_code_gen(ModuleInfo, ELDS, !IO) :-
+ module_info_get_name(ModuleInfo, ModuleName),
+ erl_gen_preds(ModuleInfo, Defns, !IO),
+ ELDS = elds(ModuleName, Defns).
+
+:- pred erl_gen_preds(module_info::in, list(elds_defn)::out, io::di, io::uo)
+ is det.
+
+erl_gen_preds(ModuleInfo, PredDefns, !IO) :-
+ module_info_preds(ModuleInfo, PredTable),
+ map.keys(PredTable, PredIds),
+ erl_gen_preds_2(ModuleInfo, PredIds, PredTable, [], RevPredDefns, !IO),
+ PredDefns = list.reverse(RevPredDefns).
+
+:- pred erl_gen_preds_2(module_info::in, list(pred_id)::in, pred_table::in,
+ list(elds_defn)::in, list(elds_defn)::out, io::di, io::uo) is det.
+
+erl_gen_preds_2(ModuleInfo, PredIds0, PredTable, !Defns, !IO) :-
+ (
+ PredIds0 = [PredId | PredIds],
+ map.lookup(PredTable, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ (
+ (
+ ImportStatus = status_imported(_)
+ ;
+ % XXX comment was from ml_code_gen.m, don't know if it applies.
+ % We generate incorrect and unnecessary code for the external
+ % special preds which are pseudo_imported, so just ignore them.
+ is_unify_or_compare_pred(PredInfo),
+ ImportStatus = status_external(status_pseudo_imported)
+ )
+ ->
+ true
+ ;
+ erl_gen_pred(ModuleInfo, PredId, PredInfo, ImportStatus,
+ !Defns, !IO)
+ ),
+ erl_gen_preds_2(ModuleInfo, PredIds, PredTable, !Defns, !IO)
+ ;
+ PredIds0 = []
+ ).
+
+ % Generate ELDS definitions for all the non-imported procedures
+ % of a given predicate (or function).
+ %
+:- pred erl_gen_pred(module_info::in, pred_id::in, pred_info::in,
+ import_status::in, list(elds_defn)::in, list(elds_defn)::out,
+ io::di, io::uo) is det.
+
+erl_gen_pred(ModuleInfo, PredId, PredInfo, ImportStatus, !Defns, !IO) :-
+ ( ImportStatus = status_external(_) ->
+ ProcIds = pred_info_procids(PredInfo)
+ ;
+ ProcIds = pred_info_non_imported_procids(PredInfo)
+ ),
+ (
+ ProcIds = []
+ ;
+ ProcIds = [_ | _],
+ write_pred_progress_message("% Generating ELDS code for ",
+ PredId, ModuleInfo, !IO),
+ pred_info_get_procedures(PredInfo, ProcTable),
+ erl_gen_procs(ProcIds, ModuleInfo, PredId, PredInfo, ProcTable, !Defns)
+ ).
+
+:- pred erl_gen_procs(list(proc_id)::in, module_info::in, pred_id::in,
+ pred_info::in, proc_table::in, list(elds_defn)::in, list(elds_defn)::out)
+ is det.
+
+erl_gen_procs([], _, _, _, _, !Defns).
+erl_gen_procs([ProcId | ProcIds], ModuleInfo, PredId, PredInfo, ProcTable,
+ !Defns) :-
+ map.lookup(ProcTable, ProcId, ProcInfo),
+ erl_gen_proc(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo, !Defns),
+ erl_gen_procs(ProcIds, ModuleInfo, PredId, PredInfo, ProcTable, !Defns).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for handling individual procedures
+%
+
+ % Generate ELDS code for the specified procedure.
+ %
+:- pred erl_gen_proc(module_info::in, pred_id::in, proc_id::in, pred_info::in,
+ proc_info::in, list(elds_defn)::in, list(elds_defn)::out) is det.
+
+erl_gen_proc(ModuleInfo, PredId, ProcId, _PredInfo, _ProcInfo, !Defns) :-
+ erl_gen_proc_defn(ModuleInfo, PredId, ProcId, Arity, ProcVarSet,
+ ProcClause),
+ ProcDefn = elds_defn(proc(PredId, ProcId), Arity, ProcVarSet, ProcClause),
+ !:Defns = [ProcDefn | !.Defns].
+
+ % Generate an ELDS definition for the specified procedure.
+ %
+:- pred erl_gen_proc_defn(module_info::in, pred_id::in, proc_id::in,
+ arity::out, prog_varset::out, elds_clause::out) is det.
+
+erl_gen_proc_defn(ModuleInfo, PredId, ProcId, Arity, ProcVarSet, ProcClause) :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ proc_info_interface_code_model(ProcInfo, CodeModel),
+ proc_info_get_headvars(ProcInfo, HeadVars),
+ proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap0),
+ proc_info_get_goal(ProcInfo, Goal0),
+
+ % The HLDS front-end sometimes over-estimates the set of non-locals.
+ % We need to restrict the set of non-locals for the top-level goal
+ % to just the headvars, because otherwise variables which occur in the
+ % top-level non-locals but which are not really non-local will not be
+ % declared.
+
+ Goal0 = hlds_goal(GoalExpr, GoalInfo0),
+ goal_info_get_code_gen_nonlocals(GoalInfo0, NonLocals0),
+ set.list_to_set(HeadVars, HeadVarsSet),
+ set.intersect(HeadVarsSet, NonLocals0, NonLocals),
+ goal_info_set_code_gen_nonlocals(NonLocals, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+
+ goal_info_get_context(GoalInfo, _Context),
+
+ some [!Info] (
+ !:Info = erl_gen_info_init(ModuleInfo, PredId, ProcId),
+
+ ( ImportStatus = status_external(_) ->
+ sorry(this_file, "external procedures in Erlang backend")
+ ;
+ erl_gen_proc_body(CodeModel, InstMap0, Goal, ProcClause,
+ !Info)
+ ),
+
+ erl_gen_info_get_input_vars(!.Info, InputVars),
+ Arity = list.length(InputVars),
+
+ erl_gen_info_get_varset(!.Info, ProcVarSet)
+ ).
+
+:- pred erl_gen_proc_body(code_model::in, instmap::in, hlds_goal::in,
+ elds_clause::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_proc_body(CodeModel, InstMap0, Goal, ProcClause, !Info) :-
+ erl_gen_info_get_input_vars(!.Info, InputVars),
+ erl_gen_info_get_output_vars(!.Info, OutputVars),
+ (
+ ( CodeModel = model_det
+ ; CodeModel = model_semi
+ ),
+ SuccessExpr = elds_term(elds_tuple(exprs_from_vars(OutputVars)))
+ ;
+ CodeModel = model_non,
+ sorry(this_file, "nondet code in Erlang backend")
+ ),
+ erl_gen_goal(CodeModel, InstMap0, Goal, yes(SuccessExpr), Statement,
+ !Info),
+ ProcClause = elds_clause(terms_from_vars(InputVars), Statement).
+
+%-----------------------------------------------------------------------------%
+%
+% Stuff to generate code for goals.
+%
+
+:- pred erl_gen_goal(code_model::in, instmap::in, hlds_goal::in,
+ maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+ % Generate ELDS code for the specified goal in the specified code model.
+ %
+erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExpr, Code, !Info) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ goal_info_get_context(GoalInfo, Context),
+
+ % Generate code for the goal in its own code model.
+ goal_info_get_code_model(GoalInfo, GoalCodeModel),
+ erl_gen_goal_expr(GoalExpr, GoalCodeModel, InstMap, Context,
+ MaybeSuccessExpr, GoalCode, !Info),
+
+ % Add whatever wrapper is needed to convert the goal's code model
+ % to the desired code model.
+ erl_gen_wrap_goal(CodeModel, GoalCodeModel, Context,
+ GoalCode, Code, !Info).
+
+ % If the inner and outer code models are equal, we don't need to do
+ % anything special.
+
+erl_gen_wrap_goal(model_det, model_det, _, !Code, !Info).
+erl_gen_wrap_goal(model_semi, model_semi, _, !Code, !Info).
+erl_gen_wrap_goal(model_non, model_non, _, !Code, !Info).
+
+ % If the inner code model is more precise than the outer code model,
+ % then we need to append some statements to convert the calling convention
+ % for the inner code model to that of the outer code model.
+
+erl_gen_wrap_goal(model_semi, model_det, _Context, !Code, !Info).
+ % Currently nothing is required because det goals always
+ % return their results in a tuple, which is exactly the same as
+ % a successful return from a semidet goal.
+
+erl_gen_wrap_goal(model_non, model_det, _Context, !Code, !Info) :-
+ sorry(this_file, "nondet code in Erlang backend").
+
+erl_gen_wrap_goal(model_non, model_semi, _Context, !Code, !Info) :-
+ sorry(this_file, "nondet code in Erlang backend").
+
+ % If the inner code model is less precise than the outer code model,
+ % then simplify.m is supposed to wrap the goal inside a `some'
+ % to indicate that a commit is needed.
+
+erl_gen_wrap_goal(model_det, model_semi, _, _, _, !Info) :-
+ unexpected(this_file,
+ "erl_gen_wrap_goal: code model mismatch -- semi in det").
+erl_gen_wrap_goal(model_det, model_non, _, _, _, !Info) :-
+ unexpected(this_file,
+ "erl_gen_wrap_goal: code model mismatch -- nondet in det").
+erl_gen_wrap_goal(model_semi, model_non, _, _, _, !Info) :-
+ unexpected(this_file,
+ "erl_gen_wrap_goal: code model mismatch -- nondet in semi").
+
+%-----------------------------------------------------------------------------%
+
+ % Generate ELDS code for the different kinds of HLDS goals.
+ %
+:- pred erl_gen_goal_expr(hlds_goal_expr::in, code_model::in, instmap::in,
+ prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_goal_expr(switch(Var, CanFail, CasesList), CodeModel, InstMap,
+ Context, MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_switch(Var, CanFail, CasesList, CodeModel, InstMap,
+ Context, MaybeSuccessExpr, Statement, !Info).
+
+erl_gen_goal_expr(scope(ScopeReason, Goal), CodeModel, InstMap, Context,
+ MaybeSuccessExpr, CodeExpr, !Info) :-
+ (
+ ( ScopeReason = exist_quant(_)
+ ; ScopeReason = promise_solutions(_, _)
+ ; ScopeReason = promise_purity(_, _)
+ ; ScopeReason = commit(_)
+ ; ScopeReason = barrier(_)
+ ; ScopeReason = trace_goal(_, _, _, _, _)
+ ),
+ sorry(this_file, "exotic scope type in erlang code generator")
+ ;
+ ScopeReason = from_ground_term(_),
+ Goal = hlds_goal(GoalExpr, _),
+ erl_gen_goal_expr(GoalExpr, CodeModel, InstMap, Context,
+ MaybeSuccessExpr, CodeExpr, !Info)
+ ).
+
+erl_gen_goal_expr(if_then_else(_Vars, Cond, Then, Else), CodeModel,
+ InstMap, Context, MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_ite(CodeModel, InstMap, Cond, Then, Else, Context,
+ MaybeSuccessExpr, Statement, !Info).
+
+erl_gen_goal_expr(negation(Goal), CodeModel, InstMap, Context,
+ MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_negation(Goal, CodeModel, InstMap, Context, MaybeSuccessExpr,
+ Statement, !Info).
+
+erl_gen_goal_expr(conj(_ConjType, Goals), CodeModel, InstMap, Context,
+ MaybeSuccessExpr, Statement, !Info) :-
+ % XXX Currently we treat parallel conjunction the same as
+ % sequential conjunction -- parallelism is not yet implemented.
+ erl_gen_conj(Goals, CodeModel, InstMap, Context, MaybeSuccessExpr,
+ Statement, !Info).
+
+erl_gen_goal_expr(disj(Goals), CodeModel, InstMap, Context,
+ MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_disj(Goals, CodeModel, InstMap, Context, MaybeSuccessExpr,
+ Statement, !Info).
+
+erl_gen_goal_expr(generic_call(GenericCall, Vars, Modes, Detism),
+ CodeModel, _InstMap, Context, MaybeSuccessExpr, Statement, !Info) :-
+ determinism_to_code_model(Detism, CallCodeModel),
+ expect(unify(CodeModel, CallCodeModel), this_file,
+ "erl_gen_generic_call: code model mismatch"),
+ (
+ GenericCall = higher_order(_, _, _, _),
+ erl_gen_higher_order_call(GenericCall, Vars, Modes, Detism,
+ Context, MaybeSuccessExpr, Statement, !Info)
+ ;
+ GenericCall = class_method(_, _, _, _),
+ sorry(this_file, "class methods calls in erlang backend")
+ ;
+ GenericCall = event_call(_),
+ sorry(this_file, "event_calls in erlang backend")
+ ;
+ GenericCall = cast(_),
+ erl_gen_cast(Context, Vars, MaybeSuccessExpr, Statement, !Info)
+ ).
+
+erl_gen_goal_expr(plain_call(PredId, ProcId, ArgVars, BuiltinState, _, _),
+ CodeModel, _InstMap, Context, MaybeSuccessExpr, Statement, !Info) :-
+ (
+ BuiltinState = not_builtin,
+ erl_variable_types(!.Info, ArgVars, ActualArgTypes),
+ erl_gen_call(PredId, ProcId, ArgVars, ActualArgTypes,
+ CodeModel, Context, MaybeSuccessExpr, Statement, !Info)
+ ;
+ BuiltinState = inline_builtin,
+ erl_gen_builtin(PredId, ProcId, ArgVars, CodeModel, Context,
+ MaybeSuccessExpr, Statement, !Info)
+ ;
+ BuiltinState = out_of_line_builtin,
+ unexpected(this_file, "erl_gen_goal_expr: out_of_line_builtin")
+ ).
+
+erl_gen_goal_expr(unify(_LHS, _RHS, _Mode, Unification, _UnifyContext),
+ CodeModel, _InstMap, Context, MaybeSuccessExpr, Statement, !Info) :-
+ erl_gen_unification(Unification, CodeModel, Context, MaybeSuccessExpr,
+ Statement, !Info).
+
+erl_gen_goal_expr(
+ call_foreign_proc(_Attributes, _PredId, _ProcId, _Args, _ExtraArgs,
+ _MaybeTraceRuntimeCond, _PragmaImpl), _CodeModel, _InstMap,
+ _OuterContext, _MaybeSuccessExpr, _Statement, !_Info) :-
+ sorry(this_file, "call_foreign_proc in erlang backend").
+
+erl_gen_goal_expr(shorthand(_), _, _, _, _, _, !Info) :-
+ % these should have been expanded out by now
+ unexpected(this_file, "erl_gen_goal_expr: unexpected shorthand").
+
+%-----------------------------------------------------------------------------%
+%
+% Code for switches
+%
+
+ % The generated code looks like:
+ %
+ % case Var of
+ % Pattern1 -> Expr1 [[ MaybeSuccessExpr ]];
+ % Pattern2 -> Expr2 [[ MaybeSuccessExpr ]];
+ % ...
+ % end
+ %
+ % If the switch can fail, a default case is added:
+ %
+ % _ -> fail
+ %
+:- pred erl_gen_switch(prog_var::in, can_fail::in, list(hlds_goal.case)::in,
+ code_model::in, instmap::in, prog_context::in, maybe(elds_expr)::in,
+ elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_switch(Var, CanFail, CasesList, CodeModel, InstMap, _Context,
+ MaybeSuccessExpr, Statement, !Info) :-
+ % Get the union of all variables bound in all cases.
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ CasesGoals = list.map((func(case(_, Goal)) = Goal), CasesList),
+ union_bound_nonlocals_in_goals(ModuleInfo, InstMap, CasesGoals,
+ MustBindNonLocals),
+
+ % Generate code for each case.
+ list.map_foldl(erl_gen_case(CodeModel, InstMap, MustBindNonLocals,
+ MaybeSuccessExpr), CasesList, ErlCases0, !Info),
+ (
+ CanFail = can_fail,
+ % Add `_ -> fail' default case.
+ DefaultCase = elds_case(elds_anon_var, elds_term(elds_fail)),
+ ErlCases = ErlCases0 ++ [DefaultCase]
+ ;
+ CanFail = cannot_fail,
+ ErlCases = ErlCases0
+ ),
+ Statement = elds_case_expr(expr_from_var(Var), ErlCases).
+
+:- pred union_bound_nonlocals_in_goals(module_info::in, instmap::in,
+ hlds_goals::in, set(prog_var)::out) is det.
+
+union_bound_nonlocals_in_goals(ModuleInfo, InstMap, Goals, NonLocalsUnion) :-
+ IsBound = erl_bound_nonlocals_in_goal(ModuleInfo, InstMap),
+ list.map(IsBound, Goals, NonLocalsLists),
+ NonLocalsUnion = set.union_list(NonLocalsLists).
+
+:- pred erl_gen_case(code_model::in, instmap::in, set(prog_var)::in,
+ maybe(elds_expr)::in, hlds_goal.case::in, elds_case::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_case(CodeModel, InstMap, MustBindNonLocals, MaybeSuccessExpr,
+ case(ConsId, Goal), ELDSCase, !Info) :-
+ ( ConsId = cons(_, Arity) ->
+ % Create dummy variables to fill the pattern with.
+ erl_gen_info_new_anonymous_vars(Arity, DummyVars, !Info)
+ ;
+ DummyVars = []
+ ),
+ ( cons_id_to_term(ConsId, DummyVars, Pattern0, !Info) ->
+ Pattern = Pattern0
+ ;
+ unexpected(this_file, "erl_gen_case: cannot pattern match on object")
+ ),
+ erl_gen_goal(CodeModel, InstMap, Goal, MaybeSuccessExpr, Statement0,
+ !Info),
+ %
+ % To prevent warnings from the Erlang compiler we must make sure all cases
+ % bind the same set of variables. This might not be true if the Mercury
+ % compiler knows that a case calls a procedure which throws an exception.
+ %
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_bind_unbound_vars(ModuleInfo, MustBindNonLocals, Goal, InstMap,
+ Statement0, Statement),
+ ELDSCase = elds_case(Pattern, Statement).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for if-then-else
+%
+
+:- pred erl_gen_ite(code_model::in, instmap::in,
+ hlds_goal::in, hlds_goal::in, hlds_goal::in,
+ prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_ite(CodeModel, InstMap0, Cond, Then, Else, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Cond = hlds_goal(_, CondGoalInfo),
+ goal_info_get_code_model(CondGoalInfo, CondCodeModel),
+ (
+ % model_det Cond:
+ % <(Cond -> Then ; Else)>
+ % ===>
+ % <Cond>,
+ % <Then>
+
+ CondCodeModel = model_det,
+ erl_gen_goal(model_det, InstMap0, Cond, no, CondStatement, !Info),
+ update_instmap(Cond, InstMap0, CondInstMap),
+ erl_gen_goal(CodeModel, CondInstMap, Then, MaybeSuccessExpr,
+ ThenStatement, !Info),
+ Statement = join_exprs(CondStatement, ThenStatement)
+ ;
+ % model_semi cond:
+ % <(Cond -> Then ; Else)>
+ % ===>
+ % case
+ % <Cond [[ Outputs ]]>
+ % of
+ % {Outputs} -> <Then> ;
+ % fail -> <Else>
+ % end
+ %
+ % where Outputs is the set of variables bound by Bound. To avoid
+ % warnings from the Erlang compiler, we rename the set of output
+ % variables in the code generated for Cond itself, so they are only
+ % bound in the outer `case' statement.
+ %
+
+ CondCodeModel = model_semi,
+
+ % Find the non-local variables bound in the condition.
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Cond, CondVarsSet),
+ CondVars = set.to_sorted_list(CondVarsSet),
+
+ % Generate the condition goal, making it evaluate to a tuple of the
+ % non-local variables that it binds on success.
+ CondVarsTerm = elds_tuple(exprs_from_vars(CondVars)),
+ erl_gen_goal(model_semi, InstMap0, Cond,
+ yes(elds_term(CondVarsTerm)), CondStatement0, !Info),
+
+ % Rename the variables in the generated condition expression.
+ erl_create_renaming(CondVars, Subn, !Info),
+ erl_rename_vars_in_expr(Subn, CondStatement0, CondStatement),
+
+ % Generate the Then and Else branches.
+ update_instmap(Cond, InstMap0, InstMap1),
+ erl_gen_goal(CodeModel, InstMap1, Then, MaybeSuccessExpr,
+ ThenStatement0, !Info),
+ erl_gen_goal(CodeModel, InstMap0, Else, MaybeSuccessExpr,
+ ElseStatement0, !Info),
+
+ % Make sure both branches bind the same sets of variables.
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap1, Then, ThenVars),
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap0, Else, ElseVars),
+ erl_bind_unbound_vars(ModuleInfo, ElseVars, Then, InstMap1,
+ ThenStatement0, ThenStatement),
+ erl_bind_unbound_vars(ModuleInfo, ThenVars, Else, InstMap0,
+ ElseStatement0, ElseStatement),
+
+ Statement = elds_case_expr(CondStatement, [TrueCase, FalseCase]),
+ TrueCase = elds_case(CondVarsTerm, ThenStatement),
+ FalseCase = elds_case(elds_anon_var, ElseStatement)
+ ;
+ CondCodeModel = model_non,
+ sorry(this_file, "nondet code in Erlang backend")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for negation
+%
+
+:- pred erl_gen_negation(hlds_goal::in, code_model::in, instmap::in,
+ prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_negation(Cond, CodeModel, InstMap, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Cond = hlds_goal(_, CondGoalInfo),
+ goal_info_get_code_model(CondGoalInfo, CondCodeModel),
+ (
+ % model_det negation:
+ % <not(Goal)>
+ % ===>
+
+ CodeModel = model_det,
+ % XXX haven't found a test case for this yet
+ sorry(this_file, "erl_gen_negation: model_det")
+ ;
+ % model_semi negation, model_det goal:
+ % <succeeded = not(Goal)>
+ % ===>
+ % <do Goal>,
+ % fail
+
+ CodeModel = model_semi, CondCodeModel = model_det,
+ erl_gen_goal(model_det, InstMap, Cond, no, CondStatement, !Info),
+ Statement = join_exprs(CondStatement, elds_term(elds_fail))
+ ;
+ % model_semi negation, model_semi goal:
+ % <succeeded = not(Goal)>
+ % ===>
+ %
+ % case
+ % <Goal [[ true ]]>
+ % of
+ % fail ->
+ % <SuccessExpr> ;
+ % _ ->
+ % fail
+ % end
+
+ CodeModel = model_semi, CondCodeModel = model_semi,
+
+ OnSuccess = yes(elds_term(elds_true)), % anything other than fail
+ erl_gen_goal(model_semi, InstMap, Cond, OnSuccess, CondStatement,
+ !Info),
+ Statement = elds_case_expr(CondStatement, [FailCase, OtherCase]),
+ FailCase = elds_case(elds_fail, expr_or_void(MaybeSuccessExpr)),
+ OtherCase = elds_case(elds_anon_var, elds_term(elds_fail))
+ ;
+ CodeModel = model_semi, CondCodeModel = model_non,
+ unexpected(this_file, "erl_gen_negation: nondet cond")
+ ;
+ CodeModel = model_non,
+ unexpected(this_file, "erl_gen_negation: nondet negation")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for conjunctions
+%
+
+:- pred erl_gen_conj(hlds_goals::in, code_model::in, instmap::in,
+ prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_conj([], CodeModel, _InstMap0, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ % XXX implement this for other code models
+ require(unify(CodeModel, model_det),
+ "erl_gen_conj: CodeModel != model_det"),
+ Statement = expr_or_void(MaybeSuccessExpr).
+erl_gen_conj([SingleGoal], CodeModel, InstMap0, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ erl_gen_goal(CodeModel, InstMap0, SingleGoal, MaybeSuccessExpr,
+ Statement, !Info).
+erl_gen_conj([First | Rest], CodeModel, InstMap0, Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Rest = [_ | _],
+ First = hlds_goal(_, FirstGoalInfo),
+ 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)
+ ;
+ determinism_to_code_model(FirstDeterminism, FirstCodeModel),
+ update_instmap(First, InstMap0, InstMap1),
+ (
+ FirstCodeModel = model_det,
+ erl_gen_goal(model_det, InstMap0, First, no,
+ FirstStatement, !Info),
+ erl_gen_conj(Rest, CodeModel, InstMap1, Context, MaybeSuccessExpr,
+ RestStatement, !Info),
+ Statement = join_exprs(FirstStatement, RestStatement)
+ ;
+ FirstCodeModel = model_semi,
+ erl_gen_conj(Rest, CodeModel, InstMap1, Context, MaybeSuccessExpr,
+ RestStatement, !Info),
+ erl_gen_goal(model_semi, InstMap0, First, yes(RestStatement),
+ Statement, !Info)
+ ;
+ FirstCodeModel = model_non,
+ sorry(this_file, "nondet code in Erlang backend")
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for disjunctions
+%
+
+:- pred erl_gen_disj(hlds_goals::in, code_model::in, instmap::in,
+ prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_disj([], CodeModel, _InstMap, _Context, _MaybeSuccessExpr,
+ Statement, !Info) :-
+ (
+ CodeModel = model_det,
+ unexpected(this_file, "erl_gen_disj: `fail' has determinism `det'")
+ ;
+ ( CodeModel = model_semi
+ ; CodeModel = model_non
+ ),
+ Statement = elds_term(elds_fail)
+ ).
+
+erl_gen_disj([SingleGoal], CodeModel, InstMap, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ % Handle singleton disjunctions.
+ erl_gen_goal(CodeModel, InstMap, SingleGoal, MaybeSuccessExpr,
+ Statement, !Info).
+
+erl_gen_disj([First | Rest], CodeModel, InstMap, Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Rest = [_ | _],
+ ( CodeModel = model_non ->
+ % model_non disj:
+ %
+ % <(Goal ; Goals) && SUCCEED()>
+ % ===>
+
+ sorry(this_file, "nondet code in Erlang backend")
+ ;
+ % model_det/model_semi disj:
+ %
+ % model_det goal:
+ % <Goal ; Goals>
+ % ===>
+ % <Goal>
+ % /* <Goals> will never be reached */
+ %
+ % model_semi goal:
+ % <Goal ; Goals>
+ % ===>
+ % case Goal of
+ % fail -> Goals ;
+ % Anything -> Anything
+ % end
+ %
+ % TODO This can lead to contorted code when <Goal> itself is a `case'
+ % expression. In that case it would be better for <Goals> to appear in
+ % the failure case of <Goal> directly.
+ %
+
+ First = hlds_goal(_, FirstGoalInfo),
+ goal_info_get_code_model(FirstGoalInfo, FirstCodeModel),
+ (
+ FirstCodeModel = model_det,
+ erl_gen_goal(model_det, InstMap, First, MaybeSuccessExpr,
+ GoalStatement, !Info),
+ % Is this necessary?
+ erl_gen_wrap_goal(CodeModel, model_det, Context,
+ GoalStatement, Statement, !Info)
+ ;
+ FirstCodeModel = model_semi,
+
+ erl_gen_goal(CodeModel, InstMap, First, MaybeSuccessExpr,
+ FirstStatement0, !Info),
+ erl_gen_disj(Rest, CodeModel, InstMap, Context, MaybeSuccessExpr,
+ RestStatement, !Info),
+
+ % Need to do some renaming otherwise FirstStatement and
+ % RestStatement end up binding the same variables which triggers a
+ % (spurious) warning from the Erlang compiler.
+ %
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap, First,
+ FirstVarsSet),
+ FirstVars = set.to_sorted_list(FirstVarsSet),
+ erl_create_renaming(FirstVars, Subn, !Info),
+ erl_rename_vars_in_expr(Subn, FirstStatement0, FirstStatement),
+
+ erl_gen_info_new_var(Dummy, !Info),
+ Statement = elds_case_expr(FirstStatement, [FailCase, OtherCase]),
+ FailCase = elds_case(elds_fail, RestStatement),
+ OtherCase = elds_case(term_from_var(Dummy), expr_from_var(Dummy))
+ ;
+ FirstCodeModel = model_non,
+ % simplify.m should get wrap commits around these.
+ unexpected(this_file, "model_non disj in model_det disjunction")
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "erl_code_gen.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module erl_code_gen.
+%-----------------------------------------------------------------------------%
Index: compiler/erl_code_util.m
===================================================================
RCS file: compiler/erl_code_util.m
diff -N compiler/erl_code_util.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/erl_code_util.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,413 @@
+%-----------------------------------------------------------------------------%
+% 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_code_util.m.
+% Main author: wangp.
+%
+% This module is part of the Erlang code generator.
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.erl_code_util.
+:- interface.
+
+:- import_module erl_backend.elds.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.instmap.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module set.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% The `erl_gen_info' ADT.
+%
+
+ % The `erl_gen_info' type holds information used during
+ % ELDS code generation for a given procedure.
+ %
+:- type erl_gen_info.
+
+ % Initialize the erl_gen_info, so that it is ready for generating code
+ % for the given procedure.
+ %
+:- func erl_gen_info_init(module_info, pred_id, proc_id) = erl_gen_info.
+
+:- pred erl_gen_info_get_module_info(erl_gen_info::in, module_info::out)
+ is det.
+:- pred erl_gen_info_get_varset(erl_gen_info::in, prog_varset::out) is det.
+:- pred erl_gen_info_get_var_types(erl_gen_info::in, vartypes::out) is det.
+:- pred erl_gen_info_get_input_vars(erl_gen_info::in, prog_vars::out) is det.
+:- pred erl_gen_info_get_output_vars(erl_gen_info::in, prog_vars::out) is det.
+
+ % Create a new variable.
+ %
+:- pred erl_gen_info_new_var(prog_var::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+ % Create multiple new variables.
+ %
+:- pred erl_gen_info_new_vars(int::in, prog_vars::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+ % Create multiple new variables, which have names beginning with
+ % underscores.
+ %
+:- pred erl_gen_info_new_anonymous_vars(int::in, prog_vars::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+ % Lookup the types of a list of variables.
+ %
+:- pred erl_variable_types(erl_gen_info::in, prog_vars::in,
+ list(mer_type)::out) is det.
+
+ % Lookup the type of a variable.
+ %
+:- pred erl_variable_type(erl_gen_info::in, prog_var::in, mer_type::out) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% Various utility routines used for ELDS code generation
+%
+
+ % Separate procedure call arguments into inputs and output variables.
+ % Dummy types are ignored.
+ %
+:- pred erl_gen_arg_list(module_info::in, list(T)::in,
+ list(mer_type)::in, list(mer_mode)::in,
+ list(T)::out, list(T)::out) is det.
+
+ % Return the set of variables non-local to a goal which are bound
+ % by that goal.
+ %
+:- pred erl_bound_nonlocals_in_goal(module_info::in, instmap::in,
+ hlds_goal::in, set(prog_var)::out) is det.
+
+ % erl_bind_unbound_vars(ModuleInfo, VarsToBind, Goal, InstMap,
+ % !Statement)
+ %
+ % For any variables in VarsToBind which are not bound in Goal, add
+ % assignment expressions to !Statement. This is necessary to ensure that
+ % all branches of ELDS code bind the same variables, to avoid warnings from
+ % the Erlang compiler when one branch doesn't bind all the variables
+ % because it has determinism `erroneous'.
+ %
+:- pred erl_bind_unbound_vars(module_info::in, set(prog_var)::in,
+ hlds_goal::in, instmap::in, elds_expr::in, elds_expr::out) is det.
+
+ % erl_create_renaming(Vars, Subst, !Info):
+ %
+ % Create a substitution for each variable in Vars to a fresh variable.
+ %
+:- pred erl_create_renaming(prog_vars::in, prog_var_renaming::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+ % erl_rename_vars_in_expr(Subn, Expr0, Expr):
+ %
+ % Substitute every occurrence of any variable for a substitute that appears
+ % in the mapping Subn. Variables which do not appear in Subn are left
+ % unsubstituted.
+ %
+:- pred erl_rename_vars_in_expr(prog_var_renaming::in,
+ elds_expr::in, elds_expr::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module check_hlds.type_util.
+:- import_module libs.compiler_util.
+
+:- import_module map.
+:- import_module set.
+:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+%
+% The definition of the `erl_gen_info' ADT.
+%
+
+% The `erl_gen_info' type holds information used during Erlang code generation
+% for a given procedure.
+
+:- type erl_gen_info
+ ---> erl_gen_info(
+ % These fields remain constant for each procedure,
+ % except for the varset which can be added to as variables
+ % are introduced.
+
+ module_info :: module_info,
+ pred_id :: pred_id,
+ proc_id :: proc_id,
+ varset :: prog_varset,
+ var_types :: vartypes,
+
+ % input_vars and output_vars do not include variables of dummy
+ % types.
+ input_vars :: prog_vars,
+ output_vars :: prog_vars
+ ).
+
+erl_gen_info_init(ModuleInfo, PredId, ProcId) = Info :-
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo),
+ proc_info_get_headvars(ProcInfo, HeadVars),
+ proc_info_get_varset(ProcInfo, VarSet),
+ 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),
+ Info = erl_gen_info(
+ ModuleInfo,
+ PredId,
+ ProcId,
+ VarSet,
+ VarTypes,
+ InputVars,
+ OutputVars
+ ).
+
+erl_gen_info_get_module_info(Info, Info ^ module_info).
+erl_gen_info_get_varset(Info, Info ^ varset).
+erl_gen_info_get_var_types(Info, Info ^ var_types).
+erl_gen_info_get_input_vars(Info, Info ^ input_vars).
+erl_gen_info_get_output_vars(Info, Info ^ output_vars).
+
+:- pred erl_gen_info_set_varset(prog_varset::in,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_info_set_varset(VarSet, Info, Info ^ varset := VarSet).
+
+erl_gen_info_new_var(NewVar, !Info) :-
+ erl_gen_info_get_varset(!.Info, VarSet0),
+ varset.new_var(VarSet0, NewVar, VarSet),
+ erl_gen_info_set_varset(VarSet, !Info).
+
+erl_gen_info_new_vars(Num, NewVars, !Info) :-
+ erl_gen_info_get_varset(!.Info, VarSet0),
+ varset.new_vars(VarSet0, Num, NewVars, VarSet),
+ erl_gen_info_set_varset(VarSet, !Info).
+
+erl_gen_info_new_anonymous_vars(Num, NewVars, !Info) :-
+ erl_gen_info_get_varset(!.Info, VarSet0),
+ list.map_foldl(erl_gen_info_new_anonymous_var, 1 .. Num, NewVars,
+ VarSet0, VarSet),
+ erl_gen_info_set_varset(VarSet, !Info).
+
+:- pred erl_gen_info_new_anonymous_var(int::in, prog_var::out,
+ prog_varset::in, prog_varset::out) is det.
+
+erl_gen_info_new_anonymous_var(_Num, NewVar, VarSet0, VarSet) :-
+ varset.new_named_var(VarSet0, "_", NewVar, VarSet).
+
+erl_variable_types(Info, Vars, Types) :-
+ list.map(erl_variable_type(Info), Vars, Types).
+
+erl_variable_type(Info, Var, Type) :-
+ erl_gen_info_get_var_types(Info, VarTypes),
+ map.lookup(VarTypes, Var, Type).
+
+%-----------------------------------------------------------------------------%
+%
+% Various utility routines used for ELDS code generation
+%
+
+ % XXX arg_info.partition_* does a similar thing but returns sets instead
+ % of lists
+ %
+erl_gen_arg_list(ModuleInfo, VarNames, ArgTypes, Modes, Inputs, Outputs) :-
+ (
+ VarNames = [],
+ ArgTypes = [],
+ Modes = []
+ ->
+ Inputs = [],
+ Outputs = []
+ ;
+ VarNames = [VarName | VarNames1],
+ ArgTypes = [ArgType | ArgTypes1],
+ Modes = [Mode | Modes1]
+ ->
+ erl_gen_arg_list(ModuleInfo, VarNames1, ArgTypes1,
+ Modes1, Inputs1, Outputs1),
+ mode_to_arg_mode(ModuleInfo, Mode, ArgType, ArgMode),
+ (
+ ( is_dummy_argument_type(ModuleInfo, ArgType)
+ ; ArgMode = top_unused
+ )
+ ->
+ % Exclude arguments of type io.state etc.
+ % Also exclude those with arg_mode `top_unused'.
+ Inputs = Inputs1,
+ Outputs = Outputs1
+ ;
+ ArgMode = top_in
+ ->
+ % It's an input argument.
+ Inputs = [VarName | Inputs1],
+ Outputs = Outputs1
+ ;
+ % It's an output argument.
+ Inputs = Inputs1,
+ Outputs = [VarName | Outputs1]
+ )
+ ;
+ unexpected(this_file, "erl_gen_arg_list: length mismatch")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+erl_bound_nonlocals_in_goal(ModuleInfo, InstMap, Goal, BoundNonLocals) :-
+ Goal = hlds_goal(_, GoalInfo),
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
+ goal_info_get_instmap_delta(GoalInfo, InstmapDelta),
+ IsBound = var_is_bound_in_instmap_delta(ModuleInfo, InstMap, InstmapDelta),
+ BoundNonLocals = set.filter(IsBound, NonLocals).
+
+erl_bind_unbound_vars(ModuleInfo, VarsToBind, Goal, InstMap,
+ Statement0, Statement) :-
+ erl_bound_nonlocals_in_goal(ModuleInfo, InstMap, Goal, Bound),
+ NotBound = set.difference(VarsToBind, Bound),
+ (if set.empty(NotBound) then
+ 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)
+ ).
+
+:- 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) :-
+ erl_gen_info_new_vars(list.length(Vars), NewVars, !Info),
+ map.from_corresponding_lists(Vars, NewVars, Subst).
+
+:- pred erl_rename_vars_in_exprs(prog_var_renaming::in,
+ list(elds_expr)::in, list(elds_expr)::out) is det.
+
+erl_rename_vars_in_exprs(Subn, Exprs0, Exprs) :-
+ list.map(erl_rename_vars_in_expr(Subn), Exprs0, Exprs).
+
+erl_rename_vars_in_expr(Subn, Expr0, Expr) :-
+ (
+ Expr0 = elds_block(Exprs0),
+ erl_rename_vars_in_exprs(Subn, Exprs0, Exprs),
+ Expr = elds_block(Exprs)
+ ;
+ Expr0 = elds_term(Term0),
+ erl_rename_vars_in_term(Subn, Term0, Term),
+ Expr = elds_term(Term)
+ ;
+ Expr0 = elds_eq(ExprA0, ExprB0),
+ erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
+ erl_rename_vars_in_expr(Subn, ExprB0, ExprB),
+ Expr = elds_eq(ExprA, ExprB)
+ ;
+ Expr0 = elds_unop(Op, ExprA0),
+ erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
+ Expr = elds_unop(Op, ExprA)
+ ;
+ Expr0 = elds_binop(Op, ExprA0, ExprB0),
+ erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
+ 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),
+ erl_rename_vars_in_exprs(Subn, ExprsB0, ExprsB),
+ Expr = elds_call_ho(ExprA, ExprsB)
+ ;
+ Expr0 = elds_fun(Clause0),
+ erl_rename_vars_in_clause(Subn, Clause0, Clause),
+ Expr = elds_fun(Clause)
+ ;
+ Expr0 = elds_case_expr(ExprA0, Cases0),
+ erl_rename_vars_in_expr(Subn, ExprA0, ExprA),
+ erl_rename_vars_in_cases(Subn, Cases0, Cases),
+ Expr = elds_case_expr(ExprA, Cases)
+ ).
+
+:- pred erl_rename_vars_in_terms(prog_var_renaming::in,
+ list(elds_term)::in, list(elds_term)::out) is det.
+
+erl_rename_vars_in_terms(Subn, Terms0, Terms) :-
+ list.map(erl_rename_vars_in_term(Subn), Terms0, Terms).
+
+:- pred erl_rename_vars_in_term(prog_var_renaming::in,
+ elds_term::in, elds_term::out) is det.
+
+erl_rename_vars_in_term(Subn, Term0, Term) :-
+ (
+ ( Term0 = elds_int(_)
+ ; Term0 = elds_float(_)
+ ; Term0 = elds_string(_)
+ ; Term0 = elds_char(_)
+ ; Term0 = elds_atom_raw(_)
+ ; Term0 = elds_atom(_)
+ ; Term0 = elds_anon_var
+ ),
+ Term = Term0
+ ;
+ Term0 = elds_tuple(Exprs0),
+ erl_rename_vars_in_exprs(Subn, Exprs0, Exprs),
+ Term = elds_tuple(Exprs)
+ ;
+ Term0 = elds_var(Var0),
+ Var = (if map.search(Subn, Var0, Var1) then Var1 else Var0),
+ Term = elds_var(Var)
+ ).
+
+:- pred erl_rename_vars_in_clause(prog_var_renaming::in,
+ elds_clause::in, elds_clause::out) is det.
+
+erl_rename_vars_in_clause(Subn, Clause0, Clause) :-
+ Clause0 = elds_clause(Pattern0, Expr0),
+ erl_rename_vars_in_terms(Subn, Pattern0, Pattern),
+ erl_rename_vars_in_expr(Subn, Expr0, Expr),
+ Clause = elds_clause(Pattern, Expr).
+
+:- pred erl_rename_vars_in_cases(prog_var_renaming::in,
+ list(elds_case)::in, list(elds_case)::out) is det.
+
+erl_rename_vars_in_cases(Subn, Cases0, Cases) :-
+ list.map(erl_rename_vars_in_case(Subn), Cases0, Cases).
+
+:- pred erl_rename_vars_in_case(prog_var_renaming::in,
+ elds_case::in, elds_case::out) is det.
+
+erl_rename_vars_in_case(Subn, Case0, Case) :-
+ Case0 = elds_case(Pattern0, Expr0),
+ erl_rename_vars_in_term(Subn, Pattern0, Pattern),
+ erl_rename_vars_in_expr(Subn, Expr0, Expr),
+ Case = elds_case(Pattern, Expr).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "erl_code_util.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module erl_code_util.
+%-----------------------------------------------------------------------------%
Index: compiler/erl_unify_gen.m
===================================================================
RCS file: compiler/erl_unify_gen.m
diff -N compiler/erl_unify_gen.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/erl_unify_gen.m 14 May 2007 04:00:50 -0000
@@ -0,0 +1,286 @@
+%-----------------------------------------------------------------------------%
+% 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_unify_gen.m
+% Main author: wangp.
+%
+% This module is part of the Erlang code generator.
+% It handles Erlang code generation for unifications.
+%
+%-----------------------------------------------------------------------------%
+
+:- module erl_backend.erl_unify_gen.
+:- interface.
+
+:- import_module erl_backend.elds.
+:- import_module erl_backend.erl_code_util.
+:- import_module hlds.code_model.
+:- import_module hlds.hlds_goal.
+:- import_module parse_tree.prog_data.
+
+:- import_module maybe.
+
+%-----------------------------------------------------------------------------%
+
+ % Generate ELDS code for a unification.
+ %
+:- pred erl_gen_unification(unification::in, code_model::in, prog_context::in,
+ maybe(elds_expr)::in, elds_expr::out, erl_gen_info::in, erl_gen_info::out)
+ is det.
+
+ % Convert a cons id to the ELDS equivalent term, if any. That is, any term
+ % returned by this predicate must be useable as part of a pattern matching
+ % operation.
+ %
+:- pred cons_id_to_term(cons_id, prog_vars, elds_term,
+ erl_gen_info, erl_gen_info).
+:- mode cons_id_to_term(in, in, out, in, out) is semidet.
+:- mode cons_id_to_term(in(termable_cons_id), in, out, in, out) is det.
+
+:- inst termable_cons_id
+ ---> cons(ground, ground)
+ ; int_const(ground)
+ ; string_const(ground)
+ ; float_const(ground).
+
+ % Convert a cons id to the ELDS equivalent expression.
+ %
+:- pred cons_id_to_expr(cons_id::in, prog_vars::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.type_util.
+:- import_module erl_backend.erl_code_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 int.
+:- import_module list.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+erl_gen_unification(Unification, _CodeModel, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Unification = assign(TargetVar, SourceVar),
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ erl_variable_type(!.Info, TargetVar, VarType),
+ ( is_dummy_argument_type(ModuleInfo, VarType) ->
+ Statement = expr_or_void(MaybeSuccessExpr)
+ ;
+ Assign = elds_eq(expr_from_var(TargetVar), expr_from_var(SourceVar)),
+ Statement = maybe_join_exprs(Assign, MaybeSuccessExpr)
+ ).
+
+erl_gen_unification(Unification, CodeModel, _Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Unification = simple_test(Var1, Var2),
+ expect(unify(CodeModel, model_semi), this_file,
+ "erl_code_gen: simple_test not semidet"),
+ %
+ % case Var1 =:= Var2 of
+ % true -> MaybeSuccessExpr ;
+ % false -> fail
+ % end
+ %
+ Statement = elds_case_expr(Test, [TrueCase, FalseCase]),
+ Test = elds_binop((=:=), expr_from_var(Var1), expr_from_var(Var2)),
+ TrueCase = elds_case(elds_true, expr_or_void(MaybeSuccessExpr)),
+ FalseCase = elds_case(elds_false, elds_term(elds_fail)).
+
+erl_gen_unification(Unification, CodeModel, Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Unification = construct(Var, ConsId, Args, ArgModes, _HowToConstruct,
+ _CellIsUnique, SubInfo),
+ expect(unify(CodeModel, model_det), this_file,
+ "erl_code_gen: construct not det"),
+ (
+ SubInfo = no_construct_sub_info
+ ;
+ SubInfo = construct_sub_info(_MaybeTakeAddr, MaybeSizeProfInfo),
+ 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_unification(Unification, CodeModel, Context, MaybeSuccessExpr,
+ Statement, !Info) :-
+ Unification = deconstruct(Var, ConsId, Args, ArgModes, CanFail, _CanCGC),
+ (
+ CanFail = can_fail,
+ ExpectedCodeModel = model_semi,
+ erl_gen_semidet_deconstruct(Var, ConsId, Args, ArgModes, Context,
+ MaybeSuccessExpr, Statement1, !Info)
+ ;
+ CanFail = cannot_fail,
+ ExpectedCodeModel = model_det,
+ erl_gen_det_deconstruct(Var, ConsId, Args, ArgModes, Context,
+ Statement0, !Info),
+ Statement1 = maybe_join_exprs(Statement0, MaybeSuccessExpr)
+ ),
+
+ % In ml_unify_gen.m it's written:
+ % We used to require that CodeModel = ExpectedCodeModel. But the
+ % delds_terminism field in the goal_info is allowed to be a conservative
+ % approximation, so we need to handle the case were CodeModel is less
+ % precise than ExpectedCodeModel.
+ %
+ erl_gen_wrap_goal(CodeModel, ExpectedCodeModel, Context,
+ Statement1, Statement, !Info).
+
+erl_gen_unification(complicated_unify(_, _, _), _, _, _, _, !Info) :-
+ % Simplify.m should have converted these into procedure calls.
+ unexpected(this_file, "erl_code_gen: complicated unify").
+
+%-----------------------------------------------------------------------------%
+
+:- pred erl_gen_construct(prog_var::in, cons_id::in, prog_vars::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) :-
+ cons_id_to_expr(ConsId, Args, RHS, !Info),
+ Statement = elds_eq(expr_from_var(Var), RHS).
+
+%-----------------------------------------------------------------------------%
+
+:- pred erl_gen_det_deconstruct(prog_var::in, cons_id::in, prog_vars::in,
+ list(uni_mode)::in, prog_context::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_det_deconstruct(Var, ConsId, Args, _Modes, _Context, Statement,
+ !Info) :-
+ cons_id_to_expr(ConsId, Args, LHS, !Info),
+ Statement = elds_eq(LHS, expr_from_var(Var)).
+
+:- pred erl_gen_semidet_deconstruct(prog_var::in, cons_id::in, prog_vars::in,
+ list(uni_mode)::in, prog_context::in, maybe(elds_expr)::in, elds_expr::out,
+ erl_gen_info::in, erl_gen_info::out) is det.
+
+erl_gen_semidet_deconstruct(Var, ConsId, Args, _Modes, _Context,
+ MaybeSuccessExpr, Statement, !Info) :-
+ (
+ MaybeSuccessExpr = yes(SuccessExpr)
+ ;
+ MaybeSuccessExpr = no,
+ unexpected(this_file, "erl_gen_semidet_deconstruct: no success value")
+ ),
+ ( cons_id_to_term(ConsId, Args, Pattern0, !Info) ->
+ Pattern = Pattern0
+ ;
+ unexpected(this_file,
+ "erl_gen_semidet_deconstruct: undeconstructable object")
+ ),
+ %
+ % case Var of
+ % Pattern -> SuccessExpr ;
+ % _ -> fail
+ % end
+ %
+ Statement = elds_case_expr(expr_from_var(Var), [SucceedCase, FailCase]),
+ SucceedCase = elds_case(Pattern, SuccessExpr),
+ FailCase = elds_case(elds_anon_var, elds_term(elds_fail)).
+
+%-----------------------------------------------------------------------------%
+
+cons_id_to_term(ConsId, Args, Term, !Info) :-
+ (
+ ConsId = cons(Name, _Arity),
+ (
+ Name = unqualified(String),
+ string.char_to_string(Char, String)
+ ->
+ Term = elds_char(Char)
+ ;
+ % XXX optimise the cases where we don't actually need a
+ % distinguishing atom.
+ Functor = elds_term(elds_atom(Name)),
+ Term = elds_tuple([Functor | exprs_from_vars(Args)])
+ )
+ ;
+ ConsId = int_const(Int),
+ Term = elds_int(Int)
+ ;
+ ConsId = string_const(String),
+ Term = elds_string(String)
+ ;
+ ConsId = float_const(Float),
+ Term = elds_float(Float)
+ ).
+
+cons_id_to_expr(ConsId, Args, Expr, !Info) :-
+ (
+ ( ConsId = cons(_, _)
+ ; ConsId = int_const(_)
+ ; ConsId = string_const(_)
+ ; ConsId = float_const(_)
+ ),
+ cons_id_to_term(ConsId, Args, Term, !Info),
+ Expr = elds_term(Term)
+ ;
+ 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 = typeclass_info_cell_constructor
+ ),
+ % XXX RTTI not implemented for Erlang backend yet.
+ Expr = elds_term(elds_atom_raw("todo_some_rtti_thing"))
+ ;
+ ( ConsId = tabling_info_const(_)
+ ; ConsId = deep_profiling_proc_layout(_)
+ ; ConsId = table_io_decl(_)
+ ),
+ sorry(this_file,
+ "tabling and deep profiling not support on Erlang backend")
+ ).
+
+:- 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) :-
+ erl_gen_info_get_module_info(!.Info, ModuleInfo),
+ PredProcId = unshroud_pred_proc_id(ShroudedPredProcId),
+ module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
+ pred_info_get_arg_types(PredInfo, CalleeTypes),
+ proc_info_get_argmodes(ProcInfo, ArgModes),
+
+ % Create extra variables needed to complete the call to the procedure.
+ NumExtraVars = list.length(CalleeTypes) - list.length(Args),
+ 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),
+
+ % (elds_fun(InputExtraVars, ...) -> Proc(AllInputVars, ...) end)
+ % where InputExtraVars are part of AllInputVars.
+ %
+ FunExpr = elds_fun(elds_clause(terms_from_vars(InputExtraVars), Call)),
+ Call = elds_call(PredProcId, exprs_from_vars(AllInputVars)).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "erl_unify_gen.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module erl_unify_gen.
+%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.433
diff -u -r1.433 mercury_compile.m
--- compiler/mercury_compile.m 7 May 2007 05:21:31 -0000 1.433
+++ compiler/mercury_compile.m 14 May 2007 04:00:50 -0000
@@ -145,6 +145,11 @@
:- import_module ml_backend.maybe_mlds_to_gcc. % MLDS -> GCC back-end
:- import_module ml_backend.ml_util. % MLDS utility predicates
+ % the Erlang back-end
+:- import_module erl_backend.elds.
+:- import_module erl_backend.elds_to_erlang.
+:- import_module erl_backend.erl_code_gen.
+
% miscellaneous compiler modules
:- import_module check_hlds.goal_path.
:- import_module check_hlds.inst_check.
@@ -1693,7 +1698,9 @@
FactTableBaseFiles = []
;
Target = target_erlang,
- sorry(this_file, "mercury_compile_after_front_end: target erlang")
+ erlang_backend(!HLDS, ELDS, !DumpInfo, !IO),
+ elds_to_erlang(!.HLDS, ELDS, !IO),
+ FactTableBaseFiles = []
),
recompilation.usage.write_usage_file(!.HLDS, NestedSubModules,
MaybeTimestamps, !IO),
@@ -5157,6 +5164,30 @@
).
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+%
+% Erlang backend
+%
+
+:- pred erlang_backend(module_info::in, module_info::out, 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).
+
+:- pred elds_to_erlang(module_info::in, elds::in, io::di, io::uo) is det.
+
+elds_to_erlang(ModuleInfo, ELDS, !IO) :-
+ globals.io_lookup_bool_option(verbose, Verbose, !IO),
+ globals.io_lookup_bool_option(statistics, Stats, !IO),
+
+ maybe_write_string(Verbose, "% Converting ELDS to Erlang...\n", !IO),
+ elds_to_erlang.output_elds(ModuleInfo, ELDS, !IO),
+ maybe_write_string(Verbose, "% Finished converting ELDS to Erlang.\n",
+ !IO),
+ maybe_report_stats(Stats, !IO).
+
+%-----------------------------------------------------------------------------%
:- func this_file = string.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.422
diff -u -r1.422 modules.m
--- compiler/modules.m 7 May 2007 05:21:34 -0000 1.422
+++ compiler/modules.m 14 May 2007 04:00:50 -0000
@@ -81,6 +81,13 @@
:- pred module_name_to_file_name(module_name::in, string::in, bool::in,
file_name::out, io::di, io::uo) is det.
+ % module_name_to_file_name_sep(Module, Sep, Extension, Mkdir, FileName):
+ %
+ % As above but module qualifiers are separated by Sep instead of ".".
+ %
+:- pred module_name_to_file_name_sep(module_name::in, string::in, string::in,
+ bool::in, file_name::out, io::di, io::uo) is det.
+
% module_name_to_search_file_name(Module, Extension, FileName):
%
% As above, but for a file which might be in an installed library,
@@ -837,20 +844,26 @@
mercury_std_library_module(ModuleNameStr).
module_name_to_search_file_name(ModuleName, Ext, FileName, !IO) :-
- module_name_to_file_name(ModuleName, Ext, yes, no, FileName, !IO).
+ module_name_to_file_name_sep(ModuleName, ".", Ext, yes, no, FileName, !IO).
module_name_to_file_name(ModuleName, Ext, MkDir, FileName, !IO) :-
- module_name_to_file_name(ModuleName, Ext, no, MkDir, FileName, !IO).
+ module_name_to_file_name_sep(ModuleName, ".", Ext, no, MkDir, FileName,
+ !IO).
-:- pred module_name_to_file_name(module_name::in, string::in, bool::in,
- bool::in, file_name::out, io::di, io::uo) is det.
+module_name_to_file_name_sep(ModuleName, Sep, Ext, MkDir, FileName, !IO) :-
+ module_name_to_file_name_sep(ModuleName, Sep, Ext, no, MkDir, FileName,
+ !IO).
+
+:- pred module_name_to_file_name_sep(module_name::in, string::in, string::in,
+ bool::in, bool::in, file_name::out, io::di, io::uo) is det.
-module_name_to_file_name(ModuleName, Ext, Search, MkDir, FileName, !IO) :-
+module_name_to_file_name_sep(ModuleName, Sep, Ext, Search, MkDir, FileName,
+ !IO) :-
( Ext = ".m" ->
% Look up the module in the module->file mapping.
source_file_map.lookup_module_source_file(ModuleName, FileName, !IO)
;
- string.append(sym_name_to_string(ModuleName), Ext, BaseName),
+ string.append(sym_name_to_string_sep(ModuleName, Sep), Ext, BaseName),
choose_file_name(ModuleName, BaseName, Ext, Search, MkDir, FileName,
!IO)
).
Index: compiler/top_level.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/top_level.m,v
retrieving revision 1.7
diff -u -r1.7 top_level.m
--- compiler/top_level.m 23 Feb 2006 09:37:10 -0000 1.7
+++ compiler/top_level.m 14 May 2007 04:00:50 -0000
@@ -1,7 +1,7 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
-% Copyright (C) 2002-2006 The University of Melbourne.
+% Copyright (C) 2002-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.
%-----------------------------------------------------------------------------%
@@ -26,6 +26,7 @@
% Incomplete back-ends.
:- import_module bytecode_backend.
+:- import_module erl_backend.
% Misc utilities.
:- import_module backend_libs.
Index: library/array.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.153
diff -u -r1.153 array.m
--- library/array.m 27 Feb 2007 02:12:34 -0000 1.153
+++ library/array.m 14 May 2007 04:00:50 -0000
@@ -416,6 +416,10 @@
where equality is array.array_equal,
comparison is array.array_compare.
+:- pragma foreign_type("Erlang", array(T), "")
+ where equality is array.array_equal,
+ comparison is array.array_compare.
+
% unify/2 for arrays
%
:- pred array_equal(array(T)::in, array(T)::in) is semidet.
Index: library/bitmap.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/bitmap.m,v
retrieving revision 1.18
diff -u -r1.18 bitmap.m
--- library/bitmap.m 2 May 2007 06:16:38 -0000 1.18
+++ library/bitmap.m 14 May 2007 04:00:50 -0000
@@ -1399,6 +1399,8 @@
:- pragma foreign_type("IL", bitmap,
"class [mercury]mercury.bitmap__csharp_code.MercuryBitmap")
where equality is bitmap_equal, comparison is bitmap_compare.
+:- pragma foreign_type("Erlang", bitmap, "")
+ where equality is bitmap_equal, comparison is bitmap_compare.
:- pred bitmap_equal(bitmap, bitmap).
:- mode bitmap_equal(in, in) is semidet.
Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.381
diff -u -r1.381 io.m
--- library/io.m 23 Apr 2007 02:43:59 -0000 1.381
+++ library/io.m 14 May 2007 04:00:50 -0000
@@ -1503,6 +1503,7 @@
:- pragma foreign_type(il, io.system_error,
"class [mscorlib]System.Exception").
:- pragma foreign_type(java, io.system_error, "java.lang.Exception").
+:- pragma foreign_type(erlang, io.system_error, "").
% io.make_err_msg(Error, MessagePrefix, Message):
% `Message' is an error message obtained by looking up the
--------------------------------------------------------------------------
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