[m-rev.] diff: Represent coerce goals as a type of cast.
Peter Wang
novalazy at gmail.com
Wed Apr 14 15:21:32 AEST 2021
compiler/hlds_goal.m:
Move subtype_coerce from a option of hlds_goal_expr into cast_kind.
It was useful to identify places where we needed to consider
coercions separately from other types of casts, but that's done now.
compiler/hlds_pred.m:
Delete gcid_coerce option of generic_call_id.
compiler/arg_info.m:
compiler/build_mode_constraints.m:
compiler/bytecode_gen.m:
compiler/call_gen.m:
compiler/coverage_profiling.m:
compiler/deep_profiling.m:
compiler/exception_analysis.m:
compiler/float_regs.m:
compiler/follow_vars.m:
compiler/goal_util.m:
compiler/higher_order.m:
compiler/hlds_desc.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_util.m:
compiler/intermod.m:
compiler/interval.m:
compiler/lambda.m:
compiler/live_vars.m:
compiler/ml_call_gen.m:
compiler/ml_code_gen.m:
compiler/mode_constraints.m:
compiler/mode_errors.m:
compiler/modecheck_goal.m:
compiler/old_type_constraints.m:
compiler/post_typecheck.m:
compiler/pre_quantification.m:
compiler/purity.m:
compiler/simplify_goal.m:
compiler/simplify_goal_call.m:
compiler/structure_reuse.direct.detect_garbage.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
compiler/superhomogeneous.m:
compiler/tabling_analysis.m:
compiler/term_traversal.m:
compiler/trailing_analysis.m:
compiler/tupling.m:
compiler/typecheck.m:
compiler/unique_modes.m:
compiler/unused_imports.m:
Conform to changes.
compiler/hlds_statistics.m:
Count coercions as casts, for consistency in terminology.
compiler/prog_rep.m:
Delete XXX about adding a coerce_rep in addition to cast_rep.
diff --git a/compiler/arg_info.m b/compiler/arg_info.m
index bc6e94706..1dba916c2 100644
--- a/compiler/arg_info.m
+++ b/compiler/arg_info.m
@@ -363,7 +363,6 @@ generic_call_arg_reg_types(ModuleInfo, _VarTypes, GenericCall, ArgVars,
( GenericCall = class_method(_, _, _, _)
; GenericCall = event_call(_)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
list.duplicate(length(ArgVars), reg_r, ArgRegTypes)
).
diff --git a/compiler/build_mode_constraints.m b/compiler/build_mode_constraints.m
index 8a2e89a64..86209cb0d 100644
--- a/compiler/build_mode_constraints.m
+++ b/compiler/build_mode_constraints.m
@@ -476,11 +476,18 @@ add_goal_expr_constraints(ModuleInfo, ProgVarset, PredId, GoalExpr,
Details = event_call(_),
sorry($pred, "event_call generic_call")
;
- % No mode constraints
- Details = cast(_)
- ;
- Details = subtype_coerce,
- sorry($pred, "coerce generic_call")
+ Details = cast(CastType),
+ (
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ )
+ % No mode constraints.
+ ;
+ CastType = subtype_coerce,
+ sorry($pred, "subtype_coerce generic_call")
+ )
)
;
GoalExpr = switch(_, _, _),
diff --git a/compiler/bytecode_gen.m b/compiler/bytecode_gen.m
index 33a222343..1fac40c6f 100644
--- a/compiler/bytecode_gen.m
+++ b/compiler/bytecode_gen.m
@@ -224,7 +224,6 @@ gen_goal_expr(GoalExpr, GoalInfo, !ByteInfo, Code) :-
( GenericCallType = class_method(_, _, _, _)
; GenericCallType = cast(_)
; GenericCallType = event_call(_)
- ; GenericCallType = subtype_coerce
),
% XXX
% string.append_list([
diff --git a/compiler/call_gen.m b/compiler/call_gen.m
index f343d6e13..cf930af76 100644
--- a/compiler/call_gen.m
+++ b/compiler/call_gen.m
@@ -193,9 +193,7 @@ generate_generic_call(OuterCodeModel, GenericCall, Args, Modes,
GenericCall = event_call(EventName),
generate_event_call(EventName, Args, GoalInfo, Code, !CI, !CLD)
;
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- ),
+ GenericCall = cast(_),
( if Args = [InputArg, OutputArg] then
get_module_info(!.CI, ModuleInfo),
get_proc_info(!.CI, ProcInfo),
@@ -439,7 +437,6 @@ generic_call_info(Globals, GenericCall, NumInputArgsR, NumInputArgsF,
% Events and casts are generated inline.
( GenericCall = event_call(_)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
CodeAddr = do_not_reached,
SpecifierArgInfos = [],
@@ -512,8 +509,6 @@ generic_call_nonvar_setup(event_call(_), _, _, _, _, !CLD) :-
unexpected($pred, "event_call").
generic_call_nonvar_setup(cast(_), _, _, _, _, !CLD) :-
unexpected($pred, "cast").
-generic_call_nonvar_setup(subtype_coerce, _, _, _, _, !CLD) :-
- unexpected($pred, "coerce").
%---------------------------------------------------------------------------%
diff --git a/compiler/coverage_profiling.m b/compiler/coverage_profiling.m
index 903bfb3de..71d78d94e 100644
--- a/compiler/coverage_profiling.m
+++ b/compiler/coverage_profiling.m
@@ -250,7 +250,6 @@ coverage_prof_second_pass_goal(Goal0, Goal,
GathersCoverageAfter = yes
;
( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
; GenericCall = event_call(_)
),
GathersCoverageAfter = no
@@ -913,7 +912,6 @@ coverage_prof_first_pass(CPOptions, Goal0, Goal, PortCountsCoverageAfterBefore,
PortCountsCoverageAfterDirect = port_counts_give_coverage_after
;
( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
; GenericCall = event_call(_)
),
Trivial0 = goal_is_trivial,
diff --git a/compiler/deep_profiling.m b/compiler/deep_profiling.m
index cc1c320cb..8dc00d84c 100644
--- a/compiler/deep_profiling.m
+++ b/compiler/deep_profiling.m
@@ -1067,7 +1067,6 @@ deep_prof_transform_goal(Goal0, Goal, AddedImpurity, !DeepInfo) :-
;
( GenericCall = event_call(_)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
Goal = Goal1,
AddedImpurity = no
@@ -1348,9 +1347,6 @@ deep_prof_wrap_call(Goal0, Goal, !DeepInfo) :-
;
Generic = cast(_),
unexpected($pred, "cast")
- ;
- Generic = subtype_coerce,
- unexpected($pred, "coerce")
),
GoalCodeModel = goal_info_get_code_model(GoalInfo0),
module_info_get_globals(ModuleInfo, Globals),
diff --git a/compiler/exception_analysis.m b/compiler/exception_analysis.m
index 534d9900a..db9d9755c 100644
--- a/compiler/exception_analysis.m
+++ b/compiler/exception_analysis.m
@@ -558,8 +558,6 @@ check_goal_for_exceptions_generic_call(VarTypes, Details, Args, GoalInfo,
Details = event_call(_)
;
Details = cast(_)
- ;
- Details = subtype_coerce
).
:- pred check_goals_for_exceptions(scc::in, vartypes::in,
diff --git a/compiler/float_regs.m b/compiler/float_regs.m
index 7f148be69..e1d08fae3 100644
--- a/compiler/float_regs.m
+++ b/compiler/float_regs.m
@@ -711,7 +711,6 @@ insert_reg_wrappers_goal_2(Goal0, Goal, !InstMap, !Info, !Specs) :-
;
( GenericCall = event_call(_)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
Goal = Goal0,
update_instmap(Goal, !InstMap)
diff --git a/compiler/follow_vars.m b/compiler/follow_vars.m
index 8e68877ba..d3c4dc920 100644
--- a/compiler/follow_vars.m
+++ b/compiler/follow_vars.m
@@ -253,9 +253,7 @@ find_follow_vars_in_goal_expr(GoalExpr0, GoalExpr, !GoalInfo,
GoalExpr0 = generic_call(GenericCall, Args, Modes, MaybeArgRegs, Det),
GoalExpr = GoalExpr0,
(
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- )
+ GenericCall = cast(_)
% Casts are generated inline.
;
( GenericCall = higher_order(_, _, _, _)
diff --git a/compiler/goal_util.m b/compiler/goal_util.m
index 596e2eb44..9e5a5bfb2 100644
--- a/compiler/goal_util.m
+++ b/compiler/goal_util.m
@@ -714,7 +714,6 @@ generic_call_vars(higher_order(Var, _, _, _), [Var]).
generic_call_vars(class_method(Var, _, _, _), [Var]).
generic_call_vars(event_call(_), []).
generic_call_vars(cast(_), []).
-generic_call_vars(subtype_coerce, []).
%-----------------------------------------------------------------------------%
diff --git a/compiler/higher_order.m b/compiler/higher_order.m
index ed1a8f4b7..84fc3f8e7 100644
--- a/compiler/higher_order.m
+++ b/compiler/higher_order.m
@@ -597,7 +597,6 @@ ho_traverse_goal(Goal0, Goal, !Info) :-
;
( GenericCall = event_call(_)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
Goal = Goal0
)
diff --git a/compiler/hlds_desc.m b/compiler/hlds_desc.m
index 4a0df6854..6798dbcb0 100644
--- a/compiler/hlds_desc.m
+++ b/compiler/hlds_desc.m
@@ -111,11 +111,9 @@ describe_goal(ModuleInfo, VarSet, Goal) = FullDesc :-
GCall = event_call(Event),
Desc = "event " ++ Event ++ describe_args(VarSet, Args)
;
- GCall = cast(_),
- Desc = "cast " ++ describe_args(VarSet, Args)
- ;
- GCall = subtype_coerce,
- Desc = "coerce " ++ describe_args(VarSet, Args)
+ GCall = cast(CastType),
+ Desc = describe_cast(CastType) ++ " " ++
+ describe_args(VarSet, Args)
)
;
GoalExpr = call_foreign_proc(_, PredId, _, Args, ExtraArgs, _, _),
@@ -238,6 +236,23 @@ arg_type_ctor_name_to_string(TypeCtor) = TypeCtorStr :-
TypeCtorStr = string.format("%s_%d",
[s(sym_name_to_string(TypeCtorSymName)), i(TypeCtorArity)]).
+%---------------------------------------------------------------------------%
+
+:- func describe_cast(cast_kind) = string.
+
+describe_cast(CastType) = Desc :-
+ (
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ ),
+ Desc = "cast"
+ ;
+ CastType = subtype_coerce,
+ Desc = "coerce"
+ ).
+
%---------------------------------------------------------------------------%
:- end_module hlds.hlds_desc.
%---------------------------------------------------------------------------%
diff --git a/compiler/hlds_goal.m b/compiler/hlds_goal.m
index 7061b793c..70f8b184a 100644
--- a/compiler/hlds_goal.m
+++ b/compiler/hlds_goal.m
@@ -700,12 +700,7 @@
% A cast generic_call with two arguments, Input and Output,
% assigns `Input' to `Output', performing a cast of this kind.
cast_kind :: cast_kind
- )
-
- ; subtype_coerce.
- % A coerce expression with two arguments, Input and Output,
- % assigns `Input' to `Output'. (We could merge this into cast_kind
- % eventually.)
+ ).
% The various kinds of casts that we can do.
%
@@ -719,7 +714,7 @@
; equiv_type_cast
% A safe type cast between equivalent types, in either direction.
- ; exists_cast.
+ ; exists_cast
% A safe cast between an internal type_info or typeclass_info
% variable, for which the bindings of existential type variables
% are known statically, to an external type_info or typeclass_info
@@ -728,6 +723,9 @@
% to merge the two variables, which could lead to inconsistencies
% in the rtti_varmaps.
+ ; subtype_coerce.
+ % A coerce expression.
+
% Get a description of a generic_call goal.
%
:- pred generic_call_to_id(generic_call::in, generic_call_id::out) is det.
@@ -1931,9 +1929,6 @@ generic_call_to_id(GenericCall, GenericCallId) :-
;
GenericCall = cast(CastType),
GenericCallId = gcid_cast(CastType)
- ;
- GenericCall = subtype_coerce,
- GenericCallId = gcid_coerce
).
generic_call_pred_or_func(GenericCall) = PredOrFunc :-
@@ -1945,7 +1940,6 @@ generic_call_pred_or_func(GenericCall) = PredOrFunc :-
;
( GenericCall = event_call(_)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
PredOrFunc = pf_predicate
).
@@ -3273,7 +3267,6 @@ rename_generic_call(Must, Subn, Call0, Call) :-
;
( Call0 = event_call(_EventName)
; Call0 = cast(_CastKind)
- ; Call0 = subtype_coerce
),
Call = Call0
).
diff --git a/compiler/hlds_out_goal.m b/compiler/hlds_out_goal.m
index 1ffc54747..64d46dc6f 100644
--- a/compiler/hlds_out_goal.m
+++ b/compiler/hlds_out_goal.m
@@ -1520,15 +1520,8 @@ write_goal_generic_call(Info, Stream, _ModuleInfo, VarSet, _TypeQual,
mercury_output_term(VarSet, VarNamePrint, Term, Stream, !IO),
io.write_string(Stream, Follow, !IO)
;
- (
- GenericCall = cast(CastType),
- CastTypeString = cast_type_to_string(CastType),
- PredOrFunc = pf_predicate
- ;
- GenericCall = subtype_coerce,
- CastTypeString = "coerce",
- PredOrFunc = pf_function
- ),
+ GenericCall = cast(CastType),
+ CastTypeString = cast_type_to_string(CastType),
( if string.contains_char(DumpOptions, 'l') then
write_indent(Stream, Indent, !IO),
io.write_strings(Stream, ["% ", CastTypeString, "\n"], !IO),
@@ -1546,6 +1539,7 @@ write_goal_generic_call(Info, Stream, _ModuleInfo, VarSet, _TypeQual,
else
true
),
+ PredOrFunc = write_cast_as_pred_or_func(CastType),
(
PredOrFunc = pf_predicate,
Functor = term.atom(CastTypeString),
@@ -1593,6 +1587,21 @@ ho_arg_reg_to_string(ArgReg) = Str :-
Str = "reg_f"
).
+:- func write_cast_as_pred_or_func(cast_kind) = pred_or_func.
+
+write_cast_as_pred_or_func(CastType) = PredOrFunc :-
+ (
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ ),
+ PredOrFunc = pf_predicate
+ ;
+ CastType = subtype_coerce,
+ PredOrFunc = pf_function
+ ).
+
%---------------------------------------------------------------------------%
%
% Write out calls to foreign procs.
diff --git a/compiler/hlds_out_util.m b/compiler/hlds_out_util.m
index 5358f519d..f7aa8454a 100644
--- a/compiler/hlds_out_util.m
+++ b/compiler/hlds_out_util.m
@@ -515,13 +515,12 @@ generic_call_id_to_string(gcid_event_call(EventName)) =
"event " ++ EventName.
generic_call_id_to_string(gcid_cast(CastType)) =
cast_type_to_string(CastType).
-generic_call_id_to_string(gcid_coerce) =
- "coerce".
cast_type_to_string(unsafe_type_cast) = "unsafe_type_cast".
cast_type_to_string(unsafe_type_inst_cast) = "unsafe_type_inst_cast".
cast_type_to_string(equiv_type_cast) = "equiv_type_cast".
cast_type_to_string(exists_cast) = "exists_cast".
+cast_type_to_string(subtype_coerce) = "coerce".
call_arg_id_to_string(CallId, ArgNum, PredMarkers) = Str :-
( if ArgNum =< 0 then
@@ -598,11 +597,14 @@ arg_number_to_string(CallId, ArgNum) = Str :-
;
( GenericCallId = gcid_class_method(_, _)
; GenericCallId = gcid_event_call(_)
- ; GenericCallId = gcid_cast(_)
+ ; GenericCallId = gcid_cast(unsafe_type_cast)
+ ; GenericCallId = gcid_cast(unsafe_type_inst_cast)
+ ; GenericCallId = gcid_cast(equiv_type_cast)
+ ; GenericCallId = gcid_cast(exists_cast)
),
Str = "argument " ++ int_to_string(ArgNum)
;
- GenericCallId = gcid_coerce,
+ GenericCallId = gcid_cast(subtype_coerce),
( if ArgNum = 2 then
Str = "the result"
else
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index d8866f2d1..18b7fa444 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -171,8 +171,7 @@
---> gcid_higher_order(purity, pred_or_func, arity)
; gcid_class_method(class_id, pf_sym_name_arity)
; gcid_event_call(string)
- ; gcid_cast(cast_kind)
- ; gcid_coerce.
+ ; gcid_cast(cast_kind).
:- type pred_proc_list == list(pred_proc_id).
diff --git a/compiler/hlds_statistics.m b/compiler/hlds_statistics.m
index f37967406..9f84d4932 100644
--- a/compiler/hlds_statistics.m
+++ b/compiler/hlds_statistics.m
@@ -183,9 +183,6 @@ accumulate_proc_stats_in_goal(Goal, !UsedVars, !Stats) :-
;
CallKind = cast(_),
!Stats ^ ps_casts := !.Stats ^ ps_casts + 1
- ;
- CallKind = subtype_coerce,
- !Stats ^ ps_coerces := !.Stats ^ ps_coerces + 1
)
;
GoalExpr = conj(ConjType, Conjs),
@@ -302,7 +299,6 @@ accumulate_proc_stats_in_switch([Case | Cases], !UsedVars, !Stats) :-
ps_method_calls :: int,
ps_event_calls :: int,
ps_casts :: int,
- ps_coerces :: int,
ps_plain_conjs :: int,
ps_plain_conjuncts :: int,
@@ -329,7 +325,7 @@ accumulate_proc_stats_in_switch([Case | Cases], !UsedVars, !Stats) :-
:- func init_proc_stats = proc_stats.
init_proc_stats = Stats :-
- Stats = proc_stats(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ Stats = proc_stats(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0).
:- pred write_proc_stat_components(io.output_stream::in, string::in,
@@ -340,7 +336,7 @@ write_proc_stat_components(OutStream, Msg, Name, PredId, ProcId, Stats, !IO) :-
Stats = proc_stats(UnifyConstructs, UnifyDeconstructs,
UnifyAssigns, UnifyTests, UnifyComplicateds,
PlainCalls, ForeignCalls, HOCalls, MethodCalls, EventCalls, Casts,
- Coerces, PlainConjs, PlainConjuncts, ParallelConjs, ParallelConjuncts,
+ PlainConjs, PlainConjuncts, ParallelConjs, ParallelConjuncts,
Disjs, Disjuncts, Switches, SwitchArms,
IfThenElses, Negations, Scopes, BiImplications, AtomicGoals, TryGoals),
@@ -348,7 +344,7 @@ write_proc_stat_components(OutStream, Msg, Name, PredId, ProcId, Stats, !IO) :-
UnifyConstructs + UnifyDeconstructs +
UnifyAssigns + UnifyTests + UnifyComplicateds +
PlainCalls + ForeignCalls +
- HOCalls + MethodCalls + EventCalls + Casts + Coerces +
+ HOCalls + MethodCalls + EventCalls + Casts +
PlainConjs + ParallelConjs +
Disjs + Switches +
IfThenElses + Negations + Scopes +
@@ -377,8 +373,6 @@ write_proc_stat_components(OutStream, Msg, Name, PredId, ProcId, Stats, !IO) :-
"event_calls", EventCalls, !IO),
output_proc_stat_component(OutStream, Msg, Name, PredId, ProcId,
"casts", Casts, !IO),
- output_proc_stat_component(OutStream, Msg, Name, PredId, ProcId,
- "coerces", Coerces, !IO),
output_proc_stat_component(OutStream, Msg, Name, PredId, ProcId,
"plain_conjs", PlainConjs, !IO),
diff --git a/compiler/intermod.m b/compiler/intermod.m
index 1fd75855c..b5d1746f0 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -621,14 +621,24 @@ gather_entities_to_opt_export_in_goal_expr(GoalExpr, DoWrite,
CallType = higher_order(_, _, _, _),
DoWrite = yes
;
- ( CallType = class_method(_, _, _, _)
- ; CallType = event_call(_)
- ; CallType = cast(_)
- ),
+ CallType = class_method(_, _, _, _),
DoWrite = no
;
- CallType = subtype_coerce,
- DoWrite = yes
+ CallType = event_call(_),
+ DoWrite = no
+ ;
+ CallType = cast(CastType),
+ (
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ ),
+ DoWrite = no
+ ;
+ CastType = subtype_coerce,
+ DoWrite = yes
+ )
)
;
GoalExpr = call_foreign_proc(Attrs, _, _, _, _, _, _),
diff --git a/compiler/interval.m b/compiler/interval.m
index 566b84012..9ef57b036 100644
--- a/compiler/interval.m
+++ b/compiler/interval.m
@@ -307,9 +307,7 @@ build_interval_info_in_goal(hlds_goal(GoalExpr, GoalInfo), !IntervalInfo,
list.append(InputArgsR, InputArgsF, InputArgs),
(
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- ),
+ GenericCall = cast(_),
% Casts are generated inline.
require_in_regs(InputArgs, !IntervalInfo),
require_access(InputArgs, !IntervalInfo)
@@ -997,9 +995,7 @@ record_decisions_in_goal(Goal0, Goal, !VarInfo, !VarRename, InsertMap,
GoalExpr0 = generic_call(GenericCall, _, _, _, _),
% Casts are generated inline.
(
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- ),
+ GenericCall = cast(_),
MustHaveMap = no
;
( GenericCall = higher_order(_, _, _, _)
diff --git a/compiler/lambda.m b/compiler/lambda.m
index 7a2887664..7bf5b3103 100644
--- a/compiler/lambda.m
+++ b/compiler/lambda.m
@@ -782,8 +782,6 @@ find_used_vars_in_goal(Goal, !VarUses) :-
GenericCall = event_call(_)
;
GenericCall = cast(_)
- ;
- GenericCall = subtype_coerce
),
mark_vars_as_used(ArgVars, !VarUses)
;
diff --git a/compiler/live_vars.m b/compiler/live_vars.m
index 1681ddead..af1a140b8 100644
--- a/compiler/live_vars.m
+++ b/compiler/live_vars.m
@@ -467,9 +467,7 @@ build_live_sets_in_goal_expr(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo,
GoalExpr0 = generic_call(GenericCall, ArgVars, Modes, _, _),
GoalExpr = GoalExpr0,
(
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- ),
+ GenericCall = cast(_),
GoalInfo = GoalInfo0
;
( GenericCall = higher_order(_, _, _, _)
diff --git a/compiler/ml_call_gen.m b/compiler/ml_call_gen.m
index fced45a98..8688db7f3 100644
--- a/compiler/ml_call_gen.m
+++ b/compiler/ml_call_gen.m
@@ -123,9 +123,7 @@ ml_gen_generic_call(GenericCall, ArgVars, ArgModes, Determinism, Context,
FuncDefns = [],
Stmts = []
;
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- ),
+ GenericCall = cast(_),
ml_gen_cast(Context, ArgVars, LocalVarDefns, FuncDefns, Stmts, !Info)
).
diff --git a/compiler/ml_code_gen.m b/compiler/ml_code_gen.m
index 7d249ec6a..d70c641be 100644
--- a/compiler/ml_code_gen.m
+++ b/compiler/ml_code_gen.m
@@ -785,7 +785,6 @@ goal_expr_find_subgoal_nonlocals(GoalExpr, SubGoalNonLocals) :-
;
( GenericCall = event_call(_Eventname)
; GenericCall = cast(_CastKind)
- ; GenericCall = subtype_coerce
),
SubGoalNonLocals = set_of_var.list_to_set(ArgVars)
)
diff --git a/compiler/mode_constraints.m b/compiler/mode_constraints.m
index bb544d796..441648cbb 100644
--- a/compiler/mode_constraints.m
+++ b/compiler/mode_constraints.m
@@ -1363,10 +1363,7 @@ goal_constraints_2(GoalId, NonLocals, Vars, CanSucceed, GoalExpr0, GoalExpr,
sorry($pred, "event_call NYI")
;
GenericCall = cast(_),
- sorry($pred, "type/inst cast call NYI")
- ;
- GenericCall = subtype_coerce,
- sorry($pred, "coerce NYI")
+ sorry($pred, "type/inst cast or coerce NYI")
),
GoalExpr = GoalExpr0
;
diff --git a/compiler/mode_errors.m b/compiler/mode_errors.m
index a3dd30426..b91267361 100644
--- a/compiler/mode_errors.m
+++ b/compiler/mode_errors.m
@@ -831,7 +831,6 @@ mode_error_no_matching_mode_to_spec(ModeInfo, Vars, Insts, InitialInsts)
;
( GenericCallId = gcid_event_call(_)
; GenericCallId = gcid_cast(_)
- ; GenericCallId = gcid_coerce
),
PredOrFunc = pf_predicate
),
diff --git a/compiler/modecheck_goal.m b/compiler/modecheck_goal.m
index 44e2cef88..25ceaa3b4 100644
--- a/compiler/modecheck_goal.m
+++ b/compiler/modecheck_goal.m
@@ -1314,7 +1314,12 @@ modecheck_goal_generic_call(GenericCall, Args0, Modes0, GoalInfo0, GoalExpr,
GoalExpr = generic_call(GenericCall, Args, Modes, arg_reg_types_unset,
detism_det)
;
- GenericCall = cast(_CastType),
+ GenericCall = cast(CastType),
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ ),
( if
goal_info_has_feature(GoalInfo0, feature_keep_constant_binding),
mode_info_get_instmap(!.ModeInfo, InstMap),
@@ -1351,7 +1356,7 @@ modecheck_goal_generic_call(GenericCall, Args0, Modes0, GoalInfo0, GoalExpr,
handle_extra_goals(GoalExpr1, ExtraGoals, GoalInfo0, Args0, Args,
InstMap0, GoalExpr, !ModeInfo)
;
- GenericCall = subtype_coerce,
+ GenericCall = cast(subtype_coerce),
modecheck_coerce(Args0, Args, Modes0, Modes, Det, ExtraGoals,
!ModeInfo),
GoalExpr1 = generic_call(GenericCall, Args, Modes, arg_reg_types_unset,
diff --git a/compiler/old_type_constraints.m b/compiler/old_type_constraints.m
index 6581948b6..3204445f6 100644
--- a/compiler/old_type_constraints.m
+++ b/compiler/old_type_constraints.m
@@ -852,11 +852,18 @@ generic_call_goal_to_constraint(Environment, GoalExpr, GoalInfo, !TCInfo) :-
add_message_to_spec(ErrMsg, !TCInfo)
)
;
- % Casts do not contain any type information.
- Details = cast(_)
- ;
- Details = subtype_coerce,
- sorry($pred, "coerce")
+ Details = cast(CastType),
+ (
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ )
+ % Casts do not contain any type information.
+ ;
+ CastType = subtype_coerce,
+ sorry($pred, "subtype_coerce")
+ )
).
% Creates a constraint from the information stored in a predicate
diff --git a/compiler/post_typecheck.m b/compiler/post_typecheck.m
index 0db4f2eda..999eca32c 100644
--- a/compiler/post_typecheck.m
+++ b/compiler/post_typecheck.m
@@ -342,7 +342,6 @@ describe_constrained_goal(ModuleInfo, Goal) = Pieces :-
;
( GoalExpr = generic_call(event_call(_), _, _, _, _)
; GoalExpr = generic_call(cast(_), _, _, _, _)
- ; GoalExpr = generic_call(subtype_coerce, _, _, _, _)
; GoalExpr = unify(_, _, _, _, _)
; GoalExpr = conj(_, _)
; GoalExpr = disj(_)
diff --git a/compiler/pre_quantification.m b/compiler/pre_quantification.m
index 623f6a9c0..e80e30c52 100644
--- a/compiler/pre_quantification.m
+++ b/compiler/pre_quantification.m
@@ -202,8 +202,6 @@ build_vars_to_zones_in_goal(CurZone, Goal, !TraceCounter, !VarsToZones) :-
GenericCall = event_call(_)
;
GenericCall = cast(_)
- ;
- GenericCall = subtype_coerce
)
;
GoalExpr = call_foreign_proc(_Attrs, _PredId, _ProcId,
diff --git a/compiler/prog_rep.m b/compiler/prog_rep.m
index c2c8b9f98..41ce732f6 100644
--- a/compiler/prog_rep.m
+++ b/compiler/prog_rep.m
@@ -571,15 +571,7 @@ goal_to_goal_rep(Info, Instmap0, hlds_goal(GoalExpr, GoalInfo), GoalRep) :-
( if ArgsRep = [InputArgRep, OutputArgRep] then
AtomicGoalRep = cast_rep(OutputArgRep, InputArgRep)
else
- unexpected($pred, "cast arity != 2")
- )
- ;
- GenericCall = subtype_coerce,
- ( if ArgsRep = [InputArgRep, OutputArgRep] then
- % XXX SUBTYPE add coerce_rep
- AtomicGoalRep = cast_rep(OutputArgRep, InputArgRep)
- else
- unexpected($pred, "coerce arity != 2")
+ unexpected($pred, "cast/coerce arity != 2")
)
)
;
diff --git a/compiler/purity.m b/compiler/purity.m
index 1a65557b4..915e79c76 100644
--- a/compiler/purity.m
+++ b/compiler/purity.m
@@ -677,7 +677,6 @@ compute_expr_purity(GoalExpr0, GoalExpr, GoalInfo, Purity, ContainsTrace,
Purity = purity_pure % XXX this is wrong!
;
( GenericCall0 = cast(_)
- ; GenericCall0 = subtype_coerce
; GenericCall0 = event_call(_)
),
Purity = purity_pure
diff --git a/compiler/simplify_goal.m b/compiler/simplify_goal.m
index 29051ab11..5a0c71001 100644
--- a/compiler/simplify_goal.m
+++ b/compiler/simplify_goal.m
@@ -434,9 +434,6 @@ will_flush(GoalExpr, BeforeAfter) = WillFlush :-
;
GenericCall = cast(_),
WillFlush0 = no
- ;
- GenericCall = subtype_coerce,
- WillFlush0 = no
),
(
BeforeAfter = before,
diff --git a/compiler/simplify_goal_call.m b/compiler/simplify_goal_call.m
index 2408d15c3..8b416ffbf 100644
--- a/compiler/simplify_goal_call.m
+++ b/compiler/simplify_goal_call.m
@@ -262,7 +262,6 @@ simplify_goal_generic_call(GoalExpr0, GoalExpr, GoalInfo, GoalInfo,
;
( GenericCall = class_method(_, _, _, _)
; GenericCall = cast(_)
- ; GenericCall = subtype_coerce
),
GoalExpr = GoalExpr0,
Common = Common0
diff --git a/compiler/structure_reuse.direct.detect_garbage.m b/compiler/structure_reuse.direct.detect_garbage.m
index e6669c219..f56a10d14 100644
--- a/compiler/structure_reuse.direct.detect_garbage.m
+++ b/compiler/structure_reuse.direct.detect_garbage.m
@@ -235,7 +235,6 @@ determine_dead_deconstructions_generic_call(ModuleInfo, ProcInfo,
;
( GenDetails = event_call(_) % XXX too conservative
; GenDetails = cast(_)
- ; GenDetails = subtype_coerce
),
SetToTop = yes
),
diff --git a/compiler/structure_reuse.indirect.m b/compiler/structure_reuse.indirect.m
index 4232745e3..9ab8787c6 100644
--- a/compiler/structure_reuse.indirect.m
+++ b/compiler/structure_reuse.indirect.m
@@ -660,7 +660,6 @@ indirect_reuse_analyse_generic_call(BaseInfo, GenDetails, CallArgs, Modes,
;
( GenDetails = event_call(_) % XXX too conservative
; GenDetails = cast(_)
- ; GenDetails = subtype_coerce
),
SetToTop = yes
),
diff --git a/compiler/structure_sharing.analysis.m b/compiler/structure_sharing.analysis.m
index d110304ea..a25a94abc 100644
--- a/compiler/structure_sharing.analysis.m
+++ b/compiler/structure_sharing.analysis.m
@@ -770,7 +770,6 @@ analyse_generic_call(ModuleInfo, ProcInfo, GenDetails, CallArgs, Modes,
;
( GenDetails = event_call(_) % XXX too conservative
; GenDetails = cast(_)
- ; GenDetails = subtype_coerce
),
SetToTop = yes
),
diff --git a/compiler/superhomogeneous.m b/compiler/superhomogeneous.m
index a93967e25..185c9898d 100644
--- a/compiler/superhomogeneous.m
+++ b/compiler/superhomogeneous.m
@@ -1067,7 +1067,7 @@ maybe_unravel_special_var_functor_unification(XVar, YAtom, YArgTerms,
!ModuleInfo, !QualInfo, !Specs),
RValTermExpansion = expansion(_, RValGoalCord)
),
- CoerceGoalExpr = generic_call(subtype_coerce,
+ CoerceGoalExpr = generic_call(cast(subtype_coerce),
[RValTermVar, XVar], [in_mode, out_mode],
arg_reg_types_unset, detism_det),
goal_info_init(Context, CoerceGoalInfo),
diff --git a/compiler/tabling_analysis.m b/compiler/tabling_analysis.m
index cb97383d1..91d6a5ad9 100644
--- a/compiler/tabling_analysis.m
+++ b/compiler/tabling_analysis.m
@@ -345,9 +345,6 @@ check_goal_for_mm_tabling(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
;
Details = cast(_),
Result = mm_tabled_will_not_call
- ;
- Details = subtype_coerce,
- Result = mm_tabled_will_not_call
),
MaybeAnalysisStatus = yes(optimal)
;
@@ -640,9 +637,6 @@ mm_tabling_annotate_goal_2(VarTypes, !GoalExpr, Status, !ModuleInfo) :-
;
GenericCall = cast(_),
Status = mm_tabled_will_not_call
- ;
- GenericCall = subtype_coerce,
- Status = mm_tabled_will_not_call
)
;
!.GoalExpr = conj(ConjType, Conjuncts0),
diff --git a/compiler/term_traversal.m b/compiler/term_traversal.m
index b9da50e21..a0d005de8 100644
--- a/compiler/term_traversal.m
+++ b/compiler/term_traversal.m
@@ -308,8 +308,6 @@ term_traverse_goal(ModuleInfo, Params, Goal, !Info) :-
Details = event_call(_)
;
Details = cast(_)
- ;
- Details = subtype_coerce
)
;
GoalExpr = conj(_, Goals),
diff --git a/compiler/trailing_analysis.m b/compiler/trailing_analysis.m
index 99312d685..dbeeeed7b 100644
--- a/compiler/trailing_analysis.m
+++ b/compiler/trailing_analysis.m
@@ -432,7 +432,6 @@ check_goal_for_trail_mods(SCC, VarTypes, Goal, Result, MaybeAnalysisStatus,
MaybeAnalysisStatus = yes(optimal)
;
( Details = cast(_)
- ; Details = subtype_coerce
; Details = event_call(_)
),
Result = trail_will_not_modify,
@@ -959,9 +958,6 @@ trail_annotate_goal_2(VarTypes, GoalInfo, !GoalExpr, Status, !ModuleInfo) :-
;
GenericCall = cast(_),
Status = trail_will_not_modify
- ;
- GenericCall = subtype_coerce,
- Status = trail_will_not_modify
)
;
!.GoalExpr = conj(ConjType, Conjuncts0),
diff --git a/compiler/tupling.m b/compiler/tupling.m
index c95a35ba6..913d6e073 100644
--- a/compiler/tupling.m
+++ b/compiler/tupling.m
@@ -1129,9 +1129,7 @@ count_load_stores_in_goal(Goal, CountInfo, !CountState) :-
count_load_stores_for_call(CountInfo, Inputs, Outputs,
MaybeNeedAcrossCall, GoalInfo, !CountState)
;
- ( GenericCall = cast(_)
- ; GenericCall = subtype_coerce
- ),
+ GenericCall = cast(_),
% Casts are generated inline.
cls_require_in_regs(CountInfo, InputArgs, !CountState),
cls_put_in_regs(OutputArgs, !CountState)
diff --git a/compiler/typecheck.m b/compiler/typecheck.m
index 8bf12a6fe..a1ce39e67 100644
--- a/compiler/typecheck.m
+++ b/compiler/typecheck.m
@@ -1479,16 +1479,23 @@ typecheck_goal_expr(GoalExpr0, GoalExpr, GoalInfo, !TypeAssignSet, !Info) :-
typecheck_event_call(Context, EventName, Args,
!TypeAssignSet, !Info)
;
- GenericCall = cast(_)
- % A cast imposes no restrictions on its argument types,
- % so nothing needs to be done here.
- ;
- GenericCall = subtype_coerce,
- trace [compiletime(flag("type_checkpoint")), io(!IO)] (
- type_checkpoint("coerce", ModuleInfo, VarSet,
- !.TypeAssignSet, !IO)
- ),
- typecheck_coerce(Context, Args, !TypeAssignSet, !Info)
+ GenericCall = cast(CastType),
+ (
+ ( CastType = unsafe_type_cast
+ ; CastType = unsafe_type_inst_cast
+ ; CastType = equiv_type_cast
+ ; CastType = exists_cast
+ )
+ % A cast imposes no restrictions on its argument types,
+ % so nothing needs to be done here.
+ ;
+ CastType = subtype_coerce,
+ trace [compiletime(flag("type_checkpoint")), io(!IO)] (
+ type_checkpoint("coerce", ModuleInfo, VarSet,
+ !.TypeAssignSet, !IO)
+ ),
+ typecheck_coerce(Context, Args, !TypeAssignSet, !Info)
+ )
),
GoalExpr = GoalExpr0
;
diff --git a/compiler/unique_modes.m b/compiler/unique_modes.m
index 501325175..789004481 100644
--- a/compiler/unique_modes.m
+++ b/compiler/unique_modes.m
@@ -608,11 +608,9 @@ unique_modes_check_goal_generic_call(GenericCall, ArgVars, Modes,
ArgOffset = 0
;
% Casts are introduced by the compiler and should be mode correct.
+ % Coercions are mode checked.
GenericCall = cast(_),
ArgOffset = 0
- ;
- GenericCall = subtype_coerce,
- ArgOffset = 0
),
unique_modes_check_call_modes(ArgVars, Modes, ArgOffset, Detism,
CanProcSucceed, !ModeInfo),
diff --git a/compiler/unused_imports.m b/compiler/unused_imports.m
index d857bf497..ace7b5ec2 100644
--- a/compiler/unused_imports.m
+++ b/compiler/unused_imports.m
@@ -813,7 +813,6 @@ hlds_goal_used_modules(Goal, !UsedModules) :-
( Call = higher_order(_, _, _, _)
; Call = event_call(_)
; Call = cast(_)
- ; Call = subtype_coerce
)
)
;
--
2.30.0
More information about the reviews
mailing list