[m-rev.] dynamic_cast optimizations

[Fergus Henderson]

Estimated hours taken: 4
Branches: main

Do constant propagation for calls to private_builtin.typed_unify and
std_util.dynamic_cast, i.e. evaluate them at compile time if the types
are known, and optimize the implementation of dynamic_cast.

Also clean up the code in const_prop.m.

library/std_util.m:
	Implement dynamic_cast more efficiently, using typed_unify(X, Y)
	rather than univ_to_type(univ(X), Y).  This avoids allocating a
	cell on the heap.

compiler/const_prop.m:
	Keep track of the types of the arguments.

	Add new code for evaluating semidet calls with one output,
	and use this to evaluate calls to dynamic_cast and typed_unify.

	Rename evaluate_builtin to evaluate_call, since it may evaluate
	any standard library procedure, not just those which are builtin
	(in the sense of pred_info_is_builtin).  Likewise for its subroutines.

	Various other clean-ups, e.g. combine evaluate_builtin_bi and
	evaluate_builtin_tri into a single predicate evaluate_det_call,
	delete unused arguments, reorder arguments so that inputs precede
	outputs, use combined pred-mode declarations, and add some comments.

compiler/simplify.m:
	Update to reflect the new interface to const_prop.m.

tests/hard_coded/constant_prop_2.m:
tests/hard_coded/constant_prop_2.exp:
	Test that we do constant propagation for calls to typed_unify
	and dynamic_cast.

Workspace: /home/jupiter/fjh/ws-jupiter/mercury
Index: compiler/const_prop.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/const_prop.m,v
retrieving revision 1.21
diff -u -d -r1.21 const_prop.m
--- compiler/const_prop.m	12 Jan 2004 05:56:21 -0000	1.21
+++ compiler/const_prop.m	13 Feb 2004 01:45:37 -0000
@@ -7,10 +7,14 @@
 % file: const_prop.m
 % main author: conway.
 %
-% This module provides the facility to evaluate calls at compile time -
-% transforming them to simpler goals such as construction unifications.
+% This module provides the facility to evaluate calls to standard library
+% routines at compile time, transforming them to simpler goals such as
+% construction unifications.
 %
-% XXX We should check for overflow.
+% XXX We should check for overflow.  This is particularly important when
+% cross-compiling, since the overflow behaviour of the host machine might
+% not be the same as that of the target machine, e.g. if they have different
+% word sizes.
 % 
 %------------------------------------------------------------------------------%
 
@@ -22,10 +26,18 @@
 :- import_module parse_tree__prog_data, hlds__instmap.
 :- import_module list.
 
-:- pred evaluate_builtin(pred_id, proc_id, list(prog_var), hlds_goal_info,
-		hlds_goal_expr, hlds_goal_info, instmap,
-		module_info, module_info).
-:- mode evaluate_builtin(in, in, in, in, out, out, in, in, out) is semidet.
+	% evaluate_call(PredId, ProcId, Args, GoalInfo0,
+	%	GoalExpr, GoalInfo, VarTypes, Instmap, !ModuleInfo):
+	%
+	% This attempts to evaluate a call to the specified procedure
+	% with the specified arguments.  If the call can be statically
+	% evaluated, evaluate_builtin will succeed, returning the new
+	% goal in GoalExpr (and the new GoalInfo).
+	% Otherwise it fails.
+
+:- pred evaluate_call(pred_id::in, proc_id::in, list(prog_var)::in,
+		hlds_goal_info::in, vartypes::in, instmap::in, module_info::in,
+		hlds_goal_expr::out, hlds_goal_info::out) is semidet.
 
 %------------------------------------------------------------------------------%
 
@@ -56,290 +68,313 @@
 
 %------------------------------------------------------------------------------%
 
-evaluate_builtin(PredId, ProcId, Args, GoalInfo0, Goal, GoalInfo,
-		InstMap, ModuleInfo0, ModuleInfo) :-
-	predicate_module(ModuleInfo0, PredId, ModuleName),
-	predicate_name(ModuleInfo0, PredId, PredName),
+	% This type groups the information from the HLDS
+	% about a procedure call argument.
+:- type arg_hlds_info
+	---> arg_hlds_info(
+		arg_var		:: prog_var,
+		arg_type	:: prog_data__type,
+		arg_inst	:: (inst)
+	).
+
+evaluate_call(PredId, ProcId, Args, GoalInfo0, VarTypes, InstMap, ModuleInfo,
+		Goal, GoalInfo) :-
+	predicate_module(ModuleInfo, PredId, ModuleName),
+	predicate_name(ModuleInfo, PredId, PredName),
 	proc_id_to_int(ProcId, ProcInt),
-	LookupVarInsts = (pred(V::in, J::out) is det :-
-		instmap__lookup_var(InstMap, V, VInst),
-		J = V - VInst
+	LookupArgs = (func(Var) = arg_hlds_info(Var, Type, Inst) :-
+		instmap__lookup_var(InstMap, Var, Inst),
+		Type = VarTypes ^ det_elem(Var)
 	),
-	list__map(LookupVarInsts, Args, ArgInsts),
-	evaluate_builtin_2(ModuleName, PredName, ProcInt, ArgInsts, GoalInfo0,
-		Goal, GoalInfo, ModuleInfo0, ModuleInfo).
+	ArgHldsInfos = list__map(LookupArgs, Args),
+	evaluate_call_2(ModuleName, PredName, ProcInt, ArgHldsInfos,
+		GoalInfo0, Goal, GoalInfo).
 
-:- pred evaluate_builtin_2(module_name, string, int,
-		list(pair(prog_var, (inst))), hlds_goal_info, hlds_goal_expr,
-		hlds_goal_info, module_info, module_info).
-:- mode evaluate_builtin_2(in, in, in, in, in, out, out, in, out) is semidet.
+:- pred evaluate_call_2(module_name::in, string::in, int::in,
+	list(arg_hlds_info)::in, hlds_goal_info::in,
+	hlds_goal_expr::out, hlds_goal_info::out) is semidet.
 
 	% Module_info is not actually used at the moment.
 
-evaluate_builtin_2(Module, Pred, ModeNum, Args, GoalInfo0, Goal, GoalInfo,
-		ModuleInfo, ModuleInfo) :-
+evaluate_call_2(Module, Pred, ModeNum, Args, GoalInfo0, Goal, GoalInfo) :-
 	% -- not yet:
 	% Module = qualified(unqualified("std"), Mod),
 	Module = unqualified(Mod),
 	(
-		Args = [X, Y],
-		evaluate_builtin_bi(Mod, Pred, ModeNum, X, Y, W, Cons)
+		evaluate_det_call(Mod, Pred, ModeNum, Args, OutputArg, Cons)
 	->
-		make_construction(W, Cons, Goal),
-		goal_info_get_instmap_delta(GoalInfo0, Delta0),
-		W = Var - _WInst,
-		instmap_delta_set(Delta0, Var,
-			bound(unique, [functor(Cons, [])]), Delta),
-		goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo)
+		make_construction_goal(OutputArg, Cons, GoalInfo0,
+			Goal, GoalInfo)
 	;
-		Args = [X, Y, Z],
-		evaluate_builtin_tri(Mod, Pred, ModeNum, X, Y, Z, W, Cons)
+		evaluate_test(Mod, Pred, ModeNum, Args, Succeeded)
 	->
-		make_construction(W, Cons, Goal),
-		goal_info_get_instmap_delta(GoalInfo0, Delta0),
-		W = Var - _WInst,
-		instmap_delta_set(Delta0, Var,
-			bound(unique, [functor(Cons, [])]), Delta),
-		goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo)
+		make_true_or_fail(Succeeded, GoalInfo0, Goal, GoalInfo)
 	;
-		evaluate_builtin_test(Mod, Pred, ModeNum, Args, Result)
+		evaluate_semidet_call(Mod, Pred, ModeNum, Args, Result)
 	->
-		make_true_or_fail(Result, GoalInfo0, Goal, GoalInfo)
+		(
+			Result = yes(OutputArg - const(Cons)),
+			make_construction_goal(OutputArg, Cons, GoalInfo0,
+				Goal, GoalInfo)
+		;
+			Result = yes(OutputArg - var(InputArg)),
+			make_assignment_goal(OutputArg, InputArg, GoalInfo0,
+				Goal, GoalInfo)
+		;
+			Result = no,
+			make_true_or_fail(no, GoalInfo0, Goal, GoalInfo)
+		)
 	;
 		fail
 	).
 
 %------------------------------------------------------------------------------%
 
-:- pred evaluate_builtin_bi(string, string, int,
-		pair(prog_var, (inst)), pair(prog_var, (inst)), 
-		pair(prog_var, (inst)), cons_id).
-:- mode evaluate_builtin_bi(in, in, in, in, in, out, out) is semidet.
+	% evaluate_det_call(ModuleName, ProcName, ModeNum,
+	%	Args, OutputArg, OutputArgVal):
+	%
+	% This attempts to evaluate a call to
+	%	ModuleName.ProcName(Args)
+	% whose mode is specified by ModeNum.
+	% If the call is a det call with one output that can be
+	% statically evaluated, evaluate_det_call succeeds with
+	% OutputArg being whichever of Args is output,
+	% and with OutputArgVal being the computed value of OutputArg.
+	% Otherwise it fails.
+
+:- pred evaluate_det_call(string::in, string::in, int::in,
+		list(arg_hlds_info)::in, arg_hlds_info::out, cons_id::out)
+		is semidet.
+
+%
+% Unary operators
+%
 
 	% Integer arithmetic
 
-evaluate_builtin_bi("int", "+", 0, X, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	ZVal = XVal.
+evaluate_det_call("int", "+", 0, [X, Y], Y, int_const(YVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	YVal = XVal.
 
-evaluate_builtin_bi("int", "-", 0, X, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	ZVal = -XVal.
+evaluate_det_call("int", "-", 0, [X, Y], Y, int_const(YVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	YVal = -XVal.
 
-evaluate_builtin_bi("int", "\\", 0, X, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	ZVal = \ XVal.
+evaluate_det_call("int", "\\", 0, [X, Y], Y, int_const(YVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	YVal = \ XVal.
 
 	% Floating point arithmetic
 
-evaluate_builtin_bi("float", "+", 0, X, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	ZVal = XVal.
-
-evaluate_builtin_bi("float", "-", 0, X, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	ZVal = -XVal.
+evaluate_det_call("float", "+", 0, [X, Y], Y, int_const(YVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	YVal = XVal.
 
-%------------------------------------------------------------------------------%
+evaluate_det_call("float", "-", 0, [X, Y], Y, int_const(YVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	YVal = -XVal.
 
-:- pred evaluate_builtin_tri(string, string, int,
-		pair(prog_var, (inst)), pair(prog_var, (inst)),
-		pair(prog_var, (inst)), pair(prog_var, (inst)), cons_id).
-:- mode evaluate_builtin_tri(in, in, in, in, in, in, out, out) is semidet.
+%
+% Binary operators
+%
 
-	%
 	% Integer arithmetic
-	%
-evaluate_builtin_tri("int", "+", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+
+evaluate_det_call("int", "+", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal + YVal.
-evaluate_builtin_tri("int", "+", 1, X, Y, Z, X, int_const(XVal)) :-
-	Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "+", 1, [X, Y, Z], X, int_const(XVal)) :-
+	Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	XVal = ZVal - YVal.
-evaluate_builtin_tri("int", "+", 2, X, Y, Z, Y, int_const(YVal)) :-
-	Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
+evaluate_det_call("int", "+", 2, [X, Y, Z], Y, int_const(YVal)) :-
+	Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
 	YVal = ZVal - XVal.
 
-evaluate_builtin_tri("int", "-", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "-", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal - YVal.
-evaluate_builtin_tri("int", "-", 1, X, Y, Z, X, int_const(XVal)) :-
-	Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "-", 1, [X, Y, Z], X, int_const(XVal)) :-
+	Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	XVal = YVal + ZVal.
-evaluate_builtin_tri("int", "-", 2, X, Y, Z, Y, int_const(YVal)) :-
-	Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
+evaluate_det_call("int", "-", 2, [X, Y, Z], Y, int_const(YVal)) :-
+	Z ^ arg_inst = bound(_ZUniq, [functor(int_const(ZVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
 	YVal = XVal - ZVal.
 
-evaluate_builtin_tri("int", "*", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "*", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal * YVal.
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("int", "//", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "//", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	YVal \= 0,
 	ZVal = XVal // YVal.
 
-evaluate_builtin_tri("int", "unchecked_quotient", 0, X, Y, Z, Z,
+evaluate_det_call("int", "unchecked_quotient", 0, [X, Y, Z], Z,
 		int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	YVal \= 0,
 	ZVal = unchecked_quotient(XVal, YVal).
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("int", "mod", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "mod", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	YVal \= 0,
 	ZVal = XVal mod YVal.
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("int", "rem", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "rem", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	YVal \= 0,
 	ZVal = XVal rem YVal.
 
-evaluate_builtin_tri("int", "unchecked_rem", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "unchecked_rem", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	YVal \= 0,
 	ZVal = unchecked_rem(XVal, YVal).
 
-evaluate_builtin_tri("int", "unchecked_left_shift",
-		0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "unchecked_left_shift",
+		0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = unchecked_left_shift(XVal, YVal).
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("int", "<<", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "<<", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal << YVal.
 
-evaluate_builtin_tri("int", "unchecked_right_shift",
-		0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "unchecked_right_shift",
+		0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = unchecked_right_shift(XVal, YVal).
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("int", ">>", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", ">>", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal >> YVal.
 
-evaluate_builtin_tri("int", "/\\", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "/\\", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal /\ YVal.
 
-evaluate_builtin_tri("int", "\\/", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "\\/", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal \/ YVal.
 
-evaluate_builtin_tri("int", "xor", 0, X, Y, Z, Z, int_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+evaluate_det_call("int", "xor", 0, [X, Y, Z], Z, int_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	ZVal = XVal `xor` YVal.
 
-	%
 	% float arithmetic
-	%
 
-evaluate_builtin_tri("float", "+", 0, X, Y, Z, Z, float_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+evaluate_det_call("float", "+", 0, [X, Y, Z], Z, float_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	ZVal = XVal + YVal.
 
-evaluate_builtin_tri("float", "-", 0, X, Y, Z, Z, float_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+evaluate_det_call("float", "-", 0, [X, Y, Z], Z, float_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	ZVal = XVal - YVal.
 
-evaluate_builtin_tri("float", "*", 0, X, Y, Z, Z, float_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+evaluate_det_call("float", "*", 0, [X, Y, Z], Z, float_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	ZVal = XVal * YVal.
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("float", "/", 0, X, Y, Z, Z, float_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+evaluate_det_call("float", "/", 0, [X, Y, Z], Z, float_const(ZVal)) :-
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	YVal \= 0.0,
 	ZVal = XVal / YVal.
 
-evaluate_builtin_tri("float", "unchecked_quotient", 0, X, Y, Z, Z,
+evaluate_det_call("float", "unchecked_quotient", 0, [X, Y, Z], Z,
 		float_const(ZVal)) :-
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	YVal \= 0.0,
 	ZVal = unchecked_quotient(XVal, YVal).
 
-	% This isn't actually a builtin.
-evaluate_builtin_tri("string", Name, _, X, Y, Z, Z, string_const(ZVal)) :-
+	% string operations
+
+evaluate_det_call("string", Name, _, [X, Y, Z], Z, string_const(ZVal)) :-
 	( Name = "++"
 	; Name = "append"
 	),
-	X = _XVar - bound(_XUniq, [functor(string_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(string_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(string_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(string_const(YVal), [])]),
 
 		% We can only do the append if Z is free (this allows
 		% us to ignore the mode number and pick up both the
 		% predicate and function versions of append)
-	Z = _ZVar - free,
+	Z ^ arg_inst = free,
 	ZVal = XVal ++ YVal.
 
 %------------------------------------------------------------------------------%
 
-:- pred evaluate_builtin_test(string, string, int,
-		list(pair(prog_var, inst)), bool).
-:- mode evaluate_builtin_test(in, in, in, in, out) is semidet.
+	% evaluate_test(ModuleName, ProcName, ModeNum, ArgList, Result):
+	%
+	% This attempts to evaluate a call to
+	%	ModuleName.ProcName(ArgList)
+	% whose mode is specified by ModeNum.
+	%
+	% If the call is a semidet call with no outputs that can be
+	% statically evaluated, evaluate_test succeeds with
+	% Result being "yes" if the call will succeed and "no" if the
+	% call will fail.
+	% Otherwise (i.e. if the call is not semidet, has any outputs,
+	% or cannot be statically evaluated), evaluate_test fails.
+
+:- pred evaluate_test(string::in, string::in, int::in,
+		list(arg_hlds_info)::in, bool::out) is semidet.
 
 	% Integer comparisons
 
-evaluate_builtin_test("int", "<", 0, Args, Result) :-
+evaluate_test("int", "<", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	( XVal < YVal ->
 		Result = yes
 	;
 		Result = no
 	).
-evaluate_builtin_test("int", "=<", 0, Args, Result) :-
+evaluate_test("int", "=<", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	( XVal =< YVal ->
 		Result = yes
 	;
 		Result = no
 	).
-evaluate_builtin_test("int", ">", 0, Args, Result) :-
+evaluate_test("int", ">", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	( XVal > YVal ->
 		Result = yes
 	;
 		Result = no
 	).
-evaluate_builtin_test("int", ">=", 0, Args, Result) :-
+evaluate_test("int", ">=", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(int_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(int_const(YVal), [])]),
 	( XVal >= YVal ->
 		Result = yes
 	;
@@ -348,52 +383,186 @@
 
 	% Float comparisons
 
-evaluate_builtin_test("float", "<", 0, Args, Result) :-
+evaluate_test("float", "<", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	( XVal < YVal ->
 		Result = yes
 	;
 		Result = no
 	).
-evaluate_builtin_test("float", "=<", 0, Args, Result) :-
+evaluate_test("float", "=<", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	( XVal =< YVal ->
 		Result = yes
 	;
 		Result = no
 	).
-evaluate_builtin_test("float", ">", 0, Args, Result) :-
+evaluate_test("float", ">", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	( XVal > YVal ->
 		Result = yes
 	;
 		Result = no
 	).
-evaluate_builtin_test("float", ">=", 0, Args, Result) :-
+evaluate_test("float", ">=", 0, Args, Result) :-
 	Args = [X, Y],
-	X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
-	Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
+	X ^ arg_inst = bound(_XUniq, [functor(float_const(XVal), [])]),
+	Y ^ arg_inst = bound(_YUniq, [functor(float_const(YVal), [])]),
 	( XVal >= YVal ->
 		Result = yes
 	;
 		Result = no
 	).
+evaluate_test("private_builtin", "typed_unify", Mode, Args, Result) :-
+	% mode 0 is the (in, in) mode
+	% mode 1 is the (in, out) mode
+	% both modes are semidet
+	Mode = 0,
+	Args = [TypeOfX, TypeOfY, X, Y],
+	eval_unify(TypeOfX, TypeOfY, Result0),
+	(
+		Result0 = no,
+		Result = no
+	;
+		Result0 = yes,
+		eval_unify(X, Y, Result)
+	).
+
+	% evaluate_semidet_call(ModuleName, ProcName, ModeNum,
+	%	Args, Result):
+	%
+	% This attempts to evaluate a call to
+	%	ModuleName.ProcName(Args)
+	% whose mode is specified by ModeNum.
+	%
+	% If the call is a semidet call with one output that can be
+	% statically evaluated, evaluate_semidet_call succeeds with
+	% Result being "no" if the call will fail, or
+	% yes(OutputArg - OutputArgValue) if it will succeed, with
+	% OutputArg being whichever of the arguments is output,
+	% and with OutputArgVal being the computed value of OutputArg.
+	%
+	% Otherwise (i.e. if the call is not semidet, or has no outputs
+	% or more than one output, or cannot be statically evaluated),
+	% evaluate_semidet_call fails.
+
+:- type arg_val
+	--->	const(cons_id)
+	;	var(arg_hlds_info).
+
+:- pred evaluate_semidet_call(string::in, string::in, int::in,
+		list(arg_hlds_info)::in,
+		maybe(pair(arg_hlds_info, arg_val))::out) is semidet.
+
+evaluate_semidet_call("std_util", "dynamic_cast", 0, Args, Result) :-
+	evaluate_semidet_call("private_builtin", "typed_unify", 1,
+		Args, Result).
+
+evaluate_semidet_call("private_builtin", "typed_unify", Mode, Args, Result) :-
+	% mode 0 is the (in, in) mode
+	% mode 1 is the (in, out) mode
+	% both modes are semidet
+	Mode = 1,
+	Args = [TypeOfX, TypeOfY, X, Y],
+	eval_unify(TypeOfX, TypeOfY, Result0),
+	(
+		Result0 = no,
+		Result = no
+	;
+		Result0 = yes,
+		Result = yes(Y - var(X))
+	).
+
+	% evaluate_unify(FirstArg, SecondArg, Result):
+	%
+	% This attempts to evaluate a call to
+	%	builtin.unify(FirstArg, SecondArg)
+	% with mode (in, in).
+	% If the unification can be statically evaluated,
+	% evaluate_builtin_test succeeds with Result being "yes"
+	% if the unification will succeed and "no" if the
+	% unification will fail.  Otherwise (i.e. if the unification
+	% cannot be statically evaluated), evaluate_unify fails.
+
+:- pred eval_unify(arg_hlds_info::in, arg_hlds_info::in, bool::out) is semidet.
+eval_unify(X, Y, Result) :-
+	(
+		X ^ arg_var = Y ^ arg_var
+	->
+		Result = yes
+	;
+		X ^ arg_inst = bound(_, [functor(XCtor, XArgVars)]),
+		Y ^ arg_inst = bound(_, [functor(YCtor, YArgVars)])
+	->
+		% XXX is it safe to use unification here to test for
+		%     functors being equal?
+		( XCtor = YCtor, XArgVars = YArgVars ->
+			Result = yes
+		;
+			( XCtor \= YCtor
+			; length(XArgVars) \= length(YArgVars) `with_type` int
+			)
+		->
+			Result = no
+		;
+			fail
+		)
+	;
+		fail
+	).
 
 %------------------------------------------------------------------------------%
 
+:- pred make_assignment_goal(arg_hlds_info::in, arg_hlds_info::in,
+		hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out)
+		is det.
+make_assignment_goal(OutputArg, InputArg, GoalInfo0, Goal, GoalInfo) :-
+	make_assignment(OutputArg, InputArg, Goal),
+	goal_info_get_instmap_delta(GoalInfo0, Delta0),
+	instmap_delta_set(Delta0, OutputArg ^ arg_var, InputArg ^ arg_inst,
+		Delta),
+	goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo1),
+	goal_info_set_determinism(GoalInfo1, det, GoalInfo).
+
+
+:- pred make_construction_goal(arg_hlds_info::in, cons_id::in,
+		hlds_goal_info::in, hlds_goal_expr::out, hlds_goal_info::out)
+		is det.
+make_construction_goal(OutputArg, Cons, GoalInfo0, Goal, GoalInfo) :-
+	make_construction(OutputArg, Cons, Goal),
+	goal_info_get_instmap_delta(GoalInfo0, Delta0),
+	instmap_delta_set(Delta0, OutputArg ^ arg_var,
+		bound(unique, [functor(Cons, [])]), Delta),
+	goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo1),
+	goal_info_set_determinism(GoalInfo1, det, GoalInfo).
+
+:- pred make_assignment(arg_hlds_info::in, arg_hlds_info::in,
+	hlds_goal_expr::out) is det.
+            
+make_assignment(OutputArg, InputArg, Goal) :-
+	OutVar = OutputArg ^ arg_var,
+	InVar = InputArg ^ arg_var,
+	Inst = InputArg ^ arg_inst,
+	OutputArgMode = (free -> Inst),
+	InputArgMode = (Inst -> Inst),
+	UniMode = OutputArgMode - InputArgMode,
+	Context = unify_context(explicit, []),
+	Goal = unify(OutVar, var(InVar), UniMode, assign(OutVar, InVar),
+		Context).
+
 	% recompute_instmap_delta is run by simplify.m if anything changes,
 	% so the insts are not important here.
-:- pred make_construction(pair(prog_var, inst), cons_id, hlds_goal_expr).
+:- pred make_construction(arg_hlds_info, cons_id, hlds_goal_expr).
 :- mode make_construction(in, in, out) is det.
 
-make_construction(Var - _, ConsId, Goal) :-
-	make_const_construction(Var, ConsId, Goal - _).
+make_construction(Arg, ConsId, Goal) :-
+	make_const_construction(Arg ^ arg_var, ConsId, Goal - _).
 
 %------------------------------------------------------------------------------%
 
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.127
diff -u -d -r1.127 simplify.m
--- compiler/simplify.m	21 Dec 2003 05:04:37 -0000	1.127
+++ compiler/simplify.m	12 Feb 2004 23:16:45 -0000
@@ -1348,15 +1348,17 @@
 	( simplify_do_const_prop(Info3) ->
 		simplify_info_get_instmap(Info3, Instmap0),
 		simplify_info_get_module_info(Info3, ModuleInfo2),
+		simplify_info_get_var_types(Info3, VarTypes),
 		(
 			Goal1 = call(_, _, _, _, _, _),
-			evaluate_builtin(PredId, ProcId, Args, GoalInfo0, 
-				Goal2, GoalInfo2, Instmap0,
-				ModuleInfo2, ModuleInfo3)
+			const_prop.evaluate_call(PredId, ProcId, Args,
+				GoalInfo0, VarTypes, Instmap0, ModuleInfo2,
+				Goal2, GoalInfo2)
 		->
 			Goal = Goal2,
 			GoalInfo = GoalInfo2,
-			simplify_info_set_module_info(Info3, ModuleInfo3, Info4),
+			simplify_info_set_module_info(Info3, ModuleInfo2,
+				Info4),
 			simplify_info_set_requantify(Info4, Info)
 		;
 			Goal = Goal1,
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.290
diff -u -d -r1.290 std_util.m
--- library/std_util.m	20 Jan 2004 23:05:43 -0000	1.290
+++ library/std_util.m	13 Feb 2004 00:35:19 -0000
@@ -1607,7 +1607,7 @@
 	univ_value(Univ) = X.
 
 dynamic_cast(X, Y) :-
-	univ_to_type(univ(X), Y).
+	private_builtin__typed_unify(X, Y).
 
 %-----------------------------------------------------------------------------%
 
Index: tests/hard_coded/constant_prop_2.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/constant_prop_2.exp,v
retrieving revision 1.1
diff -u -d -r1.1 constant_prop_2.exp
--- tests/hard_coded/constant_prop_2.exp	10 Feb 2004 13:13:11 -0000	1.1
+++ tests/hard_coded/constant_prop_2.exp	13 Feb 2004 01:48:20 -0000
@@ -1,3 +1,9 @@
 yes
 yes
 yes
+yes
+no
+43
+no
+45
+no
Index: tests/hard_coded/constant_prop_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/constant_prop_2.m,v
retrieving revision 1.1
diff -u -d -r1.1 constant_prop_2.m
--- tests/hard_coded/constant_prop_2.m	10 Feb 2004 13:13:11 -0000	1.1
+++ tests/hard_coded/constant_prop_2.m	13 Feb 2004 00:44:39 -0000
@@ -5,7 +5,7 @@
 :- pred main(io::di, io::uo) is det.
 
 :- implementation.
-:- import_module string, int, float.
+:- import_module string, int, float, private_builtin, std_util.
 
 main -->
 	( { "abc" ++ "xyz" = "abcxyz" } ->
@@ -22,6 +22,36 @@
 		io.write_string("yes"), io.nl
 	;
 		link_error
+	),
+	( { private_builtin.typed_unify(42, 42) } ->
+		io.write_string("yes"), io.nl
+	;
+		link_error
+	),
+	( { private_builtin.typed_unify(1, 2) } ->
+		link_error
+	;
+		io.write_string("no"), io.nl
+	),
+	( { private_builtin.typed_unify(43, X1) } ->
+		io.write_int(X1), io.nl
+	;
+		link_error
+	),
+	( { private_builtin.typed_unify(44, _ `with_type` string) } ->
+		link_error
+	;
+		io.write_string("no"), io.nl
+	),
+	( { std_util.dynamic_cast(45, X2) } ->
+		io.write_int(X2), io.nl
+	;
+		link_error
+	),
+	( { std_util.dynamic_cast(46, _ `with_type` string) } ->
+		link_error
+	;
+		io.write_string("no"), io.nl
 	).
 
 	% We should be able to optimize away all calls to this procedure

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------