type_t array_aggregate_type(type_t array, int from_dim)
{
if (type_is_unconstrained(array)) {
const int nindex = type_index_constrs(array);
assert(from_dim < nindex);
type_t type = type_new(T_UARRAY);
type_set_ident(type, type_ident(array));
type_set_elem(type, type_elem(array));
for (int i = from_dim; i < nindex; i++)
type_add_index_constr(type, type_index_constr(array, i));
return type;
}
else {
const int ndims = type_dims(array);
assert(from_dim < ndims);
type_t type = type_new(T_CARRAY);
type_set_ident(type, type_ident(array));
type_set_elem(type, type_elem(array));
for (int i = from_dim; i < ndims; i++)
type_add_dim(type, type_dim(array, i));
return type;
}
}
void type_replace(type_t t, type_t a)
{
assert(t != NULL);
assert(IS(t, T_INCOMPLETE));
t->kind = a->kind;
t->ident = a->ident;
const imask_t has = has_map[t->kind];
if (has & I_DIMS) {
const int ndims = type_dims(a);
for (int i = 0; i < ndims; i++)
type_add_dim(t, type_dim(a, i));
}
switch (a->kind) {
case T_UARRAY:
for (unsigned i = 0; i < type_index_constrs(a); i++)
type_add_index_constr(t, type_index_constr(a, i));
// Fall-through
case T_CARRAY:
type_set_elem(t, type_elem(a));
break;
case T_SUBTYPE:
type_set_base(t, type_base(a));
break;
case T_FUNC:
type_set_result(t, type_result(a));
break;
case T_INTEGER:
case T_REAL:
break;
case T_ENUM:
for (unsigned i = 0; i < type_enum_literals(a); i++)
type_enum_add_literal(t, type_enum_literal(a, i));
break;
case T_RECORD:
for (unsigned i = 0; i < type_fields(a); i++)
type_add_field(t, type_field(a, i));
break;
default:
assert(false);
}
}
static type_t type_make_universal(type_kind_t kind, const char *name,
tree_t min, tree_t max)
{
type_t t = type_new(kind);
type_set_ident(t, ident_new(name));
range_t r = { .kind = RANGE_TO,
.left = min,
.right = max };
type_add_dim(t, r);
tree_set_type(min, t);
tree_set_type(max, t);
return t;
}
static tree_t str_to_agg(const char *p, const char *end)
{
tree_t t = tree_new(T_AGGREGATE);
unsigned len = 0;
while (*p != '\0' && p != end) {
const char ch[] = { '\'', *p++, '\'', '\0' };
tree_t ref = tree_new(T_REF);
tree_set_ident(ref, ident_new(ch));
tree_t a = tree_new(T_ASSOC);
tree_set_subkind(a, A_POS);
tree_set_value(a, ref);
tree_add_assoc(t, a);
++len;
}
tree_t left = tree_new(T_LITERAL);
tree_set_subkind(left, L_INT);
tree_set_ival(left, 0);
tree_t right = tree_new(T_LITERAL);
tree_set_subkind(right, L_INT);
tree_set_ival(right, len - 1);
type_t type = type_new(T_CARRAY);
type_set_ident(type, ident_new("string"));
type_set_elem(type, type_universal_int());
range_t r = { .kind = RANGE_DOWNTO, .left = left, .right = right };
type_add_dim(type, r);
tree_set_type(t, type);
return t;
}
