[m-dev.] for review: MLDS back-end stuff
Fergus Henderson
fjh at cs.mu.OZ.AU
Wed Aug 4 15:54:06 AEST 1999
Tyson, could you please review this?
The file mlds_to_c.m is still quite incomplete at this point,
but I will nevertheless commit this change as soon as it has been
reviewed, because Tyson wants access to mlds_to_c.m.
-------------------------------------------------------------------------------
Estimated hours taken: 30
A batch of changes related to the development of the new MLDS back-end.
compiler/notes/compiler_design.html:
Reorganize the documentation to reflect the multi-target /
multiple back-end nature of the compiler.
Document mlds.m and the new modules c_util.m and mlds_to_c.m.
compiler/mlds_to_c.m:
New module. This converts MLDS to C/C++ code.
This version compiles, but it is still quite incomplete;
there's lots of parts which are still not yet implemented.
compiler/llds_out.m:
compiler/c_util.m:
Move some procedures from llds_out.m into a new module c_util.m,
so that they can also be used by mlds_to_c.m.
compiler/mlds.m:
- Add new functions for use by mlds_to_c.m:
* get_prog_context/1, for getting the prog_context from an
mlds__context
* get_module_name/1, for getting the module name from the mlds
* module_name_to_sym_name/1, for converting an mlds_module_name
to a sym_name
- Change the mlds__func_signature type to
* allow multiple return values, for consistency with the
MLDS `return' statement;
* include the names of the parameters.
- Undo the premature over-optimization of making the `constness'
and `finality' flags share the same flag bit.
Workspace: /home/mercury0/fjh/mercury
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.34
diff -u -r1.34 compiler_design.html
--- compiler_design.html 1999/07/29 07:51:39 1.34
+++ compiler_design.html 1999/08/04 05:45:05
@@ -8,39 +8,37 @@
<body bgcolor="#ffffff" text="#000000">
<hr>
-<!-------------------------->
+<!---------------------------------------------------------------------------->
-This file contains various notes about the design of the compiler.
+This file contains an overview of the design of the compiler.
<hr>
-<!-------------------------->
+<!---------------------------------------------------------------------------->
-
<h2> OUTLINE </h2>
<p>
The main job of the compiler is to translate Mercury into C, although it
-can also translate (subsets of) Mercury to some other languages (Goedel,
-the bytecode of a debugger currently under development, and in the future
-the Aditi Relational Language).
+can also translate (subsets of) Mercury to some other languages: Goedel,
+bytecode (for a planned bytecode interpreter),
+and RL (the Aditi Relational Language).
<p>
The top-level of the compiler is in the file mercury_compile.m.
The basic design is that compilation is broken into the following
stages:
-
-<ol>
-<li> parsing (source files -> HLDS)
-<li> semantic analysis and error checking (HLDS -> annotated HLDS)
-<li> high-level transformations (annotated HLDS -> annotated HLDS)
-<li> code generation (annotated HLDS -> LLDS or RL)
-<li> low-level optimizations (LLDS -> LLDS or RL -> RL)
-<li> output code (LLDS -> C or RL -> bytecode)
-</ol>
-<p>
+<ul>
+<li> 1. parsing (source files -> HLDS)
+<li> 2. semantic analysis and error checking (HLDS -> annotated HLDS)
+<li> 3. high-level transformations (annotated HLDS -> annotated HLDS)
+<li> 4. code generation (annotated HLDS -> target representation)
+<li> 5. low-level optimizations
+ (target representation -> target representation)
+<li> 6. output code (target representation -> target code)
+</ul>
Note that in reality the separation is not quite as simple as that.
Although parsing is listed as step 1 and semantic analysis is listed
@@ -54,18 +52,65 @@
<p>
+In addition, the compiler is actually a multi-targeted compiler
+with several different back-ends. When you take the different
+back-ends into account, the structure looks like this:
+
+<ul type=disc>
+<li> front-end
+ <ul type=disc>
+ <li> 1. parsing (source files -> HLDS)
+ <li> 2. semantic analysis and error checking (HLDS -> annotated HLDS)
+ <li> 3. high-level transformations (annotated HLDS -> annotated HLDS)
+ </ul>
+<li> back-ends
+ <ul type=disc>
+ <li> a. LLDS back-end
+ <ul type=disc>
+ <li> 4a. code generation (annotated HLDS -> LLDS)
+ <li> 5a. low-level optimizations (LLDS -> LLDS)
+ <li> 6a. output code (LLDS -> C)
+ </ul>
+ <li> b. MLDS back-end
+ <ul type=disc>
+ <li> 4b. code generation (annotated HLDS -> MLDS)
+ <li> 5b. MLDS transformations (MLDS -> MLDS)
+ <li> 6b. output code
+ (MLDS -> C or eventually MLDS -> Java, etc.)
+ </ul>
+ <li> c. RL back-end
+ <ul type=disc>
+ <li> 4c. code generation (annotated HLDS -> RL)
+ <li> 5c. low-level optimizations (RL -> RL)
+ <li> 6c. output code (RL -> RL-bytecode)
+ </ul>
+ <li> d. bytecode back-end
+ <ul type=disc>
+ <li> 4d. code generation (annotated HLDS -> bytecode)
+ </ul>
+ </ul>
+</ul>
+
+<p>
<hr>
-<!-------------------------->
+<!---------------------------------------------------------------------------->
+
+<h2> DETAILED DESIGN </h2>
-<h2> DETAILED DESIGN </h2> (well, more detailed than the OUTLINE anyway ;-)
+This section describes the role of each module in the compiler.
+For more information about the design of a particular module,
+see the documentation at the start of that module's source code.
<p>
+<hr>
+<!---------------------------------------------------------------------------->
+<p>
The action is co-ordinated from mercury_compile.m.
<p>
-<h3> 0. Option handling </h3>
+<h3> Option handling </h3>
<p>
@@ -74,8 +119,13 @@
defined in options.m as arguments, to parse them. It then invokes
handle_options.m to postprocess the option set. The results are
stored in the io__state, using the type globals defined in globals.m.
+
+<p>
+<hr>
+<!---------------------------------------------------------------------------->
-<h3> 1. Parsing </h3>
+<h3> FRONT END </h3>
+<h4> 1. Parsing </h4>
<p>
@@ -190,7 +240,7 @@
<p>
-<h3> 2. Semantic analysis and error checking </h3>
+<h4> 2. Semantic analysis and error checking </h4>
<p>
@@ -400,7 +450,7 @@
</dl>
-<h3> 3. High-level transformations </h3>
+<h4> 3. High-level transformations </h4>
<p>
@@ -525,8 +575,12 @@
for high-level optimizations (but which is not yet used).
<p>
+<hr>
+<!---------------------------------------------------------------------------->
+
+<h3> a. LLDS BACK-END </h3>
-<h3> 4. Code generation </h3>
+<h4> 4a. Code generation. </h4>
<p>
@@ -656,7 +710,7 @@
<p>
-<h3> 5. Low-level optimization </h3>
+<h4> 5a. Low-level optimization (LLDS). </h4>
<p>
@@ -760,7 +814,7 @@
<p>
-<h3> 6. Output C code </h3>
+<h4> 6a. Output C code </h4>
<ul>
<li> base_type_info.m generates the base_type_info structures that list the
@@ -794,10 +848,39 @@
</ul>
<p>
+<hr>
+<!---------------------------------------------------------------------------->
-<h3> 7. Aditi-RL generation </h3>
+<h3> b. MLDS BACK-END </h3>
+The original LLDS code generator generates very low-level code,
+since the LLDS was designed to map easily to RISC architectures.
+We're currently developing a new back-end that generates much higher-level
+code, suitable for generating Java, high-level C, etc.
+This back-end uses the Medium Level Data Structure (mlds.m) as it's
+intermediate representation.
+
+<h4> 4b. MLDS code generation </h4>
<ul>
+<li> ml_code_gen.m (not yet committed) converts HLDS code to MLDS.
+</ul>
+
+<h4> 5b. MLDS transformations </h4>
+None yet. Eventually there will be one or more modules here for
+performing transformations such as hoisting out nested functions.
+
+<h4> 6b. MLDS output </h4>
+mlds_to_c.m converts MLDS to C/C++ code.
+
+<p>
+<hr>
+<!---------------------------------------------------------------------------->
+
+<h3> c. Aditi-RL BACK-END </h3>
+
+<h4> 4c. Aditi-RL generation </h4>
+
+<ul>
<li> rl_gen.m converts HLDS to RL.
<li> rl_relops.m generates RL for relational operations such as joins.
@@ -811,7 +894,7 @@
<li> rl_dump.m contains predicates to write the types defined in rl.m.
</ul>
-<h3> 8. Aditi-RL optimization </h3>
+<h4> 5c. Aditi-RL optimization </h4>
<ul>
<li> rl_opt.m invokes the RL optimization passes.
@@ -841,7 +924,7 @@
<li> rl_stream.m detects relations which do not need to be materialised.
</ul>
-<h3> 9. Output Aditi-RL code </h3>
+<h4> 6c. Output Aditi-RL code </h4>
<ul>
<li> rl_out.m converts from the instructions defined in rl.m
@@ -858,19 +941,18 @@
<li> rl_file.m contains routines to output the bytecodes defined in rl_code.m.
</ul>
-<hr>
-<!-------------------------->
-
<p>
+<hr>
+<!---------------------------------------------------------------------------->
-<h2> BYTECODE </h2>
+<h3> d. BYTECODE BACK-END </h3>
<p>
The Mercury compiler can translate Mercury programs into bytecode for
-interpretation by the Mercury debugger currently under development.
-The generation of bytecode happens after semantic checks have been
-completed.
+interpretation by a bytecode interpreter. The intent of this is to
+achieve faster turn-around time during development. However, the
+bytecode interpreter has not yet been written.
<ul>
<li> bytecode.m defines the internal representation of bytecodes, and contains
@@ -884,12 +966,12 @@
and floats into bytecode. This is also used by rl_code.m.
</ul>
+<p>
<hr>
-<!-------------------------->
+<!---------------------------------------------------------------------------->
+<h3> MISCELLANEOUS </h3>
-<h2> MISCELLANEOUS </h2>
-
<dl>
<dt> builtin_ops:
<dd>
@@ -897,6 +979,11 @@
which are used by several of the different back-ends:
bytecode.m, llds.m, and mlds.m.
+ <dt> c_util:
+ <dd>
+ This module defines utility routines useful for generating
+ C code. It is used by both llds_out.m and mlds_to_c.m.
+
<dt> det_util:
<dd>
This module contains utility predicates needed by the parts
@@ -936,12 +1023,11 @@
</dl>
-<hr>
-<!-------------------------->
-
<p>
+<hr>
+<!---------------------------------------------------------------------------->
-<h2> CURRENTLY USELESS </h2>
+<h3> CURRENTLY USELESS </h3>
<p>
@@ -976,13 +1062,15 @@
<dt> mercury_to_c.m:
<dd>
The very incomplete beginnings of an alternate
- code generator. When finished, it will convert HLDS
- to high-level C code (without going via LLDS).
+ code generator. It was intended to convert HLDS
+ to high-level C code without going via LLDS.
+ The new MLDS back-end will make this module obsolete.
</dl>
+<p>
<hr>
-<!-------------------------->
+<!---------------------------------------------------------------------------->
Last update was $Date: 1999/07/29 07:51:39 $ by $Author: fjh $@cs.mu.oz.au. <br>
</body>
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.115
diff -u -r1.115 llds_out.m
--- llds_out.m 1999/07/13 08:53:06 1.115
+++ llds_out.m 1999/07/29 07:28:55
@@ -148,12 +148,14 @@
:- implementation.
-:- import_module globals, options, varset, term.
+:- import_module globals, options.
:- import_module exprn_aux, prog_util, prog_out, hlds_pred.
:- import_module export, mercury_to_mercury, modules.
+:- import_module c_util.
:- import_module int, list, char, string, map, std_util.
:- import_module set, bintree_set, assoc_list, require.
+:- import_module varset, term.
:- import_module library. % for the version number.
%-----------------------------------------------------------------------------%
@@ -1630,53 +1632,6 @@
output_pragma_c_component(pragma_c_raw_code(C_Code)) -->
io__write_string(C_Code).
-:- pred output_set_line_num(prog_context, io__state, io__state).
-:- mode output_set_line_num(in, di, uo) is det.
-
-output_set_line_num(Context) -->
- { term__context_file(Context, File) },
- { term__context_line(Context, Line) },
- % The context is unfortunately bogus for pragma_c_codes inlined
- % from a .opt file.
- globals__io_lookup_bool_option(line_numbers, LineNumbers),
- (
- { Line > 0 },
- { File \= "" },
- { LineNumbers = yes }
- ->
- io__write_string("#line "),
- io__write_int(Line),
- io__write_string(" """),
- output_c_quoted_string(File),
- io__write_string("""\n")
- ;
- []
- ).
-
-:- pred output_reset_line_num(io__state, io__state).
-:- mode output_reset_line_num(di, uo) is det.
-
-output_reset_line_num -->
- % We want to generate another #line directive to reset the C compiler's
- % idea of what it is processing back to the file we are generating.
- io__get_output_line_number(Line),
- io__output_stream_name(FileName),
- globals__io_lookup_bool_option(line_numbers, LineNumbers),
- (
- { Line > 0 },
- { FileName \= "" },
- { LineNumbers = yes }
- ->
- io__write_string("#line "),
- { NextLine is Line + 1 },
- io__write_int(NextLine),
- io__write_string(" """),
- output_c_quoted_string(FileName),
- io__write_string("""\n")
- ;
- []
- ).
-
% Output the local variable declarations at the top of the
% pragma_c_code code.
:- pred output_pragma_decls(list(pragma_c_decl), io__state, io__state).
@@ -2016,7 +1971,7 @@
% which we might want to box we declare a static const
% variable holding that constant.
%
- ( { llds_out__float_op(Op, OpStr) } ->
+ ( { c_util__float_op(Op, OpStr) } ->
globals__io_lookup_bool_option(unboxed_float, UnboxFloat),
globals__io_lookup_bool_option(static_ground_terms,
StaticGroundTerms),
@@ -3460,7 +3415,7 @@
output_rval_as_type(Y, integer),
io__write_string("]")
;
- { llds_out__string_op(Op, OpStr) }
+ { c_util__string_compare_op(Op, OpStr) }
->
io__write_string("(strcmp((char *)"),
output_rval_as_type(X, word),
@@ -3472,9 +3427,9 @@
io__write_string(" "),
io__write_string("0)")
;
- ( { llds_out__float_compare_op(Op, OpStr1) } ->
+ ( { c_util__float_compare_op(Op, OpStr1) } ->
{ OpStr = OpStr1 }
- ; { llds_out__float_op(Op, OpStr2) } ->
+ ; { c_util__float_op(Op, OpStr2) } ->
{ OpStr = OpStr2 }
;
{ fail }
@@ -3595,54 +3550,9 @@
:- pred output_unary_op(unary_op, io__state, io__state).
:- mode output_unary_op(in, di, uo) is det.
-output_unary_op(mktag) -->
- io__write_string("MR_mktag").
-output_unary_op(tag) -->
- io__write_string("MR_tag").
-output_unary_op(unmktag) -->
- io__write_string("MR_unmktag").
-output_unary_op(mkbody) -->
- io__write_string("MR_mkbody").
-output_unary_op(body) -->
- io__write_string("MR_body").
-output_unary_op(unmkbody) -->
- io__write_string("MR_unmkbody").
-output_unary_op(hash_string) -->
- io__write_string("hash_string").
-output_unary_op(bitwise_complement) -->
- io__write_string("~").
-output_unary_op(not) -->
- io__write_string("!").
-output_unary_op(cast_to_unsigned) -->
- io__write_string("(Unsigned)").
-
-:- pred llds_out__string_op(binary_op, string).
-:- mode llds_out__string_op(in, out) is semidet.
-
-llds_out__string_op(str_eq, "==").
-llds_out__string_op(str_ne, "!=").
-llds_out__string_op(str_le, "<=").
-llds_out__string_op(str_ge, ">=").
-llds_out__string_op(str_lt, "<").
-llds_out__string_op(str_gt, ">").
-
-:- pred llds_out__float_op(binary_op, string).
-:- mode llds_out__float_op(in, out) is semidet.
-
-llds_out__float_op(float_plus, "+").
-llds_out__float_op(float_minus, "-").
-llds_out__float_op(float_times, "*").
-llds_out__float_op(float_divide, "/").
-
-:- pred llds_out__float_compare_op(binary_op, string).
-:- mode llds_out__float_compare_op(in, out) is semidet.
-
-llds_out__float_compare_op(float_eq, "==").
-llds_out__float_compare_op(float_ne, "!=").
-llds_out__float_compare_op(float_le, "<=").
-llds_out__float_compare_op(float_ge, ">=").
-llds_out__float_compare_op(float_lt, "<").
-llds_out__float_compare_op(float_gt, ">").
+output_unary_op(Op) -->
+ { c_util__unary_prefix_op(Op, OpString) },
+ io__write_string(OpString).
:- pred output_rval_const(rval_const, io__state, io__state).
:- mode output_rval_const(in, di, uo) is det.
@@ -3858,61 +3768,28 @@
%-----------------------------------------------------------------------------%
-output_c_quoted_string(S0) -->
- ( { string__first_char(S0, Char, S1) } ->
- ( { quote_c_char(Char, QuoteChar) } ->
- io__write_char('\\'),
- io__write_char(QuoteChar)
- ;
- io__write_char(Char)
- ),
- output_c_quoted_string(S1)
- ;
- []
- ).
+:- pred output_set_line_num(prog_context, io__state, io__state).
+:- mode output_set_line_num(in, di, uo) is det.
-output_c_quoted_multi_string(Len, S) -->
- output_c_quoted_multi_string_2(0, Len, S).
+output_set_line_num(Context) -->
+ { term__context_file(Context, File) },
+ { term__context_line(Context, Line) },
+ c_util__set_line_num(File, Line).
-:- pred output_c_quoted_multi_string_2(int::in, int::in, string::in,
- io__state::di, io__state::uo) is det.
+:- pred output_reset_line_num(io__state, io__state).
+:- mode output_reset_line_num(di, uo) is det.
-output_c_quoted_multi_string_2(Cur, Len, S) -->
- ( { Cur < Len } ->
- % we must use unsafe index, because we want to be able
- % to access chars beyond the first NULL
- { string__unsafe_index(S, Cur, Char) },
- ( { char__to_int(Char, 0) } ->
- io__write_string("\\0")
- ; { quote_c_char(Char, QuoteChar) } ->
- io__write_char('\\'),
- io__write_char(QuoteChar)
- ;
- io__write_char(Char)
- ),
- output_c_quoted_multi_string_2(Cur + 1, Len, S)
- ;
- []
- ).
+output_reset_line_num -->
+ c_util__reset_line_num.
+
+output_c_quoted_string(S) -->
+ c_util__output_quoted_string(S).
+
+output_c_quoted_multi_string(Len, S) -->
+ c_util__output_quoted_multi_string(Len, S).
llds_out__quote_c_string(String, QuotedString) :-
- QuoteOneChar = (pred(Char::in, RevChars0::in, RevChars::out) is det :-
- ( quote_c_char(Char, QuoteChar) ->
- RevChars = [QuoteChar, '\\' | RevChars0]
- ;
- RevChars = [Char | RevChars0]
- )),
- string__foldl(QuoteOneChar, String, [], RevQuotedChars),
- string__from_rev_char_list(RevQuotedChars, QuotedString).
-
-:- pred quote_c_char(char, char).
-:- mode quote_c_char(in, out) is semidet.
-
-quote_c_char('"', '"').
-quote_c_char('\\', '\\').
-quote_c_char('\n', 'n').
-quote_c_char('\t', 't').
-quote_c_char('\b', 'b').
+ c_util__quote_string(String, QuotedString).
%-----------------------------------------------------------------------------%
Index: compiler/c_util.m
===================================================================
RCS file: c_util.m
diff -N c_util.m
--- /dev/null Wed Aug 4 15:41:20 1999
+++ c_util.m Mon Jul 26 22:02:39 1999
@@ -0,0 +1,226 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1999 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: c_util.m
+% Main author: fjh.
+
+% This module defines utility routines that are useful when
+% generating and/or emitting C code.
+
+%-----------------------------------------------------------------------------%
+
+:- module c_util.
+:- interface.
+:- import_module io, char, string, int.
+:- import_module builtin_ops.
+
+%-----------------------------------------------------------------------------%
+
+ % set_line_num(FileName, LineNum):
+ % emit a #line directive to set the specified filename & linenum
+ % so that C compiler error messages etc. will refer to the
+ % correct location in the original source file location.
+:- pred c_util__set_line_num(string, int, io__state, io__state).
+:- mode c_util__set_line_num(in, in, di, uo) is det.
+
+ % emit a #line directive to cancel the effect of any previous
+ % #line directives, so that C compiler error messages etc. will
+ % refer to the appropriate location in the generated .c file.
+:- pred c_util__reset_line_num(io__state, io__state).
+:- mode c_util__reset_line_num(di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+ % Print out a string suitably escaped for use as a C string literal.
+ % This doesn't actually print out the enclosing double quotes --
+ % that is the caller's responsibility.
+:- pred c_util__output_quoted_string(string, io__state, io__state).
+:- mode c_util__output_quoted_string(in, di, uo) is det.
+
+ % output_quoted_multi_string is like output_quoted_string
+ % except that the string may contain embedded NUL characters
+ % (i.e. '\0'). The int specifies the length of the string.
+:- type multi_string == string.
+:- pred c_util__output_quoted_multi_string(int, multi_string,
+ io__state, io__state).
+:- mode c_util__output_quoted_multi_string(in, in, di, uo) is det.
+
+ % Convert a string to a form that is suitably escaped for use as a
+ % C string literal. This doesn't actually add the enclosing double
+ % quotes -- that is the caller's responsibility.
+:- pred c_util__quote_string(string, string).
+:- mode c_util__quote_string(in, out) is det.
+
+ % Convert a character to a form that is suitably escaped for use as a
+ % C character literal. This doesn't actually add the enclosing double
+ % quotes -- that is the caller's responsibility.
+:- pred c_util__quote_char(char, char).
+:- mode c_util__quote_char(in, out) is semidet.
+
+%-----------------------------------------------------------------------------%
+%
+% The following predicates all take as input an operator,
+% check if it is an operator of the specified kind,
+% and if so, return the name of the corresponding C operator
+% that can be used to implement it.
+%
+
+ % The operator returned will be <, >, etc.;
+ % it can be used in the form `strcmp(<Arg1>, <Arg2>) <Op> 0'.
+ %
+:- pred c_util__string_compare_op(binary_op, string).
+:- mode c_util__string_compare_op(in, out) is semidet.
+
+ % The operator returned will be +, *, etc.;
+ % the arguments should be floats and the result will be a float.
+:- pred c_util__float_op(binary_op, string).
+:- mode c_util__float_op(in, out) is semidet.
+
+ % The operator returned will be <, >, etc.;
+ % the arguments should be floats and the result will be a boolean.
+:- pred c_util__float_compare_op(binary_op, string).
+:- mode c_util__float_compare_op(in, out) is semidet.
+
+ % The operator returned with be either a prefix operator
+ % or a macro or function name. The operand needs
+ % to be placed in parentheses after the operator name.
+:- pred c_util__unary_prefix_op(unary_op, string).
+:- mode c_util__unary_prefix_op(in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module globals, options.
+:- import_module list, bool.
+
+%-----------------------------------------------------------------------------%
+
+c_util__set_line_num(File, Line) -->
+ globals__io_lookup_bool_option(line_numbers, LineNumbers),
+ (
+ { Line > 0 },
+ { File \= "" },
+ { LineNumbers = yes }
+ ->
+ io__write_string("#line "),
+ io__write_int(Line),
+ io__write_string(" """),
+ c_util__output_quoted_string(File),
+ io__write_string("""\n")
+ ;
+ []
+ ).
+
+c_util__reset_line_num -->
+ % We want to generate another #line directive to reset the C compiler's
+ % idea of what it is processing back to the file we are generating.
+ io__get_output_line_number(Line),
+ io__output_stream_name(FileName),
+ globals__io_lookup_bool_option(line_numbers, LineNumbers),
+ (
+ { Line > 0 },
+ { FileName \= "" },
+ { LineNumbers = yes }
+ ->
+ io__write_string("#line "),
+ { NextLine is Line + 1 },
+ io__write_int(NextLine),
+ io__write_string(" """),
+ c_util__output_quoted_string(FileName),
+ io__write_string("""\n")
+ ;
+ []
+ ).
+
+%-----------------------------------------------------------------------------%
+
+c_util__output_quoted_string(S0) -->
+ ( { string__first_char(S0, Char, S1) } ->
+ ( { c_util__quote_char(Char, QuoteChar) } ->
+ io__write_char('\\'),
+ io__write_char(QuoteChar)
+ ;
+ io__write_char(Char)
+ ),
+ c_util__output_quoted_string(S1)
+ ;
+ []
+ ).
+
+c_util__output_quoted_multi_string(Len, S) -->
+ c_util__output_quoted_multi_string_2(0, Len, S).
+
+:- pred c_util__output_quoted_multi_string_2(int::in, int::in, string::in,
+ io__state::di, io__state::uo) is det.
+
+c_util__output_quoted_multi_string_2(Cur, Len, S) -->
+ ( { Cur < Len } ->
+ % we must use unsafe index, because we want to be able
+ % to access chars beyond the first NUL
+ { string__unsafe_index(S, Cur, Char) },
+ ( { char__to_int(Char, 0) } ->
+ io__write_string("\\0")
+ ; { c_util__quote_char(Char, QuoteChar) } ->
+ io__write_char('\\'),
+ io__write_char(QuoteChar)
+ ;
+ io__write_char(Char)
+ ),
+ output_quoted_multi_string_2(Cur + 1, Len, S)
+ ;
+ []
+ ).
+
+c_util__quote_string(String, QuotedString) :-
+ QuoteOneChar = (pred(Char::in, RevChars0::in, RevChars::out) is det :-
+ ( c_util__quote_char(Char, QuoteChar) ->
+ RevChars = [QuoteChar, '\\' | RevChars0]
+ ;
+ RevChars = [Char | RevChars0]
+ )),
+ string__foldl(QuoteOneChar, String, [], RevQuotedChars),
+ string__from_rev_char_list(RevQuotedChars, QuotedString).
+
+c_util__quote_char('"', '"').
+c_util__quote_char('\\', '\\').
+c_util__quote_char('\n', 'n').
+c_util__quote_char('\t', 't').
+c_util__quote_char('\b', 'b').
+
+%-----------------------------------------------------------------------------%
+
+c_util__unary_prefix_op(mktag, "MR_mktag").
+c_util__unary_prefix_op(tag, "MR_tag").
+c_util__unary_prefix_op(unmktag, "MR_unmktag").
+c_util__unary_prefix_op(mkbody, "MR_mkbody").
+c_util__unary_prefix_op(body, "MR_body").
+c_util__unary_prefix_op(unmkbody, "MR_unmkbody").
+c_util__unary_prefix_op(hash_string, "hash_string").
+c_util__unary_prefix_op(bitwise_complement, "~").
+c_util__unary_prefix_op(not, "!").
+c_util__unary_prefix_op(cast_to_unsigned, "(Unsigned)").
+
+c_util__string_compare_op(str_eq, "==").
+c_util__string_compare_op(str_ne, "!=").
+c_util__string_compare_op(str_le, "<=").
+c_util__string_compare_op(str_ge, ">=").
+c_util__string_compare_op(str_lt, "<").
+c_util__string_compare_op(str_gt, ">").
+
+c_util__float_op(float_plus, "+").
+c_util__float_op(float_minus, "-").
+c_util__float_op(float_times, "*").
+c_util__float_op(float_divide, "/").
+
+c_util__float_compare_op(float_eq, "==").
+c_util__float_compare_op(float_ne, "!=").
+c_util__float_compare_op(float_le, "<=").
+c_util__float_compare_op(float_ge, ">=").
+c_util__float_compare_op(float_lt, "<").
+c_util__float_compare_op(float_gt, ">").
+
+%-----------------------------------------------------------------------------%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.4
diff -u -r1.4 mlds.m
--- mlds.m 1999/07/11 11:22:22 1.4
+++ mlds.m 1999/08/02 09:39:18
@@ -220,7 +220,7 @@
% It would be nice to avoid this dependency...
:- import_module llds.
-:- import_module bool, list, std_util.
+:- import_module bool, list, assoc_list, std_util.
%-----------------------------------------------------------------------------%
@@ -228,6 +228,7 @@
%
% The type `mlds' is the actual MLDS.
+% XXX we ought to make this type abstract
%
:- type mlds
---> mlds(
@@ -241,6 +242,8 @@
mlds__defns % Definitions of code and data
).
+:- func mlds__get_module_name(mlds) = mercury_module_name.
+
:- type mlds__imports == list(mlds__import).
% Currently an import just gives the name of the package to be imported.
@@ -260,6 +263,11 @@
% MLDS package.
:- func mercury_module_name_to_mlds(mercury_module_name) = mlds__package_name.
+% Given the name of a Mercury module, return the name of the corresponding
+% MLDS package.
+:- func mlds_module_name_to_sym_name(mlds__package_name) = sym_name.
+
+
:- type mlds__defns == list(mlds__defn).
:- type mlds__defn
---> mlds__defn(
@@ -331,7 +339,7 @@
; mlds__function(
maybe(pred_proc_id), % identifies the original
% Mercury procedure, if any
- mlds__func_signature, % the argument & return types
+ mlds__func_params, % the arguments & return types
maybe(mlds__statement) % the function body, or `no'
% if the function is abstract
)
@@ -342,12 +350,23 @@
:- type mlds__initializer == list(mlds__rval).
+:- type mlds__func_params
+ ---> mlds__func_params(
+ assoc_list(entity_name, mlds__type), % arguments (inputs)
+ list(mlds__type) % return values (outputs)
+ ).
+
+ % An mlds__func_signature is like an mlds__func_params
+ % except that it only includes the function's type, not
+ % the parameter names.
:- type mlds__func_signature
---> mlds__func_signature(
- mlds__type, % return type
- list(mlds__type) % argument types
+ list(mlds__type), % argument types
+ list(mlds__type) % return types
).
+:- func mlds__get_func_signature(mlds__func_params) = mlds__func_signature.
+
:- type mlds__class_kind
---> mlds__class % A generic class:
% can inherit other classes and
@@ -378,7 +397,7 @@
mlds__defns % contains these members
).
-:- type mlds__type.
+:- type mlds__type ---> mlds__type(prog_data__type).
:- type mercury_type == prog_data__type.
:- func mercury_type_to_mlds_type(mercury_type) = mlds__type.
@@ -463,6 +482,8 @@
:- func mlds__make_context(prog_context) = mlds__context.
+:- func mlds__get_prog_context(mlds__context) = prog_context.
+
%-----------------------------------------------------------------------------%
:- type mlds__statement
@@ -922,21 +943,31 @@
%-----------------------------------------------------------------------------%
+mlds__get_module_name(mlds(ModuleName, _, _, _)) = ModuleName.
+
+%-----------------------------------------------------------------------------%
+
% Currently mlds__contexts just contain a prog_context.
:- type mlds__context ---> mlds__context(prog_context).
mlds__make_context(Context) = mlds__context(Context).
+mlds__get_prog_context(mlds__context(Context)) = Context.
+
%-----------------------------------------------------------------------------%
% Currently mlds__types are just the same as Mercury types.
% XXX something more complicated may be needed here...
-:- type mlds__type == prog_data__type.
+mercury_type_to_mlds_type(Type) = mlds__type(Type).
-mercury_type_to_mlds_type(Type) = Type.
+%-----------------------------------------------------------------------------%
+mlds__get_func_signature(func_params(Parameters, RetTypes)) =
+ func_signature(ParamTypes, RetTypes) :-
+ assoc_list__values(Parameters, ParamTypes).
+
%-----------------------------------------------------------------------------%
% Mercury module names are the same as MLDS package names, except that
@@ -1008,6 +1039,8 @@
mercury_std_library_module("tree234").
mercury_std_library_module("varset").
+mlds_module_name_to_sym_name(MLDS_Package) = MLDS_Package.
+
%-----------------------------------------------------------------------------%
%
@@ -1066,9 +1099,6 @@
:- func virtuality_mask = int.
virtuality_mask = virtuality_bits(virtual).
-% For functions we use finality, and for variables we use constness.
-% These two properties use the same bitfield.
-
:- func finality_bits(finality) = int.
:- mode finality_bits(in) = out is det.
:- mode finality_bits(out) = in is semidet.
@@ -1078,14 +1108,11 @@
:- func finality_mask = int.
finality_mask = finality_bits(final).
-% For functions we use finality, and for variables we use constness.
-% These two properties use the same bitfield.
-
:- func constness_bits(constness) = int.
:- mode constness_bits(in) = out is det.
:- mode constness_bits(out) = in is semidet.
constness_bits(modifiable) = 0x00.
-constness_bits(const) = 0x20.
+constness_bits(const) = 0x40.
:- func constness_mask = int.
constness_mask = constness_bits(const).
@@ -1094,7 +1121,7 @@
:- mode abstractness_bits(in) = out is det.
:- mode abstractness_bits(out) = in is semidet.
abstractness_bits(abstract) = 0x00.
-abstractness_bits(concrete) = 0x40.
+abstractness_bits(concrete) = 0x80.
:- func abstractness_mask = int.
abstractness_mask = abstractness_bits(abstract).
@@ -1155,7 +1182,8 @@
access_bits(Access) \/
per_instance_bits(PerInstance) \/
virtuality_bits(Virtuality) \/
- finality_bits(Finality) \/ constness_bits(Constness) \/
+ finality_bits(Finality) \/
+ constness_bits(Constness) \/
abstractness_bits(Abstractness).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: mlds_to_c.m
diff -N mlds_to_c.m
--- /dev/null Wed Aug 4 15:41:20 1999
+++ mlds_to_c.m Mon Aug 2 19:51:27 1999
@@ -0,0 +1,1230 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1999 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.
+%-----------------------------------------------------------------------------%
+
+% mlds_to_c - Convert MLDS to C/C++ code.
+% Main author: fjh.
+
+%-----------------------------------------------------------------------------%
+
+:- module mlds_to_c.
+:- interface.
+
+:- import_module mlds.
+:- import_module io.
+
+:- pred mlds_to_c__output_mlds(mlds, io__state, io__state).
+:- mode mlds_to_c__output_mlds(in, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module globals, options, passes_aux.
+:- import_module builtin_ops, c_util, modules.
+:- import_module hlds_pred. % for `pred_proc_id'.
+:- import_module prog_data, prog_out.
+
+:- import_module bool, int, string, list, assoc_list, term, std_util, require.
+
+%-----------------------------------------------------------------------------%
+
+mlds_to_c__output_mlds(MLDS) -->
+ { ModuleName = mlds__get_module_name(MLDS) },
+ module_name_to_file_name(ModuleName, ".h", no, HeaderFile),
+ module_name_to_file_name(ModuleName, ".c", no, SourceFile),
+ { Indent = 0 },
+ mlds_output_to_file(HeaderFile, mlds_output_hdr_file(Indent, MLDS)),
+ mlds_output_to_file(SourceFile, mlds_output_src_file(Indent, MLDS)).
+ %
+ % XXX at some point we should also handle output of any non-C
+ % foreign code (Ada, Fortran, etc.) to appropriate files.
+
+:- pred mlds_output_to_file(string, pred(io__state, io__state),
+ io__state, io__state).
+:- mode mlds_output_to_file(in, pred(di, uo) is det, di, uo) is det.
+
+mlds_output_to_file(FileName, Action) -->
+ globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(statistics, Stats),
+ maybe_write_string(Verbose, "% Writing to file `"),
+ maybe_write_string(Verbose, FileName),
+ maybe_write_string(Verbose, "'...\n"),
+ maybe_flush_output(Verbose),
+ io__tell(FileName, Res),
+ ( { Res = ok } ->
+ Action,
+ io__told,
+ maybe_write_string(Verbose, "% done.\n"),
+ maybe_report_stats(Stats)
+ ;
+ maybe_write_string(Verbose, "\n"),
+ { string__append_list(["can't open file `",
+ FileName, "' for output."], ErrorMessage) },
+ report_error(ErrorMessage)
+ ).
+
+ %
+ % Generate the header file
+ %
+:- pred mlds_output_hdr_file(int, mlds, io__state, io__state).
+:- mode mlds_output_hdr_file(in, in, di, uo) is det.
+
+mlds_output_hdr_file(Indent, MLDS) -->
+ { MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) },
+ { list__filter(defn_is_public, Defns, PublicDefns) },
+ mlds_output_hdr_start(Indent, ModuleName), io__nl,
+ mlds_output_hdr_imports(Indent, Imports), io__nl,
+ mlds_output_c_hdr_decls(Indent, ForeignCode), io__nl,
+ mlds_output_decls(Indent, PublicDefns), io__nl,
+ mlds_output_hdr_end(Indent, ModuleName).
+
+:- pred defn_is_public(mlds__defn).
+:- mode defn_is_public(in) is semidet.
+
+defn_is_public(Defn) :-
+ Defn = mlds__defn(_Name, _Context, Flags, _Body),
+ access(Flags) \= private.
+
+:- pred mlds_output_hdr_imports(int, mlds__imports, io__state, io__state).
+:- mode mlds_output_hdr_imports(in, in, di, uo) is det.
+
+mlds_output_hdr_imports(Indent, Imports) -->
+ list__foldl(mlds_output_hdr_import(Indent), Imports).
+
+:- pred mlds_output_src_imports(int, mlds__imports, io__state, io__state).
+:- mode mlds_output_src_imports(in, in, di, uo) is det.
+
+% XXX currently we assume all imports are header imports
+mlds_output_src_imports(_Indent, _Imports) --> [].
+
+:- pred mlds_output_hdr_import(int, mlds__import, io__state, io__state).
+:- mode mlds_output_hdr_import(in, in, di, uo) is det.
+
+mlds_output_hdr_import(_Indent, Import) -->
+ { SymName = mlds_module_name_to_sym_name(Import) },
+ module_name_to_file_name(SymName, ".h", no, HeaderFile),
+ io__write_strings(["#include """, HeaderFile, """\n"]).
+
+
+ %
+ % Generate the `.c' file
+ %
+ % (Calling it the "source" file is a bit of a misnomer,
+ % since in our case it is actually the target file,
+ % but there's no obvious alternative term to use which
+ % also has a clear and concise abbreviation, so never mind...)
+ %
+:- pred mlds_output_src_file(int, mlds, io__state, io__state).
+:- mode mlds_output_src_file(in, in, di, uo) is det.
+
+mlds_output_src_file(Indent, MLDS) -->
+ { MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) },
+ { list__filter(defn_is_public, Defns, _PublicDefns, PrivateDefns) },
+ mlds_output_src_start(Indent, ModuleName), io__nl,
+ mlds_output_src_imports(Indent, Imports), io__nl,
+ mlds_output_c_decls(Indent, ForeignCode), io__nl,
+ mlds_output_c_defns(Indent, ForeignCode), io__nl,
+ mlds_output_decls(Indent, PrivateDefns), io__nl,
+ mlds_output_defns(Indent, Defns), io__nl,
+ mlds_output_src_end(Indent, ModuleName).
+
+:- pred mlds_output_hdr_start(int, mercury_module_name, io__state, io__state).
+:- mode mlds_output_hdr_start(in, in, di, uo) is det.
+
+mlds_output_hdr_start(Indent, ModuleName) -->
+ % XXX should spit out an "automatically generated by ..." comment
+ mlds_indent(Indent),
+ io__write_string("/* :- module "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(". */\n"),
+ mlds_indent(Indent),
+ io__write_string("/* :- interface. */\n"),
+ io__nl,
+ mlds_indent(Indent),
+ io__write_string("#include ""mercury_imp.h""\n\n").
+
+:- pred mlds_output_src_start(int, mercury_module_name, io__state, io__state).
+:- mode mlds_output_src_start(in, in, di, uo) is det.
+
+mlds_output_src_start(Indent, ModuleName) -->
+ % XXX should spit out an "automatically generated by ..." comment
+ mlds_indent(Indent),
+ io__write_string("/* :- module "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(". */\n\n"),
+ mlds_indent(Indent),
+ io__write_string("/* :- implementation. */\n"),
+ io__nl,
+ module_name_to_file_name(ModuleName, ".h", no, HeaderFile),
+ io__write_string("#include """),
+ io__write_string(HeaderFile),
+ io__write_string("""\n"),
+ io__nl.
+
+:- pred mlds_output_hdr_end(int, mercury_module_name, io__state, io__state).
+:- mode mlds_output_hdr_end(in, in, di, uo) is det.
+
+mlds_output_hdr_end(Indent, ModuleName) -->
+ mlds_indent(Indent),
+ io__write_string("/* :- end_interface "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(". */\n").
+
+:- pred mlds_output_src_end(int, mercury_module_name, io__state, io__state).
+:- mode mlds_output_src_end(in, in, di, uo) is det.
+
+mlds_output_src_end(Indent, ModuleName) -->
+ mlds_indent(Indent),
+ io__write_string("/* :- end_module "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(". */\n").
+
+%-----------------------------------------------------------------------------%
+%
+% C interface stuff
+%
+
+:- pred mlds_output_c_hdr_decls(int, mlds__foreign_code, io__state, io__state).
+:- mode mlds_output_c_hdr_decls(in, in, di, uo) is det.
+
+% XXX not yet implemented
+mlds_output_c_hdr_decls(_, _) --> [].
+
+:- pred mlds_output_c_decls(int, mlds__foreign_code, io__state, io__state).
+:- mode mlds_output_c_decls(in, in, di, uo) is det.
+
+% XXX not yet implemented
+mlds_output_c_decls(_, _) --> [].
+
+:- pred mlds_output_c_defns(int, mlds__foreign_code, io__state, io__state).
+:- mode mlds_output_c_defns(in, in, di, uo) is det.
+
+% XXX not yet implemented
+mlds_output_c_defns(_, _) --> [].
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output declarations and definitions
+%
+
+
+:- pred mlds_output_decls(int, mlds__defns, io__state, io__state).
+:- mode mlds_output_decls(in, in, di, uo) is det.
+
+mlds_output_decls(Indent, Defns) -->
+ list__foldl(mlds_output_decl(Indent), Defns).
+
+:- pred mlds_output_defns(int, mlds__defns, io__state, io__state).
+:- mode mlds_output_defns(in, in, di, uo) is det.
+
+mlds_output_defns(Indent, Defns) -->
+ list__foldl(mlds_output_defn(Indent), Defns).
+
+
+:- pred mlds_output_decl(int, mlds__defn, io__state, io__state).
+:- mode mlds_output_decl(in, in, di, uo) is det.
+
+mlds_output_decl(Indent, Defn) -->
+ { Defn = mlds__defn(Name, Context, Flags, DefnBody) },
+ mlds_output_context(Context),
+ mlds_indent(Indent),
+ mlds_output_decl_flags(Flags),
+ mlds_output_decl_body(Indent, Name, DefnBody).
+
+:- pred mlds_output_defn(int, mlds__defn, io__state, io__state).
+:- mode mlds_output_defn(in, in, di, uo) is det.
+
+mlds_output_defn(Indent, Defn) -->
+ { Defn = mlds__defn(Name, Context, Flags, DefnBody) },
+ mlds_output_context(Context),
+ mlds_indent(Indent),
+ mlds_output_decl_flags(Flags),
+ mlds_output_defn_body(Indent, Name, DefnBody).
+
+
+:- pred mlds_output_decl_body(int, mlds__entity_name, mlds__entity_defn,
+ io__state, io__state).
+:- mode mlds_output_decl_body(in, in, in, di, uo) is det.
+
+mlds_output_decl_body(Indent, Name, DefnBody) -->
+ (
+ { DefnBody = mlds__data(Type, _MaybeInitializer) },
+ mlds_output_data_decl(Name, Type)
+ ;
+ { DefnBody = mlds__function(MaybePredProcId, Signature,
+ _MaybeBody) },
+ mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id),
+ mlds_output_func_decl(Indent, Name, Signature)
+ ;
+ { DefnBody = mlds__class(ClassDefn) },
+ mlds_output_class_decl(Indent, Name, ClassDefn)
+ ),
+ io__write_string(";\n").
+
+:- pred mlds_output_defn_body(int, mlds__entity_name, mlds__entity_defn,
+ io__state, io__state).
+:- mode mlds_output_defn_body(in, in, in, di, uo) is det.
+
+mlds_output_defn_body(Indent, Name, DefnBody) -->
+ (
+ { DefnBody = mlds__data(Type, MaybeInitializer) },
+ mlds_output_data_defn(Name, Type, MaybeInitializer)
+ ;
+ { DefnBody = mlds__function(MaybePredProcId, Signature,
+ MaybeBody) },
+ mlds_output_maybe(MaybePredProcId, mlds_output_pred_proc_id),
+ mlds_output_func(Indent, Name, Signature, MaybeBody)
+ ;
+ { DefnBody = mlds__class(ClassDefn) },
+ mlds_output_class(Indent, Name, ClassDefn),
+ io__write_string(";\n")
+ ).
+
+
+:- pred mlds_output_context(mlds__context, io__state, io__state).
+:- mode mlds_output_context(in, di, uo) is det.
+
+mlds_output_context(Context) -->
+ { ProgContext = mlds__get_prog_context(Context) },
+ { term__context_file(ProgContext, FileName) },
+ { term__context_line(ProgContext, LineNumber) },
+ c_util__set_line_num(FileName, LineNumber).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output type declarations/definitions
+%
+
+:- pred mlds_output_class(int, mlds__entity_name, mlds__class,
+ io__state, io__state).
+:- mode mlds_output_class(in, in, in, di, uo) is erroneous.
+
+mlds_output_class(_Indent, _Name, _ClassDefn) -->
+ { error("NYI 3") }.
+
+:- pred mlds_output_class_decl(int, mlds__entity_name, mlds__class,
+ io__state, io__state).
+:- mode mlds_output_class_decl(in, in, in, di, uo) is erroneous.
+
+mlds_output_class_decl(_Indent, _Name, _ClassDefn) -->
+ { error("NYI 3b") }.
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output data declarations/definitions
+%
+
+:- pred mlds_output_data_decl(mlds__entity_name, mlds__type,
+ io__state, io__state).
+:- mode mlds_output_data_decl(in, in, di, uo) is det.
+
+mlds_output_data_decl(Name, Type) -->
+ mlds_output_type(Type),
+ io__write_char(' '),
+ mlds_output_name(Name).
+
+:- pred mlds_output_data_defn(mlds__entity_name, mlds__type,
+ maybe(mlds__initializer), io__state, io__state).
+:- mode mlds_output_data_defn(in, in, in, di, uo) is det.
+
+mlds_output_data_defn(Name, Type, MaybeInitializer) -->
+ mlds_output_data_decl(Name, Type),
+ mlds_output_maybe(MaybeInitializer,
+ mlds_output_initializer(Type)),
+ io__write_string(";\n").
+
+:- pred mlds_output_maybe(maybe(T), pred(T, io__state, io__state),
+ io__state, io__state).
+:- mode mlds_output_maybe(in, pred(in, di, uo) is det, di, uo) is det.
+
+mlds_output_maybe(MaybeValue, OutputAction) -->
+ ( { MaybeValue = yes(Value) } ->
+ OutputAction(Value)
+ ;
+ []
+ ).
+
+:- pred mlds_output_initializer(mlds__type, mlds__initializer,
+ io__state, io__state).
+:- mode mlds_output_initializer(in, in, di, uo) is det.
+
+mlds_output_initializer(_Type, Initializer) -->
+ ( { Initializer = [SingleValue] } ->
+ io__write_string(" = "),
+ mlds_output_rval(SingleValue)
+ ;
+ % XXX we should eventually handle these...
+ { error("sorry, complex initializers not yet implemented") }
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output function declarations/definitions
+%
+
+:- pred mlds_output_pred_proc_id(pred_proc_id, io__state, io__state).
+:- mode mlds_output_pred_proc_id(in, di, uo) is det.
+
+mlds_output_pred_proc_id(proc(PredId, ProcId)) -->
+ io__write_string("/* pred_id: "),
+ { pred_id_to_int(PredId, PredIdNum) },
+ io__write_int(PredIdNum),
+ io__write_string(", proc_id: "),
+ { proc_id_to_int(ProcId, ProcIdNum) },
+ io__write_int(ProcIdNum),
+ io__write_string("*/").
+
+:- pred mlds_output_func(int, entity_name, func_params, maybe(statement),
+ io__state, io__state).
+:- mode mlds_output_func(in, in, in, in, di, uo) is det.
+
+mlds_output_func(Indent, Name, Signature, MaybeBody) -->
+ mlds_output_func_decl(Indent, Name, Signature),
+ (
+ { MaybeBody = no },
+ io__write_string(";\n")
+ ;
+ { MaybeBody = yes(Body) },
+ % require Body0 = statement(block(_, _), _)
+ mlds_output_statement(Indent, Body)
+ ).
+
+:- pred mlds_output_func_decl(int, entity_name, func_params,
+ io__state, io__state).
+:- mode mlds_output_func_decl(in, in, in, di, uo) is det.
+
+mlds_output_func_decl(Indent, Name, Signature) -->
+ { Signature = mlds__func_params(Parameters, RetTypes) },
+ ( { RetTypes = [] } ->
+ io__write_string("void")
+ ; { RetTypes = [RetType] } ->
+ mlds_output_type(RetType)
+ ;
+ { error("mlds_output_func: multiple return types") }
+ ),
+ io__write_char(' '),
+ mlds_output_name(Name),
+ mlds_output_params(Indent, Parameters).
+
+:- pred mlds_output_params(int, assoc_list(entity_name, mlds__type),
+ io__state, io__state).
+:- mode mlds_output_params(in, in, di, uo) is det.
+
+mlds_output_params(Indent, Parameters) -->
+ io__write_char('('),
+ io__write_list(Parameters, ", ", mlds_output_param(Indent)),
+ io__write_char(')').
+
+:- pred mlds_output_param(int, pair(mlds__entity_name, mlds__type),
+ io__state, io__state).
+:- mode mlds_output_param(in, in, di, uo) is det.
+
+mlds_output_param(_Indent, Name - Type) -->
+ mlds_output_type(Type),
+ io__write_char(' '),
+ mlds_output_name(Name).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output names of various entities
+%
+
+:- pred mlds_output_fully_qualified_name(mlds__fully_qualified_name(T),
+ pred(T, io__state, io__state), io__state, io__state).
+:- mode mlds_output_fully_qualified_name(in, pred(in, di, uo) is det,
+ di, uo) is det.
+
+mlds_output_fully_qualified_name(qual(ModuleName, Name), OutputFunc) -->
+ { SymName = mlds_module_name_to_sym_name(ModuleName) },
+ { Separator = "__" },
+ { sym_name_to_string(SymName, Separator, ModuleNameString) },
+ io__write_string(ModuleNameString),
+ io__write_string(Separator),
+ OutputFunc(Name).
+
+:- pred mlds_output_module_name(mercury_module_name, io__state, io__state).
+:- mode mlds_output_module_name(in, di, uo) is det.
+
+mlds_output_module_name(ModuleName) -->
+ { Separator = "__" },
+ { sym_name_to_string(ModuleName, Separator, ModuleNameString) },
+ io__write_string(ModuleNameString).
+
+:- pred mlds_output_name(mlds__entity_name, io__state, io__state).
+:- mode mlds_output_name(in, di, uo) is det.
+
+% XXX FIXME!
+% XXX we should escape special characters
+% XXX we should avoid appending the arity, modenum, and seqnum
+% if they are not needed.
+
+mlds_output_name(type(Name, Arity)) -->
+ io__format("%s_%d", [s(Name), i(Arity)]).
+mlds_output_name(data(DataName)) -->
+ mlds_output_data_name(DataName).
+mlds_output_name(function(PredLabel, ProcId, MaybeSeqNum, _PredId)) -->
+ mlds_output_pred_label(PredLabel),
+ { proc_id_to_int(ProcId, ModeNum) },
+ io__format("_%d", [i(ModeNum)]),
+ ( { MaybeSeqNum = yes(SeqNum) } ->
+ io__format("_%d", [i(SeqNum)])
+ ;
+ []
+ ).
+
+:- pred mlds_output_pred_label(mlds__pred_label, io__state, io__state).
+:- mode mlds_output_pred_label(in, di, uo) is det.
+
+mlds_output_pred_label(pred(PredOrFunc, MaybeDefiningModule, Name, Arity)) -->
+ ( { PredOrFunc = predicate, Suffix = "p" }
+ ; { PredOrFunc = function, Suffix = "f" }
+ ),
+ io__format("%s_%d_%s", [s(Name), i(Arity), s(Suffix)]),
+ ( { MaybeDefiningModule = yes(DefiningModule) } ->
+ io__write_string("_in__"),
+ mlds_output_module_name(DefiningModule)
+ ;
+ []
+ ).
+mlds_output_pred_label(special_pred(PredName, TypeModule, TypeName, TypeArity))
+ -->
+ io__write_string(PredName),
+ io__write_string("__"),
+ mlds_output_module_name(TypeModule),
+ io__write_string("__"),
+ io__write_string(TypeName),
+ io__write_string("_"),
+ io__write_int(TypeArity).
+
+:- pred mlds_output_data_name(mlds__data_name, io__state, io__state).
+:- mode mlds_output_data_name(in, di, uo) is det.
+
+% XX some of these should probably be escaped
+
+mlds_output_data_name(var(Name)) -->
+ io__write_string(Name).
+mlds_output_data_name(common(Num)) -->
+ io__write_string("common_"),
+ io__write_int(Num).
+mlds_output_data_name(type_ctor(_BaseData, _Name, _Arity)) -->
+ { error("mlds_to_c.m: NYI: type_ctor") }.
+mlds_output_data_name(base_typeclass_info(_ClassId, _InstanceId)) -->
+ { error("mlds_to_c.m: NYI: basetypeclass_info") }.
+mlds_output_data_name(module_layout) -->
+ { error("mlds_to_c.m: NYI: module_layout") }.
+mlds_output_data_name(proc_layout(_ProcLabel)) -->
+ { error("mlds_to_c.m: NYI: proc_layout") }.
+mlds_output_data_name(internal_layout(_ProcLabel, _FuncSeqNum)) -->
+ { error("mlds_to_c.m: NYI: internal_layout") }.
+mlds_output_data_name(tabling_pointer(_ProcLabel)) -->
+ { error("mlds_to_c.m: NYI: tabling_pointer") }.
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output types
+%
+
+:- pred mlds_output_type(mlds__type, io__state, io__state).
+:- mode mlds_output_type(in, di, uo) is det.
+
+mlds_output_type(mlds__type(Type)) -->
+ ( { Type = term__functor(term__atom("character"), [], _) } ->
+ io__write_string("char")
+ ; { Type = term__functor(term__atom("int"), [], _) } ->
+ io__write_string("int")
+ ; { Type = term__functor(term__atom("string"), [], _) } ->
+ io__write_string("String")
+ ; { Type = term__functor(term__atom("float"), [], _) } ->
+ io__write_string("Float")
+ ;
+ io__write_string("Word")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output declaration specifiers
+%
+
+:- pred mlds_output_decl_flags(mlds__decl_flags, io__state, io__state).
+:- mode mlds_output_decl_flags(in, di, uo) is det.
+
+mlds_output_decl_flags(Flags) -->
+ mlds_output_access(access(Flags)),
+ mlds_output_per_instance(per_instance(Flags)),
+ mlds_output_virtuality(virtuality(Flags)),
+ mlds_output_finality(finality(Flags)),
+ mlds_output_constness(constness(Flags)),
+ mlds_output_abstractness(abstractness(Flags)).
+
+:- pred mlds_output_access(access, io__state, io__state).
+:- mode mlds_output_access(in, di, uo) is det.
+
+mlds_output_access(public) --> io__write_string("/* public: */ ").
+mlds_output_access(private) --> io__write_string("/* private: */ ").
+mlds_output_access(protected) --> io__write_string("/* protected: */ ").
+mlds_output_access(default) --> [].
+
+:- pred mlds_output_per_instance(per_instance, io__state, io__state).
+:- mode mlds_output_per_instance(in, di, uo) is det.
+
+mlds_output_per_instance(one_copy) --> io__write_string("static ").
+mlds_output_per_instance(per_instance) --> [].
+
+:- pred mlds_output_virtuality(virtuality, io__state, io__state).
+:- mode mlds_output_virtuality(in, di, uo) is det.
+
+mlds_output_virtuality(virtual) --> io__write_string("virtual ").
+mlds_output_virtuality(non_virtual) --> [].
+
+:- pred mlds_output_finality(finality, io__state, io__state).
+:- mode mlds_output_finality(in, di, uo) is det.
+
+mlds_output_finality(final) --> io__write_string("final ").
+mlds_output_finality(overridable) --> [].
+
+:- pred mlds_output_constness(constness, io__state, io__state).
+:- mode mlds_output_constness(in, di, uo) is det.
+
+mlds_output_constness(const) --> io__write_string("const ").
+mlds_output_constness(modifiable) --> [].
+
+:- pred mlds_output_abstractness(abstractness, io__state, io__state).
+:- mode mlds_output_abstractness(in, di, uo) is det.
+
+mlds_output_abstractness(abstract) --> io__write_string("/* abstract */ ").
+mlds_output_abstractness(concrete) --> [].
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output statements
+%
+
+:- pred mlds_output_statements(int, list(mlds__statement),
+ io__state, io__state).
+:- mode mlds_output_statements(in, in, di, uo) is det.
+
+mlds_output_statements(Indent, Statements) -->
+ list__foldl(mlds_output_statement(Indent), Statements).
+
+:- pred mlds_output_statement(int, mlds__statement, io__state, io__state).
+:- mode mlds_output_statement(in, in, di, uo) is det.
+
+mlds_output_statement(Indent, mlds__statement(Statement, Context)) -->
+ mlds_output_context(Context),
+ mlds_output_stmt(Indent, Statement).
+
+:- pred mlds_output_stmt(int, mlds__stmt, io__state, io__state).
+:- mode mlds_output_stmt(in, in, di, uo) is det.
+
+ %
+ % sequence
+ %
+mlds_output_stmt(Indent, block(Defns, Statements)) -->
+ mlds_indent(Indent),
+ io__write_string("{\n"),
+ ( { Defns \= [] } ->
+ mlds_output_defns(Indent + 1, Defns),
+ io__write_string("\n")
+ ;
+ []
+ ),
+ mlds_output_statements(Indent + 1, Statements),
+ mlds_indent(Indent),
+ io__write_string("}\n").
+
+ %
+ % iteration
+ %
+mlds_output_stmt(Indent, while(Cond, Statement, no)) -->
+ mlds_indent(Indent),
+ io__write_string("while ("),
+ mlds_output_rval(Cond),
+ io__write_string(")\n"),
+ mlds_output_statement(Indent + 1, Statement).
+mlds_output_stmt(Indent, while(Cond, Statement, yes)) -->
+ mlds_indent(Indent),
+ io__write_string("do {\n"),
+ mlds_output_statement(Indent + 1, Statement),
+ mlds_indent(Indent),
+ io__write_string("} while ("),
+ mlds_output_rval(Cond),
+ io__write_string(");\n").
+
+ %
+ % selection (see also computed_goto)
+ %
+mlds_output_stmt(Indent, if_then_else(Cond, Then0, MaybeElse)) -->
+ %
+ % we need to take care to avoid problems caused by the
+ % dangling else ambiguity
+ %
+ {
+ MaybeElse = yes(_),
+ Then0 = statement(if_then_else(_, _, no), Context)
+ ->
+ Then = statement(block([], [Then0]), Context)
+ ;
+ Then = Then0
+ },
+ mlds_indent(Indent),
+ io__write_string("if ("),
+ mlds_output_rval(Cond),
+ io__write_string(")\n"),
+ mlds_output_statement(Indent + 1, Then),
+ ( { MaybeElse = yes(Else) } ->
+ mlds_indent(Indent),
+ io__write_string("else\n"),
+ mlds_output_statement(Indent + 1, Else)
+ ;
+ []
+ ).
+
+ %
+ % transfer of control
+ %
+mlds_output_stmt(Indent, label(LabelName)) -->
+ %
+ % Note: MLDS allows labels at the end of blocks.
+ % C doesn't. Hence we need to insert a semi-colon after the colon
+ % to ensure that there is a statement to attach the label to.
+ %
+ mlds_indent(Indent - 1),
+ mlds_output_label_name(LabelName),
+ io__write_string(":;\n").
+mlds_output_stmt(Indent, goto(LabelName)) -->
+ mlds_indent(Indent),
+ io__write_string("goto "),
+ mlds_output_label_name(LabelName),
+ io__write_string(";\n").
+mlds_output_stmt(Indent, computed_goto(Expr, Labels)) -->
+ % XXX for GNU C, we could output potentially more efficient code
+ % by using an array of labels; this would tell the compiler that
+ % it didn't need to do any range check.
+ mlds_indent(Indent),
+ io__write_string("switch ("),
+ mlds_output_rval(Expr),
+ io__write_string(") {"),
+ { OutputLabel =
+ (pred(Label::in, Count0::in, Count::out, di, uo) is det -->
+ mlds_indent(Indent + 1),
+ io__write_string("case "),
+ io__write_int(Count0),
+ io__write_string(": goto "),
+ mlds_output_label_name(Label),
+ io__write_string(";\n"),
+ { Count = Count0 + 1 }
+ ) },
+ list__foldl2(OutputLabel, Labels, 0, _FinalCount),
+ mlds_indent(Indent + 1),
+ io__write_string("default: /*NOTREACHED*/ assert(0);\n"),
+ mlds_indent(Indent),
+ io__write_string("}\n").
+
+ %
+ % function call/return
+ %
+mlds_output_stmt(Indent, call(_Signature, Func, MaybeObject, Args, Results,
+ IsTailCall)) -->
+ mlds_indent(Indent),
+ ( { IsTailCall = tail_call } ->
+ io__write_string("return ")
+ ;
+ []
+ ),
+ ( { MaybeObject = yes(Object) } ->
+ mlds_output_bracketed_rval(Object),
+ io__write_string(".")
+ ;
+ []
+ ),
+ ( { Results = [] } ->
+ []
+ ; { Results = [Lval] } ->
+ mlds_output_lval(Lval),
+ io__write_string(" = ")
+ ;
+ { error("mld_output_stmt: multiple return values") }
+ ),
+ mlds_output_bracketed_rval(Func),
+ io__write_string("("),
+ io__write_list(Args, ", ", mlds_output_rval),
+ io__write_string(");\n").
+
+mlds_output_stmt(Indent, return(Results)) -->
+ mlds_indent(Indent),
+ io__write_string("return"),
+ ( { Results = [] } ->
+ []
+ ; { Results = [Rval] } ->
+ io__write_char(' '),
+ mlds_output_rval(Rval)
+ ;
+ { error("mld_output_stmt: multiple return values") }
+ ),
+ io__write_string(";\n").
+
+ %
+ % exception handling
+ %
+
+ /* XXX not yet implemented */
+
+ %
+ % atomic statements
+ %
+mlds_output_stmt(Indent, atomic(AtomicStatement)) -->
+ mlds_output_atomic_stmt(Indent, AtomicStatement).
+
+:- pred mlds_output_label_name(mlds__label, io__state, io__state).
+:- mode mlds_output_label_name(in, di, uo) is det.
+
+mlds_output_label_name(LabelName) -->
+ io__write_string(LabelName).
+
+:- pred mlds_output_atomic_stmt(int, mlds__atomic_statement,
+ io__state, io__state).
+:- mode mlds_output_atomic_stmt(in, in, di, uo) is det.
+
+ %
+ % comments
+ %
+mlds_output_atomic_stmt(Indent, comment(Comment)) -->
+ % XXX we should escape any "*/"'s in the Comment.
+ % we should also split the comment into lines and indent
+ % each line appropriately.
+ mlds_indent(Indent),
+ io__write_string("/* "),
+ io__write_string(Comment),
+ io__write_string(" */").
+
+ %
+ % assignment
+ %
+mlds_output_atomic_stmt(Indent, assign(Lval, Rval)) -->
+ mlds_indent(Indent),
+ mlds_output_lval(Lval),
+ io__write_string(" = "),
+ mlds_output_rval(Rval),
+ io__write_string(";\n").
+
+ %
+ % heap management
+ %
+mlds_output_atomic_stmt(Indent, new_object(Target,
+ MaybeTag, Type, MaybeSize, MaybeCtorName, Args, ArgTypes)) -->
+ mlds_indent(Indent),
+ mlds_output_lval(Target),
+ io__write_string(" = "),
+ ( { MaybeTag = yes(Tag) } ->
+ io__write_string("MR_mkword("),
+ mlds_output_tag(Tag),
+ io__write_string(", "),
+ { EndMkword = ")" }
+ ;
+ { EndMkword = "" }
+ ),
+ io__write_string("MR_new_object("),
+ mlds_output_type(Type),
+ io__write_string(", "),
+ ( { MaybeSize = yes(Size) } ->
+ mlds_output_rval(Size)
+ ;
+ % XXX what should we do here?
+ io__write_int(-1)
+ ),
+ io__write_string(", "),
+ ( { MaybeCtorName = yes(CtorName) } ->
+ io__write_string(CtorName)
+ ;
+ io__write_string("NULL")
+ ),
+ io__write_string(")"),
+ io__write_string(EndMkword),
+ io__write_string(";\n"),
+ %
+ % XXX we should handle the constructor arguments / initializer
+ %
+ ( { Args = [], ArgTypes = [] } ->
+ []
+ ;
+ { error("mlds_output_atomic_stmt: new_object initializer") }
+ ).
+
+mlds_output_atomic_stmt(Indent, mark_hp(Lval)) -->
+ mlds_indent(Indent),
+ io__write_string("MR_mark_hp("),
+ mlds_output_lval(Lval),
+ io__write_string(");\n").
+
+mlds_output_atomic_stmt(Indent, restore_hp(Rval)) -->
+ mlds_indent(Indent),
+ io__write_string("MR_mark_hp("),
+ mlds_output_rval(Rval),
+ io__write_string(");\n").
+
+ %
+ % trail management
+ %
+mlds_output_atomic_stmt(_Indent, trail_op(_TrailOp)) -->
+ { error("mlds_to_c.m: sorry, trail_ops not implemented") }.
+
+ %
+ % foreign language interfacing
+ %
+mlds_output_atomic_stmt(_Indent, target_code(_TargetLang, _CodeString)) -->
+ { error("mlds_to_c.m: sorry, target_code not implemented") }.
+/*
+ target_code(target_lang, string)
+ % Do whatever is specified by the string,
+ % which can be any piece of code in the specified
+ % target language (C, assembler, or whatever)
+ % that does not have any non-local flow of control.
+*/
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output expressions
+%
+
+:- pred mlds_output_lval(mlds__lval, io__state, io__state).
+:- mode mlds_output_lval(in, di, uo) is det.
+
+mlds_output_lval(field(_MaybeTag, _Rval, _FieldId)) -->
+ { error("mlds.m: sorry, not yet implemented: field") }.
+mlds_output_lval(mem_ref(Rval)) -->
+ io__write_string("*"),
+ mlds_output_bracketed_rval(Rval).
+mlds_output_lval(var(VarName)) -->
+ mlds_output_fully_qualified_name(VarName, io__write_string).
+
+:- pred mlds_output_bracketed_rval(mlds__rval, io__state, io__state).
+:- mode mlds_output_bracketed_rval(in, di, uo) is det.
+
+mlds_output_bracketed_rval(Rval) -->
+ io__write_char('('),
+ mlds_output_rval(Rval),
+ io__write_char(')').
+
+:- pred mlds_output_rval(mlds__rval, io__state, io__state).
+:- mode mlds_output_rval(in, di, uo) is det.
+
+mlds_output_rval(lval(Lval)) -->
+ mlds_output_lval(Lval).
+/**** XXX do we need this?
+mlds_output_rval(lval(Lval)) -->
+ % if a field is used as an rval, then we need to use
+ % the MR_const_field() macro, not the MR_field() macro,
+ % to avoid warnings about discarding const,
+ % and similarly for MR_mask_field.
+ ( { Lval = field(MaybeTag, Rval, FieldNum) } ->
+ ( { MaybeTag = yes(Tag) } ->
+ io__write_string("MR_const_field("),
+ mlds_output_tag(Tag),
+ io__write_string(", ")
+ ;
+ io__write_string("MR_const_mask_field(")
+ ),
+ mlds_output_rval(Rval),
+ io__write_string(", "),
+ mlds_output_rval(FieldNum),
+ io__write_string(")")
+ ;
+ mlds_output_lval(Lval)
+ ).
+****/
+
+mlds_output_rval(mkword(Tag, Rval)) -->
+ io__write_string("MR_mkword("),
+ mlds_output_tag(Tag),
+ io__write_string(", "),
+ mlds_output_rval(Rval),
+ io__write_string(")").
+
+mlds_output_rval(const(Const)) -->
+ mlds_output_rval_const(Const).
+
+mlds_output_rval(unop(Op, Rval)) -->
+ mlds_output_unop(Op, Rval).
+
+mlds_output_rval(binop(Op, Rval1, Rval2)) -->
+ mlds_output_binop(Op, Rval1, Rval2).
+
+mlds_output_rval(mem_addr(Lval)) -->
+ % XXX are parentheses needed?
+ io__write_string("&"),
+ mlds_output_lval(Lval).
+
+:- pred mlds_output_unop(unary_op, mlds__rval, io__state, io__state).
+:- mode mlds_output_unop(in, in, di, uo) is det.
+
+mlds_output_unop(UnaryOp, Exprn) -->
+ { c_util__unary_prefix_op(UnaryOp, UnaryOpString) },
+ io__write_string(UnaryOpString),
+ io__write_string("("),
+ mlds_output_rval(Exprn),
+ io__write_string(")").
+
+:- pred mlds_output_binop(binary_op, mlds__rval, mlds__rval,
+ io__state, io__state).
+:- mode mlds_output_binop(in, in, in, di, uo) is det.
+
+mlds_output_binop(Op, X, Y) -->
+ (
+ { Op = array_index }
+ ->
+ mlds_output_bracketed_rval(X),
+ io__write_string("["),
+ mlds_output_rval(Y),
+ io__write_string("]")
+ ;
+ { c_util__string_compare_op(Op, OpStr) }
+ ->
+ io__write_string("(strcmp("),
+ mlds_output_rval(X),
+ io__write_string(", "),
+ mlds_output_rval(Y),
+ io__write_string(")"),
+ io__write_string(" "),
+ io__write_string(OpStr),
+ io__write_string(" "),
+ io__write_string("0)")
+ ;
+ ( { c_util__float_compare_op(Op, OpStr1) } ->
+ { OpStr = OpStr1 }
+ ; { c_util__float_op(Op, OpStr2) } ->
+ { OpStr = OpStr2 }
+ ;
+ { fail }
+ )
+ ->
+ io__write_string("("),
+ mlds_output_bracketed_rval(X), % XXX as float
+ io__write_string(" "),
+ io__write_string(OpStr),
+ io__write_string(" "),
+ mlds_output_bracketed_rval(Y), % XXX as float
+ io__write_string(")")
+ ;
+/****
+XXX broken for C == minint
+(since `NewC is 0 - C' overflows)
+ { Op = (+) },
+ { Y = const(int_const(C)) },
+ { C < 0 }
+ ->
+ { NewOp = (-) },
+ { NewC is 0 - C },
+ { NewY = const(int_const(NewC)) },
+ io__write_string("("),
+ mlds_output_rval(X),
+ io__write_string(" "),
+ mlds_output_binary_op(NewOp),
+ io__write_string(" "),
+ mlds_output_rval(NewY),
+ io__write_string(")")
+ ;
+******/
+ io__write_string("("),
+ mlds_output_rval(X),
+ io__write_string(" "),
+ mlds_output_binary_op(Op),
+ io__write_string(" "),
+ mlds_output_rval(Y),
+ io__write_string(")")
+ ).
+
+:- pred mlds_output_binary_op(binary_op, io__state, io__state).
+:- mode mlds_output_binary_op(in, di, uo) is erroneous.
+
+mlds_output_binary_op(_Op) -->
+ { error("NYI 7") }.
+ % XXX
+ % { c_util__binary_op(Op, OpStr) },
+ % io__write_string(OpStr).
+
+:- pred mlds_output_rval_const(mlds__rval_const, io__state, io__state).
+:- mode mlds_output_rval_const(in, di, uo) is det.
+
+mlds_output_rval_const(true) -->
+ io__write_string("TRUE"). % XXX should we use `MR_TRUE'?
+mlds_output_rval_const(false) -->
+ io__write_string("FALSE"). % XXX should we use `MR_FALSE'?
+mlds_output_rval_const(int_const(N)) -->
+ % we need to cast to (Integer) to ensure
+ % things like 1 << 32 work when `Integer' is 64 bits
+ % but `int' is 32 bits.
+ io__write_string("(Integer) "),
+ io__write_int(N).
+mlds_output_rval_const(float_const(FloatVal)) -->
+ % the cast to (Float) here lets the C compiler
+ % do arithmetic in `float' rather than `double'
+ % if `Float' is `float' not `double'.
+ io__write_string("(Float) "),
+ io__write_float(FloatVal).
+mlds_output_rval_const(string_const(String)) -->
+ io__write_string(""""),
+ c_util__output_quoted_string(String),
+ io__write_string("""").
+mlds_output_rval_const(multi_string_const(Length, String)) -->
+ io__write_string(""""),
+ c_util__output_quoted_multi_string(Length, String),
+ io__write_string("""").
+mlds_output_rval_const(code_addr_const(CodeAddr)) -->
+ mlds_output_code_addr(CodeAddr).
+mlds_output_rval_const(data_addr_const(DataAddr)) -->
+ mlds_output_data_addr(DataAddr).
+
+%-----------------------------------------------------------------------------%
+
+:- pred mlds_output_tag(tag, io__state, io__state).
+:- mode mlds_output_tag(in, di, uo) is det.
+
+mlds_output_tag(Tag) -->
+ io__write_string("MR_mktag("),
+ io__write_int(Tag),
+ io__write_string(")").
+
+%-----------------------------------------------------------------------------%
+
+:- pred mlds_output_code_addr(mlds__code_addr, io__state, io__state).
+:- mode mlds_output_code_addr(in, di, uo) is erroneous.
+
+mlds_output_code_addr(proc(_Label)) -->
+ { error("NYI 1") }.
+mlds_output_code_addr(internal(_Label, _SeqNum)) -->
+ { error("NYI 2") }.
+
+:- pred mlds_output_data_addr(mlds__data_addr, io__state, io__state).
+:- mode mlds_output_data_addr(in, di, uo) is det.
+
+mlds_output_data_addr(data_addr(_ModuleName, DataName)) -->
+ % XXX ModuleName
+ mlds_output_data_name(DataName).
+
+%-----------------------------------------------------------------------------%
+%
+% Miscellaneous
+%
+
+:- pred mlds_indent(int, io__state, io__state).
+:- mode mlds_indent(in, di, uo) is det.
+
+mlds_indent(N) -->
+ ( { N =< 0 } ->
+ []
+ ;
+ io__write_string(" "),
+ mlds_indent(N - 1)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+/*****
+
+:- type base_data
+ ---> info
+ ; functors
+ ; layout.
+
+ % see runtime/mercury_trail.h
+:- type reset_trail_reason
+ ---> undo
+ ; commit
+ ; solve
+ ; exception
+ ; gc
+ .
+
+:- type mlds__qualified_proc_label
+ == mlds__fully_qualified_name(mlds__proc_label).
+:- type mlds__proc_label
+ == pair(mlds__pred_label, proc_id).
+
+:- type mlds__qualified_pred_label
+ == mlds__fully_qualified_name(mlds__pred_label).
+
+:- type field_id == mlds__fully_qualified_name(field_name).
+:- type field_name == string.
+
+:- type mlds__var == mlds__fully_qualified_name(mlds__var_name).
+:- type mlds__var_name == string.
+
+*****/
+
+/**************************
+% An mlds__module_name specifies the name of an mlds package or class.
+:- type mlds__module_name.
+
+% An mlds__package_name specifies the name of an mlds package.
+:- type mlds__package_name == mlds__module_name.
+
+% Given the name of a Mercury module, return the name of the corresponding
+% MLDS package.
+:- func mercury_module_name_to_mlds(mercury_module_name) = mlds__package_name.
+
+:- type mlds__qualified_entity_name
+ == mlds__fully_qualified_name(mlds__entity_name).
+
+:- type mlds__class_kind
+ ---> mlds__class % A generic class:
+ % can inherit other classes and
+ % interfaces
+ % (but most targets will only support
+ % single inheritence, so usually there
+ % will be at most one class).
+ ; mlds__package % A class with only static members
+ % (can only inherit other packages).
+ % Unlike other kinds of classes,
+ % packages should not be used as types.
+ ; mlds__interface % A class with no variable data members
+ % (can only inherit other interfaces)
+ ; mlds__struct % A value class
+ % (can only inherit other structs).
+ ; mlds__enum % A class with one integer member and
+ % a bunch of static consts
+ % (cannot inherit anything).
+ .
+
+:- type mlds__class
+ ---> mlds__class(
+ mlds__class_kind,
+ mlds__imports, % imports these classes (or
+ % modules, packages, ...)
+ list(mlds__class_id), % inherits these base classes
+ list(mlds__interface_id), % implements these interfaces
+ mlds__defns % contains these members
+ ).
+
+:- type mlds__type.
+:- type mercury_type == prog_data__type.
+
+:- func mercury_type_to_mlds_type(mercury_type) = mlds__type.
+
+% Hmm... this is tentative.
+:- type mlds__class_id == mlds__type.
+:- type mlds__interface_id == mlds__type.
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % C code required for the C interface.
+ % When compiling to a language other than C,
+ % this part still needs to be generated as C code
+ % and compiled with a C compiler.
+ %
+:- type mlds__foreign_code
+ ---> mlds__foreign_code(
+ c_header_info,
+ list(user_c_code),
+ list(c_export) % XXX we will need to modify
+ % export.m to handle different
+ % target languages
+ ).
+
+%-----------------------------------------------------------------------------%
+
+**************************/
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list