Commit b78897a6 authored by Sven-Bodo Scholz's avatar Sven-Bodo Scholz
Browse files

started cleaning out the new new_types.c

parent 1db3840c
......@@ -12,40 +12,18 @@
* TC_simple, TC_symbol, TC_user, TC_aks, TC_akd, ...
*/
#ifndef TCITypeConstr
#define TCITypeConstr(typeconstr)
#endif
TCI (TC_simple, 0, "Simple", 0, simple, a_simple)
TCI (TC_symbol, 0, "Symbol", 0, attr_symbol, a_symbol)
TCI (TC_user, 0, "User", 0, usertype, a_user)
TCI (TC_akv, 1, "AKV", 0, constant *, a_akv) /* Known value */
TCI (TC_aks, 1, "AKS", 0, shape *, a_aks) /* Known shape */
TCI (TC_akd, 1, "AKD", 0, attr_akd, a_akd) /* Known dimension */
TCI (TC_aud, 1, "AUD", 0, char, dummy_aud) /* Unknown dimension */
TCI (TC_audgz, 1, "AUDGZ", 0, char, dummy_audgz) /* Unknown dimension, greater zero */
TCI (TC_prod, 0, "PROD", 1, char, dummy_prod)
TCI (TC_union, 2, "UNION", 1, char, dummy_union)
TCI (TC_alpha, 0, "ALPHA", 0, tvar *, a_alpha)
TCI (TC_bottom, 0, "BOTTOM", 0, char *, a_bottom)
TCI (TC_poly, 0, "POLY", 0, char *, a_poly)
TCI (TC_polyuser, 0, "POLYUSER", 0, attr_polyuser, a_polyuser)
#ifndef TCIArity
#define TCIArity(arity)
#endif
#ifndef TCIDbugString
#define TCIDbugString(dbug_str)
#endif
#ifndef TCIVariableArity
#define TCIVariableArity(variable_arity)
#endif
#define TCI(typeconstr, default_arity, dbug_str, variable_arity) \
TCITypeConstr (typeconstr) TCIArity (default_arity) TCIDbugString (dbug_str) \
TCIVariableArity (variable_arity)
TCI (TC_simple, 0, "Simple", 0), TCI (TC_symbol, 0, "Symbol", 0),
TCI (TC_user, 0, "User", 0), TCI (TC_akv, 1, "AKV", 0), /* Known value */
TCI (TC_aks, 1, "AKS", 0), /* Known shape */
TCI (TC_akd, 1, "AKD", 0), /* Known dimension */
TCI (TC_aud, 1, "AUD", 0), /* Unknown dimension */
TCI (TC_audgz, 1, "AUDGZ", 0), /* Unknown dimension, greater zero */
TCI (TC_prod, 0, "PROD", 1), TCI (TC_union, 2, "UNION", 1), TCI (TC_fun, 1, "FUN", 1),
TCI (TC_ibase, 3, "IBASE", 0), TCI (TC_iarr, 1, "IARR", 1), TCI (TC_idim, 1, "IDIM", 1),
TCI (TC_ishape, 1, "ISHAPE", 0), TCI (TC_ires, 1, "IRES", 0),
TCI (TC_alpha, 0, "ALPHA", 0), TCI (TC_bottom, 0, "BOTTOM", 0),
TCI (TC_poly, 0, "POLY", 0), TCI (TC_polyuser, 0, "POLYUSER", 0),
TCI (TC_dummy, 0, "LastTCI", 0)
#undef TCITypeConstr
#undef TCIArity
#undef TCIDbugString
#undef TCIVariableArity
......@@ -12,40 +12,10 @@
* TC_simple, TC_symbol, TC_user, TC_aks, TC_akd, ...
*/
#ifndef TCITypeConstr
#define TCITypeConstr(typeconstr)
#endif
TCI (TC_fun, 1, "FUN", 1, char, dummy_fun)
TCI (TC_ibase, 3, "IBASE", 0, struct NTYPE *, a_ibase)
TCI (TC_iarr, 1, "IARR", 1, char, dummy_iarr)
TCI (TC_idim, 1, "IDIM", 1, size_t, a_idim)
TCI (TC_ishape, 1, "ISHAPE", 0, shape *, a_ishape)
TCI (TC_ires, 1, "IRES", 0, attr_ires, a_ires)
#ifndef TCIArity
#define TCIArity(arity)
#endif
#ifndef TCIDbugString
#define TCIDbugString(dbug_str)
#endif
#ifndef TCIVariableArity
#define TCIVariableArity(variable_arity)
#endif
#define TCI(typeconstr, default_arity, dbug_str, variable_arity) \
TCITypeConstr (typeconstr) TCIArity (default_arity) TCIDbugString (dbug_str) \
TCIVariableArity (variable_arity)
TCI (TC_simple, 0, "Simple", 0), TCI (TC_symbol, 0, "Symbol", 0),
TCI (TC_user, 0, "User", 0), TCI (TC_akv, 1, "AKV", 0), /* Known value */
TCI (TC_aks, 1, "AKS", 0), /* Known shape */
TCI (TC_akd, 1, "AKD", 0), /* Known dimension */
TCI (TC_aud, 1, "AUD", 0), /* Unknown dimension */
TCI (TC_audgz, 1, "AUDGZ", 0), /* Unknown dimension, greater zero */
TCI (TC_prod, 0, "PROD", 1), TCI (TC_union, 2, "UNION", 1), TCI (TC_fun, 1, "FUN", 1),
TCI (TC_ibase, 3, "IBASE", 0), TCI (TC_iarr, 1, "IARR", 1), TCI (TC_idim, 1, "IDIM", 1),
TCI (TC_ishape, 1, "ISHAPE", 0), TCI (TC_ires, 1, "IRES", 0),
TCI (TC_alpha, 0, "ALPHA", 0), TCI (TC_bottom, 0, "BOTTOM", 0),
TCI (TC_poly, 0, "POLY", 0), TCI (TC_polyuser, 0, "POLYUSER", 0),
TCI (TC_dummy, 0, "LastTCI", 0)
#undef TCITypeConstr
#undef TCIArity
#undef TCIDbugString
#undef TCIVariableArity
......@@ -61,6 +61,7 @@
#include <limits.h>
#include "new_local.h"
#include "new_types.h"
#define DBUG_PREFIX "NTY"
......@@ -262,12 +263,12 @@ struct NTYPE {
*/
static char *dbug_str[] = {
#define TCIDbugString(a) a
#define TCIDbugString(a) a,
#include "type_constructor_info.mac"
};
static int variable_arity[] = {
#define TCIVariableArity(a) a
#define TCIVariableArity(a) a,
#include "type_constructor_info.mac"
};
......
......@@ -139,9 +139,6 @@
#include "types.h"
typeconstr TYgetConstr (ntype *type);
mutcScope TYgetMutcScope (ntype *type);
mutcUsage TYgetMutcUsage (ntype *type);
/*
* Scalar Types: Simple / User / Symbol
*/
......@@ -153,10 +150,6 @@ extern ntype *TYmakeSymbType (char *name, namespace_t *mod);
extern ntype *TYsetSimpleType (ntype *simple, simpletype base);
extern ntype *TYsetHiddenUserType (ntype *simple, usertype udt);
extern ntype *TYsetMutcUsage (ntype *type, mutcUsage usage);
extern ntype *TYsetMutcScope (ntype *type, mutcScope scope);
extern ntype *TYsetUnique (ntype *type, bool val);
extern ntype *TYsetDistributed (ntype *type, distmem_dis val);
extern simpletype TYgetSimpleType (ntype *simple);
extern usertype TYgetHiddenUserType (ntype *simple);
......@@ -284,7 +277,6 @@ extern bool TYisProdOfAKVafter (ntype *, size_t);
extern bool TYisProdContainingAKV (ntype *);
extern bool TYgetUnique (ntype *type);
extern distmem_dis TYgetDistributed (ntype *type);
extern int TYcountNonFixedAlpha (ntype *);
extern int TYcountNoMinAlpha (ntype *);
......
......@@ -263,12 +263,12 @@ struct NTYPE {
*/
static char *dbug_str[] = {
#define TCIDbugString(a) a
#define TCIDbugString(a) a,
#include "type_constructor_info.mac"
};
static int variable_arity[] = {
#define TCIVariableArity(a) a
#define TCIVariableArity(a) a,
#include "type_constructor_info.mac"
};
......
......@@ -141,9 +141,6 @@
#if 0 //CHARL
typeconstr TYgetConstr (ntype *type);
mutcScope TYgetMutcScope (ntype *type);
mutcUsage TYgetMutcUsage (ntype *type);
/*
* Scalar Types: Simple / User / Symbol
*/
......@@ -155,10 +152,6 @@ extern ntype *TYmakeSymbType (char *name, namespace_t *mod);
extern ntype *TYsetSimpleType (ntype *simple, simpletype base);
extern ntype *TYsetHiddenUserType (ntype *simple, usertype udt);
extern ntype *TYsetMutcUsage (ntype *type, mutcUsage usage);
extern ntype *TYsetMutcScope (ntype *type, mutcScope scope);
extern ntype *TYsetUnique (ntype *type, bool val);
extern ntype *TYsetDistributed (ntype *type, distmem_dis val);
extern simpletype TYgetSimpleType (ntype *simple);
extern usertype TYgetHiddenUserType (ntype *simple);
......@@ -286,7 +279,6 @@ extern bool TYisProdOfAKVafter (ntype *, size_t);
extern bool TYisProdContainingAKV (ntype *);
extern bool TYgetUnique (ntype *type);
extern distmem_dis TYgetDistributed (ntype *type);
extern int TYcountNonFixedAlpha (ntype *);
extern int TYcountNoMinAlpha (ntype *);
......
......@@ -92,70 +92,15 @@
#include "traverse.h"
#include "flattengenerators.h"
/*
* Since all type constructors may have different attributes,
* for each type constructor TC_xx that requires at least two attributes
* a new type attr_xx is defined:
*/
typedef struct ATTR_AKD {
shape *shp;
size_t dots;
} attr_akd;
typedef struct ATTR_SYMBOL {
namespace_t *mod;
char *name;
} attr_symbol;
typedef struct ATTR_IRES {
size_t num_funs;
node **fundefs;
int *poss;
} attr_ires;
typedef struct ATTR_POLYUSER {
char *outer;
char *inner;
char *shape;
bool denest : 1;
bool renest : 1;
} attr_polyuser;
typedef struct DFT_STATE {
size_t max_funs;
size_t cnt_funs;
node **fundefs;
bool *legal;
int *ups;
int *downs;
} dft_state;
typedef struct SIMPLE {
simpletype simple;
usertype udt;
} simple;
/*
* In order to have a uniform type for ALL type constructors, we define
* a union type over all potential attributes:
*/
typedef union {
simple a_simple;
attr_symbol a_symbol;
usertype a_user;
shape *a_aks;
attr_akd a_akd;
constant *a_akv;
struct NTYPE *a_ibase;
size_t a_idim;
shape *a_ishape;
attr_ires a_ires;
tvar *a_alpha;
char *a_bottom;
char *a_poly;
attr_polyuser a_polyuser;
#define TCIAttrType(a) a
#define TCIAttrName(a) a;
#include "type_constructor_info.mac"
} typeattr;
/*
......@@ -177,84 +122,6 @@ struct NTYPE {
struct NTYPE **sons;
};
/*
* For internal usage within this module only, we define the following
* shape access macros:
*
* First, we define some basic ntype-access-macros:
*/
#define NTYPE_CON(n) (n->mtypeconstr)
#define NTYPE_ARITY(n) (n->arity)
#define NTYPE_SONS(n) (n->sons)
#define NTYPE_SON(n, i) (n->sons[i])
#define NTYPE_MUTC_SCOPE(n) (n->mutcscope)
#define NTYPE_MUTC_USAGE(n) (n->mutcusage)
#define NTYPE_UNIQUE(n) (n->unique)
#define NTYPE_DISTRIBUTED(n) (n->distributed)
/*
* Macros for accessing the attributes...
*/
#define SIMPLE_TYPE(n) (n->mtypeattr.a_simple.simple)
#define SIMPLE_HIDDEN_UDT(n) (n->mtypeattr.a_simple.udt)
#define SYMBOL_NS(n) (n->mtypeattr.a_symbol.mod)
#define SYMBOL_NAME(n) (n->mtypeattr.a_symbol.name)
#define USER_TYPE(n) (n->mtypeattr.a_user)
#define AKV_CONST(n) (n->mtypeattr.a_akv)
#define AKS_SHP(n) (n->mtypeattr.a_aks)
#define AKD_SHP(n) (n->mtypeattr.a_akd.shp)
#define AKD_DOTS(n) (n->mtypeattr.a_akd.dots)
#define IBASE_BASE(n) (n->mtypeattr.a_ibase)
#define IDIM_DIM(n) (n->mtypeattr.a_idim)
#define ISHAPE_SHAPE(n) (n->mtypeattr.a_ishape)
#define IRES_NUMFUNS(n) (n->mtypeattr.a_ires.num_funs)
#define IRES_FUNDEFS(n) (n->mtypeattr.a_ires.fundefs)
#define IRES_FUNDEF(n, i) (n->mtypeattr.a_ires.fundefs[i])
#define IRES_POSS(n) (n->mtypeattr.a_ires.poss)
#define IRES_POS(n, i) (n->mtypeattr.a_ires.poss[i])
#define ALPHA_SSI(n) (n->mtypeattr.a_alpha)
#define BOTTOM_MSG(n) (n->mtypeattr.a_bottom)
#define POLY_NAME(n) (n->mtypeattr.a_poly)
#define POLYUSER_OUTER(n) (n->mtypeattr.a_polyuser.outer)
#define POLYUSER_INNER(n) (n->mtypeattr.a_polyuser.inner)
#define POLYUSER_SHAPE(n) (n->mtypeattr.a_polyuser.shape)
#define POLYUSER_DENEST(n) (n->mtypeattr.a_polyuser.denest)
#define POLYUSER_RENEST(n) (n->mtypeattr.a_polyuser.renest)
/*
* Macros for accessing the sons...
*/
#define AKV_BASE(n) (n->sons[0])
#define AKS_BASE(n) (n->sons[0])
#define AKD_BASE(n) (n->sons[0])
#define AUDGZ_BASE(n) (n->sons[0])
#define AUD_BASE(n) (n->sons[0])
#define UNION_MEMBER(n, i) (n->sons[i])
#define PROD_MEMBER(n, i) (n->sons[i])
#define FUN_POLY(n) (n->sons[0])
#define FUN_UPOLY(n) (n->sons[1])
#define FUN_IBASE(n, i) (n->sons[i + 2])
#define IBASE_GEN(n) (n->sons[0])
#define IBASE_SCAL(n) (n->sons[1])
#define IBASE_IARR(n) (n->sons[2])
#define IARR_GEN(n) (n->sons[0])
#define IARR_IDIM(n, i) (n->sons[i + 1])
#define IDIM_GEN(n) (n->sons[0])
#define IDIM_ISHAPE(n, i) (n->sons[i + 1])
#define ISHAPE_GEN(n) (n->sons[0])
#define IRES_TYPE(n) (n->sons[0])
/*
* For dbug-output purposes we keep an array of strings for the individual
* type constructors and an array of flags indicating whether the number of
......@@ -262,12 +129,12 @@ struct NTYPE {
*/
static char *dbug_str[] = {
#define TCIDbugString(a) a
#define TCIDbugString(a) a,
#include "type_constructor_info.mac"
};
static int variable_arity[] = {
#define TCIVariableArity(a) a
#define TCIVariableArity(a) a,
#include "type_constructor_info.mac"
};
......@@ -286,8 +153,7 @@ static int variable_arity[] = {
*
******************************************************************************/
static ntype *
MakeNtype (typeconstr con, size_t arity)
ntype * MakeNtype (typeconstr con, size_t arity)
{
ntype *res;
size_t i;
......@@ -325,8 +191,7 @@ MakeNtype (typeconstr con, size_t arity)
*
******************************************************************************/
ntype *
MakeNewSon (ntype *father, ntype *son)
ntype * MakeNewSon (ntype *father, ntype *son)
{
ntype **new_sons;
size_t i, arity;
......@@ -414,50 +279,6 @@ IncreaseArity (ntype *type, size_t amount)
DBUG_RETURN (type);
}
/******************************************************************************
*
* function:
* ntype *MakeNewFundefsPoss( ntype *ires, int num,
* node **fundefs, int *poss)
*
* description:
* Internal function for adding <num> fundefs and <num> poss to an ires's
* fundefs and poss list.
* Like all Makexxx functions it consumes (reuses) both its arguments!!
*
******************************************************************************/
ntype *
MakeNewFundefsPoss (ntype *ires, size_t num, node **fundefs, int *poss)
{
node **new_fundefs;
int *new_poss;
size_t i, arity;
DBUG_ENTER ();
arity = IRES_NUMFUNS (ires);
IRES_NUMFUNS (ires) = arity + num;
new_fundefs = (node **)MEMmalloc (sizeof (node *) * IRES_NUMFUNS (ires));
new_poss = (int *)MEMmalloc (sizeof (int) * IRES_NUMFUNS (ires));
for (i = 0; i < arity; i++) {
new_fundefs[i] = IRES_FUNDEF (ires, i);
new_poss[i] = IRES_POS (ires, i);
}
for (; i < IRES_NUMFUNS (ires); i++) {
new_fundefs[i] = fundefs[i - arity];
new_poss[i] = poss[i - arity];
}
IRES_FUNDEFS (ires) = MEMfree (IRES_FUNDEFS (ires));
IRES_POSS (ires) = MEMfree (IRES_POSS (ires));
fundefs = MEMfree (fundefs);
poss = MEMfree (poss);
IRES_FUNDEFS (ires) = new_fundefs;
IRES_POSS (ires) = new_poss;
DBUG_RETURN (ires);
}
/***
*** Functions for creating and inspecting ntypes (MakeXYZ, GetXYZ):
*** these functions are the sole functions that use arg-pointers as
......@@ -545,104 +366,6 @@ TYgetDistributed (ntype *type)
DBUG_RETURN (NTYPE_DISTRIBUTED (type));
}
/******************************************************************************
*
* function:
* ntype * TYmakeSimpleType( simpletype base)
* ntype * TYmakeHiddenSimpleType( usertype udt)
* ntype * TYmakeSymbType( char *name, namespace_t *ns)
* ntype * TYmakeUserType( usertype udt)
*
* ntype * TYsetSimpleType( ntype *simple, simpletype base)
*
* description:
* Several functions for creating scalar types
* (type-constructors with arity 0).
*
******************************************************************************/
ntype *
TYmakeSimpleType (simpletype base)
{
ntype *res;
DBUG_ENTER ();
DBUG_ASSERT (base != T_hidden, "TYmakeSimpleType called with T_hidden arg!"
"Please use TYmakeHiddenSimpleType instead!");
res = MakeNtype (TC_simple, 0);
SIMPLE_TYPE (res) = base;
SIMPLE_HIDDEN_UDT (res) = UT_NOT_DEFINED;
DBUG_RETURN (res);
}
ntype *
TYmakeHiddenSimpleType (usertype udt)
{
ntype *res;
DBUG_ENTER ();
res = MakeNtype (TC_simple, 0);
SIMPLE_TYPE (res) = T_hidden;
SIMPLE_HIDDEN_UDT (res) = udt;
DBUG_RETURN (res);
}
ntype *
TYmakeSymbType (char *name, namespace_t *ns)
{
ntype *res;
DBUG_ENTER ();
DBUG_ASSERT (name != NULL, "TYmakeSymbType called with NULL name!");
res = MakeNtype (TC_symbol, 0);
SYMBOL_NS (res) = ns;
SYMBOL_NAME (res) = name;
DBUG_RETURN (res);
}
ntype *
TYmakeUserType (usertype udt)
{
ntype *res;
DBUG_ENTER ();
DBUG_PRINT_TAG ("TYmakeUserType", "MAKING USER TYPE: %s", UTgetName (udt));
res = MakeNtype (TC_user, 0);
USER_TYPE (res) = udt;
DBUG_RETURN (res);
}
ntype *
TYsetSimpleType (ntype *simple, simpletype base)
{
DBUG_ENTER ();
SIMPLE_TYPE (simple) = base;
DBUG_RETURN (simple);
}
ntype *
TYsetHiddenUserType (ntype *simple, usertype udt)
{
DBUG_ENTER ();
SIMPLE_HIDDEN_UDT (simple) = udt;
DBUG_RETURN (simple);
}
ntype *
TYsetMutcUsage (ntype *type, mutcUsage usage)
{
......@@ -697,3734 +420,52 @@ TYsetMutcScope (ntype *type, mutcScope scope)
*
******************************************************************************/
simpletype
TYgetSimpleType (ntype *simple)
{
DBUG_ENTER ();
if (NTYPE_CON (simple) != TC_simple) {
printf ("NTYPE_CON() returns %i instead of %i (TC_simple)\n", NTYPE_CON (simple),
TC_simple);
}
DBUG_ASSERT (NTYPE_CON (simple) == TC_simple,
"TYgetSimpleType applied to nonsimple-type!");
DBUG_RETURN (SIMPLE_TYPE (simple));
}
usertype
TYgetHiddenUserType (ntype *simple)
{
DBUG_ENTER ();
DBUG_ASSERT (NTYPE_CON (simple) == TC_simple,
"TYgetHiddenUserType applied to nonsimple-type!");
DBUG_ASSERT (SIMPLE_TYPE (simple) == T_hidden,
"TYgetHiddenUserType applied to non hidden type!");
DBUG_RETURN (SIMPLE_HIDDEN_UDT (simple));
}
usertype
TYgetUserType (ntype *user)
{
DBUG_ENTER ();
DBUG_ASSERT (NTYPE_CON (user) == TC_user, "TYgetUserType applied to non-user-type!");
DBUG_RETURN (USER_TYPE (user));
}
char *
TYgetName (ntype *symb)
{
DBUG_ENTER ();
DBUG_ASSERT (NTYPE_CON (symb) == TC_symbol, "TYgetName applied to nonsymbol-type!");
DBUG_RETURN (SYMBOL_NAME (symb));
}
const namespace_t *
TYgetNamespace (ntype *symb)
{
DBUG_ENTER ();
DBUG_ASSERT (NTYPE_CON (symb) == TC_symbol,
"TYgetNamespace applied to nonsymbol-type!");
DBUG_RETURN (SYMBOL_NS (symb));
}
/***
*** functions that check for the relationship of types:
***/
/******************************************************************************
*
* function:
* ntype * TYsetNamespace( ntype *symb, namespace_t *ns)
* ct_res TYcmpTypes( ntype *t1, ntype *t2)
* bool TYleTypes( ntype *t1, ntype *t2)
* bool TYeqTypes( ntype *t1, ntype *t2)
*
* description:
* Several functions for changing the attributes from scalar types.
*
******************************************************************************/
ntype *
TYsetNamespace (ntype *symb, namespace_t *ns)
{
DBUG_ENTER ();
DBUG_ASSERT (NTYPE_CON (symb) == TC_symbol,
"TYsetNamespace applied to nonsymbol-type!");
if (SYMBOL_NS (symb) != NULL) {
SYMBOL_NS (symb) = NSfreeNamespace (SYMBOL_NS (symb));
}
SYMBOL_NS (symb) = ns;
DBUG_RETURN (symb);
}