[m-rev.] for review: implement deconstruct of du types for Erlang backend

[Peter Wang]

On 04/06/07, Peter Ross <pro at missioncriticalit.com> wrote:
> Peter Wang,
>
> Can you have a look at this?
>
>
> ===================================================================
>
>
> Estimated hours taken: 8
> Branches: main
>
> Implement the RTTI for calling deconstruct on du types.
>
> compiler/erl_rtti.m:
>         Fix a bug where we gave the incorrect arity of notag functors.
>         Give the correct ordinal to enum and du functors.
>         Rewrite rtti_type_info_to_elds and rtti_pseudo_type_info_to_elds
>         so that we no longer generate code which causes an infinite loop
>         when constructing these types.

Briefly mention how.

> Index: compiler/erl_rtti.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/erl_rtti.m,v
> retrieving revision 1.7
> diff -u -r1.7 erl_rtti.m
> --- compiler/erl_rtti.m 1 Jun 2007 06:05:43 -0000       1.7
> +++ compiler/erl_rtti.m 4 Jun 2007 06:40:58 -0000

> @@ -165,7 +165,8 @@
>      NoTagFunctor = notag_functor(Name, TypeInfo, ArgName),
>      ArgTypeInfo = convert_to_rtti_maybe_pseudo_type_info_or_self(TypeInfo),
>      ArgInfos = [du_arg_info(ArgName, ArgTypeInfo)],
> -    DUFunctor = erlang_du_functor(Name, 0, 1, Name, ArgInfos, no),
> +    DUFunctor =
> +        erlang_du_functor(Name, 1, 1, erlang_atom_raw(Name), ArgInfos, no),
>      Details = erlang_du([DUFunctor]).
>  erlang_type_ctor_details_2(eqv(Type)) = erlang_eqv(Type).
>  erlang_type_ctor_details_2(builtin(Builtin)) = erlang_builtin(Builtin).
> @@ -178,8 +179,8 @@
>      %
>  :- func convert_enum_functor(enum_functor) = erlang_du_functor.
>
> -convert_enum_functor(enum_functor(Name, _)) =
> -    erlang_du_functor(Name, 0, 1, Name, [], no).
> +convert_enum_functor(enum_functor(Name, Ordinal)) =
> +    erlang_du_functor(Name, 0, Ordinal, erlang_atom_raw(Name), [], no).
>
>      %
>      % Convert a du_functor into the equivalent erlang_du_functor
> @@ -187,7 +188,8 @@
>  :- func convert_du_functor(du_functor) = erlang_du_functor.
>
>  convert_du_functor(du_functor(Name, Arity, Ordinal, _, ArgInfos, Exist)) =
> -    erlang_du_functor(Name, Arity, Ordinal + 1, Name, ArgInfos, Exist).
> +    erlang_du_functor(Name, Arity,
> +        Ordinal, erlang_atom_raw(Name), ArgInfos, Exist).
>
>  :- func convert_to_rtti_maybe_pseudo_type_info_or_self(
>      rtti_maybe_pseudo_type_info) = rtti_maybe_pseudo_type_info_or_self.
> @@ -387,53 +389,51 @@
>  :- pred rtti_type_info_to_elds(module_info::in, rtti_type_info::in,
>      list(elds_rtti_defn)::out) is det.
>
> -rtti_type_info_to_elds(_ModuleInfo, TypeInfo, RttiDefns) :-
> -    TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
> -
> -    TypeCtorRttiId = elds_rtti_type_ctor_id(RttiTypeCtor),
> -    ELDSTypeInfo = elds_rtti_ref(TypeCtorRttiId),
> -
> -    RttiId = elds_rtti_type_info_id(TypeInfo),
> -    IsExported = no,
> -    RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
> -        elds_clause([], ELDSTypeInfo)),
> -
> -    RttiDefns = [RttiDefn].
> -
>  rtti_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns) :-
> -    TypeInfo = plain_type_info(TypeCtor, ArgTypeInfos),
> -
> -    rtti_type_info_to_elds_2(ModuleInfo,
> -            ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
> +    (
> +        TypeInfo = plain_arity_zero_type_info(RttiTypeCtor),
>
> -    ELDSTypeInfo = elds_tuple(
> -        [elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)) | ELDSArgTypeInfos]),
> +        TypeCtorRttiId = elds_rtti_type_ctor_id(RttiTypeCtor),
> +        ELDSTypeInfo = elds_rtti_ref(TypeCtorRttiId),
>
> -    RttiId = elds_rtti_type_info_id(TypeInfo),
> -    IsExported = no,
> -    RttiDefn = elds_rtti_defn(RttiId, IsExported, varset.init,
> -        elds_clause([], elds_term(ELDSTypeInfo))),
> +        ArgRttiDefns = []
> +    ;
> +        TypeInfo = plain_type_info(TypeCtor, ArgTypeInfos),
>
> -    RttiDefns = [RttiDefn | ArgRttiDefns ].
> +        rtti_type_info_to_elds_2(ModuleInfo,
> +                ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
>
> -rtti_type_info_to_elds(ModuleInfo, TypeInfo, RttiDefns) :-
> -    TypeInfo = var_arity_type_info(VarCtorId, ArgTypeInfos),
> -    TypeCtor = var_arity_id_to_rtti_type_ctor(VarCtorId),
> +        ELDSTypeInfo = elds_term(elds_tuple([
> +            elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)) |
> +            ELDSArgTypeInfos]))
> +    ;
> +        TypeInfo = var_arity_type_info(VarCtorId, ArgTypeInfos),
> +        TypeCtor = var_arity_id_to_rtti_type_ctor(VarCtorId),
>
> -    rtti_type_info_to_elds_2(ModuleInfo,
> -            ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
> +        rtti_type_info_to_elds_2(ModuleInfo,
> +                ArgTypeInfos, ELDSArgTypeInfos, ArgRttiDefns),
>
> -    ELDSTypeInfo = elds_tuple([
> -        elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)),
> -        elds_term(elds_int(list.length(ArgTypeInfos))) |
> -        ELDSArgTypeInfos]),
> +        ELDSTypeInfo = elds_term(elds_tuple([
> +            elds_rtti_ref(elds_rtti_type_ctor_id(TypeCtor)),
> +            elds_term(elds_int(list.length(ArgTypeInfos))) |
> +            ELDSArgTypeInfos]))
> +    ),
>
> +        %
> +        % A type_info can contain a call to construct a type_ctor_info
> +        % which requires this type_info, leading to infinite recursion,

full stop

> @@ -751,42 +739,92 @@
>      ).
>
>
> -:- pred erlang_du_functor(module_info::in, erlang_du_functor::in,
> -    elds_expr::out, list(elds_rtti_defn)::in, list(elds_rtti_defn)::out) is det.
> +%-----------------------------------------------------------------------------%
> +%-----------------------------------------------------------------------------%
>
> -erlang_du_functor(ModuleInfo, Functor, elds_term(Term), !Defns) :-
> -    Functor = erlang_du_functor(Name, Arity, Ord, Rep, ArgInfos, MaybeExist),
> +:- import_module deconstruct.
> +:- import_module exception.

Move these to the top of the file.

>
> -    list.map_foldl(du_arg_info(ModuleInfo), ArgInfos, ELDSArgInfos, !Defns),
> -    ELDSExist = convert_to_elds_term(MaybeExist),
> +    %
> +    % rtti_to_elds_expr(MI, T, Expr, !Defns)
> +    %
> +    % Given some T which is a representation of the RTTI data,
> +    % it generates the elds_expr which would represent that T as an erlang
> +    % term.

I suggest

   Return the ELDS expression, Expr, that represents the RTTI data, T, as
   an Erlang term.

and writing MI in full.

> +:- pred convert_arg_to_elds_expr(module_info::in, T::in, int::in,
>      elds_expr::out, list(elds_rtti_defn)::in, list(elds_rtti_defn)::out) is det.
>
> -du_arg_info(ModuleInfo, du_arg_info(MaybeName, TI), elds_term(Term), !Defns) :-
> -    (
> -        MaybeName = yes(Name),
> -        NameTerm = elds_string(Name)
> +convert_arg_to_elds_expr(MI, Term, Index, ELDS, !Defns) :-
> +    ( arg(Term, do_not_allow, Index, Arg) ->
> +        rtti_to_elds_expr(MI, Arg, ELDS, !Defns)

Module qualify that I think.

> +:- pred convert_maybe_pseudo_type_info_to_elds(module_info::in,
> +    rtti_maybe_pseudo_type_info::in,
> +    elds_expr::out, list(elds_rtti_defn)::in, list(elds_rtti_defn)::out) is det.
> +
> +convert_maybe_pseudo_type_info_to_elds(MI, TI, Expr, !Defns) :-
> +    maybe_pseudo_type_info_to_elds(MI, TI, RttiId, Defns),
> +    !:Defns = list.sort_and_remove_dups(Defns ++ !.Defns),
> +    Expr = elds_rtti_ref(RttiId).

Rename Defns to distinguish it from !Defns.

> @@ -102,17 +105,19 @@
>                  edu_name            :: string,
>                  edu_orig_arity      :: int,
>
> -                    % Size of the tuple needed to represent the
> -                    % functor.
> +                    % The declaration order of the functor.
>                  edu_ordinal         :: int,
>
>                      % erlang atom which represents the functor
>                      % currently encoded version of name
>                      % in the future maybe name_arity
> -                edu_rep             :: string,
> +                edu_rep             :: erlang_atom_raw,
>                  edu_arg_infos       :: list(du_arg_info),
>                  edu_exist_info      :: maybe(exist_info)
>              ).
> +
> +:- type erlang_atom_raw
> +    ---> erlang_atom_raw(string).

Indent that and add a comment that it's needed for rtti_to_elds_expr.

> Index: library/erlang_rtti_implementation.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/erlang_rtti_implementation.m,v
> retrieving revision 1.3
> diff -u -r1.3 erlang_rtti_implementation.m
> --- library/erlang_rtti_implementation.m        1 Jun 2007 08:30:58 -0000       1.3
> +++ library/erlang_rtti_implementation.m        4 Jun 2007 06:40:58 -0000
> @@ -285,7 +285,12 @@
>          Functor, Arity, Arguments) :-
>      (
>          TypeCtorRep = etcr_du,
> -        Functor = "XXX", Arity = 0, Arguments = []
> +        FunctorReps = TypeCtorInfo ^ type_ctor_functors,
> +        FunctorRep = matching_du_functor(FunctorReps, Term),
> +        Functor = FunctorRep ^ edu_name,
> +        Arity = FunctorRep ^ edu_orig_arity,
> +        Arguments = list.map(
> +            get_du_functor_arg(TypeInfo, FunctorRep, Term), 1 .. Arity)
>      ;
>          TypeCtorRep = etcr_list,
>          Functor = "XXX", Arity = 0, Arguments = []
> @@ -366,8 +371,8 @@
>                  Arity = 0,
>                  Arguments = []
>              ;
> -                deconstruct_2(Term, TypeInfo, TypeCtorInfo, etcr_foreign, NonCanon,
> -                        Functor, Arity, Arguments)
> +                deconstruct_2(Term, TypeInfo, TypeCtorInfo,
> +                    etcr_foreign, NonCanon, Functor, Arity, Arguments)
>              )
>          )
>      ;
> @@ -389,6 +394,132 @@
>      ).
>
>      %
> +    % matching_du_functor(Functors, Term)
> +    %
> +    % finds the erlang_du_functor in the list Functors which describes
> +    % the given Term.
> +    %
> +:- func matching_du_functor(list(erlang_du_functor), T) = erlang_du_functor.
> +
> +matching_du_functor([], _) = func_error(this_file ++ " matching_du_functor/2").
> +matching_du_functor([F | Fs], T) =
> +    ( matches_du_functor(T, F) ->
> +        F
> +    ;
> +        matching_du_functor(Fs, T)
> +    ).
> +
> +    %
> +    % A functor matches a term, if the first argument of the term
> +    % is the same erlang atom as the recorded in the edu_rep field,

as recorded

> +    % and the size of the term matches the calculated size of term.

of Term.

> +    %
> +    % Note we have to do this second step because a functor is distinguished
> +    % by both it's name and arity.

its

> +    %
> +    % Note it is possible for this code to do the wrong thing, see the comment
> +    % at the top of erl_unify_gen.m.
> +    %

Add to the comment in erl_unify_gen that this comment should be deleted
once that's fixed.

> +:- pred matches_du_functor(T::in, erlang_du_functor::in) is semidet.
> +
> +matches_du_functor(Term, Functor) :-
> +    check_functor(Term, Functor ^ edu_rep, Size),
> +    Functor ^ edu_orig_arity + 1 + extra_args(Functor) = Size.
> +
> +:- pred check_functor(T::in, erlang_atom::in, int::out) is semidet.
> +:- pragma foreign_proc("Erlang", check_functor(Term::in, Atom::in, Size::out),
> +        [will_not_call_mercury, promise_pure, thread_safe], "

Move the quote down.

> @@ -584,6 +727,10 @@
>      [promise_pure],
>  "
>      % TypeInfo_for_U to avoid compiler warning
> +
> +    %io:format(""get_subterm(~p, ~p, ~p, ~p)~n"",
> +    %    [TypeInfo, Term, Index, ExtraArgs]),
> +

Delete that.

>      TypeInfo_for_T = TypeInfo,
>      Arg = element(Index + ExtraArgs, Term)
>  ").
> @@ -672,7 +819,7 @@
>
>  semidet_unimplemented(S) :-
>      ( semidet_succeed ->
> -        error("rtti_implementation: unimplemented: " ++ S)
> +        error(this_file ++ ": unimplemented: " ++ S)
>      ;
>          semidet_succeed
>      ).
> @@ -681,7 +828,7 @@
>
>  det_unimplemented(S) :-
>      ( semidet_succeed ->
> -        error("rtti_implementation: unimplemented: " ++ S)
> +        error(this_file ++ ": unimplemented: " ++ S)
>      ;
>          true
>      ).
> @@ -788,6 +935,117 @@
>      type_to_univ(Term, Univ),
>      det_univ_to_type(Univ, Actual).
>
> +%-----------------------------------------------------------------------------%
> +%-----------------------------------------------------------------------------%
> +%
> +% These types have to be kept in sync with the corresponding types in
> +% compiler/erlang_rtti.m
> +%
> +
> +:- import_module maybe.

Move that up.

> +:- type maybe_pseudo_type_info
> +    --->    pseudo(pseudo_type_info_thunk)
> +    ;       plain(type_info_thunk).
> +
> +% XXX
> +:- type pseudo_type_info_thunk.
> +:- pragma foreign_type("Erlang", pseudo_type_info_thunk, "").
> +:- type pseudo_type_info_thunk ---> pseudo_type_info_thunk.

Any reason?

> +
> +:- type type_info_thunk.
> +:- pragma foreign_type("Erlang", type_info_thunk, "").
> +:- type type_info_thunk ---> type_info_thunk.
> +
> +:- type evaluated_type_info_thunk
> +    --->    universal_type_info(int)
> +    ;       existential_type_info(int)
> +    ;       type_info(type_info)
> +    .
> +
> +:- func eval_type_info(type_info_thunk) = evaluated_type_info_thunk.
> +:- pragma foreign_proc("Erlang", eval_type_info(Thunk::in) = (TypeInfo::out),
> +        [will_not_call_mercury, thread_safe, promise_pure], "

Reformat that.

> +    MaybeTypeInfo = Thunk(),
> +    TypeInfo =
> +        if
> +            is_integer(MaybeTypeInfo), MaybeTypeInfo < 512 ->
> +                { universal_type_info, MaybeTypeInfo };
> +            is_integer(MaybeTypeInfo) ->
> +                { existential_type_info, MaybeTypeInfo - 512 };
> +            true ->
> +                { type_info, MaybeTypeInfo }
> +        end,
> +    % io:format(""eval_type_info: ~p~n"", [TypeInfo]),
> +    void

Delete that.


Peter
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------