static void ids(node_t *sym)
{
if (token->id == ID) {
int val = 0;
do {
node_t *s = lookup(token->name, identifiers);
if (s && is_current_scope(s))
redefinition_error(source, s);
s = install(token->name, &identifiers, SCOPE);
SYM_TYPE(s) = SYM_TYPE(sym);
AST_SRC(s) = source;
SYM_SCLASS(s) = ENUM;
expect(ID);
if (token->id == '=') {
expect('=');
val = intexpr();
}
SYM_VALUE_U(s) = val++;
if (token->id != ',')
break;
expect(',');
} while (token->id == ID);
} else {
error("expect identifier");
}
}
void
initialize_intrinsic() {
int i;
SYMBOL sp;
intrinsic_entry *ep;
for (i = 0, ep = &intrinsic_table[0];
INTR_OP((ep = &intrinsic_table[i])) != INTR_END; i++){
if ((ep->langSpec & langSpecSet) == 0) {
continue;
}
if (!(isValidString(INTR_NAME(ep)))) {
continue;
}
if (INTR_HAS_KIND_ARG(ep)) {
if (((INTR_OP(ep) != INTR_MINLOC) &&
(INTR_OP(ep) != INTR_MAXLOC)) &&
INTR_RETURN_TYPE_SAME_AS(ep) != -1) {
fatal("%: Invalid intrinsic initialization.", __func__);
}
}
sp = find_symbol((char *)INTR_NAME(ep));
SYM_TYPE(sp) = S_INTR;
SYM_VAL(sp) = i;
}
}
double selectSigma(const std::vector<std::vector<std::vector<SYM_TYPE> > > &slist,int N) {
std::vector<double> symDist(N);
int sA,sB,symA,symB;
size_t listSize=slist.size();
size_t symDim=slist[0][0].size();
if(N<=0) {
N=0;
for(size_t i=0; i<slist.size(); i++) {
N+=slist[i].size();
}
N=std::floor(std::sqrt(N));
}
for(int i=0; i<N; i++) {
sA=rand()%listSize;
symA=rand()%slist[sA].size();
sB=rand()%listSize;
symB=rand()%slist[sA].size();
SYM_TYPE sum=SYM_TYPE(0);
for(size_t d=0; d<symDim; d++) {
sum+=(slist[sA][symA][d]-slist[sB][symB][d])*(slist[sA][symA][d]-slist[sB][symB][d]);
}
symDist[i]=std::sqrt(sum);
}
std::vector<double>::iterator first=symDist.begin();
std::vector<double>::iterator last=symDist.end();
std::vector<double>::iterator median=first+(last-first)/2;
nth_element(first,median,last);
return *median;
}
static void fields(node_t * sym)
{
int follow[] = {INT, CONST, '}', IF, 0};
node_t *sty = SYM_TYPE(sym);
if (!first_decl(token)) {
error("expect type name or qualifiers");
return;
}
struct vector *v = vec_new();
do {
node_t *basety = specifiers(NULL, NULL);
for (;;) {
node_t *field = new_field();
if (token->id == ':') {
bitfield(field);
FIELD_TYPE(field) = basety;
} else {
node_t *ty = NULL;
struct token *id = NULL;
declarator(&ty, &id, NULL);
attach_type(&ty, basety);
if (token->id == ':')
bitfield(field);
FIELD_TYPE(field) = ty;
if (id) {
for (int i = 0; i < vec_len(v); i++) {
node_t *f = vec_at(v, i);
if (FIELD_NAME(f) &&
!strcmp(FIELD_NAME(f), id->name)) {
errorf(id->src,
"redefinition of '%s'",
id->name);
break;
}
}
FIELD_NAME(field) = id->name;
AST_SRC(field) = id->src;
}
}
vec_push(v, field);
if (token->id != ',')
break;
expect(',');
ensure_field(field, vec_len(v), false);
}
match(';', follow);
ensure_field(vec_tail(v), vec_len(v),
isstruct(sty) && !first_decl(token));
} while (first_decl(token));
TYPE_FIELDS(sty) = (node_t **) vtoa(v);
set_typesize(sty);
}
static node_t *tag_decl(void)
{
int t = token->id;
const char *id = NULL;
node_t *sym = NULL;
struct source src = source;
int follow[] = {INT, CONST, STATIC, IF, 0};
expect(t);
if (token->id == ID) {
id = token->name;
expect(ID);
}
if (token->id == '{') {
expect('{');
sym = tag_type(t, id, src);
if (t == ENUM)
ids(sym);
else
fields(sym);
match('}', follow);
SYM_DEFINED(sym) = true;
} else if (id) {
sym = lookup(id, tags);
if (sym) {
if (is_current_scope(sym) && TYPE_OP(SYM_TYPE(sym)) != t)
errorf(src,
"use of '%s' with tag type that does not match "
"previous declaration '%s' at %s:%u:%u",
id2s(t), type2s(SYM_TYPE(sym)),
AST_SRC(sym).file,
AST_SRC(sym).line,
AST_SRC(sym).column);
} else {
sym = tag_type(t, id, src);
}
} else {
error("expected identifier or '{'");
sym = tag_type(t, NULL, src);
}
return SYM_TYPE(sym);
}
static int subprocess(void *context)
{
struct context *con = (struct context *)context;
const char *code = con->code;
const char *type = con->type;
const char *output = con->output;
node_t *n = compile(code);
node_t *n1 = DECL_EXTS(n)[0];
node_t *ty = SYM_TYPE(DECL_SYM(n1));
const char *ret;
const char *p1, *p2;
if (strcmp(TYPE_NAME(unqual(ty)), type))
fail("type not equal: %s != %s", TYPE_NAME(unqual(ty)), type);
ret = type2s(ty);
p1 = ret;
p2 = output;
for (;;) {
while (isspace((unsigned char)*ret))
ret++;
while (isspace((unsigned char)*output))
output++;
if (*ret == '\0' || *output == '\0')
break;
if (*ret != *output)
fail("'%s' != '%s' at '%c' != '%c'", p1, p2, *ret,
*output);
ret++;
output++;
}
if (*ret != '\0' || *output != '\0')
fail("'%s' != '%s'", p1, p2);
return EXIT_SUCCESS;
}
expv
compile_intrinsic_call(ID id, expv args) {
intrinsic_entry *ep = NULL;
int found = 0;
int nArgs = 0;
int nIntrArgs = 0;
int i;
expv ret = NULL;
expv a = NULL;
TYPE_DESC tp = NULL, ftp;
list lp;
INTR_OPS iOps = INTR_END;
const char *iName = NULL;
expv kindV = NULL;
int typeNotMatch = 0;
int isVarArgs = 0;
EXT_ID extid;
if (SYM_TYPE(ID_SYM(id)) != S_INTR) {
//fatal("%s: not intrinsic symbol", __func__);
// declarea as intrinsic but not defined in the intrinc table
SYM_TYPE(ID_SYM(id)) = S_INTR;
if (args == NULL) {
args = list0(LIST);
}
if (ID_TYPE(id) == NULL) implicit_declaration(id);
tp = ID_TYPE(id);
//tp = BASIC_TYPE_DESC(TYPE_SUBR);
expv symV = expv_sym_term(F_FUNC, NULL, ID_SYM(id));
ftp = function_type(tp);
TYPE_SET_INTRINSIC(ftp);
extid = new_external_id_for_external_decl(ID_SYM(id), ftp);
ID_TYPE(id) = ftp;
PROC_EXT_ID(id) = extid;
if (TYPE_IS_EXTERNAL(tp)){
ID_STORAGE(id) = STG_EXT;
}
else{
EXT_PROC_CLASS(extid) = EP_INTRINSIC;
}
ret = expv_cons(FUNCTION_CALL, tp, symV, args);
return ret;
}
ep = &(intrinsic_table[SYM_VAL(ID_SYM(id))]);
iOps = INTR_OP(ep);
iName = ID_NAME(id);
/* Count a number of argument, first. */
nArgs = 0;
if (args == NULL) {
args = list0(LIST);
}
FOR_ITEMS_IN_LIST(lp, args) {
nArgs++;
}
/* Search an intrinsic by checking argument types. */
found = 0;
for (;
((INTR_OP(ep) == iOps) &&
((strcasecmp(iName, INTR_NAME(ep)) == 0) ||
!(isValidString(INTR_NAME(ep)))));
ep++) {
kindV = NULL;
typeNotMatch = 0;
isVarArgs = 0;
/* Check a number of arguments. */
if (INTR_N_ARGS(ep) < 0 ||
INTR_N_ARGS(ep) == nArgs) {
/* varriable args or no kind arg. */
if (INTR_N_ARGS(ep) < 0) {
isVarArgs = 1;
}
nIntrArgs = nArgs;
} else if (INTR_HAS_KIND_ARG(ep) &&
((INTR_N_ARGS(ep) + 1) == nArgs)) {
/* could be intrinsic call with kind arg. */
expv lastV = expr_list_get_n(args, nArgs - 1);
if (lastV == NULL) {
return NULL; /* error recovery */
}
if (EXPV_KW_IS_KIND(lastV)) {
goto gotKind;
}
tp = EXPV_TYPE(lastV);
if (!(isValidType(tp))) {
return NULL; /* error recovery */
}
if (TYPE_BASIC_TYPE(tp) != TYPE_INT) {
/* kind arg must be integer type. */
continue;
}
gotKind:
nIntrArgs = INTR_N_ARGS(ep);
kindV = lastV;
} else {
continue;
}
/* The number of arguments matchs. Then check types. */
for (i = 0; i < nIntrArgs; i++) {
a = expr_list_get_n(args, i);
if (a == NULL) {
return NULL; /* error recovery */
}
tp = EXPV_TYPE(a);
if (!(isValidType(tp))) {
//return NULL; /* error recovery */
continue;
}
if (compare_intrinsic_arg_type(a, tp,
((isVarArgs == 0) ?
INTR_ARG_TYPE(ep)[i] :
INTR_ARG_TYPE(ep)[0])) != 0) {
/* Type mismatch. */
typeNotMatch = 1;
break;
}
}
if (typeNotMatch == 1) {
continue;
} else {
found = 1;
break;
}
}
if (found == 1) {
/* Yes we found an intrinsic to use. */
SYMBOL sp = NULL;
expv symV = NULL;
/* Then we have to determine return type. */
if (INTR_RETURN_TYPE(ep) != INTR_TYPE_NONE) {
tp = get_intrinsic_return_type(ep, args, kindV);
if (!(isValidType(tp))) {
//fatal("%s: can't determine return type.", __func__);
//return NULL;
tp = BASIC_TYPE_DESC(TYPE_GNUMERIC_ALL);
}
} else {
tp = BASIC_TYPE_DESC(TYPE_SUBR);
}
/* Finally find symbol for the intrinsic and make it expv. */
sp = find_symbol((char *)iName);
if (sp == NULL) {
fatal("%s: symbol '%s' is not created??",
__func__,
INTR_NAME(ep));
/* not reached */
return NULL;
}
symV = expv_sym_term(F_FUNC, NULL, sp);
if (symV == NULL) {
fatal("%s: symbol expv creation failure.", __func__);
/* not reached */
return NULL;
}
ftp = function_type(tp);
TYPE_SET_INTRINSIC(ftp);
/* set external id for functionType's type ID.
* dont call declare_external_id() */
extid = new_external_id_for_external_decl(ID_SYM(id), ftp);
ID_TYPE(id) = ftp;
PROC_EXT_ID(id) = extid;
if(TYPE_IS_EXTERNAL(tp)){
ID_STORAGE(id) = STG_EXT;
}else{
EXT_PROC_CLASS(extid) = EP_INTRINSIC;
}
ret = expv_cons(FUNCTION_CALL, tp, symV, args);
}
if (ret == NULL) {
error_at_node((expr)args,
"argument(s) mismatch for an intrinsic '%s()'.",
iName);
}
return ret;
}
int
is_intrinsic_function(ID id) {
return (SYM_TYPE(ID_SYM(id)) == S_INTR) ? TRUE : FALSE;
}
