tree_t type_field(type_t t, unsigned n)
{
if (t->kind == T_SUBTYPE)
return type_field(type_base(t), n);
else
return tree_array_nth(&(lookup_item(t, I_FIELDS)->tree_array), n);
}
ident_t type_ident(type_t t)
{
assert(t != NULL);
if (t->ident == NULL) {
char *buf;
switch (t->kind) {
case T_SUBTYPE:
return type_ident(type_base(t));
case T_ACCESS:
buf = xasprintf("access to %s",
istr(type_ident(type_access(t))));
break;
case T_NONE:
buf = xasprintf("none");
break;
default:
assert(false);
}
ident_t ident = ident_new(buf);
free(buf);
return ident;
}
else
return t->ident;
}
unsigned type_fields(type_t t)
{
if (t->kind == T_SUBTYPE)
return type_fields(type_base(t));
else
return lookup_item(t, I_FIELDS)->tree_array.count;
}
type_t type_base_recur(type_t t)
{
assert(t != NULL);
while (t->kind == T_SUBTYPE)
t = type_base(t);
return t;
}
bool type_is_real(type_t t)
{
assert(t != NULL);
if (t->kind == T_SUBTYPE)
return type_is_real(type_base(t));
else
return (t->kind == T_REAL);
}
bool type_is_integer(type_t t)
{
assert(t != NULL);
if (t->kind == T_SUBTYPE)
return type_is_integer(type_base(t));
else
return (t->kind == T_INTEGER);
}
bool type_is_enum(type_t t)
{
assert(t != NULL);
if (t->kind == T_SUBTYPE)
return type_is_enum(type_base(t));
else
return (t->kind == T_ENUM);
}
bool type_is_array(type_t t)
{
assert(t != NULL);
if (t->kind == T_SUBTYPE)
return type_is_array(type_base(t));
else
return (t->kind == T_CARRAY || t->kind == T_UARRAY);
}
bool type_is_scalar(type_t t)
{
assert(t != NULL);
if (t->kind == T_SUBTYPE)
return type_is_scalar(type_base(t));
else
return (t->kind == T_INTEGER)
|| (t->kind == T_REAL)
|| (t->kind == T_ENUM);
}
bool type_is_unconstrained(type_t t)
{
assert(t != NULL);
if (t->kind == T_SUBTYPE) {
if (type_dims(t) == 0)
return type_is_unconstrained(type_base(t));
else
return false;
}
else
return (t->kind == T_UARRAY);
}
type_t type_elem(type_t t)
{
assert(t != NULL);
if (IS(t, T_SUBTYPE))
return type_elem(type_base(t));
else {
item_t *item = lookup_item(t, I_ELEM);
assert(item->type != NULL);
return item->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);
}
}
ast_t* type_builtin(pass_opt_t* opt, ast_t* from, const char* name)
{
ast_t* ast = type_base(from, NULL, name);
if(!names_nominal(opt, from, &ast, false))
{
ast_error(from, "unable to validate '%s'", name);
ast_free(ast);
return NULL;
}
return ast;
}
void main(int argc, string argv[])
{
string type, name;
initparam(argv, defv);
type = getparam("type");
name = getparam("name");
printf("type_length(\"%s\") = %d\n", type, type_length(type));
printf("type_name(\"%s\") = %s\n", type, type_name(type));
printf("type_base(\"%s\") = %s\n", type, type_base(type));
printf("type_fmt(\"%s\", TRUE) = %s\n", type, type_fmt(type, TRUE));
printf("type_fmt(\"%s\", FALSE) = %s\n", type, type_fmt(type, FALSE));
printf("name_type(\"%s\") = %s\n", name, name_type(name));
}
ast_t* type_sugar(ast_t* from, const char* package, const char* name)
{
return type_base(from, package, name);
}
bool type_eq(type_t a, type_t b)
{
assert(a != NULL);
assert(b != NULL);
type_kind_t kind_a = type_kind(a);
type_kind_t kind_b = type_kind(b);
if ((kind_a == T_UNRESOLVED) || (kind_b == T_UNRESOLVED))
return false;
if (a == b)
return true;
// Subtypes are convertible to the base type
while ((kind_a = type_kind(a)) == T_SUBTYPE)
a = type_base(a);
while ((kind_b = type_kind(b)) == T_SUBTYPE)
b = type_base(b);
const bool compare_c_u_arrays =
(kind_a == T_CARRAY && kind_b == T_UARRAY)
|| (kind_a == T_UARRAY && kind_b == T_CARRAY);
if ((kind_a != kind_b) && !compare_c_u_arrays)
return false;
// Universal integer type is equal to any other integer type
type_t universal_int = type_universal_int();
ident_t uint_i = type_ident(universal_int);
if (kind_a == T_INTEGER
&& (type_ident(a) == uint_i || type_ident(b) == uint_i))
return true;
// Universal real type is equal to any other real type
type_t universal_real = type_universal_real();
ident_t ureal_i = type_ident(universal_real);
if (kind_a == T_REAL
&& (type_ident(a) == ureal_i || type_ident(b) == ureal_i))
return true;
// XXX: this is not quite right as structurally equivalent types
// may be declared in different scopes with the same name but
// shouldn't compare equal
if (type_ident(a) != type_ident(b))
return false;
// Access types are equal if the pointed to type is the same
if (kind_a == T_ACCESS)
return type_eq(type_access(a), type_access(b));
if (compare_c_u_arrays)
return type_eq(type_elem(a), type_elem(b));
const imask_t has = has_map[a->kind];
if ((has & I_DIMS) && (type_dims(a) != type_dims(b)))
return false;
if (type_kind(a) == T_FUNC) {
if (!type_eq(type_result(a), type_result(b)))
return false;
}
if (has & I_PARAMS) {
if (type_params(a) != type_params(b))
return false;
const int nparams = type_params(a);
for (int i = 0; i < nparams; i++) {
if (!type_eq(type_param(a, i), type_param(b, i)))
return false;
}
}
return true;
}
