15.4.676  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

stipulate
    package tdt =  type_declaration_types;                      # type_declaration_types        is from   src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg
herein

    api Resolve_Overloaded_Literals {

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

        make_overloaded_literal_resolver
            :
            Void
            ->
            { note_overloaded_literal:           tdt::Typoid -> Void,
              resolve_all_overloaded_literals:   Void -> Bool
            };

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

        is_literal_typoid:  (tdt::Literal_Kind, tdt::Typoid) -> Bool;
    };
end;

stipulate
    package tdt =  type_declaration_types;                      # type_declaration_types        is from   src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg
    package mtt =  more_type_types;                             # more_type_types               is from   src/lib/compiler/front/typer/types/more-type-types.pkg
    package tj  =  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_typoids    =  [mtt::int_typoid, mtt::int1_typoid, mtt::int2_typoid, mtt::multiword_int_typoid];
        unt_typoids    =  [mtt::unt_typoid, mtt::unt8_typoid, mtt::unt1_typoid, mtt::unt2_typoid];
        float_typoids  =  [mtt::float64_typoid];

        char_typoids   =  [mtt::char_typoid];
        string_typoids =  [mtt::string_typoid];

        fun in_ilk (type, tys)
            =
            list::exists   (\\ type' =  tj::typoids_are_equal (type, type'))   tys;

        # This gets called from
        #
        #     src/lib/compiler/front/typer/types/unify-typoids.pkg
        #
        fun is_literal_typoid (tdt::INT,    typoid) => in_ilk (typoid, int_typoids   );
            is_literal_typoid (tdt::UNT,    typoid) => in_ilk (typoid, unt_typoids   );
            is_literal_typoid (tdt::FLOAT,  typoid) => in_ilk (typoid, float_typoids );
            is_literal_typoid (tdt::CHAR,   typoid) => in_ilk (typoid, char_typoids  );
            is_literal_typoid (tdt::STRING, typoid) => in_ilk (typoid, string_typoids);
        end;

        fun default tdt::INT    =>  mtt::int_typoid;
            default tdt::UNT    =>  mtt::unt_typoid;
            default tdt::FLOAT  =>  mtt::float64_typoid;
            default tdt::CHAR   =>  mtt::char_typoid;
            default tdt::STRING =>  mtt::string_typoid;
        end;

        fun make_overloaded_literal_resolver ()
            =
            { 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;
                        #
                        list::length *overloaded_literals  >  0;
                    }
                    where
                        fun resolve_overloaded_literal type
                            =
                            case (tj::drop_resolved_typevars type)
                                #
                                tdt::TYPEVAR_REF { id, ref_typevar => tv as REF (tdt::LITERAL_TYPEVAR { kind, ... } ) }
                                    =>
                                    tv :=  tdt::RESOLVED_TYPEVAR (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-2015,
## released per terms of SMLNJ-COPYRIGHT.