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;
}
static bool dot_or_tilde(pass_opt_t* opt, ast_t** astp, bool partial)
{
typecheck_t* t = &opt->check;
ast_t* ast = *astp;
// Left is a postfix expression, right is an id.
ast_t* left = ast_child(ast);
switch(ast_id(left))
{
case TK_PACKAGEREF:
return package_access(opt, astp);
case TK_TYPEREF:
return type_access(opt, astp);
default: {}
}
ast_t* type = ast_type(left);
if(type == NULL)
{
ast_error(ast, "invalid left hand side");
return false;
}
if(!literal_member_access(ast, opt))
return false;
// Type already set by literal handler
if(ast_type(ast) != NULL)
return true;
type = ast_type(left); // Literal handling may have changed lhs type
assert(type != NULL);
if(ast_id(type) == TK_TUPLETYPE)
return tuple_access(ast);
return member_access(t, ast, partial);
}
static bool entity_access(pass_opt_t* opt, ast_t** astp)
{
ast_t* ast = *astp;
// Left is a postfix expression, right is an id.
ast_t* left = ast_child(ast);
switch(ast_id(left))
{
case TK_PACKAGEREF:
return package_access(opt, astp);
case TK_TYPEREF:
return type_access(opt, astp);
default: {}
}
ast_t* type = ast_type(left);
if(type == NULL)
return false;
if(!literal_member_access(ast, opt))
return false;
// Type already set by literal handler
if(ast_type(ast) != NULL)
return true;
type = ast_type(left); // Literal handling may have changed lhs type
assert(type != NULL);
if(ast_id(type) == TK_TUPLETYPE)
return tuple_access(opt, ast);
return member_access(opt, ast);
}
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;
}
