15.4.626  src/lib/compiler/front/typer-stuff/types/tuples.pkg

## tuples.pkg 

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



# 'Tuples' and 'tuples' should be called 'Records' and 'records', since 
# records are the primary concept, and tuples are a derived form.   XXX BUGGO FIXME


api Tuples {

     number_to_label:               Int -> types::Label;
     make_tuple_typ:   Int -> types::Typ;
     is_tuple_typ:     types::Typ -> Bool;
     make_record_typ:  List( types::Label ) -> types::Typ;

};  #  Api Tuples 



stipulate
    package sy  =  symbol;                                      # symbol                        is from   src/lib/compiler/front/basics/map/symbol.pkg
    package wht =  word_string_hashtable;                       # word_string_hashtable         is from   src/lib/compiler/front/basics/hash/wordstr-hashtable.pkg
herein


    package   tuples
    : (weak)  Tuples                                            # Tuples                        is from   src/lib/compiler/front/typer-stuff/types/tuples.pkg
    {
        include types;

        Optional_Label
             =
             NO_LABEL | SOME_LABEL  Label;

        Optional_Typ
             =
             NO_TYP | SOME_TYP  Typ;

        package label_array
            =
            expanding_rw_vector_g (

                package {
                    include rw_vector;
                    Rw_Vector  = Rw_Vector( Optional_Label );
                    Vector     =    Vector( Optional_Label );
                    Element    =            Optional_Label;
                }
            );

        package typ_array
            =
            expanding_rw_vector_g (

                package {
                    include rw_vector;
                    Rw_Vector  = Rw_Vector( Optional_Typ );
                    Vector     =    Vector( Optional_Typ );
                    Element   =             Optional_Typ;
                }
            );

        exception NEW;


        # XXX BUGGO FIXME This looks like icky global mutable state
        # that will foul us up when/if we do parallel compiles
        # in different threads or such.  All such state should
        # be in a compile_state record of some type...

        typ_table    =  wht::make_hashtable  { size_hint => 32,  not_found_exception => NEW  }  :   wht::Hashtable(  Typ );
        #
        typ_map      =  wht::get   typ_table;
        note_uniqtyp =  wht::set   typ_table;

        fun labels_to_symbol (labels: List(Label)):  sy::Symbol
            =
            sy::make_type_symbol (cat("{ " ! wrap labels))
            where
                fun wrap [] => ["}"];
                    wrap [id] => [sy::name id, " }"];
                    wrap (id ! rest) => sy::name id ! ", " ! wrap rest;
                end;
            end;


        # This is a tweak to make similar
        # record typs point to the same thing,
        # thus speeding equality testing on them:
        #
        fun make_record_typ labels
            = 
            {   record_name = labels_to_symbol labels;

                number     = sy::number record_name;
                name       = sy::name   record_name;

                typ_map (number, name)
                except
                    NEW
                    =
                    {   typ = RECORD_TYP labels;

                        note_uniqtyp ((number, name), typ);
                        typ;
                    };
            };

        numeric_labels
           =
           label_array::rw_vector (0, NO_LABEL);

        tuple_typs
           =
           typ_array::rw_vector (0, NO_TYP);

        fun number_to_label i
            =
            case (label_array::get (numeric_labels, i))

                 NO_LABEL
                     =>
                     {   newlabel
                             =
                             sy::make_label_symbol (int::to_string i);

                         label_array::set (numeric_labels, i, SOME_LABEL (newlabel));
                         newlabel;
                     };

                 SOME_LABEL label
                     =>
                     label;
            esac;

        fun numlabels n
            =
            labels (n, NIL)
            where
                fun labels (0, result_list) =>  result_list;
                    labels (i, result_list) =>  labels (i - 1, number_to_label i ! result_list);
                end;
            end;

        fun make_tuple_typ n
            =
            case (typ_array::get (tuple_typs, n))

                 NO_TYP
                     =>
                     {   typ
                             =
                             make_record_typ (numlabels n);

                         typ_array::set (tuple_typs, n, SOME_TYP (typ));
                         typ;
                     };

                 SOME_TYP (typ)
                     =>
                     typ;
            esac;

        fun check_labels (2, NIL) =>  FALSE;   #  { 1: t } is not a tuple 
            check_labels (n, NIL) =>  TRUE;

            check_labels (n, lab ! labs)
                => 
                sy::eq (lab, number_to_label n)
                and
                check_labels (n+1, labs);
        end;

        fun is_tuple_typ (RECORD_TYP labels)
                =>
                check_labels (1, labels);

            is_tuple_typ _ => FALSE;
        end;

    };          #  package tuples 
end;