[m-rev.] for review: do not generate trace events in private_builtin

[Julien Fischer]

On Fri, 18 Nov 2005, Ian MacLarty wrote:

> Index: library/builtin.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
> retrieving revision 1.112
> diff -u -r1.112 builtin.m
> --- library/builtin.m	17 Oct 2005 11:35:16 -0000	1.112
> +++ library/builtin.m	17 Nov 2005 08:43:23 -0000
> @@ -368,15 +368,6 @@
>
>  :- implementation.
>
> -:- import_module char.
> -:- import_module float.
> -:- import_module int.
> -:- import_module list.
> -:- import_module require.
> -:- import_module std_util.
> -:- import_module string.
> -:- import_module string.
> -
>  %-----------------------------------------------------------------------------%
>
>  false :-
> Index: library/exception.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/exception.m,v
> retrieving revision 1.100
> diff -u -r1.100 exception.m
> --- library/exception.m	20 Sep 2005 03:47:30 -0000	1.100
> +++ library/exception.m	16 Nov 2005 12:50:21 -0000
> @@ -720,10 +720,18 @@
>
>  % builtin_throw and builtin_catch are implemented below using
>  % hand-coded low-level C code.
> +% builtin_throw is exported, so that it can be called from private_builtin.
> +% private_builtin needs to call builtin_throw directly to avoid generating
> +% trace events.
>  %
That should be marked with an XXX.

>  :- pragma terminates(builtin_throw/1).
> +
> +:- interface.
> +
>  :- pred builtin_throw(univ::in) is erroneous.
>
> +:- implementation.
> +
>  :- /* impure */
>     pred builtin_catch(pred(T), handler(T), T).
>  :- mode builtin_catch(pred(out) is det, in(handler), out) is det.
> Index: library/private_builtin.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
> retrieving revision 1.148
> diff -u -r1.148 private_builtin.m
> --- library/private_builtin.m	17 Oct 2005 07:43:28 -0000	1.148
> +++ library/private_builtin.m	16 Nov 2005 12:57:58 -0000
> @@ -25,6 +25,11 @@
>  % definitions because the compiler generates code for them inline. Some others
>  % are implemented in the runtime.
>
> +% NOTE: This module is never traced, even in debugging grades.  To avoid
> +% confusing the declarative debugger, all predicates and functions defined in
> +% this module should avoid calling predicates or functions in other modules
> +% which could be traced.
> +
>  %-----------------------------------------------------------------------------%
>  %-----------------------------------------------------------------------------%
>
> @@ -34,6 +39,8 @@
>
>  :- interface.
>
> +:- import_module type_desc.
> +
>      % This section of the module contains predicates that are used
>      % by the compiler, to implement polymorphism. These predicates
>      % should not be used by user programs directly.
> @@ -102,20 +109,31 @@
>      %
>  :- pred typed_compare(comparison_result::uo, T1::in, T2::in) is det.
>
> +    % The function type_of/1 returns a representation of the type
> +    % of its argument.
> +    %
> +    % (Note: it is not possible for the type of a variable to be an unbound
> +    % type variable; if there are no constraints on a type variable, then the
> +    % typechecker will use the type `void'. `void' is a special (builtin) type
> +    % that has no constructors. There is no way of creating an object of
> +    % type `void'. `void' is not considered to be a discriminated union, so
> +    % get_functor/5 and construct/3 will fail if used upon a value of
> +    % this type.)
> +    %
> +:- func type_of(T::unused) = (type_desc__type_desc::out) is det.
> +
>      % N.B. interface continued below.
>
>  %-----------------------------------------------------------------------------%
>
>  :- implementation.
>
> -:- import_module char.
> +:- import_module exception.
>  :- import_module float.
>  :- import_module int.
>  :- import_module list.
>  :- import_module require.
>  :- import_module std_util.
> -:- import_module string.
> -:- import_module string.
>
>  :- pragma foreign_code("C#", "
>
> @@ -147,8 +165,8 @@
>  builtin_unify_character(C, C).
>
>  builtin_compare_character(R, X, Y) :-
> -    char__to_int(X, XI),
> -    char__to_int(Y, YI),
> +    private_builtin.to_int(X, XI),
> +    private_builtin.to_int(Y, YI),
>      ( XI < YI ->
>          R = (<)
>      ; XI = YI ->
> @@ -200,20 +218,20 @@
>      ).
>
>  builtin_unify_tuple(_, _) :-
> -    ( semidet_succeed ->
> +    ( private_builtin.semidet_succeed ->
>          % The generic unification function in the runtime
>          % should handle this itself.
> -        error("builtin_unify_tuple called")
> +        private_builtin.error("builtin_unify_tuple called")
>      ;
>          % The following is never executed.
> -        semidet_succeed
> +        private_builtin.semidet_succeed
>      ).
>
>  builtin_compare_tuple(Res, _, _) :-
> -    ( semidet_succeed ->
> +    ( private_builtin.semidet_succeed ->
>          % The generic comparison function in the runtime
>          % should handle this itself.
> -        error("builtin_compare_tuple called")
> +        private_builtin.error("builtin_compare_tuple called")
>      ;
>          % The following is never executed.
>          Res = (<)
> @@ -221,17 +239,17 @@
>
>  :- pragma no_inline(builtin_unify_pred/2).
>  builtin_unify_pred(_X, _Y) :-
> -    ( semidet_succeed ->
> -        error("attempted higher-order unification")
> +    ( private_builtin.semidet_succeed ->
> +        private_builtin.error("attempted higher-order unification")
>      ;
>          % The following is never executed.
> -        semidet_succeed
> +        private_builtin.semidet_succeed
>      ).
>
>  :- pragma no_inline(builtin_compare_pred/3).
>  builtin_compare_pred(Result, _X, _Y) :-
> -    ( semidet_succeed ->
> -        error("attempted higher-order comparison")
> +    ( private_builtin.semidet_succeed ->
> +        private_builtin.error("attempted higher-order comparison")
>      ;
>          % The following is never executed.
>          Result = (<)
> @@ -240,10 +258,11 @@
>  :- pragma no_inline(builtin_compare_non_canonical_type/3).
>  builtin_compare_non_canonical_type(Res, X, _Y) :-
>      % suppress determinism warning
> -    ( semidet_succeed ->
> +    ( private_builtin.semidet_succeed ->
> +        % XXX The call to type_name below may generate trace events.

Wasn't the point of this diff to avoid this?

>          Message = "call to compare/3 for non-canonical type `"
> -            ++ type_name(type_of(X)) ++ "'",
> -        error(Message)
> +            ++ type_desc.type_name(private_builtin.type_of(X)) ++ "'",
> +        private_builtin.error(Message)
>      ;
>          % The following is never executed.
>          Res = (<)
> @@ -251,19 +270,19 @@
>
>  :- pragma no_inline(compare_error/0).
>  compare_error :-
> -    error("internal error in compare/3").
> +    private_builtin.error("internal error in compare/3").
>
>  %-----------------------------------------------------------------------------%
>
>  typed_unify(X, Y) :-
> -    ( type_of(X) = type_of(Y) ->
> +    ( private_builtin.type_of(X) = private_builtin.type_of(Y) ->
>          unsafe_type_cast(X, Y)
>      ;
>          fail
>      ).
>
>  typed_compare(R, X, Y) :-
> -    compare(R0, type_of(X), type_of(Y)),
> +    compare(R0, private_builtin.type_of(X), private_builtin.type_of(Y)),
>      ( R0 = (=) ->
>          unsafe_type_cast(X, Z),
>          compare(R, Z, Y)
> @@ -271,6 +290,26 @@
>          R = R0
>      ).
>
> +:- pragma foreign_proc("C",
> +    type_of(_Value::unused) = (TypeInfo::out),
> +    [will_not_call_mercury, thread_safe, promise_pure],
> +"{
> +    TypeInfo = TypeInfo_for_T;
> +
> +    /*
> +    ** We used to collapse equivalences for efficiency here, but that's not
> +    ** always desirable, due to the reverse mode of make_type/2, and efficiency
> +    ** of type_infos probably isn't very important anyway.
> +    */
> +#if 0
> +    MR_save_transient_registers();
> +    TypeInfo = (MR_Word) MR_collapse_equivalences(
> +        (MR_TypeInfo) TypeInfo_for_T);
> +    MR_restore_transient_registers();
> +#endif
> +
> +}").
> +
>  %-----------------------------------------------------------------------------%
>  %-----------------------------------------------------------------------------%
>
> @@ -901,13 +940,11 @@
>  ").
>
>  trailed_nondet_pragma_foreign_code :-
> -    Msg = string__append_list([
> -        "Sorry, not implemented:\n",
> -        "for the MLDS back-end (`--high-level-code')\n",
> -        "nondet `pragma c_code' or `pragma foreign_code'\n",
> -        "is not supported when trailing (`--use-trail') is enabled."
> -    ]),
> -    error(Msg).
> +    Msg = "Sorry, not implemented:\n\
> +for the MLDS back-end (`--high-level-code')\n\
> +nondet `pragma c_code' or `pragma foreign_code'\n\
> +is not supported when trailing (`--use-trail') is enabled.",
> +    private_builtin.error(Msg).
>
>  %-----------------------------------------------------------------------------%
>
> @@ -1076,13 +1113,11 @@
>  ").
>
>  reclaim_heap_nondet_pragma_foreign_code :-
> -    Msg = string__append_list([
> -        "Sorry, not implemented:\n",
> -        "for the MLDS back-end (`--high-level-code')\n",
> -        "nondet `pragma c_code' or `pragma foreign_code'\n",
> -        "is not supported when `--reclaim-heap-on-failure' is enabled."
> -    ]),
> -    error(Msg).
> +    Msg = "Sorry, not implemented:\n\
> +for the MLDS back-end (`--high-level-code')\n\
> +nondet `pragma c_code' or `pragma foreign_code'\n\
> +is not supported when `--reclaim-heap-on-failure' is enabled.",
> +    private_builtin.error(Msg).
>
>  %-----------------------------------------------------------------------------%
>
> @@ -1226,22 +1261,22 @@
>  :- implementation.
>
>  unused :-
> -    ( semidet_succeed ->
> -        error("attempted use of dead predicate")
> +    ( private_builtin.semidet_succeed ->
> +        private_builtin.error("attempted use of dead predicate")
>      ;
>          % the following is never executed
>          true
>      ).
>
>  nyi_foreign_type_unify(_, _) :-
> -    ( semidet_succeed ->
> +    ( private_builtin.semidet_succeed ->
>          sorry("unify for foreign types")
>      ;
> -        semidet_succeed
> +        private_builtin.semidet_succeed
>      ).
>
>  nyi_foreign_type_compare(Result, _, _) :-
> -    ( semidet_succeed ->
> +    ( private_builtin.semidet_succeed ->
>          sorry("compare for foreign types")
>      ;
>          Result = (=)
> @@ -1301,11 +1336,11 @@
>  nonvar(_::unused) :- fail.
>
>  sorry(PredName) :-
> -    error("sorry, " ++ PredName ++ " not implemented\n" ++
> +    private_builtin.error("sorry, " ++ PredName ++ " not implemented\n" ++
>          "for this target language (or compiler back-end).").
>
>  no_clauses(PredName) :-
> -    error("no clauses for " ++ PredName).
> +    private_builtin.error("no clauses for " ++ PredName).
>
>  :- pragma foreign_proc(c,
>      imp,
> @@ -1528,4 +1563,73 @@
>  ").
>
>  %-----------------------------------------------------------------------------%
> +%
> +% The following predicates are duplicates of their versions in the
> +% publically visible part of the standard library.  They are duplicated here

s/publically/publicly/

> +% to guarantee that calls to procedures in private_builtin do not generate
> +% any trace events.
> +%
> +
> +:- pred semidet_succeed is semidet.
> +
> +:- pragma foreign_proc("C",
> +    semidet_succeed,
> +    [will_not_call_mercury, thread_safe, promise_pure],
> +"
> +    SUCCESS_INDICATOR = MR_TRUE;
> +").
> +
> +:- pragma foreign_proc("C#",
> +    semidet_succeed,
> +    [will_not_call_mercury, thread_safe, promise_pure],
> +"
> +    SUCCESS_INDICATOR = true;
> +").
> +
> +semidet_succeed :-
> +    0 + 0 = 0.
> +
> +:- pred to_int(character::in, int::out) is det.
> +
> +:- pragma foreign_proc("C",
> +    to_int(Character::in, Int::out),
> +    [will_not_call_mercury, promise_pure, thread_safe],
> +"
> +    Int = (MR_UnsignedChar) Character;
> +").
> +
> +:- pragma foreign_proc("C#",
> +    to_int(Character::in, Int::out),
> +    [will_not_call_mercury, promise_pure, thread_safe],
> +"
> +    Int = Character;
> +").
> +
> +:- pragma foreign_proc("Java",
> +    to_int(Character::in, Int::out),
> +    [will_not_call_mercury, promise_pure, thread_safe],
> +"
> +    Int = (int) Character;
> +").
> +
> +:- func string ++ string = string.
> +:- mode in ++ in = uo is det.
> +
> +:- pragma foreign_proc("C",
> +    (S1::in) ++ (S2::in) =  (S3::uo),
> +    [will_not_call_mercury, promise_pure, thread_safe],
> +"{
> +    size_t len_1, len_2;
> +    len_1 = strlen(S1);
> +    len_2 = strlen(S2);
> +    MR_allocate_aligned_string_msg(S3, len_1 + len_2, MR_PROC_LABEL);
> +    strcpy(S3, S1);
> +    strcpy(S3 + len_1, S2);
> +}").
> +
> +:- pred private_builtin.error(string::in) is erroneous.
> +
> +error(Message) :-
> +    exception.builtin_throw('new univ_cons'(software_error(Message))).
> +
>  %-----------------------------------------------------------------------------%
> Index: library/std_util.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
> retrieving revision 1.303
> diff -u -r1.303 std_util.m
> --- library/std_util.m	17 Oct 2005 11:35:20 -0000	1.303
> +++ library/std_util.m	16 Nov 2005 12:50:40 -0000
> @@ -1642,11 +1642,18 @@
>
>  %-----------------------------------------------------------------------------%
>
> +:- interface.
> +
>      % We call the constructor for univs `univ_cons' to avoid ambiguity
>      % with the univ/1 function which returns a univ.
> +    % The univ type is exported so that private_builtin can create
> +    % univs without generating trace events.
> +    %
>  :- type univ
>      --->    some [T] univ_cons(T).
>
> +:- implementation.
> +
>  univ_to_type(Univ, X) :- type_to_univ(X, Univ).
>

See my comments in the log message.

>  univ(X) = Univ :- type_to_univ(X, Univ).
> Index: library/type_desc.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
> retrieving revision 1.33
> diff -u -r1.33 type_desc.m
> --- library/type_desc.m	19 Sep 2005 04:29:01 -0000	1.33
> +++ library/type_desc.m	16 Nov 2005 12:03:43 -0000
> @@ -391,25 +391,7 @@
>          error("ground_pseudo_type_desc_to_type_desc_det: not ground")
>      ).
>
> -:- pragma foreign_proc("C",
> -    type_of(_Value::unused) = (TypeInfo::out),
> -    [will_not_call_mercury, thread_safe, promise_pure],
> -"{
> -    TypeInfo = TypeInfo_for_T;
> -
> -    /*
> -    ** We used to collapse equivalences for efficiency here, but that's not
> -    ** always desirable, due to the reverse mode of make_type/2, and efficiency
> -    ** of type_infos probably isn't very important anyway.
> -    */
> -#if 0
> -    MR_save_transient_registers();
> -    TypeInfo = (MR_Word) MR_collapse_equivalences(
> -        (MR_TypeInfo) TypeInfo_for_T);
> -    MR_restore_transient_registers();
> -#endif
> -
> -}").
> +type_of(Value) = private_builtin.type_of(Value).
>
>  :- pragma foreign_proc("C#",
>      type_of(_Value::unused) = (TypeInfo::out),

The rest of that looks ok.

Julien.
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------