[m-rev.] for review: decide each type's representation just once

Peter Wang novalazy at gmail.com
Thu Feb 15 16:17:22 AEDT 2018


On Thu, 15 Feb 2018 10:36:07 +1100 (AEDT), "Zoltan Somogyi" <zoltan.somogyi at runbox.com> wrote:
> Peter, can you please review this, preferably sometime soon?
> 
> The parts of the diff concerned with automatically comparing
> the output of the new algorithm with the output of the old
> are not intended to be committed. I included them both to show
> how I did that comparison, and to keep the functionality in case
> any changes in response to review comments require
> retesting.

You could commit it for a few days (however long it takes to produce a
source distribution) so that we can check for any differences on other
programs.

> Decide each type's representation just once.
> 
> compiler/du_type_layout.m:
>     Rewrite (most of) this module.
> 
>     The old algorithm was designed to preserve the approach of legacy code,
>     which could "decide" the representation of a type several times, each
>     decision overruling the previous decisions. (The first decision was for 
>     an unoptimized representation, the second tried to pack function symbols'
>     arguments, and the third tried to apply the direct_arg optimization.)
>     This made the code significantly harder to understand, and therefore
>     to modify.
> 
>     The rewrite replaces this algorithm with a totally new one. It works
>     in two passes, with the first pass fully deciding the representation
>     of simple types (dummy types, enums, and notag types) and gathering
>     some information, and the second pass fully deciding the representation
>     of all other types (using the information gathered in pass 1).
>     With this design, no decision is ever overruled, which makes
>     modifications *much* easier.
> 
>     This initial version of the new algorithm produces the exact same
>     type table as the old algorithm (verified by an automatic comparison)
>     in the hlc.gc, asm_fast.gc, asm_fast.gc.debug, csharp and java grades.
>     It contains some places where it intentionally does not take advantage
>     of optimization opportunities revealed by the new algorithm structure
>     to preserve this fact. Those opportunities will be seized by later
>     changes.
> 
> compiler/hlds_data.m:
>     We already had a predicate to convert the type table to an assoc_list
>     of type_ctors and type definitions. Add a predicate to convert in
>     the reverse direction as well, from assoc list to type table.
>     This is used by new code in du_type_layout.m.
> 
> compiler/hlds_module.m:
>     Give a name to a type used frequently in du_type_layout.m.
> 

> diff --git a/compiler/du_type_layout.m b/compiler/du_type_layout.m
> index 7d4cbaa..5663384 100644
> +++ b/compiler/du_type_layout.m
> @@ -13,42 +13,36 @@
...
> +
> +:- type maybe_unboxed_no_tag_types
> +    --->    no_unboxed_no_tag_types
> +    ;       use_unboxed_no_tag_types.

Maybe we should standardise on "notag" to avoid ambiguity.

> +%---------------------------------------------------------------------------%
> +
> +:- pred are_direct_args_enabled(globals::in, compilation_target::in,
> +    maybe_direct_args::out, direct_arg_map::in, direct_arg_map::out) is det.
> +
> +are_direct_args_enabled(Globals, Target, MaybeDirectArgs, !DirectArgMap) :-
> +    (
> +        Target = target_c,
> +        globals.lookup_bool_option(Globals, record_term_sizes_as_words,
> +            TermSizeWords),
> +        globals.lookup_bool_option(Globals, record_term_sizes_as_cells,
> +            TermSizeCells),
> +        ( if
> +            TermSizeWords = no,
> +            TermSizeCells = no
> +        then
> +            MaybeDirectArgs = direct_args_enabled
> +        else
> +            % We cannot use direct arg functors in term size grades.
> +            MaybeDirectArgs = direct_args_disabled,
> +            map.init(!:DirectArgMap)
> +        )
> +    ;
> +        ( Target = target_csharp
> +        ; Target = target_java
> +        ; Target = target_erlang
> +        ),
> +        % Direct arg functors have not (yet) been implemented on these targets.
> +        MaybeDirectArgs = direct_args_disabled,
> +        map.init(!:DirectArgMap)
> +    ).
>  

I suggest the caller clears DirectArgMap itself.

> @@ -193,459 +314,815 @@ build_type_repn_map([TypeRepn | TypeRepns], !TypeRepnMap) :-
>      build_type_repn_map(TypeRepns, !TypeRepnMap).
>  
>  %---------------------------------------------------------------------------%
> +%---------------------------------------------------------------------------%
> +%
> +% Pass 1.
> +%
> +
> +:- type fill_kind
> +    --->    fill_with_zero
> +    ;       fill_with_sign.
> +
> +:- type word_aligned_why
> +    --->    foreign_type_assertion
> +    ;       mercury_type_defn(hlds_type_defn).
> +
> +:- type component_type_kind
> +    --->    fits_in_n_bits(int, fill_kind)
> +    ;       is_word_aligned_ptr(word_aligned_why)
> +    ;       is_eqv_type(type_ctor).
> +
> +:- type component_type_map == map(type_ctor, component_type_kind).
>  
> +:- pred decide_if_simple_du_type(module_info::in, decide_du_params::in,
>      type_ctor_to_foreign_enums_map::in,
> +    pair(type_ctor, hlds_type_defn)::in, pair(type_ctor, hlds_type_defn)::out,
> +    set_tree234(type_ctor)::in, set_tree234(type_ctor)::out,
> +    component_type_map::in, component_type_map::out,
> +    no_tag_type_table::in, no_tag_type_table::out,
> +    list(error_spec)::in, list(error_spec)::out) is det.
>  
> +decide_if_simple_du_type(ModuleInfo, Params, TypeCtorToForeignEnumMap,
> +        TypeCtorTypeDefn0, TypeCtorTypeDefn, !MustBeSingleFunctorTagTypes,
> +        !ComponentTypeMap, !NoTagTypeMap, !Specs) :-
> +    TypeCtorTypeDefn0 = TypeCtor - TypeDefn0,
> +    get_type_defn_body(TypeDefn0, Body0),
>      (
> +        Body0 = hlds_du_type(Ctors, MaybeCanonical, MaybeRepn0,
>              MaybeForeign),
>          expect(unify(MaybeRepn0, no), $pred, "MaybeRepn0 != no"),
> +        expect(negate(unify(Ctors, [])), $pred, "Ctors != []"),

You could use expect_not.

>          ( if
>              map.search(TypeCtorToForeignEnumMap, TypeCtor, TCFE),
>              TCFE = type_ctor_foreign_enums(_LangContextMap,
>                  MaybeForeignEnumTagMap),
> +            MaybeForeignEnumTagMap = yes(ForeignEnumTagMap)
>          then
> +            decide_simple_type_foreign_enum(ModuleInfo, Params,
> +                TypeCtor, TypeDefn0, Body0, Ctors, ForeignEnumTagMap,
> +                TypeCtorTypeDefn, !Specs)
> +        else if
> +            ctors_are_all_constants(Ctors)
> +        then
> +            decide_simple_type_dummy_or_mercury_enum(ModuleInfo, Params,
> +                TypeCtor, TypeDefn0, Body0, Ctors, TypeCtorTypeDefn,
> +                !ComponentTypeMap, !Specs)
> +        else if
> +            Ctors = [SingleCtor]
> +        then
> +            ( if
> +                SingleCtor = ctor(no_exist_constraints, SingleCtorSymName,
> +                    [SingleArg], 1, SingleCtorContext),
> +                MaybeCanonical = canon,
> +                Params ^ ddp_unboxed_no_tag_types = use_unboxed_no_tag_types
> +            then
> +                decide_simple_type_notag(ModuleInfo, Params,
> +                    TypeCtor, TypeDefn0, Body0,
> +                    SingleCtorSymName, SingleArg, SingleCtorContext,
> +                    TypeCtorTypeDefn, !NoTagTypeMap, !Specs)
> +            else
> +                add_du_if_ctor_is_word_aligned_ptr(Params, TypeCtor, TypeDefn0,
> +                    MaybeForeign,
> +                    !MustBeSingleFunctorTagTypes, !ComponentTypeMap),

...

> +
> +                % Figure out the representation of these types
> +                % in the second pass.
> +                TypeCtorTypeDefn = TypeCtorTypeDefn0
> +            )
>          else
> +            % Figure out the representation of these types in the second pass.
> +            TypeCtorTypeDefn = TypeCtorTypeDefn0
> +        )
> +    ;
> +        Body0 = hlds_foreign_type(ForeignType),
> +        add_foreign_if_word_aligned_ptr(ModuleInfo, Params, TypeCtor,
> +            ForeignType, !ComponentTypeMap, !Specs),
> +
> +        % There are no questions of representation to figure out.
> +        TypeCtorTypeDefn = TypeCtorTypeDefn0
>      ;
> +        Body0 = hlds_abstract_type(AbstractDetails),
> +        add_abstract_if_fits_in_n_bits(TypeCtor, AbstractDetails,
> +            !ComponentTypeMap),
> +        TypeCtorTypeDefn = TypeCtorTypeDefn0
> +    ;
> +        % XXX TYPE_REPN Enter type equivalences into ComponentTypeMap.
>          ( Body0 = hlds_eqv_type(_)
>          ; Body0 = hlds_solver_type(_)
> +        ),
> +        % There are no questions of representation to figure out.
> +        TypeCtorTypeDefn = TypeCtorTypeDefn0
>      ).
>  

> +%---------------------%
> +
> +:- pred add_du_if_ctor_is_word_aligned_ptr(decide_du_params::in,
> +    type_ctor::in, hlds_type_defn::in, maybe(foreign_type_body)::in,
> +    set_tree234(type_ctor)::in, set_tree234(type_ctor)::out,
> +    component_type_map::in, component_type_map::out) is det.

add_du_if_single_ctor_is_word_aligned_ptr?

> +
> +add_du_if_ctor_is_word_aligned_ptr(Params, TypeCtor, TypeDefn, MaybeForeign,
> +        !MustBeSingleFunctorTagTypes, !ComponentTypeMap) :-
> +    % Are we guaranteed to choose a word aligned pointer as the representation?
> +    ( if
> +        TypeCtor = type_ctor(_TypeCtorSymName, TypeCtorArity),
> +
> +        % NOTE We could let the argument's type to have a set of type params
> +        % that is a subset of the type params of the containing type,
> +        % but that would require the runtime system to be able to handle
> +        % variables in the argument type, during unification and comparison
> +        % (mercury_unify_compare_body.h) during deconstruction
> +        % (mercury_ml_expand_body.h), during deep copying
> +        % (mercury_deep_copy_body.h), and maybe during some other
> +        % operations.
> +        TypeCtorArity = 0,
> +
> +        % XXX TYPE_REPN Why this test?
> +        DirectArgMap = Params ^ ddp_direct_arg_map,
> +        not map.search(DirectArgMap, TypeCtor, _DirectArgFunctors)

Hmm, I suppose this corresponded to something in the old algorithm?

> +    then
> +        set_tree234.insert(TypeCtor, !MustBeSingleFunctorTagTypes),
> +
> +        % XXX TYPE_REPN This test is only for backward compatibility.
> +        % The code we should use long term is the else arm.
> +        ( if
> +            MaybeForeign = yes(Foreign),
> +            Target = Params ^ ddp_target,
> +            is_foreign_type_body_for_target(Foreign, Target, Assertions)
> +        then
> +            ( if asserted_word_aligned_pointer(Assertions) then
> +                ComponentKind = is_word_aligned_ptr(foreign_type_assertion),
> +                map.det_insert(TypeCtor, ComponentKind, !ComponentTypeMap)
> +            else
> +                true
> +            )
> +        else
> +            ComponentKind = is_word_aligned_ptr(mercury_type_defn(TypeDefn)),
> +            map.det_insert(TypeCtor, ComponentKind, !ComponentTypeMap)
> +        )
> +    else
> +        true
>      ).
>  
> @@ -874,18 +1207,18 @@ is_direct_arg_ctor(TypeTable, Target, TypeCtorModule, TypeStatus,
>      then
>          ArgCond = arg_type_is_word_aligned_pointer
>      else
> +        map.search(ComponentTypeMap, ArgTypeCtor, ArgComponentKind),
> +        ArgComponentKind = is_word_aligned_ptr(WordAlignedWhy),
> +        (
> +            WordAlignedWhy = foreign_type_assertion,
>              ArgCond = arg_type_is_word_aligned_pointer
> +        ;
> +            WordAlignedWhy = mercury_type_defn(ArgTypeDefn),
>              % The argument type is not a foreign type.
>  
> +            % XXX TYPE_REPN Should be able to delete this test, since it
> +            % duplicates one that was done when adding this entry to
> +            % ComponentTypeMap.
>              ArgTypeCtorArgTypes = [],
>              % XXX We could let this be a subset of the type params, but that
>              % would require the runtime system to be able to handle variables
		....
>              % (mercury_deep_copy_body.h), and maybe during some other
>              % operations.
>  
> +            get_type_defn_body(ArgTypeDefn, ArgTypeDefnBody),
> +            ArgTypeDefnBody = hlds_du_type(_ArgCtors, _ArgMaybeUserEqComp,
> +                _ArgMaybeRepn, ArgMaybeForeign),
>  
> +            ArgMaybeForeign = no,
>  
>              ( if
> +                TypeDefinedHere = yes,
>                  list.contains(AssertedDirectArgCtors, ConsConsId)
>              then
>                  ArgCond = direct_arg_asserted

The rest looked fine. Just that part in
add_du_if_ctor_is_word_aligned_ptr confuses me.

Peter


More information about the reviews mailing list