## 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
stipulate
package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkgherein
api Tuples {
#
number_to_label: Int -> tdt::Label;
make_tuple_type: Int -> tdt::Type;
is_tuple_type: tdt::Type -> Bool;
make_record_type: List( tdt::Label ) -> tdt::Type;
}; # Api Tuples
end;
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 package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkgherein
package tuples
: (weak) Tuples # Tuples is from src/lib/compiler/front/typer-stuff/types/tuples.pkg {
include package type_declaration_types;
Optional_Label
#
= NO_LABEL
| SOME_LABEL Label
;
Optional_Type
#
= NO_TYPE
| SOME_TYPE tdt::Type
;
package label_array
=
expanding_rw_vector_g (
package {
include package rw_vector;
Rw_Vector = Rw_Vector( Optional_Label );
Vector = Vector( Optional_Label );
Element = Optional_Label;
}
);
package type_array
=
expanding_rw_vector_g (
package {
include package rw_vector;
Rw_Vector = Rw_Vector( Optional_Type );
Vector = Vector( Optional_Type );
Element = Optional_Type;
}
);
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...
type_table = wht::make_hashtable { size_hint => 32, not_found_exception => NEW } : wht::Hashtable( tdt::Type );
#
type_map = wht::get type_table;
note_uniqtype = wht::set type_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 types point to the same thing,
# thus speeding equality testing on them:
#
fun make_record_type labels
=
{ record_name = labels_to_symbol labels;
#
number = sy::number record_name;
name = sy::name record_name;
type_map (number, name)
except
NEW
=
{ type = RECORD_TYPE labels;
#
note_uniqtype ((number, name), type);
#
type;
};
};
numeric_labels
=
label_array::rw_vector (0, NO_LABEL);
tuple_types
=
type_array::rw_vector (0, NO_TYPE);
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_type n
=
case (type_array::get (tuple_types, n))
#
NO_TYPE
=>
{ type = make_record_type (numlabels n);
#
type_array::set (tuple_types, n, SOME_TYPE type);
type;
};
SOME_TYPE type
=>
type;
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_type (RECORD_TYPE labels)
=>
check_labels (1, labels);
is_tuple_type _ => FALSE;
end;
}; # package tuples
end;