[m-dev.] for review: refactor generation of builtins
Fergus Henderson
fjh at cs.mu.OZ.AU
Wed Mar 15 02:41:22 AEDT 2000
Hi,
Simon, could you please review the changes to rl_exprn.m,
and Zoltan, could you please review the rest?
----------
Estimated hours taken: 4
Refactor the handling of code generation for builtin
procedures to avoid code duplication and to reduce
dependencies between different sub-systems.
compiler/builtin_ops.m:
Add a new `simple_expr' type.
Add a new procedure `translate_builtin' that returns this type.
This procedure is very similar to code_util__translate_builtin
and ml_call_gen:ml_translate_builtin, but with a slightly
simpler and somewhat safer interface.
compiler/ml_call_gen.m:
Use builtin_ops__translate_builtin rather than ml_translate_builtin.
compiler/code_util.m:
compiler/call_gen.m:
compiler/bytecode_gen.m:
compiler/rl_exprn.m:
Use builtin_ops__translate_builtin rather than
code_util__translate_builtin.
Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.1
diff -u -d -r1.1 builtin_ops.m
--- compiler/builtin_ops.m 1999/07/10 07:19:50 1.1
+++ compiler/builtin_ops.m 2000/03/14 13:59:38
@@ -16,7 +16,10 @@
:- module builtin_ops.
:- interface.
+:- import_module prog_data, hlds_pred.
+:- import_module list.
+
:- type unary_op
---> mktag
; tag
@@ -68,4 +71,250 @@
; float_le
; float_ge.
+ % translate_builtin:
+ %
+ % Given a module name, a predicate name, a proc_id and a list of
+ % the arguments, find out if that procedure of that predicate
+ % is an inline builtin. If so, return code which can be used
+ % to evaluate that call: either an assignment (if the builtin is det)
+ % or a test (if the builtin is semidet).
+ %
+ % There are some further guarantees on the form of the expressions
+ % in the code returned -- see below for details.
+ % (bytecode_gen.m depends on these guarantees.)
+ %
+:- pred translate_builtin(module_name, string, proc_id, list(T),
+ simple_code(T)).
+:- mode translate_builtin(in, in, in, in, out(simple_code)) is semidet.
+
+:- type simple_code(T)
+ ---> assign(T, simple_expr(T))
+ ; test(simple_expr(T)).
+
+:- type simple_expr(T)
+ ---> leaf(T)
+ ; int_const(int)
+ ; float_const(float)
+ ; unary(unary_op, simple_expr(T))
+ ; binary(binary_op, simple_expr(T), simple_expr(T)).
+
+ % Each test expression returned is guaranteed to be either a unary
+ % or binary operator, applied to arguments that are either variables
+ % (from the argument list) or constants.
+ %
+ % Each to be assigned expression is guaranteed to be either in a form
+ % acceptable for a test rval, or in the form of a variable.
+
+:- inst simple_code
+ ---> assign(ground, simple_assign_expr)
+ ; test(simple_test_expr).
+
+:- inst simple_arg_expr
+ ---> leaf(ground)
+ ; int_const(ground)
+ ; float_const(ground).
+
+:- inst simple_test_expr
+ ---> unary(ground, simple_arg_expr)
+ ; binary(ground, simple_arg_expr, simple_arg_expr).
+
+:- inst simple_assign_expr
+ ---> unary(ground, simple_arg_expr)
+ ; binary(ground, simple_arg_expr, simple_arg_expr)
+ ; leaf(ground).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
+translate_builtin(FullyQualifiedModule, PredName, ProcId, Args, Code) :-
+ proc_id_to_int(ProcId, ProcInt),
+ % -- not yet:
+ % FullyQualifiedModule = qualified(unqualified("std"), ModuleName),
+ FullyQualifiedModule = unqualified(ModuleName),
+ translate_builtin_2(ModuleName, PredName, ProcInt, Args, Code).
+
+:- pred translate_builtin_2(string, string, int, list(T), simple_code(T)).
+:- mode translate_builtin_2(in, in, in, in, out) is semidet.
+
+translate_builtin_2("private_builtin", "unsafe_type_cast", 0,
+ [X, Y], assign(Y, leaf(X))).
+translate_builtin_2("builtin", "unsafe_promise_unique", 0,
+ [X, Y], assign(Y, leaf(X))).
+
+translate_builtin_2("private_builtin", "builtin_int_gt", 0, [X, Y],
+ test(binary((>), leaf(X), leaf(Y)))).
+translate_builtin_2("private_builtin", "builtin_int_lt", 0, [X, Y],
+ test(binary((<), leaf(X), leaf(Y)))).
+
+translate_builtin_2("int", "builtin_plus", 0, [X, Y, Z],
+ assign(Z, binary((+), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_plus", 1, [X, Y, Z],
+ assign(X, binary((-), leaf(Z), leaf(Y)))).
+translate_builtin_2("int", "builtin_plus", 2, [X, Y, Z],
+ assign(Y, binary((-), leaf(Z), leaf(X)))).
+translate_builtin_2("int", "+", 0, [X, Y, Z],
+ assign(Z, binary((+), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "+", 1, [X, Y, Z],
+ assign(X, binary((-), leaf(Z), leaf(Y)))).
+translate_builtin_2("int", "+", 2, [X, Y, Z],
+ assign(Y, binary((-), leaf(Z), leaf(X)))).
+translate_builtin_2("int", "builtin_minus", 0, [X, Y, Z],
+ assign(Z, binary((-), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_minus", 1, [X, Y, Z],
+ assign(X, binary((+), leaf(Y), leaf(Z)))).
+translate_builtin_2("int", "builtin_minus", 2, [X, Y, Z],
+ assign(Y, binary((-), leaf(X), leaf(Z)))).
+translate_builtin_2("int", "-", 0, [X, Y, Z],
+ assign(Z, binary((-), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "-", 1, [X, Y, Z],
+ assign(X, binary((+), leaf(Y), leaf(Z)))).
+translate_builtin_2("int", "-", 2, [X, Y, Z],
+ assign(Y, binary((-), leaf(X), leaf(Z)))).
+translate_builtin_2("int", "builtin_times", 0, [X, Y, Z],
+ assign(Z, binary((*), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_times", 1, [X, Y, Z],
+ assign(X, binary((/), leaf(Z), leaf(Y)))).
+translate_builtin_2("int", "builtin_times", 2, [X, Y, Z],
+ assign(Y, binary((/), leaf(Z), leaf(X)))).
+translate_builtin_2("int", "*", 0, [X, Y, Z],
+ assign(Z, binary((*), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "*", 1, [X, Y, Z],
+ assign(X, binary((/), leaf(Z), leaf(Y)))).
+translate_builtin_2("int", "*", 2, [X, Y, Z],
+ assign(Y, binary((/), leaf(Z), leaf(X)))).
+translate_builtin_2("int", "builtin_div", 0, [X, Y, Z],
+ assign(Z, binary((/), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_div", 1, [X, Y, Z],
+ assign(X, binary((*), leaf(Y), leaf(Z)))).
+translate_builtin_2("int", "builtin_div", 2, [X, Y, Z],
+ assign(Y, binary((/), leaf(X), leaf(Z)))).
+translate_builtin_2("int", "//", 0, [X, Y, Z],
+ assign(Z, binary((/), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "//", 1, [X, Y, Z],
+ assign(X, binary((*), leaf(Y), leaf(Z)))).
+translate_builtin_2("int", "//", 2, [X, Y, Z],
+ assign(Y, binary((/), leaf(X), leaf(Z)))).
+translate_builtin_2("int", "builtin_mod", 0, [X, Y, Z],
+ assign(Z, binary((mod), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "rem", 0, [X, Y, Z],
+ assign(Z, binary((mod), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_left_shift", 0, [X, Y, Z],
+ assign(Z, binary((<<), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "unchecked_left_shift", 0, [X, Y, Z],
+ assign(Z, binary((<<), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_right_shift", 0, [X, Y, Z],
+ assign(Z, binary((>>), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "unchecked_right_shift", 0, [X, Y, Z],
+ assign(Z, binary((>>), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_bit_and", 0, [X, Y, Z],
+ assign(Z, binary((&), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "/\\", 0, [X, Y, Z],
+ assign(Z, binary((&), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_bit_or", 0, [X, Y, Z],
+ assign(Z, binary(('|'), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "\\/", 0, [X, Y, Z],
+ assign(Z, binary(('|'), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "builtin_bit_xor", 0, [X, Y, Z],
+ assign(Z, binary((^), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "^", 0, [X, Y, Z],
+ assign(Z, binary((^), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "xor", 0, [X, Y, Z],
+ assign(Z, binary((^), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "xor", 1, [X, Y, Z],
+ assign(Y, binary((^), leaf(X), leaf(Z)))).
+translate_builtin_2("int", "xor", 2, [X, Y, Z],
+ assign(X, binary((^), leaf(Y), leaf(Z)))).
+translate_builtin_2("int", "builtin_unary_plus", 0, [X, Y],
+ assign(Y, leaf(X))).
+translate_builtin_2("int", "+", 0, [X, Y],
+ assign(Y, leaf(X))).
+translate_builtin_2("int", "builtin_unary_minus", 0, [X, Y],
+ assign(Y, binary((-), int_const(0), leaf(X)))).
+translate_builtin_2("int", "-", 0, [X, Y],
+ assign(Y, binary((-), int_const(0), leaf(X)))).
+translate_builtin_2("int", "builtin_bit_neg", 0, [X, Y],
+ assign(Y, unary(bitwise_complement, leaf(X)))).
+translate_builtin_2("int", "\\", 0, [X, Y],
+ assign(Y, unary(bitwise_complement, leaf(X)))).
+translate_builtin_2("int", ">", 0, [X, Y],
+ test(binary((>), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "<", 0, [X, Y],
+ test(binary((<), leaf(X), leaf(Y)))).
+translate_builtin_2("int", ">=", 0, [X, Y],
+ test(binary((>=), leaf(X), leaf(Y)))).
+translate_builtin_2("int", "=<", 0, [X, Y],
+ test(binary((<=), leaf(X), leaf(Y)))).
+
+translate_builtin_2("float", "builtin_float_plus", 0, [X, Y, Z],
+ assign(Z, binary(float_plus, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_plus", 1, [X, Y, Z],
+ assign(X, binary(float_minus, leaf(Z), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_plus", 2, [X, Y, Z],
+ assign(Y, binary(float_minus, leaf(Z), leaf(X)))).
+translate_builtin_2("float", "+", 0, [X, Y, Z],
+ assign(Z, binary(float_plus, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "+", 1, [X, Y, Z],
+ assign(X, binary(float_minus, leaf(Z), leaf(Y)))).
+translate_builtin_2("float", "+", 2, [X, Y, Z],
+ assign(Y, binary(float_minus, leaf(Z), leaf(X)))).
+translate_builtin_2("float", "builtin_float_minus", 0, [X, Y, Z],
+ assign(Z, binary(float_minus, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_minus", 1, [X, Y, Z],
+ assign(X, binary(float_plus, leaf(Y), leaf(Z)))).
+translate_builtin_2("float", "builtin_float_minus", 2, [X, Y, Z],
+ assign(Y, binary(float_minus, leaf(X), leaf(Z)))).
+translate_builtin_2("float", "-", 0, [X, Y, Z],
+ assign(Z, binary(float_minus, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "-", 1, [X, Y, Z],
+ assign(X, binary(float_plus, leaf(Y), leaf(Z)))).
+translate_builtin_2("float", "-", 2, [X, Y, Z],
+ assign(Y, binary(float_minus, leaf(X), leaf(Z)))).
+translate_builtin_2("float", "builtin_float_times", 0, [X, Y, Z],
+ assign(Z, binary(float_times, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_times", 1, [X, Y, Z],
+ assign(X, binary(float_divide, leaf(Z), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_times", 2, [X, Y, Z],
+ assign(Y, binary(float_divide, leaf(Z), leaf(X)))).
+translate_builtin_2("float", "*", 0, [X, Y, Z],
+ assign(Z, binary(float_times, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "*", 1, [X, Y, Z],
+ assign(X, binary(float_divide, leaf(Z), leaf(Y)))).
+translate_builtin_2("float", "*", 2, [X, Y, Z],
+ assign(Y, binary(float_divide, leaf(Z), leaf(X)))).
+translate_builtin_2("float", "builtin_float_divide", 0, [X, Y, Z],
+ assign(Z, binary(float_divide, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_divide", 1, [X, Y, Z],
+ assign(X, binary(float_times, leaf(Y), leaf(Z)))).
+translate_builtin_2("float", "builtin_float_divide", 2, [X, Y, Z],
+ assign(Y, binary(float_divide, leaf(X), leaf(Z)))).
+translate_builtin_2("float", "/", 0, [X, Y, Z],
+ assign(Z, binary(float_divide, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "/", 1, [X, Y, Z],
+ assign(X, binary(float_times, leaf(Y), leaf(Z)))).
+translate_builtin_2("float", "/", 2, [X, Y, Z],
+ assign(Y, binary(float_divide, leaf(X), leaf(Z)))).
+translate_builtin_2("float", "+", 0, [X, Y],
+ assign(Y, leaf(X))).
+translate_builtin_2("float", "-", 0, [X, Y],
+ assign(Y, binary(float_minus, float_const(0.0), leaf(X)))).
+translate_builtin_2("float", "builtin_float_gt", 0, [X, Y],
+ test(binary(float_gt, leaf(X), leaf(Y)))).
+translate_builtin_2("float", ">", 0, [X, Y],
+ test(binary(float_gt, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_lt", 0, [X, Y],
+ test(binary(float_lt, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "<", 0, [X, Y],
+ test(binary(float_lt, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_ge", 0, [X, Y],
+ test(binary(float_ge, leaf(X), leaf(Y)))).
+translate_builtin_2("float", ">=", 0, [X, Y],
+ test(binary(float_ge, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "builtin_float_le", 0, [X, Y],
+ test(binary(float_le, leaf(X), leaf(Y)))).
+translate_builtin_2("float", "=<", 0, [X, Y],
+ test(binary(float_le, leaf(X), leaf(Y)))).
+
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.46
diff -u -d -r1.46 bytecode_gen.m
--- compiler/bytecode_gen.m 1999/10/25 03:48:37 1.46
+++ compiler/bytecode_gen.m 2000/03/14 14:00:02
@@ -4,7 +4,8 @@
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
-% This module generates the bytecode used by the debugger.
+% This module generates bytecode, which is intended to be used by a
+% (not yet implemented) bytecode interpreter/debugger.
%
% Author: zs.
%
@@ -21,16 +22,32 @@
io__state::di, io__state::uo) is det.
%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_pred, hlds_goal, hlds_data, prog_data, llds, arg_info.
-:- import_module passes_aux, call_gen, mode_util, code_util, goal_util.
-:- import_module globals, tree, varset, term.
+% We make use of some stuff from the LLDS back-end, in particular the stuff
+% relating to the argument passing convention in arg_info.m and call_gen.m.
+% The intent here is to use the same argument passing convention as for
+% the LLDS, to allow interoperability between code compiled to bytecode
+% and code compiled to machine code.
+%
+% XXX It might be nice to move the argument passing related stuff
+% in call_gen.m that we use here into arg_info.m, and to then rework
+% arg_info.m so that it didn't depend on the LLDS.
+
+:- import_module arg_info, call_gen. % XXX for arg passing convention
+:- import_module llds. % XXX for code_model
+:- import_module code_util. % XXX for cons_id_to_tag
+:- import_module hlds_pred, hlds_goal, hlds_data, prog_data.
+:- import_module passes_aux, mode_util, goal_util, builtin_ops.
+:- import_module globals, tree.
:- import_module bool, int, string, list, assoc_list, set, map, varset.
:- import_module std_util, require, term.
+%---------------------------------------------------------------------------%
+
bytecode_gen__module(ModuleInfo, Code) -->
{ module_info_predids(ModuleInfo, PredIds) },
bytecode_gen__preds(PredIds, ModuleInfo, CodeTree),
@@ -351,73 +368,76 @@
predicate_module(ModuleInfo, PredId, ModuleName),
predicate_name(ModuleInfo, PredId, PredName),
(
- code_util__translate_builtin(ModuleName, PredName, ProcId,
- Args, MaybeTest, MaybeAssign)
+ builtin_ops__translate_builtin(ModuleName, PredName, ProcId,
+ Args, SimpleCode)
->
- ( MaybeTest = yes(Test) ->
- bytecode_gen__map_test(ByteInfo, Test, TestCode)
- ;
- TestCode = empty
- ),
- ( MaybeAssign = yes(Var - Rval) ->
- bytecode_gen__map_assign(ByteInfo, Var, Rval,
- AssignCode)
+ (
+ SimpleCode = test(Test),
+ bytecode_gen__map_test(ByteInfo, Test, Code)
;
- AssignCode = empty
- ),
- Code = tree(TestCode, AssignCode)
+ SimpleCode = assign(Var, Expr),
+ bytecode_gen__map_assign(ByteInfo, Var, Expr,
+ Code)
+ )
;
string__append("unknown builtin predicate ", PredName, Msg),
error(Msg)
).
-:- pred bytecode_gen__map_test(byte_info::in, rval::in, byte_tree::out) is det.
+:- pred bytecode_gen__map_test(byte_info::in,
+ simple_expr(prog_var)::in(simple_test_expr),
+ byte_tree::out) is det.
-bytecode_gen__map_test(ByteInfo, Rval, Code) :-
- ( Rval = binop(Binop, X, Y) ->
+bytecode_gen__map_test(ByteInfo, TestExpr, Code) :-
+ (
+ TestExpr = binary(Binop, X, Y),
bytecode_gen__map_arg(ByteInfo, X, ByteX),
bytecode_gen__map_arg(ByteInfo, Y, ByteY),
Code = node([builtin_bintest(Binop, ByteX, ByteY)])
- ; Rval = unop(Unop, X) ->
+ ;
+ TestExpr = unary(Unop, X),
bytecode_gen__map_arg(ByteInfo, X, ByteX),
Code = node([builtin_untest(Unop, ByteX)])
- ;
- error("builtin test is not in a recognized form")
).
-:- pred bytecode_gen__map_assign(byte_info::in, prog_var::in, rval::in,
- byte_tree::out) is det.
+:- pred bytecode_gen__map_assign(byte_info::in, prog_var::in,
+ simple_expr(prog_var)::in(simple_assign_expr),
+ byte_tree::out) is det.
-bytecode_gen__map_assign(ByteInfo, Var, Rval, Code) :-
- ( Rval = binop(Binop, X, Y) ->
+bytecode_gen__map_assign(ByteInfo, Var, Expr, Code) :-
+ (
+ Expr = binary(Binop, X, Y),
bytecode_gen__map_arg(ByteInfo, X, ByteX),
bytecode_gen__map_arg(ByteInfo, Y, ByteY),
bytecode_gen__map_var(ByteInfo, Var, ByteVar),
Code = node([builtin_binop(Binop, ByteX, ByteY, ByteVar)])
- ; Rval = unop(Unop, X) ->
+ ;
+ Expr = unary(Unop, X),
bytecode_gen__map_arg(ByteInfo, X, ByteX),
bytecode_gen__map_var(ByteInfo, Var, ByteVar),
Code = node([builtin_unop(Unop, ByteX, ByteVar)])
- ; Rval = var(X) ->
+ ;
+ Expr = leaf(X),
bytecode_gen__map_var(ByteInfo, X, ByteX),
bytecode_gen__map_var(ByteInfo, Var, ByteVar),
Code = node([assign(ByteVar, ByteX)])
- ;
- error("builtin assignment is not in a recognized form")
).
-:- pred bytecode_gen__map_arg(byte_info::in, rval::in, byte_arg::out) is det.
+:- pred bytecode_gen__map_arg(byte_info::in,
+ simple_expr(prog_var)::in(simple_arg_expr),
+ byte_arg::out) is det.
-bytecode_gen__map_arg(ByteInfo, Rval, ByteArg) :-
- ( Rval = var(Var) ->
+bytecode_gen__map_arg(ByteInfo, Expr, ByteArg) :-
+ (
+ Expr = leaf(Var),
bytecode_gen__map_var(ByteInfo, Var, ByteVar),
ByteArg = var(ByteVar)
- ; Rval = const(int_const(IntVal)) ->
+ ;
+ Expr = int_const(IntVal),
ByteArg = int_const(IntVal)
- ; Rval = const(float_const(FloatVal)) ->
- ByteArg = float_const(FloatVal)
;
- error("unknown kind of builtin argument")
+ Expr = float_const(FloatVal),
+ ByteArg = float_const(FloatVal)
).
%---------------------------------------------------------------------------%
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.137
diff -u -d -r1.137 call_gen.m
--- compiler/call_gen.m 1999/11/15 00:42:08 1.137
+++ compiler/call_gen.m 2000/03/14 14:31:37
@@ -55,7 +55,7 @@
:- implementation.
-:- import_module hlds_module, hlds_data, code_util, rl.
+:- import_module hlds_module, hlds_data, code_util, builtin_ops, rl.
:- import_module arg_info, type_util, mode_util, unify_proc, instmap.
:- import_module trace, globals, options.
:- import_module std_util, bool, int, tree, map.
@@ -498,20 +498,19 @@
{ predicate_module(ModuleInfo, PredId, ModuleName) },
{ predicate_name(ModuleInfo, PredId, PredName) },
{
- code_util__translate_builtin(ModuleName, PredName,
- ProcId, Args, MaybeTestPrime, MaybeAssignPrime)
+ builtin_ops__translate_builtin(ModuleName, PredName,
+ ProcId, Args, SimpleCode0)
->
- MaybeTest = MaybeTestPrime,
- MaybeAssign = MaybeAssignPrime
+ SimpleCode = SimpleCode0
;
error("Unknown builtin predicate")
},
(
{ CodeModel = model_det },
(
- { MaybeTest = no },
- { MaybeAssign = yes(Var - Rval) }
+ { SimpleCode = assign(Var, AssignExpr) }
->
+ { Rval = convert_simple_expr(AssignExpr) },
code_info__cache_expression(Var, Rval),
{ Code = empty }
;
@@ -520,25 +519,23 @@
;
{ CodeModel = model_semi },
(
- { MaybeTest = yes(Test) }
+ { SimpleCode = test(TestExpr) }
->
- ( { Test = binop(BinOp, X0, Y0) } ->
- call_gen__generate_builtin_arg(X0, X, CodeX),
- call_gen__generate_builtin_arg(Y0, Y, CodeY),
+ (
+ { TestExpr = binary(BinOp, X0, Y0) },
+ { X1 = convert_simple_expr(X0) },
+ { Y1 = convert_simple_expr(Y0) },
+ call_gen__generate_builtin_arg(X1, X, CodeX),
+ call_gen__generate_builtin_arg(Y1, Y, CodeY),
{ Rval = binop(BinOp, X, Y) },
{ ArgCode = tree(CodeX, CodeY) }
- ; { Test = unop(UnOp, X0) } ->
- call_gen__generate_builtin_arg(X0, X, ArgCode),
- { Rval = unop(UnOp, X) }
;
- { error("Malformed semi builtin predicate") }
+ { TestExpr = unary(UnOp, X0) },
+ { X1 = convert_simple_expr(X0) },
+ call_gen__generate_builtin_arg(X1, X, ArgCode),
+ { Rval = unop(UnOp, X) }
),
code_info__fail_if_rval_is_false(Rval, TestCode),
- ( { MaybeAssign = yes(Var - AssignRval) } ->
- code_info__cache_expression(Var, AssignRval)
- ;
- []
- ),
{ Code = tree(ArgCode, TestCode) }
;
{ error("Malformed semi builtin predicate") }
@@ -547,6 +544,15 @@
{ CodeModel = model_non },
{ error("Nondet builtin predicate") }
).
+
+:- func convert_simple_expr(simple_expr(prog_var)) = rval.
+convert_simple_expr(leaf(Var)) = var(Var).
+convert_simple_expr(int_const(Int)) = const(int_const(Int)).
+convert_simple_expr(float_const(Float)) = const(float_const(Float)).
+convert_simple_expr(unary(UnOp, Expr)) =
+ unop(UnOp, convert_simple_expr(Expr)).
+convert_simple_expr(binary(BinOp, Expr1, Expr2)) =
+ binop(BinOp, convert_simple_expr(Expr1), convert_simple_expr(Expr2)).
%---------------------------------------------------------------------------%
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.117
diff -u -d -r1.117 code_util.m
--- compiler/code_util.m 2000/03/13 03:59:59 1.117
+++ compiler/code_util.m 2000/03/14 14:36:30
@@ -98,28 +98,6 @@
:- pred code_util__builtin_state(module_info, pred_id, proc_id, builtin_state).
:- mode code_util__builtin_state(in, in, in, out) is det.
- % Given a module name, a predicate name, a proc_id and a list of
- % variables as the arguments, find out if that procedure of that
- % predicate is an inline builtin. If yes, the last two arguments
- % return two things:
- %
- % - an rval to execute as a test if the builtin is semidet; and
- %
- % - an rval to assign to a variable if the builtin calls for this.
- %
- % At least one of these will be present.
- %
- % Each test rval returned is guaranteed to be either a unop or a binop,
- % applied to arguments that are either variables (from the argument
- % list) or constants.
- %
- % Each to be assigned rval is guaranteed to be either in a form
- % acceptable for a test rval, or in the form of a variable.
-
-:- pred code_util__translate_builtin(module_name, string, proc_id,
- list(prog_var), maybe(rval), maybe(pair(prog_var, rval))).
-:- mode code_util__translate_builtin(in, in, in, in, out, out) is semidet.
-
% Find out how a function symbol (constructor) is represented
% in the given type.
@@ -358,226 +336,32 @@
code_util__predinfo_is_builtin(PredInfo) :-
pred_info_module(PredInfo, ModuleName),
pred_info_name(PredInfo, PredName),
-% code_util__translate_builtin(ModuleName, PredName, _, _, _, _).
pred_info_arity(PredInfo, Arity),
- ProcId = 0,
- code_util__inline_builtin(ModuleName, PredName, ProcId, Arity).
+ hlds_pred__initial_proc_id(ProcId),
+ code_util__is_inline_builtin(ModuleName, PredName, ProcId, Arity).
-code_util__builtin_state(ModuleInfo, PredId0, ProcId, BuiltinState) :-
- predicate_module(ModuleInfo, PredId0, ModuleName),
- predicate_name(ModuleInfo, PredId0, PredName),
- predicate_arity(ModuleInfo, PredId0, Arity),
- proc_id_to_int(ProcId, ProcInt),
- ( code_util__inline_builtin(ModuleName, PredName, ProcInt, Arity) ->
+code_util__builtin_state(ModuleInfo, PredId, ProcId, BuiltinState) :-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_module(PredInfo, ModuleName),
+ pred_info_name(PredInfo, PredName),
+ pred_info_arity(PredInfo, Arity),
+ ( code_util__is_inline_builtin(ModuleName, PredName, ProcId, Arity) ->
BuiltinState = inline_builtin
;
BuiltinState = not_builtin
).
-:- pred code_util__inline_builtin(module_name, string, int, int).
-:- mode code_util__inline_builtin(in, in, in, in) is semidet.
+:- pred code_util__is_inline_builtin(module_name, string, proc_id, arity).
+:- mode code_util__is_inline_builtin(in, in, in, in) is semidet.
-code_util__inline_builtin(FullyQualifiedModule, PredName, ProcId, Arity) :-
+code_util__is_inline_builtin(ModuleName, PredName, ProcId, Arity) :-
Arity =< 3,
- varset__init(VarSet),
+ prog_varset_init(VarSet),
varset__new_vars(VarSet, Arity, Args, _),
- % --- not yet:
- % FullyQualifiedModule = qualified(unqualified("std"), ModuleName),
- FullyQualifiedModule = unqualified(ModuleName),
- code_util__translate_builtin_2(ModuleName, PredName, ProcId, Args,
- _, _).
-
-code_util__translate_builtin(FullyQualifiedModule, PredName, ProcId, Args,
- BinOp, AsgOp) :-
- proc_id_to_int(ProcId, ProcInt),
- % -- not yet:
- % FullyQualifiedModule = qualified(unqualified("std"), ModuleName),
- FullyQualifiedModule = unqualified(ModuleName),
- code_util__translate_builtin_2(ModuleName, PredName, ProcInt, Args,
- BinOp, AsgOp).
-
-:- pred code_util__translate_builtin_2(string, string, int, list(prog_var),
- maybe(rval), maybe(pair(prog_var, rval))).
-:- mode code_util__translate_builtin_2(in, in, in, in, out, out) is semidet.
-
-% WARNING: any changes here will probably require similar changes
-% in ml_code_gen:ml_translate_builtin_2 and vice versa.
-
-code_util__translate_builtin_2("private_builtin", "unsafe_type_cast", 0,
- [X, Y], no, yes(Y - var(X))).
-code_util__translate_builtin_2("builtin", "unsafe_promise_unique", 0,
- [X, Y], no, yes(Y - var(X))).
-
-code_util__translate_builtin_2("private_builtin", "builtin_int_gt", 0, [X, Y],
- yes(binop((>), var(X), var(Y))), no).
-code_util__translate_builtin_2("private_builtin", "builtin_int_lt", 0, [X, Y],
- yes(binop((<), var(X), var(Y))), no).
-
-code_util__translate_builtin_2("int", "builtin_plus", 0, [X, Y, Z],
- no, yes(Z - binop((+), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_plus", 1, [X, Y, Z],
- no, yes(X - binop((-), var(Z), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_plus", 2, [X, Y, Z],
- no, yes(Y - binop((-), var(Z), var(X)))).
-code_util__translate_builtin_2("int", "+", 0, [X, Y, Z],
- no, yes(Z - binop((+), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "+", 1, [X, Y, Z],
- no, yes(X - binop((-), var(Z), var(Y)))).
-code_util__translate_builtin_2("int", "+", 2, [X, Y, Z],
- no, yes(Y - binop((-), var(Z), var(X)))).
-code_util__translate_builtin_2("int", "builtin_minus", 0, [X, Y, Z],
- no, yes(Z - binop((-), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_minus", 1, [X, Y, Z],
- no, yes(X - binop((+), var(Y), var(Z)))).
-code_util__translate_builtin_2("int", "builtin_minus", 2, [X, Y, Z],
- no, yes(Y - binop((-), var(X), var(Z)))).
-code_util__translate_builtin_2("int", "-", 0, [X, Y, Z],
- no, yes(Z - binop((-), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "-", 1, [X, Y, Z],
- no, yes(X - binop((+), var(Y), var(Z)))).
-code_util__translate_builtin_2("int", "-", 2, [X, Y, Z],
- no, yes(Y - binop((-), var(X), var(Z)))).
-code_util__translate_builtin_2("int", "builtin_times", 0, [X, Y, Z],
- no, yes(Z - binop((*), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_times", 1, [X, Y, Z],
- no, yes(X - binop((/), var(Z), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_times", 2, [X, Y, Z],
- no, yes(Y - binop((/), var(Z), var(X)))).
-code_util__translate_builtin_2("int", "*", 0, [X, Y, Z],
- no, yes(Z - binop((*), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "*", 1, [X, Y, Z],
- no, yes(X - binop((/), var(Z), var(Y)))).
-code_util__translate_builtin_2("int", "*", 2, [X, Y, Z],
- no, yes(Y - binop((/), var(Z), var(X)))).
-code_util__translate_builtin_2("int", "builtin_div", 0, [X, Y, Z],
- no, yes(Z - binop((/), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_div", 1, [X, Y, Z],
- no, yes(X - binop((*), var(Y), var(Z)))).
-code_util__translate_builtin_2("int", "builtin_div", 2, [X, Y, Z],
- no, yes(Y - binop((/), var(X), var(Z)))).
-code_util__translate_builtin_2("int", "//", 0, [X, Y, Z],
- no, yes(Z - binop((/), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "//", 1, [X, Y, Z],
- no, yes(X - binop((*), var(Y), var(Z)))).
-code_util__translate_builtin_2("int", "//", 2, [X, Y, Z],
- no, yes(Y - binop((/), var(X), var(Z)))).
-code_util__translate_builtin_2("int", "builtin_mod", 0, [X, Y, Z],
- no, yes(Z - binop((mod), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "rem", 0, [X, Y, Z],
- no, yes(Z - binop((mod), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_left_shift", 0, [X, Y, Z],
- no, yes(Z - binop((<<), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "unchecked_left_shift", 0, [X, Y, Z],
- no, yes(Z - binop((<<), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_right_shift", 0, [X, Y, Z],
- no, yes(Z - binop((>>), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "unchecked_right_shift", 0, [X, Y, Z],
- no, yes(Z - binop((>>), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_bit_and", 0, [X, Y, Z],
- no, yes(Z - binop((&), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "/\\", 0, [X, Y, Z],
- no, yes(Z - binop((&), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_bit_or", 0, [X, Y, Z],
- no, yes(Z - binop(('|'), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "\\/", 0, [X, Y, Z],
- no, yes(Z - binop(('|'), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "builtin_bit_xor", 0, [X, Y, Z],
- no, yes(Z - binop((^), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "xor", 0, [X, Y, Z],
- no, yes(Z - binop((^), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "xor", 1, [X, Y, Z],
- no, yes(Y - binop((^), var(X), var(Z)))).
-code_util__translate_builtin_2("int", "xor", 2, [X, Y, Z],
- no, yes(X - binop((^), var(Y), var(Z)))).
-code_util__translate_builtin_2("int", "builtin_unary_plus", 0, [X, Y],
- no, yes(Y - var(X))).
-code_util__translate_builtin_2("int", "+", 0, [X, Y],
- no, yes(Y - var(X))).
-code_util__translate_builtin_2("int", "builtin_unary_minus", 0, [X, Y],
- no, yes(Y - binop((-), const(int_const(0)), var(X)))).
-code_util__translate_builtin_2("int", "-", 0, [X, Y],
- no, yes(Y - binop((-), const(int_const(0)), var(X)))).
-code_util__translate_builtin_2("int", "builtin_bit_neg", 0, [X, Y],
- no, yes(Y - unop(bitwise_complement, var(X)))).
-code_util__translate_builtin_2("int", "\\", 0, [X, Y],
- no, yes(Y - unop(bitwise_complement, var(X)))).
-code_util__translate_builtin_2("int", ">", 0, [X, Y],
- yes(binop((>), var(X), var(Y))), no).
-code_util__translate_builtin_2("int", "<", 0, [X, Y],
- yes(binop((<), var(X), var(Y))), no).
-code_util__translate_builtin_2("int", ">=", 0, [X, Y],
- yes(binop((>=), var(X), var(Y))), no).
-code_util__translate_builtin_2("int", "=<", 0, [X, Y],
- yes(binop((<=), var(X), var(Y))), no).
+ builtin_ops__translate_builtin(ModuleName, PredName, ProcId, Args, _).
-code_util__translate_builtin_2("float", "builtin_float_plus", 0, [X, Y, Z],
- no, yes(Z - binop(float_plus, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "builtin_float_plus", 1, [X, Y, Z],
- no, yes(X - binop(float_minus, var(Z), var(Y)))).
-code_util__translate_builtin_2("float", "builtin_float_plus", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, var(Z), var(X)))).
-code_util__translate_builtin_2("float", "+", 0, [X, Y, Z],
- no, yes(Z - binop(float_plus, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "+", 1, [X, Y, Z],
- no, yes(X - binop(float_minus, var(Z), var(Y)))).
-code_util__translate_builtin_2("float", "+", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, var(Z), var(X)))).
-code_util__translate_builtin_2("float", "builtin_float_minus", 0, [X, Y, Z],
- no, yes(Z - binop(float_minus, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "builtin_float_minus", 1, [X, Y, Z],
- no, yes(X - binop(float_plus, var(Y), var(Z)))).
-code_util__translate_builtin_2("float", "builtin_float_minus", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, var(X), var(Z)))).
-code_util__translate_builtin_2("float", "-", 0, [X, Y, Z],
- no, yes(Z - binop(float_minus, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "-", 1, [X, Y, Z],
- no, yes(X - binop(float_plus, var(Y), var(Z)))).
-code_util__translate_builtin_2("float", "-", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, var(X), var(Z)))).
-code_util__translate_builtin_2("float", "builtin_float_times", 0, [X, Y, Z],
- no, yes(Z - binop(float_times, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "builtin_float_times", 1, [X, Y, Z],
- no, yes(X - binop(float_divide, var(Z), var(Y)))).
-code_util__translate_builtin_2("float", "builtin_float_times", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, var(Z), var(X)))).
-code_util__translate_builtin_2("float", "*", 0, [X, Y, Z],
- no, yes(Z - binop(float_times, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "*", 1, [X, Y, Z],
- no, yes(X - binop(float_divide, var(Z), var(Y)))).
-code_util__translate_builtin_2("float", "*", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, var(Z), var(X)))).
-code_util__translate_builtin_2("float", "builtin_float_divide", 0, [X, Y, Z],
- no, yes(Z - binop(float_divide, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "builtin_float_divide", 1, [X, Y, Z],
- no, yes(X - binop(float_times, var(Y), var(Z)))).
-code_util__translate_builtin_2("float", "builtin_float_divide", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, var(X), var(Z)))).
-code_util__translate_builtin_2("float", "/", 0, [X, Y, Z],
- no, yes(Z - binop(float_divide, var(X), var(Y)))).
-code_util__translate_builtin_2("float", "/", 1, [X, Y, Z],
- no, yes(X - binop(float_times, var(Y), var(Z)))).
-code_util__translate_builtin_2("float", "/", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, var(X), var(Z)))).
-code_util__translate_builtin_2("float", "+", 0, [X, Y],
- no, yes(Y - var(X))).
-code_util__translate_builtin_2("float", "-", 0, [X, Y],
- no, yes(Y - binop(float_minus, const(float_const(0.0)), var(X)))).
-code_util__translate_builtin_2("float", "builtin_float_gt", 0, [X, Y],
- yes(binop(float_gt, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", ">", 0, [X, Y],
- yes(binop(float_gt, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", "builtin_float_lt", 0, [X, Y],
- yes(binop(float_lt, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", "<", 0, [X, Y],
- yes(binop(float_lt, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", "builtin_float_ge", 0, [X, Y],
- yes(binop(float_ge, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", ">=", 0, [X, Y],
- yes(binop(float_ge, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", "builtin_float_le", 0, [X, Y],
- yes(binop(float_le, var(X), var(Y))), no).
-code_util__translate_builtin_2("float", "=<", 0, [X, Y],
- yes(binop(float_le, var(X), var(Y))), no).
+:- pred prog_varset_init(prog_varset::out) is det.
+prog_varset_init(VarSet) :- varset__init(VarSet).
%-----------------------------------------------------------------------------%
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.2
diff -u -d -r1.2 ml_call_gen.m
--- compiler/ml_call_gen.m 2000/03/13 04:00:00 1.2
+++ compiler/ml_call_gen.m 2000/03/14 13:03:23
@@ -566,20 +566,19 @@
{ predicate_module(ModuleInfo, PredId, ModuleName) },
{ predicate_name(ModuleInfo, PredId, PredName) },
{
- ml_translate_builtin(ModuleName, PredName,
- ProcId, ArgLvals, MaybeTest0, MaybeAssign0)
+ builtin_ops__translate_builtin(ModuleName, PredName,
+ ProcId, ArgLvals, SimpleCode0)
->
- MaybeTest = MaybeTest0,
- MaybeAssign = MaybeAssign0
+ SimpleCode = SimpleCode0
;
error("ml_gen_builtin: unknown builtin predicate")
},
(
{ CodeModel = model_det },
(
- { MaybeTest = no },
- { MaybeAssign = yes(Lval - Rval) }
+ { SimpleCode = assign(Lval, SimpleExpr) }
->
+ { Rval = ml_gen_simple_expr(SimpleExpr) },
{ MLDS_Statement = ml_gen_assign(Lval, Rval,
Context) }
;
@@ -588,10 +587,10 @@
;
{ CodeModel = model_semi },
(
- { MaybeTest = yes(Test) },
- { MaybeAssign = no }
+ { SimpleCode = test(SimpleTest) }
->
- ml_gen_set_success(Test, Context, MLDS_Statement)
+ { TestRval = ml_gen_simple_expr(SimpleTest) },
+ ml_gen_set_success(TestRval, Context, MLDS_Statement)
;
{ error("Malformed semi builtin predicate") }
)
@@ -601,218 +600,11 @@
),
{ MLDS_Statements = [MLDS_Statement] },
{ MLDS_Decls = [] }.
-
- % Given a module name, a predicate name, a proc_id and a list of
- % the lvals for the arguments, find out if that procedure of that
- % predicate is an inline builtin. If yes, the last two arguments
- % return two things:
- %
- % - an rval to execute as a test if the builtin is semidet; or
- %
- % - an rval to assign to an lval if the builtin is det.
- %
- % Exactly one of these will be present.
- %
- % XXX this is not great interface design -
- % better to return a discriminated union than
- % returning two maybes. But I kept it this way so that
- % the code stays similar to code_util__translate_builtin.
-
-:- pred ml_translate_builtin(module_name, string, proc_id, list(mlds__lval),
- maybe(mlds__rval), maybe(pair(mlds__lval, mlds__rval))).
-:- mode ml_translate_builtin(in, in, in, in, out, out) is semidet.
-
-ml_translate_builtin(FullyQualifiedModule, PredName, ProcId, Args,
- TestOp, AssignmentOp) :-
- proc_id_to_int(ProcId, ProcInt),
- % -- not yet:
- % FullyQualifiedModule = qualified(unqualified("std"), ModuleName),
- FullyQualifiedModule = unqualified(ModuleName),
- ml_translate_builtin_2(ModuleName, PredName, ProcInt, Args,
- TestOp, AssignmentOp).
-
-:- pred ml_translate_builtin_2(string, string, int, list(mlds__lval),
- maybe(mlds__rval), maybe(pair(mlds__lval, mlds__rval))).
-:- mode ml_translate_builtin_2(in, in, in, in, out, out) is semidet.
-
-% WARNING: any changes here may need to be duplicated in
-% code_util__translate_builtin_2 and vice versa.
-
-ml_translate_builtin_2("private_builtin", "unsafe_type_cast", 0,
- [X, Y], no, yes(Y - lval(X))).
-ml_translate_builtin_2("builtin", "unsafe_promise_unique", 0,
- [X, Y], no, yes(Y - lval(X))).
-
-ml_translate_builtin_2("private_builtin", "builtin_int_gt", 0, [X, Y],
- yes(binop((>), lval(X), lval(Y))), no).
-ml_translate_builtin_2("private_builtin", "builtin_int_lt", 0, [X, Y],
- yes(binop((<), lval(X), lval(Y))), no).
-
-ml_translate_builtin_2("int", "builtin_plus", 0, [X, Y, Z],
- no, yes(Z - binop((+), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_plus", 1, [X, Y, Z],
- no, yes(X - binop((-), lval(Z), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_plus", 2, [X, Y, Z],
- no, yes(Y - binop((-), lval(Z), lval(X)))).
-ml_translate_builtin_2("int", "+", 0, [X, Y, Z],
- no, yes(Z - binop((+), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "+", 1, [X, Y, Z],
- no, yes(X - binop((-), lval(Z), lval(Y)))).
-ml_translate_builtin_2("int", "+", 2, [X, Y, Z],
- no, yes(Y - binop((-), lval(Z), lval(X)))).
-ml_translate_builtin_2("int", "builtin_minus", 0, [X, Y, Z],
- no, yes(Z - binop((-), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_minus", 1, [X, Y, Z],
- no, yes(X - binop((+), lval(Y), lval(Z)))).
-ml_translate_builtin_2("int", "builtin_minus", 2, [X, Y, Z],
- no, yes(Y - binop((-), lval(X), lval(Z)))).
-ml_translate_builtin_2("int", "-", 0, [X, Y, Z],
- no, yes(Z - binop((-), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "-", 1, [X, Y, Z],
- no, yes(X - binop((+), lval(Y), lval(Z)))).
-ml_translate_builtin_2("int", "-", 2, [X, Y, Z],
- no, yes(Y - binop((-), lval(X), lval(Z)))).
-ml_translate_builtin_2("int", "builtin_times", 0, [X, Y, Z],
- no, yes(Z - binop((*), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_times", 1, [X, Y, Z],
- no, yes(X - binop((/), lval(Z), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_times", 2, [X, Y, Z],
- no, yes(Y - binop((/), lval(Z), lval(X)))).
-ml_translate_builtin_2("int", "*", 0, [X, Y, Z],
- no, yes(Z - binop((*), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "*", 1, [X, Y, Z],
- no, yes(X - binop((/), lval(Z), lval(Y)))).
-ml_translate_builtin_2("int", "*", 2, [X, Y, Z],
- no, yes(Y - binop((/), lval(Z), lval(X)))).
-ml_translate_builtin_2("int", "builtin_div", 0, [X, Y, Z],
- no, yes(Z - binop((/), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_div", 1, [X, Y, Z],
- no, yes(X - binop((*), lval(Y), lval(Z)))).
-ml_translate_builtin_2("int", "builtin_div", 2, [X, Y, Z],
- no, yes(Y - binop((/), lval(X), lval(Z)))).
-ml_translate_builtin_2("int", "//", 0, [X, Y, Z],
- no, yes(Z - binop((/), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "//", 1, [X, Y, Z],
- no, yes(X - binop((*), lval(Y), lval(Z)))).
-ml_translate_builtin_2("int", "//", 2, [X, Y, Z],
- no, yes(Y - binop((/), lval(X), lval(Z)))).
-ml_translate_builtin_2("int", "builtin_mod", 0, [X, Y, Z],
- no, yes(Z - binop((mod), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "rem", 0, [X, Y, Z],
- no, yes(Z - binop((mod), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_left_shift", 0, [X, Y, Z],
- no, yes(Z - binop((<<), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "unchecked_left_shift", 0, [X, Y, Z],
- no, yes(Z - binop((<<), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_right_shift", 0, [X, Y, Z],
- no, yes(Z - binop((>>), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "unchecked_right_shift", 0, [X, Y, Z],
- no, yes(Z - binop((>>), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_bit_and", 0, [X, Y, Z],
- no, yes(Z - binop((&), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "/\\", 0, [X, Y, Z],
- no, yes(Z - binop((&), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_bit_or", 0, [X, Y, Z],
- no, yes(Z - binop(('|'), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "\\/", 0, [X, Y, Z],
- no, yes(Z - binop(('|'), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "builtin_bit_xor", 0, [X, Y, Z],
- no, yes(Z - binop((^), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "^", 0, [X, Y, Z],
- no, yes(Z - binop((^), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "xor", 0, [X, Y, Z],
- no, yes(Z - binop((^), lval(X), lval(Y)))).
-ml_translate_builtin_2("int", "xor", 1, [X, Y, Z],
- no, yes(Y - binop((^), lval(X), lval(Z)))).
-ml_translate_builtin_2("int", "xor", 2, [X, Y, Z],
- no, yes(X - binop((^), lval(Y), lval(Z)))).
-ml_translate_builtin_2("int", "builtin_unary_plus", 0, [X, Y],
- no, yes(Y - lval(X))).
-ml_translate_builtin_2("int", "+", 0, [X, Y],
- no, yes(Y - lval(X))).
-ml_translate_builtin_2("int", "builtin_unary_minus", 0, [X, Y],
- no, yes(Y - binop((-), const(int_const(0)), lval(X)))).
-ml_translate_builtin_2("int", "-", 0, [X, Y],
- no, yes(Y - binop((-), const(int_const(0)), lval(X)))).
-ml_translate_builtin_2("int", "builtin_bit_neg", 0, [X, Y],
- no, yes(Y - unop(std_unop(bitwise_complement), lval(X)))).
-ml_translate_builtin_2("int", "\\", 0, [X, Y],
- no, yes(Y - unop(std_unop(bitwise_complement), lval(X)))).
-ml_translate_builtin_2("int", ">", 0, [X, Y],
- yes(binop((>), lval(X), lval(Y))), no).
-ml_translate_builtin_2("int", "<", 0, [X, Y],
- yes(binop((<), lval(X), lval(Y))), no).
-ml_translate_builtin_2("int", ">=", 0, [X, Y],
- yes(binop((>=), lval(X), lval(Y))), no).
-ml_translate_builtin_2("int", "=<", 0, [X, Y],
- yes(binop((<=), lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", "builtin_float_plus", 0, [X, Y, Z],
- no, yes(Z - binop(float_plus, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "builtin_float_plus", 1, [X, Y, Z],
- no, yes(X - binop(float_minus, lval(Z), lval(Y)))).
-ml_translate_builtin_2("float", "builtin_float_plus", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, lval(Z), lval(X)))).
-ml_translate_builtin_2("float", "+", 0, [X, Y, Z],
- no, yes(Z - binop(float_plus, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "+", 1, [X, Y, Z],
- no, yes(X - binop(float_minus, lval(Z), lval(Y)))).
-ml_translate_builtin_2("float", "+", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, lval(Z), lval(X)))).
-ml_translate_builtin_2("float", "builtin_float_minus", 0, [X, Y, Z],
- no, yes(Z - binop(float_minus, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "builtin_float_minus", 1, [X, Y, Z],
- no, yes(X - binop(float_plus, lval(Y), lval(Z)))).
-ml_translate_builtin_2("float", "builtin_float_minus", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, lval(X), lval(Z)))).
-ml_translate_builtin_2("float", "-", 0, [X, Y, Z],
- no, yes(Z - binop(float_minus, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "-", 1, [X, Y, Z],
- no, yes(X - binop(float_plus, lval(Y), lval(Z)))).
-ml_translate_builtin_2("float", "-", 2, [X, Y, Z],
- no, yes(Y - binop(float_minus, lval(X), lval(Z)))).
-ml_translate_builtin_2("float", "builtin_float_times", 0, [X, Y, Z],
- no, yes(Z - binop(float_times, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "builtin_float_times", 1, [X, Y, Z],
- no, yes(X - binop(float_divide, lval(Z), lval(Y)))).
-ml_translate_builtin_2("float", "builtin_float_times", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, lval(Z), lval(X)))).
-ml_translate_builtin_2("float", "*", 0, [X, Y, Z],
- no, yes(Z - binop(float_times, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "*", 1, [X, Y, Z],
- no, yes(X - binop(float_divide, lval(Z), lval(Y)))).
-ml_translate_builtin_2("float", "*", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, lval(Z), lval(X)))).
-ml_translate_builtin_2("float", "builtin_float_divide", 0, [X, Y, Z],
- no, yes(Z - binop(float_divide, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "builtin_float_divide", 1, [X, Y, Z],
- no, yes(X - binop(float_times, lval(Y), lval(Z)))).
-ml_translate_builtin_2("float", "builtin_float_divide", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, lval(X), lval(Z)))).
-ml_translate_builtin_2("float", "/", 0, [X, Y, Z],
- no, yes(Z - binop(float_divide, lval(X), lval(Y)))).
-ml_translate_builtin_2("float", "/", 1, [X, Y, Z],
- no, yes(X - binop(float_times, lval(Y), lval(Z)))).
-ml_translate_builtin_2("float", "/", 2, [X, Y, Z],
- no, yes(Y - binop(float_divide, lval(X), lval(Z)))).
-ml_translate_builtin_2("float", "+", 0, [X, Y],
- no, yes(Y - lval(X))).
-ml_translate_builtin_2("float", "-", 0, [X, Y],
- no, yes(Y - binop(float_minus, const(float_const(0.0)), lval(X)))).
-ml_translate_builtin_2("float", "builtin_float_gt", 0, [X, Y],
- yes(binop(float_gt, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", ">", 0, [X, Y],
- yes(binop(float_gt, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", "builtin_float_lt", 0, [X, Y],
- yes(binop(float_lt, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", "<", 0, [X, Y],
- yes(binop(float_lt, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", "builtin_float_ge", 0, [X, Y],
- yes(binop(float_ge, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", ">=", 0, [X, Y],
- yes(binop(float_ge, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", "builtin_float_le", 0, [X, Y],
- yes(binop(float_le, lval(X), lval(Y))), no).
-ml_translate_builtin_2("float", "=<", 0, [X, Y],
- yes(binop(float_le, lval(X), lval(Y))), no).
-
+:- func ml_gen_simple_expr(simple_expr(mlds__lval)) = mlds__rval.
+ml_gen_simple_expr(leaf(Lval)) = lval(Lval).
+ml_gen_simple_expr(int_const(Int)) = const(int_const(Int)).
+ml_gen_simple_expr(float_const(Float)) = const(float_const(Float)).
+ml_gen_simple_expr(unary(Op, Expr)) = unop(std_unop(Op), ml_gen_simple_expr(Expr)).
+ml_gen_simple_expr(binary(Op, Expr1, Expr2)) =
+ binop(Op, ml_gen_simple_expr(Expr1), ml_gen_simple_expr(Expr2)).
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.13
diff -u -d -r1.13 rl_exprn.m
--- compiler/rl_exprn.m 2000/02/22 02:55:31 1.13
+++ compiler/rl_exprn.m 2000/03/14 15:25:15
@@ -113,11 +113,7 @@
:- import_module code_util, hlds_pred, hlds_data, inst_match.
:- import_module instmap, mode_util, tree, type_util, prog_out.
:- import_module rl_out, inlining, hlds_goal, prog_util, error_util.
-
-% Note: the reason that we need to import llds and builtin_ops here is that
-% we generate code for builtins by first converting the builtin to LLDS
-% and then converting the LLDS to RL.
-:- import_module llds, builtin_ops.
+:- import_module builtin_ops.
:- import_module assoc_list, bool, char, int, map.
:- import_module require, set, std_util, string, term, varset.
@@ -1443,11 +1439,12 @@
% Generate LLDS for the builtin, then convert that to Aditi bytecode.
%
(
- { code_util__translate_builtin(PredModule0, PredName,
- ProcId, Args, MaybeTest, MaybeAsg) }
+ { builtin_ops__translate_builtin(PredModule0, PredName,
+ ProcId, Args, SimpleCode) }
->
- ( { MaybeTest = yes(TestRval) } ->
- ( rl_exprn__llds_rval_to_rl_rval(TestRval, RvalCode) ->
+ (
+ { SimpleCode = test(TestExpr) },
+ ( rl_exprn__simple_expr_to_rl_rval(TestExpr, RvalCode) ->
rl_exprn_info_get_next_label_id(SuccLabel),
{ Code =
tree(RvalCode,
@@ -1458,16 +1455,15 @@
;
{ error("rl_exprn__generate_exprn_instr: invalid test") }
)
- ; { MaybeAsg = yes(OutputVar - AsgRval) } ->
+ ;
+ { SimpleCode = assign(OutputVar, AssignExpr) },
rl_exprn_info_lookup_var(OutputVar, OutputLoc),
rl_exprn_info_lookup_var_type(OutputVar, Type),
{ rl_exprn__type_to_aditi_type(Type, AditiType) },
- rl_exprn__maybe_llds_rval_to_rl_rval(yes(AsgRval),
+ rl_exprn__maybe_simple_expr_to_rl_rval(yes(AssignExpr),
AditiType, RvalCode),
rl_exprn__generate_pop(reg(OutputLoc), Type, PopCode),
{ Code = tree(RvalCode, PopCode) }
- ;
- { error("rl_exprn__builtin_call: invalid builtin result") }
)
;
{ prog_out__sym_name_to_string(PredModule0, PredModule) },
@@ -1477,52 +1473,37 @@
{ error(Msg) }
).
-:- pred rl_exprn__maybe_llds_rval_to_rl_rval(maybe(rval)::in,
+:- pred rl_exprn__maybe_simple_expr_to_rl_rval(maybe(simple_expr(prog_var))::in,
aditi_type::in, byte_tree::out,
rl_exprn_info::in, rl_exprn_info::out) is det.
-rl_exprn__maybe_llds_rval_to_rl_rval(no, _, empty) --> [].
-rl_exprn__maybe_llds_rval_to_rl_rval(yes(LLDSRval), _ResultType, Code) -->
- ( rl_exprn__llds_rval_to_rl_rval(LLDSRval, RvalCode) ->
+rl_exprn__maybe_simple_expr_to_rl_rval(no, _, empty) --> [].
+rl_exprn__maybe_simple_expr_to_rl_rval(yes(LLDSRval), _ResultType, Code) -->
+ ( rl_exprn__simple_expr_to_rl_rval(LLDSRval, RvalCode) ->
{ Code = RvalCode }
;
- { error("rl_exprn__maybe_llds_rval_to_rl_rval: invalid llds rval") }
+ { error("rl_exprn__maybe_simple_expr_to_rl_rval: invalid llds rval") }
).
-:- pred rl_exprn__llds_rval_to_rl_rval(rval::in, byte_tree::out,
+:- pred rl_exprn__simple_expr_to_rl_rval(simple_expr(prog_var)::in, byte_tree::out,
rl_exprn_info::in, rl_exprn_info::out) is semidet.
-rl_exprn__llds_rval_to_rl_rval(var(Var), Code) -->
+rl_exprn__simple_expr_to_rl_rval(leaf(Var), Code) -->
rl_exprn_info_lookup_var(Var, VarLoc),
rl_exprn_info_lookup_var_type(Var, Type),
rl_exprn__generate_push(reg(VarLoc), Type, Code).
-rl_exprn__llds_rval_to_rl_rval(const(RvalConst), PushCode) -->
- {
- RvalConst = true,
- Const = int(1),
- Type = int
- ;
- RvalConst = false,
- Const = int(0),
- Type = int
- ;
- RvalConst = int_const(Int),
- Const = int(Int),
- Type = int
- ;
- RvalConst = float_const(Float),
- Const = float(Float),
- Type = float
- ;
- RvalConst = string_const(String),
- Const = string(String),
- Type = string
- },
- { rl_exprn__aditi_type_to_type(Type, Type1) },
- rl_exprn__generate_push(const(Const), Type1, PushCode).
-rl_exprn__llds_rval_to_rl_rval(binop(BinOp, Rval1, Rval2), Code) -->
- rl_exprn__llds_rval_to_rl_rval(Rval1, Code1),
- rl_exprn__llds_rval_to_rl_rval(Rval2, Code2),
+rl_exprn__simple_expr_to_rl_rval(int_const(Int), PushCode) -->
+ { rl_exprn__aditi_type_to_type(int, Type1) },
+ rl_exprn__generate_push(const(int(Int)), Type1, PushCode).
+rl_exprn__simple_expr_to_rl_rval(float_const(Float), PushCode) -->
+ { rl_exprn__aditi_type_to_type(float, Type1) },
+ rl_exprn__generate_push(const(float(Float)), Type1, PushCode).
+rl_exprn__simple_expr_to_rl_rval(unary(_UnOp, _Expr), _Code) -->
+ % XXX is this correct?
+ { fail }.
+rl_exprn__simple_expr_to_rl_rval(binary(BinOp, Expr1, Expr2), Code) -->
+ rl_exprn__simple_expr_to_rl_rval(Expr1, Code1),
+ rl_exprn__simple_expr_to_rl_rval(Expr2, Code2),
{ rl_exprn__binop_bytecode(BinOp, Bytecode) },
{ Code =
tree(Code1,
--
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