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;
}
tree_t make_default_value(type_t type, const loc_t *loc)
{
type_t base = type_base_recur(type);
switch (type_kind(base)) {
case T_UARRAY:
assert(type_kind(type) == T_SUBTYPE);
// Fall-through
case T_CARRAY:
{
tree_t def = NULL;
const int ndims = type_dims(type);
for (int i = ndims - 1; i >= 0; i--) {
tree_t val = (def ? def : make_default_value(type_elem(base), loc));
def = tree_new(T_AGGREGATE);
tree_set_type(def, array_aggregate_type(type, i));
tree_t a = tree_new(T_ASSOC);
tree_set_subkind(a, A_OTHERS);
tree_set_value(a, val);
tree_add_assoc(def, a);
}
tree_set_type(def, type);
tree_set_loc(def, loc);
return def;
}
case T_INTEGER:
case T_PHYSICAL:
case T_REAL:
return type_dim(type, 0).left;
case T_ENUM:
{
int64_t val = 0;
const bool folded = folded_int(type_dim(type, 0).left, &val);
if (folded)
return make_ref(type_enum_literal(base, (unsigned) val));
else
return type_dim(type, 0).left;
}
case T_RECORD:
{
tree_t def = tree_new(T_AGGREGATE);
tree_set_loc(def, loc);
const int nfields = type_fields(base);
for (int i = 0; i < nfields; i++) {
tree_t field = type_field(base, i);
tree_t a = tree_new(T_ASSOC);
tree_set_subkind(a, A_POS);
tree_set_value(a, make_default_value(tree_type(field),
tree_loc(field)));
tree_add_assoc(def, a);
}
tree_set_type(def, type);
return def;
}
case T_ACCESS:
{
tree_t null = tree_new(T_LITERAL);
tree_set_loc(null, loc);
tree_set_subkind(null, L_NULL);
tree_set_type(null, type);
return null;
}
case T_UNRESOLVED:
return NULL;
default:
fatal_trace("cannot handle type %s in %s",
type_kind_str(type_kind(base)), __func__);
}
}
tree_t make_default_value(type_t type, const loc_t *loc)
{
type_t base = type_base_recur(type);
switch (type_kind(base)) {
case T_UARRAY:
assert(type_kind(type) == T_SUBTYPE);
// Fall-through
case T_CARRAY:
{
tree_t def = NULL;
const int ndims = type_dims(type);
for (int i = ndims - 1; i >= 0; i--) {
tree_t val = (def ? def : make_default_value(type_elem(base), loc));
def = tree_new(T_AGGREGATE);
tree_set_type(def, array_aggregate_type(type, i));
tree_t a = tree_new(T_ASSOC);
tree_set_subkind(a, A_OTHERS);
tree_set_value(a, val);
tree_add_assoc(def, a);
}
tree_set_type(def, type);
tree_set_loc(def, loc);
return def;
}
case T_INTEGER:
case T_PHYSICAL:
case T_REAL:
return type_dim(type, 0).left;
case T_ENUM:
return make_ref(type_enum_literal(base, 0));
case T_RECORD:
{
tree_t def = tree_new(T_AGGREGATE);
tree_set_loc(def, loc);
const int nfields = type_fields(base);
for (int i = 0; i < nfields; i++) {
tree_t field = type_field(base, i);
tree_t a = tree_new(T_ASSOC);
tree_set_subkind(a, A_POS);
tree_set_value(a, make_default_value(tree_type(field),
tree_loc(field)));
tree_add_assoc(def, a);
}
tree_set_type(def, type);
return def;
}
case T_ACCESS:
{
tree_t null = tree_new(T_LITERAL);
tree_set_loc(null, loc);
tree_set_subkind(null, L_NULL);
tree_set_type(null, type);
return null;
}
default:
assert(false);
}
}
