[m-rev.] for review: java backend abort on private_builtin.m

Peter Wang novalazy at gmail.com
Thu Apr 23 17:10:52 AEST 2009


2009/4/23 Peter Wang <novalazy at gmail.com>:
>
> I forgot that add_pred.add_builtin already treats a few builtins specially.
> That would be a better place to fix the problem.  I'll see if I can add in
> the aborting behaviour easily.

Here it is.


Branches: main

Fix an abort when compiling private_builtin.m with the Java backend.
`--optimize-constructor-last-call' is incompatible with Java but the
declarations for the builtins that it uses are in private_builtin.m, and the
predicates were being given bodies which aren't handled by the Java backend.

compiler/add_pred.m:
        If the target language is Java or Erlang, treat
        `private_builtin.store_at_ref_impure' and `store_at_ref' as stubs.
        They should never be called.

        Set `marker_builtin_stub' on those predicates, as well as
        `builtin_compound_eq' and `builtin_compound_lt'.

compiler/hlds_pred.m:
        Add a new marker type `marker_builtin_stub'.

compiler/typecheck.m:
        Generate stub clauses for predicates with the `marker_builtin_stub'
        marker, even if `--allow-stubs' is disabled.

compiler/hlds_out.m:
compiler/intermod.m:
compiler/table_gen.m:
        Conform to changes.

diff --git a/compiler/add_pred.m b/compiler/add_pred.m
index 880dcf3..a456734 100644
--- a/compiler/add_pred.m
+++ b/compiler/add_pred.m
@@ -80,6 +80,7 @@
 :- import_module hlds.hlds_rtti.
 :- import_module hlds.make_hlds.make_hlds_error.
 :- import_module libs.compiler_util.
+:- import_module libs.globals.
 :- import_module libs.options.
 :- import_module parse_tree.prog_mode.
 :- import_module parse_tree.prog_out.
@@ -200,7 +201,10 @@ add_new_pred(TVarSet, ExistQVars, PredName,
Types, Purity, ClassContext,
             predicate_table_insert_qual(PredInfo0, NeedQual, PQInfo, PredId,
                 PredTable0, PredTable1),
             ( pred_info_is_builtin(PredInfo0) ->
-                add_builtin(PredId, Types, PredInfo0, PredInfo),
+                module_info_get_globals(!.ModuleInfo, Globals),
+                globals.get_target(Globals, CompilationTarget),
+                add_builtin(PredId, Types, CompilationTarget,
+                    PredInfo0, PredInfo),
                 predicate_table_get_preds(PredTable1, Preds1),
                 map.det_update(Preds1, PredId, PredInfo, Preds),
                 predicate_table_set_preds(Preds, PredTable1, PredTable)
@@ -213,7 +217,7 @@ add_new_pred(TVarSet, ExistQVars, PredName, Types,
Purity, ClassContext,

 %-----------------------------------------------------------------------------%

-:- pred add_builtin(pred_id::in, list(mer_type)::in,
+:- pred add_builtin(pred_id::in, list(mer_type)::in, compilation_target::in,
     pred_info::in, pred_info::out) is det.

     % For most builtin predicates, say foo/2, we add a clause
@@ -227,7 +231,7 @@ add_new_pred(TVarSet, ExistQVars, PredName, Types,
Purity, ClassContext,
     %
     % A few builtins are treated specially.
     %
-add_builtin(PredId, Types, !PredInfo) :-
+add_builtin(PredId, Types, CompilationTarget, !PredInfo) :-
     Module = pred_info_module(!.PredInfo),
     Name = pred_info_name(!.PredInfo),
     pred_info_get_context(!.PredInfo, Context),
@@ -246,8 +250,15 @@ add_builtin(PredId, Types, !PredInfo) :-
         (
             ( Name = "builtin_compound_eq"
             ; Name = "builtin_compound_lt"
+            )
+        ;
+            % These predicates are incompatible with Java and Erlang.
+            ( Name = "store_at_ref_impure"
+            ; Name = "store_at_ref"
             ),
-            StubPrime = yes
+            ( CompilationTarget = target_java
+            ; CompilationTarget = target_erlang
+            )
         )
     ->
         GoalExpr = conj(plain_conj, []),
@@ -255,7 +266,7 @@ add_builtin(PredId, Types, !PredInfo) :-
         ExtraVars = [],
         ExtraTypes = [],
         VarSet = VarSet0,
-        Stub = StubPrime
+        Stub = yes
     ;
         Module = mercury_private_builtin_module,
         Name = "trace_get_io_state"
@@ -322,18 +333,24 @@ add_builtin(PredId, Types, !PredInfo) :-
         Stub = no
     ),

-    % Construct a clause containing that pseudo-recursive call.
-    Goal = hlds_goal(GoalExpr, GoalInfo),
-    Clause = clause([], Goal, impl_lang_mercury, Context),
+    (
+        Stub = no,
+        % Construct a clause containing that pseudo-recursive call.
+        Goal = hlds_goal(GoalExpr, GoalInfo),
+        Clause = clause([], Goal, impl_lang_mercury, Context),
+        set_clause_list([Clause], ClausesRep)
+    ;
+        Stub = yes,
+        set_clause_list([], ClausesRep)
+    ),

-    % Put the clause we just built into the pred_info,
+    % Put the clause we just built (if any) into the pred_info,
     % annotated with the appropriate types.
     map.from_corresponding_lists(ExtraVars ++ HeadVarList, ExtraTypes ++ Types,
         VarTypes),
     map.init(TVarNameMap),
     rtti_varmaps_init(RttiVarMaps),
     HasForeignClauses = no,
-    set_clause_list([Clause], ClausesRep),
     ClausesInfo = clauses_info(VarSet, VarTypes, TVarNameMap, VarTypes,
         HeadVars, ClausesRep, RttiVarMaps, HasForeignClauses),
     pred_info_set_clauses_info(ClausesInfo, !PredInfo),
@@ -347,7 +364,8 @@ add_builtin(PredId, Types, !PredInfo) :-
     add_marker(marker_user_marked_no_inline, Markers0, Markers1),
     (
         Stub = yes,
-        add_marker(marker_stub, Markers1, Markers)
+        add_marker(marker_stub, Markers1, Markers2),
+        add_marker(marker_builtin_stub, Markers2, Markers)
     ;
         Stub = no,
         Markers = Markers1
diff --git a/compiler/hlds_out.m b/compiler/hlds_out.m
index c250f45..df59333 100644
--- a/compiler/hlds_out.m
+++ b/compiler/hlds_out.m
@@ -1041,6 +1041,7 @@ write_marker_list(Markers, !IO) :-
     io.write_list(Markers, ", ", write_marker, !IO).

 marker_name(marker_stub, "stub").
+marker_name(marker_builtin_stub, "builtin_stub").
 marker_name(marker_infer_type, "infer_type").
 marker_name(marker_infer_modes, "infer_modes").
 marker_name(marker_user_marked_inline, "inline").
diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m
index 0cd1164..cdcccfb 100644
--- a/compiler/hlds_pred.m
+++ b/compiler/hlds_pred.m
@@ -310,6 +310,11 @@
             % is used to tell purity analysis and determinism analysis
             % not to issue warnings for these predicates.

+    ;       marker_builtin_stub
+            % This predicate is a builtin but has no clauses for whatever
+            % reason. typecheck.m should generate a stub clause for it but no
+            % warn about it.
+
     ;       marker_infer_type
             % Requests type inference for the predicate. These markers are
             % inserted by make_hlds for undeclared predicates.
diff --git a/compiler/intermod.m b/compiler/intermod.m
index a342b62..a4100eb 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -1919,6 +1919,7 @@ write_type_spec_pragma(Pragma, !IO) :-
 :- pred should_output_marker(marker::in, bool::out) is det.

 should_output_marker(marker_stub, no).
+should_output_marker(marker_builtin_stub, no).
     % Since the inferred declarations are output, these
     % don't need to be done in the importing module.
 should_output_marker(marker_infer_type, no).
diff --git a/compiler/table_gen.m b/compiler/table_gen.m
index 28ed269..2d95c6f 100644
--- a/compiler/table_gen.m
+++ b/compiler/table_gen.m
@@ -1974,6 +1974,7 @@ filter_marker(Marker) :-
 :- func keep_marker(marker) = bool.

 keep_marker(marker_stub) = no.
+keep_marker(marker_builtin_stub) = no.
 keep_marker(marker_infer_type) = no.
 keep_marker(marker_infer_modes) = no.
 keep_marker(marker_obsolete) = no.
diff --git a/compiler/typecheck.m b/compiler/typecheck.m
index 3b22054..9ccaf59 100644
--- a/compiler/typecheck.m
+++ b/compiler/typecheck.m
@@ -333,7 +333,9 @@ typecheck_pred_if_needed(Iteration, PredId,
!PredInfo, !ModuleInfo,
         Specs, Changed) :-
     (
         % Compiler-generated predicates are created already type-correct,
-        % so there's no need to typecheck them. The same is true for builtins.
+        % so there's no need to typecheck them. The same is true for builtins,
+        % except for builtins marked with marker_builtin_stub which need to
+        % have their stub clauses generated.
         % But, compiler-generated unify predicates are not guaranteed to be
         % type-correct if they call a user-defined equality or comparison
         % predicate or if it is a special pred for an existentially typed
@@ -342,7 +344,9 @@ typecheck_pred_if_needed(Iteration, PredId,
!PredInfo, !ModuleInfo,
             is_unify_or_compare_pred(!.PredInfo),
             \+ special_pred_needs_typecheck(!.PredInfo, !.ModuleInfo)
         ;
-            pred_info_is_builtin(!.PredInfo)
+            pred_info_is_builtin(!.PredInfo),
+            pred_info_get_markers(!.PredInfo, Markers),
+            \+ check_marker(Markers, marker_builtin_stub)
         )
     ->
         pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
@@ -381,37 +385,41 @@ typecheck_pred(Iteration, PredId, !PredInfo,
!ModuleInfo, Specs, Changed) :-
     ),
     pred_info_get_arg_types(!.PredInfo, _ArgTypeVarSet, ExistQVars0,
         ArgTypes0),
-    some [!ClausesInfo, !Info, !HeadTypeParams] (
-        pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
-        clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep0),
-        clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
-        clauses_info_get_varset(!.ClausesInfo, VarSet0),
-        clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes0),
-        pred_info_get_markers(!.PredInfo, Markers0),
-        % Handle the --allow-stubs and --warn-stubs options. If --allow-stubs
-        % is set, and there are no clauses, issue a warning (if --warn-stubs
-        % is set), and then generate a "stub" clause that just throws an
-        % exception.
+    pred_info_get_clauses_info(!.PredInfo, ClausesInfo0),
+    clauses_info_get_clauses_rep(ClausesInfo0, ClausesRep0),
+    pred_info_get_markers(!.PredInfo, Markers0),
+    % Handle the --allow-stubs and --warn-stubs options. If --allow-stubs
+    % is set, and there are no clauses, issue a warning (if --warn-stubs
+    % is set), and then generate a "stub" clause that just throws an
+    % exception.
+    clause_list_is_empty(ClausesRep0) = ClausesRep0IsEmpty,
+    (
+        ClausesRep0IsEmpty = yes,
         (
-            clause_list_is_empty(ClausesRep0) = yes,
             globals.lookup_bool_option(Globals, allow_stubs, yes),
             \+ check_marker(Markers0, marker_class_method)
         ->
             StartingSpecs = [report_no_clauses_stub(!.ModuleInfo, PredId,
                 !.PredInfo)],
-            PredPieces = describe_one_pred_name(!.ModuleInfo,
-                should_module_qualify, PredId),
-            PredName = error_pieces_to_string(PredPieces),
-            generate_stub_clause(PredName, !PredInfo, !.ModuleInfo, StubClause,
-                VarSet0, VarSet),
-            set_clause_list([StubClause], ClausesRep1),
-            clauses_info_set_clauses([StubClause], !ClausesInfo),
-            clauses_info_set_varset(VarSet, !ClausesInfo)
+            generate_stub_clause(PredId, !PredInfo, !.ModuleInfo)
         ;
+            check_marker(Markers0, marker_builtin_stub)
+        ->
             StartingSpecs = [],
-            VarSet = VarSet0,
-            ClausesRep1 = ClausesRep0
-        ),
+            generate_stub_clause(PredId, !PredInfo, !.ModuleInfo)
+        ;
+            StartingSpecs = []
+        )
+    ;
+        ClausesRep0IsEmpty = no,
+        StartingSpecs = []
+    ),
+    some [!ClausesInfo, !Info, !HeadTypeParams] (
+        pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
+        clauses_info_get_clauses_rep(!.ClausesInfo, ClausesRep1),
+        clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
+        clauses_info_get_varset(!.ClausesInfo, VarSet),
+        clauses_info_get_explicit_vartypes(!.ClausesInfo, ExplicitVarTypes0),
         clause_list_is_empty(ClausesRep1) = ClausesRep1IsEmpty,
         (
             ClausesRep1IsEmpty = yes,
@@ -658,10 +666,28 @@ check_mention_existq_var(TypeVarSet, Impl, TVar, !Info) :-
     %       private_builtin.sorry(PredName).
     % depending on whether the predicate is part of
     % the Mercury standard library or not.
-:- pred generate_stub_clause(string::in, pred_info::in, pred_info::out,
+    %
+:- pred generate_stub_clause(pred_id::in, pred_info::in, pred_info::out,
+    module_info::in) is det.
+
+generate_stub_clause(PredId, !PredInfo, ModuleInfo) :-
+    some [!ClausesInfo] (
+        pred_info_get_clauses_info(!.PredInfo, !:ClausesInfo),
+        clauses_info_get_varset(!.ClausesInfo, VarSet0),
+        PredPieces = describe_one_pred_name(ModuleInfo, should_module_qualify,
+            PredId),
+        PredName = error_pieces_to_string(PredPieces),
+        generate_stub_clause_2(PredName, !PredInfo, ModuleInfo, StubClause,
+            VarSet0, VarSet),
+        clauses_info_set_clauses([StubClause], !ClausesInfo),
+        clauses_info_set_varset(VarSet, !ClausesInfo),
+        pred_info_set_clauses_info(!.ClausesInfo, !PredInfo)
+    ).
+
+:- pred generate_stub_clause_2(string::in, pred_info::in, pred_info::out,
     module_info::in, clause::out, prog_varset::in, prog_varset::out) is det.

-generate_stub_clause(PredName, !PredInfo, ModuleInfo, StubClause, !VarSet) :-
+generate_stub_clause_2(PredName, !PredInfo, ModuleInfo, StubClause, !VarSet) :-
     % Mark the predicate as a stub
     % (i.e. record that it originally had no clauses)
     pred_info_get_markers(!.PredInfo, Markers0),
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list