[m-rev.] for review: allow pretest equality on java

[Peter Wang]

Branches: main

Allow `--should-pretest-equality' on Java backend.

compiler/options.m:
compiler/handle_options.m:
        Set an internal option when targetting Java which determines whether
        "pretest equality" code casts values to pointers or integers before
        comparing them.

        Allow `should_pretest_equality' when targetting Java.

compiler/hlds_goal.m:
compiler/saved_vars.m:
        Add a goal feature to be set on the unification in the pretest equality
        code.

compiler/modecheck_unify.m:
        Treat c_pointer unifications as a simple test if the previous goal
        feature is set.  Otherwise the result would be a runtime error.

compiler/unify_proc.m:
        Make the pretest equality code cast values to pointers if
        `pretest_equality_cast_pointers' is set.

        Add the goal feature on the unification goal.

diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index 8ce66e7..d608b79 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -661,9 +661,8 @@ postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
         %         XXX Previously static ground terms used to not work with
         %             --high-level-data. But this has been (mostly?) fixed now.
         %             So we should investigate re-enabling static ground terms.
+        %   - pretest-equality-cast-pointers
         %   - no library grade installation check with `mmc --make'. 
-        %   - no pretest equality check
-        %     Because it assumes pointers can be cast to integers.
         %   - cross compiling
         %     Because ints in Java are 32-bits wide which may be different to
         %     that of the host compiler.
@@ -685,8 +684,9 @@ postprocess_options_2(OptionTable0, Target, GC_Method, TagsMethod0,
             globals.set_option(unboxed_no_tag_types, bool(no), !Globals),
             globals.set_option(static_ground_cells, bool(no), !Globals),
             globals.set_option(put_nondet_env_on_heap, bool(yes), !Globals),
+            globals.set_option(pretest_equality_cast_pointers, bool(yes),
+                !Globals),
             globals.set_option(libgrade_install_check, bool(no), !Globals),
-            globals.set_option(should_pretest_equality, bool(no), !Globals),
             globals.set_option(cross_compiling, bool(yes), !Globals)
         ;
             ( Target = target_c
diff --git a/compiler/hlds_goal.m b/compiler/hlds_goal.m
index b1bcf98..f200ce1 100644
--- a/compiler/hlds_goal.m
+++ b/compiler/hlds_goal.m
@@ -1463,6 +1463,11 @@
             % circumstances we need to strip off this pretest, and replace
             % the if-then-else with just its else branch.
 
+    ;       feature_pretest_equality_condition
+            % This goal is the unification in the condition of a
+            % pretest-equality if-then-else goal. The goal feature is required
+            % to allow pointer comparisons generated by the compiler.
+
     ;       feature_lambda_undetermined_mode.
             % This goal is a lambda goal converted from a higher order term
             % for which we don't know the mode of the call to the underlying
diff --git a/compiler/modecheck_unify.m b/compiler/modecheck_unify.m
index 5629925..a432161 100644
--- a/compiler/modecheck_unify.m
+++ b/compiler/modecheck_unify.m
@@ -66,6 +66,7 @@
 :- import_module mdbcomp.
 :- import_module mdbcomp.prim_data.
 :- import_module parse_tree.
+:- import_module parse_tree.builtin_lib_types.
 :- import_module parse_tree.prog_mode.
 :- import_module parse_tree.prog_type.
 
@@ -1050,6 +1051,13 @@ categorize_unify_var_var(ModeOfX, ModeOfY, LiveX, LiveY, X, Y, Det,
         ->
             Unification = simple_test(X, Y)
         ;
+            % Unification of c_pointers is a runtime error unless introduced by
+            % the compiler.
+            Type = c_pointer_type,
+            goal_info_has_feature(GoalInfo, feature_pretest_equality_condition)
+        ->
+            Unification = simple_test(X, Y)
+        ;
             modecheck_complicated_unify(X, Y, Type, ModeOfX, ModeOfY, Det,
                 UnifyContext, Unification0, Unification, !ModeInfo)
         )
diff --git a/compiler/options.m b/compiler/options.m
index e059864..c9d6b0c 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -459,6 +459,11 @@
             % constant, can be done by casting them both to integers and
             % comparing the integers for equality.
 
+    ;       pretest_equality_cast_pointers
+            % Should be set to yes if the test of whether two input arguments
+            % are object identical should be done by casting the arguments to a
+            % generic pointer type. Otherwise they will be cast to integers.
+
     ;       can_compare_compound_values
             % Should be set to yes if the target back end supports comparison
             % of non-atomic values with builtin operators.
@@ -1297,6 +1302,7 @@ option_defaults_2(internal_use_option, [
     trace_stack_layout                  -   bool(no),
     body_typeinfo_liveness              -   bool(no),
     can_compare_constants_as_ints       -   bool(no),
+    pretest_equality_cast_pointers      -   bool(no),
     can_compare_compound_values         -   bool(no),
     lexically_order_constructors        -   bool(no),
     mutable_always_boxed                -   bool(yes),
@@ -2150,6 +2156,7 @@ long_option("procid-stack-layout",  procid_stack_layout).
 long_option("trace-stack-layout",   trace_stack_layout).
 long_option("body-typeinfo-liveness",   body_typeinfo_liveness).
 long_option("can-compare-constants-as-ints",    can_compare_constants_as_ints).
+long_option("pretest-equality-cast-pointers",   pretest_equality_cast_pointers).
 long_option("can-compare-compound-values",      can_compare_compound_values).
 long_option("lexically-order-constructors",
                                     lexically_order_constructors).
@@ -4407,6 +4414,11 @@ options_help_compilation_model -->
 %       For documentation, see the comment in the type declaration.
 
         % This is a developer only option.
+%       "--pretest-equality-cast-pointers",
+%       "(This option is not for general use.)",
+%       For documentation, see the comment in the type declaration.
+
+        % This is a developer only option.
 %       "--can-compare-compound-values"
 %       "(This option is not for general use.)",
 %       For documentation, see the comment in the type declaration.
diff --git a/compiler/saved_vars.m b/compiler/saved_vars.m
index c318814..6e0eb7f 100644
--- a/compiler/saved_vars.m
+++ b/compiler/saved_vars.m
@@ -241,6 +241,7 @@ ok_to_duplicate(feature_will_not_modify_trail) = yes.
 ok_to_duplicate(feature_will_not_call_mm_tabled) = yes.
 ok_to_duplicate(feature_contains_trace) = yes.
 ok_to_duplicate(feature_pretest_equality) = yes.
+ok_to_duplicate(feature_pretest_equality_condition) = yes.
 ok_to_duplicate(feature_lambda_undetermined_mode) = yes.
 
     % Divide a list of goals into an initial subsequence of goals
diff --git a/compiler/unify_proc.m b/compiler/unify_proc.m
index 050ecb8..6107e43 100644
--- a/compiler/unify_proc.m
+++ b/compiler/unify_proc.m
@@ -1945,18 +1945,21 @@ maybe_wrap_with_pretest_equality(Context, X, Y, MaybeCompareRes, Goal0, Goal,
         Goal = Goal0
     ;
         ShouldPretestEq = yes,
-        info_new_named_var(int_type, "CastX", CastX, !Info),
-        info_new_named_var(int_type, "CastY", CastY, !Info),
+        CastType = get_pretest_equality_cast_type(!.Info),
+        info_new_named_var(CastType, "CastX", CastX, !Info),
+        info_new_named_var(CastType, "CastY", CastY, !Info),
         generate_cast(unsafe_type_cast, X, CastX, Context, CastXGoal0),
         generate_cast(unsafe_type_cast, Y, CastY, Context, CastYGoal0),
         goal_add_feature(feature_keep_constant_binding, CastXGoal0, CastXGoal),
         goal_add_feature(feature_keep_constant_binding, CastYGoal0, CastYGoal),
         create_pure_atomic_complicated_unification(CastX, rhs_var(CastY),
-            Context, umc_explicit, [], EqualityGoal),
+            Context, umc_explicit, [], EqualityGoal0),
+        goal_add_feature(feature_pretest_equality_condition,
+            EqualityGoal0, EqualityGoal),
         CondGoalExpr = conj(plain_conj, [CastXGoal, CastYGoal, EqualityGoal]),
         goal_info_init(GoalInfo0),
         goal_info_set_context(Context, GoalInfo0, ContextGoalInfo),
-        CondGoal= hlds_goal(CondGoalExpr, ContextGoalInfo),
+        CondGoal = hlds_goal(CondGoalExpr, ContextGoalInfo),
         (
             MaybeCompareRes = no,
             EqualGoal = true_goal_with_context(Context),
@@ -1986,6 +1989,20 @@ should_pretest_equality(Info) = ShouldPretestEq :-
     module_info_get_globals(ModuleInfo, Globals),
     lookup_bool_option(Globals, should_pretest_equality, ShouldPretestEq).
 
+:- func get_pretest_equality_cast_type(unify_proc_info) = mer_type.
+
+get_pretest_equality_cast_type(Info) = CastType :-
+    ModuleInfo = Info ^ upi_module_info,
+    module_info_get_globals(ModuleInfo, Globals),
+    lookup_bool_option(Globals, pretest_equality_cast_pointers, CastPointers),
+    (
+        CastPointers = yes,
+        CastType = c_pointer_type
+    ;
+        CastPointers = no,
+        CastType = int_type
+    ).
+
 %-----------------------------------------------------------------------------%
 
 :- pred quantify_clause_body(list(prog_var)::in, hlds_goal::in,

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------