15.4.675  src/lib/compiler/front/typer/types/resolve-overloaded-literals.pkg

## resolve-overloaded-literals.pkg 
#
# Here we handle overloaded literals such as:  0
# Zero may be an 8-bit, 31-bit, 32-bit,
# 64-bit or indefinite precision integer,
# and signed or unsigned.
#
# Overloaded variables are resolved
# via a separate mechanism, see: 
#
#     src/lib/compiler/front/typer/types/resolve-overloaded-variables.pkg

# Compiled by:
#     src/lib/compiler/front/typer/typer.sublib

api Resolve_Overloaded_Literals {

    #  Functions for setting up, recording, and resolving literal overloadings 

    new:  Void -> { note_overloaded_literal:           types::Type -> Void,
                    resolve_all_overloaded_literals:   Void -> Void
                  };

    # is_literal_type is for checking compatability when instantiating 
    # overloaded literal type variables

    is_literal_type:  (types::Literal_Kind, types::Type) -> Bool;
};


stipulate
    package t= types;                           # types                         is from   src/lib/compiler/front/typer-stuff/types/types.pkg
    package tt= type_types;                     # type_types                    is from   src/lib/compiler/front/typer/types/type-types.pkg
    package ts= type_junk;                      # type_junk                     is from   src/lib/compiler/front/typer-stuff/types/type-junk.pkg
herein


    package   resolve_overloaded_literals
    : (weak)  Resolve_Overloaded_Literals               # Resolve_Overloaded_Literals   is from   src/lib/compiler/front/typer/types/resolve-overloaded-literals.pkg
    {
        # Eventually, these may be defined elsewhere,
        # perhaps via some compiler configuration mechanism.

        int_types    = [tt::int_type, tt::int1_type, tt::int2_type, tt::multiword_int_type];
        unt_types    = [tt::unt_type, tt::unt8_type, tt::unt1_type, tt::unt2_type];
        float_types  = [tt::float64_type];

        char_types   = [tt::char_type];
        string_types = [tt::string_type];

        fun in_ilk (type, tys)
            =
            list::exists   (fn type' =  ts::types_are_equal (type, type'))   tys;

        # This gets called from
        #
        #     src/lib/compiler/front/typer/types/unify-types.pkg
        #
        fun is_literal_type (t::INT,    type) => in_ilk (type, int_types   );
            is_literal_type (t::UNT,    type) => in_ilk (type, unt_types   );
            is_literal_type (t::FLOAT,  type) => in_ilk (type, float_types );
            is_literal_type (t::CHAR,   type) => in_ilk (type, char_types  );
            is_literal_type (t::STRING, type) => in_ilk (type, string_types);
        end;

        fun default t::INT    => tt::int_type;
            default t::UNT    => tt::unt_type;
            default t::FLOAT  => tt::float64_type;
            default t::CHAR   => tt::char_type;
            default t::STRING => tt::string_type;
        end;

        fun new ()
            =
            { note_overloaded_literal,
              resolve_all_overloaded_literals
            }
            where
                overloaded_literals
                    =
                    REF [];

                fun note_overloaded_literal x
                    =
                    {   overloaded_literals
                            :=
                            x ! *overloaded_literals;
                    };

                fun resolve_all_overloaded_literals ()
                    =
                    apply resolve_overloaded_literal  *overloaded_literals
                    where
                        fun resolve_overloaded_literal type
                            =
                            case (ts::prune type)

                                 t::TYPE_VARIABLE_REF { id, ref_typevar => tv as REF (t::LITERAL_TYPE_VARIABLE { kind, ... } ) }
                                     =>
                                     tv :=  t::RESOLVED_TYPE_VARIABLE (default kind);

                                _ => ();                #  ok, must have been successfully inferred
                            esac; 
                    end;
            end;

    };          #  package overloaded_literals 
end;

## COPYRIGHT 1997 Bell Laboratories 
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.