[m-rev.] for review: duplicating fields from type defns to cons defns

[Peter Ross]

On Mon, Jan 12, 2009 at 1:07 PM, Zoltan Somogyi <zs at csse.unimelb.edu.au> wrote:
> Duplicate some fields of each hlds_type_defn to the cons_defns of its data
> constructors. This way, the type analysis algorithm can avoid the need for
> a separate lookup in the type table. Since we are only copying references
> to terms that are never updated and are always live throughout execution
> anyway to other terms that are never updated and are always live throughout
> execution anyway, the only cost is only a few bytes per cons_id.
>
> compiler/hlds_data.m:
>        Add a tvarset field to the cons_defn types, and put the other fields
>        in a more logical order.
>
> compiler/add_type.m:
>        Make the duplications.
>
> compiler/type_util.m:
>        Delete a predicate that looked up both a type_ctor's and a cons_id's
>        defn, since its callers now need only the cons_id's definition. Replace
>        with a det version of an existing semidet predicate that does the
>        lookup of the cons_id's definition.
>
> compiler/intermod.m:
> compiler/ml_unify_gen.m:
> compiler/post_typecheck.m:
> compiler/recompilation.usage.m:
> compiler/typecheck.m:
>        Conform to the changes above.
>
> Zoltan.
>
> cvs diff: Diffing .
> cvs diff: Diffing analysis
> cvs diff: Diffing bindist
> cvs diff: Diffing boehm_gc
> cvs diff: Diffing boehm_gc/Mac_files
> cvs diff: Diffing boehm_gc/cord
> cvs diff: Diffing boehm_gc/cord/private
> cvs diff: Diffing boehm_gc/doc
> cvs diff: Diffing boehm_gc/include
> cvs diff: Diffing boehm_gc/include/private
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
> cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
> cvs diff: Diffing boehm_gc/tests
> cvs diff: Diffing boehm_gc/windows-untested
> cvs diff: Diffing boehm_gc/windows-untested/vc60
> cvs diff: Diffing boehm_gc/windows-untested/vc70
> cvs diff: Diffing boehm_gc/windows-untested/vc71
> cvs diff: Diffing browser
> cvs diff: Diffing bytecode
> cvs diff: Diffing compiler
> Index: compiler/add_type.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_type.m,v
> retrieving revision 1.32
> diff -u -b -r1.32 add_type.m
> --- compiler/add_type.m 11 Feb 2008 21:25:50 -0000      1.32
> +++ compiler/add_type.m 10 Jan 2009 13:27:58 -0000
> @@ -361,6 +361,7 @@
>     get_type_defn_context(TypeDefn, Context),
>     get_type_defn_tvarset(TypeDefn, TVarSet),
>     get_type_defn_tparams(TypeDefn, Args),
> +    get_type_defn_kind_map(TypeDefn, KindMap),
>     get_type_defn_body(TypeDefn, Body),
>     get_type_defn_status(TypeDefn, Status),
>     get_type_defn_need_qualifier(TypeDefn, NeedQual),
> @@ -370,7 +371,7 @@
>         module_info_get_cons_table(!.ModuleInfo, Ctors0),
>         module_info_get_partial_qualifier_info(!.ModuleInfo, PQInfo),
>         module_info_get_ctor_field_table(!.ModuleInfo, CtorFields0),
> -        ctors_add(ConsList, TypeCtor, TVarSet, NeedQual, PQInfo,
> +        ctors_add(ConsList, TypeCtor, TVarSet, Args, KindMap, NeedQual, PQInfo,
>             Context, Status, CtorFields0, CtorFields, Ctors0, Ctors,
>             [], CtorAddSpecs),
>         module_info_set_cons_table(Ctors, !ModuleInfo),
> @@ -675,32 +676,34 @@
>     ).
>
>  :- pred ctors_add(list(constructor)::in, type_ctor::in, tvarset::in,
> -    need_qualifier::in, partial_qualifier_info::in, prog_context::in,
> +    list(type_param)::in, tvar_kind_map::in, need_qualifier::in,
> +    partial_qualifier_info::in, prog_context::in,
>     import_status::in, ctor_field_table::in, ctor_field_table::out,
>     cons_table::in, cons_table::out,
>     list(error_spec)::in, list(error_spec)::out) is det.
>
> -ctors_add([], _, _, _, _, _, _, !FieldNameTable, !Ctors, !Specs).
> -ctors_add([Ctor | Rest], TypeCtor, TVarSet, NeedQual, PQInfo, _Context,
> -        ImportStatus, !FieldNameTable, !Ctors, !Specs) :-
> +ctors_add([], _, _, _, _, _, _, _, _, !FieldNameTable, !Ctors, !Specs).
> +ctors_add([Ctor | Rest], TypeCtor, TVarSet, TypeParams, KindMap, NeedQual,
> +        PQInfo, _Context, ImportStatus, !FieldNameTable, !Ctors, !Specs) :-
>     Ctor = ctor(ExistQVars, Constraints, Name, Args, Context),
>     QualifiedConsId = make_cons_id(Name, Args, TypeCtor),
> -    ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Args, TypeCtor,
> -        Context),
> -    %
> -    % Insert the fully-qualified version of this cons_id into the
> -    % cons_table.
> -    % Also check that there is at most one definition of a given
> -    % cons_id in each type.
> -    %
> +    ConsDefn = hlds_cons_defn(TypeCtor, TVarSet, TypeParams, KindMap,
> +        ExistQVars, Constraints, Args, Context),
> +
> +    % Insert the fully-qualified version of this cons_id into the cons_table.
> +    % Also check that there is at most one definition of a given cons_id
> +    % in each type.
> +
>     ( map.search(!.Ctors, QualifiedConsId, QualifiedConsDefns0) ->
>         QualifiedConsDefns1 = QualifiedConsDefns0
>     ;
>         QualifiedConsDefns1 = []
>     ),
>     (
> +        some [OtherConsDefn] (
>         list.member(OtherConsDefn, QualifiedConsDefns1),
> -        OtherConsDefn = hlds_cons_defn(_, _, _, TypeCtor, _)
> +            OtherConsDefn ^ cons_type_ctor = TypeCtor
> +        )
>     ->
>         QualifiedConsIdStr = cons_id_to_string(QualifiedConsId),
>         TypeCtorStr = type_ctor_to_string(TypeCtor),
> @@ -741,8 +744,8 @@
>     ;
>         unexpected(this_file, "ctors_add: cons_id not qualified")
>     ),
> -    ctors_add(Rest, TypeCtor, TVarSet, NeedQual, PQInfo, Context,
> -        ImportStatus, !FieldNameTable, !Ctors, !Specs).
> +    ctors_add(Rest, TypeCtor, TVarSet, TypeParams, KindMap, NeedQual,
> +        PQInfo, Context, ImportStatus, !FieldNameTable, !Ctors, !Specs).
>
>  :- pred add_ctor(string::in, int::in, hlds_cons_defn::in, module_name::in,
>     cons_id::out, cons_table::in, cons_table::out) is det.
> Index: compiler/hlds_data.m
> ===================================================================
> RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_data.m,v
> retrieving revision 1.122
> diff -u -b -r1.122 hlds_data.m
> --- compiler/hlds_data.m        4 Sep 2008 11:41:00 -0000       1.122
> +++ compiler/hlds_data.m        10 Jan 2009 12:49:00 -0000
> @@ -59,25 +59,30 @@
>     %
>  :- type hlds_cons_defn
>     --->    hlds_cons_defn(
> -                % maybe add tvarset here?
> -                % you can get the tvarset from the hlds.type_defn.
> -                cons_exist_tvars    :: existq_tvars,
> -                                    % existential type vars
> +                % The result type, i.e. the type constructor to which this
> +                % cons_defn belongs.
> +                cons_type_ctor      :: type_ctor,
>
> +                % These three fields are copies of the first three fields
> +                % of the hlds_type_defn for cons_type_ctor. They specify
> +                % the tvarset from which the type variables in the argument
> +                % types come, the type constructor's type parameter list,
> +                % and the kinds of the type variables.
> +                cons_type_tvarset   :: tvarset,
> +                cons_type_params    :: list(type_param),
> +                cons_type_kinds     :: tvar_kind_map,
> +

You should also add to this comment why you have copied these fields.

I would just add the justification from the log message.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------