[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