PreviousUpNext

15.4.624  src/lib/compiler/front/typer-stuff/types/core-basic-types.pkg

## core-type-types.pkg
## (C) 2001 Lucent Technologies, Bell Labs

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


# Nomenclature
# ============
#
#     "typ" abbreviates "type constructor",
#
# because (e.g.) 'List(Int)' constructs a new type
# from the input 'Int' type.

# a generic part of type-types.pkg (not Lib7 specific)

package core_type_types: (weak)  api

     arrow_stamp:  stamp::Stamp;
     arrow_typ:  types::Type;
     --> : (types::Type, types::Type) -> types::Type;

     ref_stamp:  stamp::Stamp;
     ref_typ_sym:  symbol::Symbol;
     ref_con_sym:  symbol::Symbol;
     ref_typ:  types::Type;
     ref_dcon:  types::Constructor;
     ref_pattern_type:  types::Type;

     bool_stamp:  stamp::Stamp;
     bool_sym:  symbol::Symbol;
     false_sym:  symbol::Symbol;
     true_sym:  symbol::Symbol;
     bool_typ:  types::Type;
     bool_type:  types::Type;
     bool_api:  access::Valcon_Signature;
     false_dcon:  types::Constructor;
     true_dcon:  types::Constructor;

     void_symbol:  symbol::Symbol;
     void_typ:  types::Type;
     void_type:  types::Type;

     int_typ:  types::Type;
     int_type:  types::Type;

     string_typ:  types::Type;
     string_type:  types::Type;

     char_typ:  types::Type;
     char_type:  types::Type;

     float64_typ:  types::Type;
     float64_type:  types::Type;

     exception_typ:  types::Type;
     exception_type:  types::Type;

     tuple_type:  List( types::Type ) -> types::Type;

     record_type:  List( (types::Label, types::Type) ) -> types::Type;

     rw_vector_typ:  types::Type;
     vector_typ:  types::Type;

end

{
    package t= types;                                           # types                                         is from   src/lib/compiler/front/typer-stuff/types/types.pkg
    package ip= inverse_path;                                   # inverse_path                                  is from   src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg
    package ptn= core_basetype_numbers; # core_basetype_numbers is from   src/lib/compiler/front/typer-stuff/basics/core-basetype-numbers.pkg

    arrow_stamp = stamp::special "->";
    ref_stamp   = stamp::special "REF";
    bool_stamp  = stamp::special "bool";

    void_symbol                 = symbol::make_type_symbol "Void";
    ref_typ_sym = symbol::make_type_symbol "Ref";
    ref_con_sym              = symbol::make_value_symbol "REF";

    bool_sym  = symbol::make_type_symbol "Bool";
    false_sym = symbol::make_value_symbol "FALSE";
    true_sym  = symbol::make_value_symbol "TRUE";

    fun tc2t typ
        =
        t::TYPCON_TYPE (typ, []);

    void_typ
        =
        t::DEFINED_TYP {
            stamp        => stamp::special "unit",
            strict       => [],
            path         => ip::INVERSE_PATH [void_symbol],
            type_scheme => t::TYPE_SCHEME { arity => 0,
                                             body  => t::TYPCON_TYPE (tuples::make_tuple_typ 0, [])
                                           }
        };

    void_type   =   tc2t void_typ;

    fun pt2tc (symbol, arity, equality_property, ptn)
        =
        t::BASE_TYP {

            stamp => stamp::special symbol,
            path  => ip::INVERSE_PATH [symbol::make_type_symbol symbol],
            arity,

            eq    => REF equality_property,
            kind  => t::BASE ptn,
            stub  => NULL
        };

    fun pt2tct args
        =
        {   typ = pt2tc args;
        
            (typ, tc2t typ);
        };

    # This stuff is duplicated here and   src/lib/compiler/front/typer-stuff/types/core-type-types.pkg
    # -- can't we factor the duplication out somehow?   XXX BUGGO FIXME

    my (      int_typ,       int_type) =   pt2tct ("Int",       0, t::YES, ptn::basetype_number_int   );
    my (   string_typ,    string_type) =   pt2tct ("String",    0, t::YES, ptn::basetype_number_string);
    my (     char_typ,      char_type) =   pt2tct ("Char",      0, t::YES, ptn::basetype_number_int   );
    my (  float64_typ,   float64_type) =   pt2tct ("Float",     0, t::NO,  ptn::basetype_number_float64  );
    my (exception_typ, exception_type) =   pt2tct ("Exception", 0, t::NO,  ptn::basetype_number_exn   );

    rw_vector_typ  = pt2tc ("Rw_Vector",  1, t::CHUNK, ptn::basetype_number_rw_vector );
    vector_typ     = pt2tc ("Vector",     1, t::YES,   ptn::basetype_number_vector);

    arrow_typ
        =
        t::BASE_TYP {
            #
            stamp => arrow_stamp,
            path  => ip::INVERSE_PATH [symbol::make_type_symbol "->"],
            arity => 2,
            #
            eq    => REF t::NO,
            kind  => t::BASE ptn::basetype_number_arrow,
            stub  => NULL
        };

    infix -->;

    fun t1 --> t2
        =
        t::TYPCON_TYPE (arrow_typ, [t1, t2]);

    fun record_type (fields: List( (t::Label, t::Type)) )
        =
        t::TYPCON_TYPE (tuples::make_record_typ (map #1 fields), map #2 fields);

    fun tuple_type types
        =
        t::TYPCON_TYPE (tuples::make_tuple_typ (length types), types);

    my (ref_typ, ref_pattern_type, ref_dcon)
        =
        {   eq_ref  =  REF t::CHUNK;
            alpha   =  t::TYPE_SCHEME_ARG_I 0;
            ref_dom =  alpha;
            refsign =  access::CSIG (1, 0);

            ref_typ = t::BASE_TYP {

                               stub  => NULL,
                               stamp => ref_stamp,
                               path  => ip::INVERSE_PATH [ ref_typ_sym ],
                               arity => 1,
                               eq    => eq_ref,
                               kind  => t::DATATYPE {
                                           index    => 0,
                                           stamps   => #[ref_stamp],
                                           free_typs => [],
                                           root     => NULL,
                                           family   => {   properties => property_list::new_holder (),
                                                          mkey       => ref_stamp,
                                                          members    => #[   {   typ_name => ref_typ_sym,
                                                                                eq         => eq_ref,
                                                                                is_lazy     => FALSE,
                                                                                arity      => 1,
                                                                                an_api => access::CSIG (1, 0),
                                                                                constructor_list => [  {   name           => ref_con_sym,
                                                                                                                 representation => access::REF_REP,
                                                                                                                 domain         => THE ref_dom
                                                                                                             }
                                                                                                          ]
                                                                            }
                                                                        ]

                                       
                                                      }
                                       }
                           };

            ref_tyfun
                =
                t::TYPE_SCHEME { arity => 1, body => alpha --> t::TYPCON_TYPE (ref_typ, [alpha]) };

            ref_pattern_type
                =
                t::TYPE_SCHEME_TYPE {
                    type_scheme_arg_eq_properties => [FALSE],
                    type_scheme => ref_tyfun
                };

            ref_dcon = t::VALCON { symbol          => ref_con_sym,
                                             const           => FALSE,
                                             is_lazy         => FALSE,
                                             form            => access::REF_REP,
                                             constructortype => ref_pattern_type,
                                             an_api          => refsign
                                           };
        
            (ref_typ, ref_pattern_type, ref_dcon);
        };

    bool_api = access::CSIG (0, 2);

    my (bool_typ, bool_type, false_dcon, true_dcon)
        =
        { booleq = REF t::YES;

            bool_typ
                =
                t::BASE_TYP {
                    stamp => bool_stamp,
                    path  => ip::INVERSE_PATH [bool_sym],
                    arity => 0,
                    eq    => booleq,
                    stub  => NULL,
                    kind  => t::DATATYPE {
                                index    => 0,
                                stamps   => #[bool_stamp],
                                free_typs => [],
                                root     => NULL,
                                family   => {   properties => property_list::new_holder (),
                                               mkey       => bool_stamp,
                                               members    => #[   {   typ_name => bool_sym,
                                                                     eq         => booleq,
                                                                     is_lazy     => FALSE,
                                                                     arity      => 0,
                                                                     an_api => bool_api,

                                                                     constructor_list =>   [  { name    => false_sym,
                                                                                                form    => access::CONSTANT 0,
                                                                                                domain  => NULL
                                                                                              },
                                                                                              { name    => true_sym,
                                                                                                form    => access::CONSTANT 1,
                                                                                                domain  => NULL
                                                                                              }
                                                                                           ]
                                                                 }
                                                             ]
                                    
                                    
                                           }
                            }
                };

            bool_type = t::TYPCON_TYPE (bool_typ, []);

            false_dcon = t::VALCON
                          {
                            symbol           => false_sym,
                            const            => TRUE,
                            is_lazy          => FALSE,
                            form             => access::CONSTANT 0,
                            type => bool_type,
                            an_api           => bool_api
                          };

            true_dcon = t::VALCON
                         {
                           symbol          => true_sym,
                           const           => TRUE,
                           is_lazy         => FALSE,
                           form            => access::CONSTANT 1,
                           constructortype => bool_type,
                           an_api          => bool_api
                         };
        
            (bool_typ, bool_type, false_dcon, true_dcon);
        };
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext