void data_section(MPL *mpl)
{ while (!(mpl->token == T_EOF || is_literal(mpl, "end")))
{ if (is_literal(mpl, "set"))
set_data(mpl);
else if (is_literal(mpl, "param"))
parameter_data(mpl);
else
error(mpl, "syntax error in data section");
}
return;
}
bool is_integer(ast_t* type)
{
return is_literal(type, "I8") ||
is_literal(type, "I16") ||
is_literal(type, "I32") ||
is_literal(type, "I64") ||
is_literal(type, "I128") ||
is_literal(type, "U8") ||
is_literal(type, "U16") ||
is_literal(type, "U32") ||
is_literal(type, "U64") ||
is_literal(type, "U128");
}
bool is_clause(ast_manager & m, expr * n) {
if (is_literal(m, n))
return true;
if (m.is_or(n)) {
unsigned num_args = to_app(n)->get_num_args();
for (unsigned i = 0; i < num_args; i++) {
if (!is_literal(m, to_app(n)->get_arg(i)))
return false;
}
return true;
}
return false;
}
void unsat_core_plugin_lemma::add_lowest_split_to_core(proof* step) const {
SASSERT(m_ctx.is_b_open(step));
ptr_buffer<proof> todo;
todo.push_back(step);
while (!todo.empty()) {
proof* pf = todo.back();
todo.pop_back();
// if current step hasn't been processed,
if (!m_ctx.is_closed(pf)) {
m_ctx.set_closed(pf, true);
// the step is b-marked and not closed.
// by I.H. the step must be already visited
// so if it is also a-marked, it must be closed
SASSERT(m_ctx.is_b(pf));
SASSERT(!m_ctx.is_a(pf));
// the current step needs to be interpolated:
expr* fact = m.get_fact(pf);
// if we trust the current step and we are able to use it
if (m_ctx.is_b_pure (pf) && (m.is_asserted(pf) || is_literal(m, fact))) {
// just add it to the core
m_ctx.add_lemma_to_core(fact);
}
// otherwise recurse on premises
else {
for (proof* premise : m.get_parents(pf))
if (m_ctx.is_b_open(premise))
todo.push_back(premise);
}
}
}
}
unsigned get_clause_num_literals(ast_manager & m, expr * cls) {
SASSERT(is_clause(m, cls));
if (is_literal(m, cls))
return 1;
SASSERT(m.is_or(cls));
return to_app(cls)->get_num_args();
}
/* put the simple value for the escape code */
static void c_map_put_esc_simple(symbol_t *sp, list_t *entry)
{
node_t *pp = entry->e3;
if (!is_literal(pp->op)) {
c_out("0");
return;
}
/* no map cascades at this time */
if (entry->type == ESC_MAP)
fatal("Internal error CM%d: Map cascading not supported", __LINE__);
c_outi("%sbs.%s%s%s", prefix,
(sp->modifiers & M_LITTLE ? "little_" : ""),
(sp->modifiers & M_UNSIGNED || sp->ptype->ident > INT ? "" : "s"), "put");
if (sp->ptype->ident <= INT) {
if (java() && sp->modifiers & M_LONG)
c_out("long(");
else
c_out("bits(%sarg,", prefix);
c_expression(pp, 0);
c_out(");\n");
}
else if (sp->ptype->ident == FLOAT)
c_out("float(%sarg);\n", prefix);
else if (sp->ptype->ident == DOUBLE && (sp->modifiers & M_LONG))
c_out("ldouble(%sarg);\n", prefix);
else
c_out("double(%sarg);\n", prefix);
}
int mpl_read_data(MPL *mpl, char *file)
{ if (mpl->phase != 1)
fault("mpl_read_data: invalid call sequence");
if (file == NULL)
fault("mpl_read_data: no input filename specified");
/* set up error handler */
if (setjmp(mpl->jump)) goto done;
/* process data section */
mpl->phase = 2;
print("Reading data section from %s...", file);
mpl->flag_d = 1;
open_input(mpl, file);
/* in this case the keyword 'data' is optional */
if (is_literal(mpl, "data"))
{ get_token(mpl /* data */);
if (mpl->token != T_SEMICOLON)
error(mpl, "semicolon missing where expected");
get_token(mpl /* ; */);
}
data_section(mpl);
/* process end statement */
end_statement(mpl);
print("%d line%s were read", mpl->line, mpl->line == 1 ? "" : "s")
;
close_input(mpl);
done: /* return to the calling program */
return mpl->phase;
}
static bool void_star_param(ast_t* param_type, ast_t* arg_type)
{
assert(param_type != NULL);
assert(arg_type != NULL);
if(!is_pointer(param_type))
return false;
ast_t* type_args = ast_childidx(param_type, 2);
if(ast_childcount(type_args) != 1 || !is_none(ast_child(type_args)))
return false;
// Parameter type is Pointer[None]
// If the argument is Pointer[A], MaybePointer[A] or USize, allow it
while(ast_id(arg_type) == TK_ARROW)
arg_type = ast_childidx(arg_type, 1);
if(is_pointer(arg_type) ||
is_maybe(arg_type) ||
is_literal(arg_type, "USize"))
return true;
return false;
}
void delete_hashlist(struct session *ses, struct hashtable *h, const char *pat, const char *msg_ok, const char *msg_none)
{
struct listnode *templist;
if (is_literal(pat))
{
if (delete_hash(h, pat))
{
if (msg_ok)
tintin_printf(ses, msg_ok, pat);
}
else
{
if (msg_none)
tintin_printf(ses, msg_none, pat);
}
return;
}
templist=hash2list(h, pat);
for (struct listnode *ln=templist->next; ln; ln=ln->next)
{
if (msg_ok)
tintin_printf(ses, msg_ok, ln->left);
delete_hash(h, ln->left);
}
if (msg_none && !templist->next)
tintin_printf(ses, msg_none, pat);
zap_list(templist);
}
expr * get_clause_literal(ast_manager & m, expr * cls, unsigned idx) {
SASSERT(is_clause(m, cls));
SASSERT(idx < get_clause_num_literals(m, cls));
if (is_literal(m, cls)) {
SASSERT(idx == 0);
return cls;
}
SASSERT(m.is_or(cls));
return to_app(cls)->get_arg(idx);
}
void get_literal_atom_sign(ast_manager & m, expr * n, expr * & atom, bool & sign) {
SASSERT(is_literal(m, n));
if (is_atom(m, n)) {
atom = n;
sign = false;
}
else {
SASSERT(m.is_not(n));
atom = to_app(n)->get_arg(0);
sign = true;
}
}
bool is_signed(ast_t* type)
{
return
is_literal(type, "I8") ||
is_literal(type, "I16") ||
is_literal(type, "I32") ||
is_literal(type, "I64") ||
is_literal(type, "I128") ||
is_literal(type, "ILong") ||
is_literal(type, "ISize");
}
/* put the class value for the escape code */
static void c_map_put_esc_class(symbol_t *sp, list_t *entry)
{
list_t *pp = entry;
list_t *stmts = find_class_stmts(sp->ptype);
if (stmts == NULL)
fatal("Internal error CM%d: Cannot find declaration of class '%s'", __LINE__, sp->name);
/* no map cascades at this time */
if (entry->type == ESC_MAP)
fatal("Internal error CM%d: Map cascading not supported", __LINE__);
while (stmts != NULL) {
switch (stmts->type) {
case DECL:
/* declarations are ok, even parsable ones, but not with classes */
if (stmts->sp->ptype->ident == CLASS_TYPE) return;
if (pp == NULL) return;
if (!is_literal(pp->e3->op)) {
c_out("0");
return;
}
c_outi("%sbs.%sput", prefix, (stmts->sp->modifiers & M_LITTLE ? "little_" : ""));
if (stmts->sp->ptype->ident <= INT) {
if (java() && stmts->sp->modifiers & M_LONG)
c_out("long(%sarg%s%s,", prefix, c_scope(), stmts->sp->name);
else
c_out("bits(%sarg%s%s,", prefix, c_scope(), stmts->sp->name);
c_expression(pp->e3, 0);
c_out(");\n");
}
else if (stmts->sp->ptype->ident == FLOAT)
c_out("float(%sarg%s%s);\n", prefix, c_scope(), stmts->sp->name);
else if (stmts->sp->ptype->ident == DOUBLE && (stmts->sp->modifiers & M_LONG))
c_out("ldouble(%sarg%s%s);\n", prefix, c_scope(), stmts->sp->name);
else
c_out("double(%sarg%s%s);\n", prefix, c_scope(), stmts->sp->name);
pp = pp->next;
break;
default:
/* everything else, isn't - has been reported already */
return;
}
stmts = stmts->next;
}
}
/* Handle backend cookies */
int magic(command *cmd, response *rsp) {
rsp->is_message = 0;
if (cmd->op != MAGIC) return FALSE;
if (strcmp(cmd->arg1, "1") == 0 &&
strcmp(cmd->arg2, "1") == 0 &&
is_literal(cmd->arg3)) {
int i = atoi(cmd->arg3);
if (i < 0) {
io_delay = 0;
} else {
io_delay = i;
}
}
return TRUE;
}
lbool check_sat(unsigned sz, expr * const * assumptions) override {
m_solver.pop_to_base_level();
m_core.reset();
if (m_solver.inconsistent()) return l_false;
expr_ref_vector _assumptions(m);
obj_map<expr, expr*> asm2fml;
for (unsigned i = 0; i < sz; ++i) {
if (!is_literal(assumptions[i])) {
expr_ref a(m.mk_fresh_const("s", m.mk_bool_sort()), m);
expr_ref fml(m.mk_eq(a, assumptions[i]), m);
assert_expr(fml);
_assumptions.push_back(a);
asm2fml.insert(a, assumptions[i]);
}
else {
_assumptions.push_back(assumptions[i]);
asm2fml.insert(assumptions[i], assumptions[i]);
}
}
TRACE("sat", tout << _assumptions << "\n";);
bool spaced(term right)
{
//literal
if(is_literal())
return true;
//open
if(is_open())
return false;
//close and right close
if(is_close()&&right.is_close())
return false;
//close
if(is_close())
return true;
//delimiter
if(is_delimiter())
return false;
//right open
if(right.is_open())
return true;
//right delimiter
if(right.is_delimiter())
return false;
return true;
}
LLVMValueRef gen_string(compile_t* c, ast_t* ast)
{
const char* name = ast_name(ast);
genned_string_t k;
k.string = name;
size_t index = HASHMAP_UNKNOWN;
genned_string_t* string = genned_strings_get(&c->strings, &k, &index);
if(string != NULL)
return string->global;
ast_t* type = ast_type(ast);
pony_assert(is_literal(type, "String"));
reach_type_t* t = reach_type(c->reach, type);
compile_type_t* c_t = (compile_type_t*)t->c_type;
size_t len = ast_name_len(ast);
LLVMValueRef args[4];
args[0] = c_t->desc;
args[1] = LLVMConstInt(c->intptr, len, false);
args[2] = LLVMConstInt(c->intptr, len + 1, false);
args[3] = codegen_string(c, name, len);
LLVMValueRef inst = LLVMConstNamedStruct(c_t->structure, args, 4);
LLVMValueRef g_inst = LLVMAddGlobal(c->module, c_t->structure, "");
LLVMSetInitializer(g_inst, inst);
LLVMSetGlobalConstant(g_inst, true);
LLVMSetLinkage(g_inst, LLVMPrivateLinkage);
LLVMSetUnnamedAddr(g_inst, true);
string = POOL_ALLOC(genned_string_t);
string->string = name;
string->global = g_inst;
genned_strings_putindex(&c->strings, string, index);
return g_inst;
}
void try_unify(std::string lhs,
bool evolve, // type hack
std::vector<std::pair<int,std::string> >::iterator end,
std::vector<std::pair<int,std::string> >::iterator &i,std::map<std::string,std::string> *b,FILE *fl) {
// printf("UNIF(%s,%s)\n",lhs.c_str(),(*i).second.c_str());
if(is_literal((*i).first)) {
fprintf(fl,"&& ((%s)==(%s))",lhs.c_str(),(*i).second.c_str());
} else {
if(constructors.count((*i).second)) {
CConstructor *c=constructors[(*i).second];
fprintf(fl,"&& ((%s.ptr->_discr)==(%s))",lhs.c_str(),c->name.c_str());
++i;
if(i==end||(*i).second==","||(*i).second==")") return;
++i;
int k=0;
for(;(*i).second!=")";) {
if((*i).second==",") { ++k; ++i; }
else {
char buf[16];
sprintf(buf,"%d",k);
try_unify(lhs+".ptr->s"+c->name+".p"+buf,types.count(c->params_canonical[k]),end,i,b,fl);
}
}
++i;
} else {
if(b->count((*i).second)) {
fprintf(fl,"&& ((%s)==(%s))",lhs.c_str(),(*b)[(*i).second].c_str()); // check binding is consistent
} else if((*i).second=="*") {
} else if(is_identifier((*i).first)) {
(*b)[(*i).second]=lhs+(evolve?".evolve()":"");
} else {
fprintf(fl,"&& ((%s)==(%s))",lhs.c_str(),(*i).second.c_str());
}
++i;
}
}
}
/* get an escape value */
static void c_map_get_assign_esc(list_t *entry)
{
node_t *esc_type = entry->e2;
unsigned mod = entry->e1->left.ival;
/* no map cascades at this time */
if (entry->type == ESC_MAP)
fatal("Internal error CM%d: Map cascading not supported", __LINE__);
/* explicit casting is needed for Java */
if (java())
if (esc_type->ptype->ident != BIT && esc_type->ptype->ident != INT)
c_out("(%s) ", esc_type->ptype->name);
/* parse length should be a literal */
if (!is_literal(entry->e3->op)) {
c_out("0"); /* error already reported - just assign 0 */
return;
}
c_out("%sbs.%s%sget", prefix,
(mod & M_LITTLE ? "little_" : ""),
(mod & M_UNSIGNED || esc_type->ptype->ident > INT ? "" : "s"));
if (esc_type->ptype->ident <= INT) {
if (java() && esc_type->ptype->modifiers & M_LONG)
c_out("long(%sesc_bits)", prefix);
else
c_out("bits(%sesc_bits)", prefix);
}
else if (esc_type->ptype->ident == FLOAT)
c_out("float()");
else if (esc_type->ptype->ident == DOUBLE && (esc_type->ptype->modifiers & M_LONG))
c_out("ldouble()");
else
c_out("double()");
}
static Const const_val(Symbol obj) /*;const_val*/
{
/* Return the constant value of the object if it has one;
* else return om.
* The constant value of a user-defined constant is derived from
* its SIGNATURE, when this is a constant value.
* The constant value of a literal is obtained from the literal map
* of its type.
*/
Tuple sig;
if (cdebug2 > 3) TO_ERRFILE("const_val");
if (is_literal(obj)) return eval_lit_map(obj);
sig = SIGNATURE(obj);
if( is_constant(obj) && is_scalar_type(TYPE_OF(obj))
&& N_KIND((Node)sig) == as_ivalue) {
return (Const) N_VAL((Node)sig);
/* TBSL: could be static but not constant folded yet. */
}
else return const_new(CONST_OM);
}
unsigned add_soft(expr* lit) {
SASSERT(is_literal(lit));
unsigned idx = m_lit2expr.size();
m_expr2lit.insert(lit, idx);
m_lit2expr.push_back(lit);
TRACE("mus", tout << idx << ": " << mk_pp(lit, m) << "\n" << m_lit2expr << "\n";);
bool is_machine_word(ast_t* type)
{
return is_bool(type) ||
is_literal(type, "I8") ||
is_literal(type, "I16") ||
is_literal(type, "I32") ||
is_literal(type, "I64") ||
is_literal(type, "I128") ||
is_literal(type, "U8") ||
is_literal(type, "U16") ||
is_literal(type, "U32") ||
is_literal(type, "U64") ||
is_literal(type, "U128") ||
is_literal(type, "F32") ||
is_literal(type, "F64");
}
static int match_in_dir(const char* d, const char* p, int flags,
int (*errfunc)(const char* path, int err), match** tail) {
DIR* dir;
struct dirent de_buf, *de;
char pat[strlen(p) + 1];
char* p2;
size_t l = strlen(d);
int literal;
int fnm_flags = ((flags & GLOB_NOESCAPE) ? FNM_NOESCAPE : 0)
| ((!(flags & GLOB_PERIOD)) ? FNM_PERIOD : 0);
int error;
if ((p2 = strchr(p, '/'))) {
strcpy(pat, p);
pat[p2 - p] = 0;
for (; *p2 == '/'; p2++)
;
p = pat;
}
literal = is_literal(p, !(flags & GLOB_NOESCAPE));
if (*d == '/' && !*(d + 1))
l = 0;
/* rely on opendir failing for nondirectory objects */
dir = opendir(*d ? d : ".");
error = errno;
if (!dir) {
/* this is not an error -- we let opendir call stat for us */
if (error == ENOTDIR)
return 0;
if (error == EACCES && !*p) {
struct stat st;
if (!stat(d, &st) && S_ISDIR(st.st_mode)) {
if (append(tail, d, l, l))
return GLOB_NOSPACE;
return 0;
}
}
if (errfunc(d, error) || (flags & GLOB_ERR))
return GLOB_ABORTED;
return 0;
}
if (!*p) {
error = append(tail, d, l, l) ? GLOB_NOSPACE : 0;
closedir(dir);
return error;
}
while (!(error = readdir_r(dir, &de_buf, &de)) && de) {
char namebuf[l + de->d_reclen + 2], *name = namebuf;
if (!literal && fnmatch(p, de->d_name, fnm_flags))
continue;
if (literal && strcmp(p, de->d_name))
continue;
if (p2 && de->d_type
&& !S_ISDIR(de->d_type<<12) && !S_ISLNK(de->d_type<<12))
continue;
if (*d) {
memcpy(name, d, l);
name[l] = '/';
strcpy(name + l + 1, de->d_name);
} else {
name = de->d_name;
}
if (p2) {
if ((error = match_in_dir(name, p2, flags, errfunc, tail))) {
closedir(dir);
return error;
}
} else {
int mark = 0;
if (flags & GLOB_MARK) {
if (de->d_type && !S_ISLNK(de->d_type<<12))
mark = S_ISDIR(de->d_type<<12);
else {
struct stat st;
stat(name, &st);
mark = S_ISDIR(st.st_mode);
}
}
if (append(tail, name, l + de->d_reclen + 1, mark)) {
closedir(dir);
return GLOB_NOSPACE;
}
}
}
closedir(dir);
if (error && (errfunc(d, error) || (flags & GLOB_ERR)))
return GLOB_ABORTED;
return 0;
}
bool is_float(ast_t* type)
{
return is_literal(type, "F32") ||
is_literal(type, "F64");
}
/* TODO: Should be up-streamed to musl */
int __glob_pattern_p(const char *pattern, int quote)
{
return !is_literal(pattern, !quote);
}
bool is_bool(ast_t* type)
{
return is_literal(type, "Bool");
}
bool is_env(ast_t* type)
{
return is_literal(type, "Env");
}
bool is_none(ast_t* type)
{
return is_literal(type, "None");
}
bool is_pointer(ast_t* type)
{
return is_literal(type, "Pointer");
}
bool expr_nominal(pass_opt_t* opt, ast_t** astp)
{
// Resolve type aliases and typeparam references.
if(!names_nominal(opt, *astp, astp, true))
return false;
ast_t* ast = *astp;
switch(ast_id(ast))
{
case TK_TYPEPARAMREF:
return flatten_typeparamref(opt, ast) == AST_OK;
case TK_NOMINAL:
break;
default:
return true;
}
// If still nominal, check constraints.
ast_t* def = (ast_t*)ast_data(ast);
// Special case: don't check the constraint of a Pointer or an Array. These
// builtin types have no contraint on their type parameter, and it is safe
// to bind a struct as a type argument (which is not safe on any user defined
// type, as that type might then be used for pattern matching).
if(is_pointer(ast) || is_literal(ast, "Array"))
return true;
ast_t* typeparams = ast_childidx(def, 1);
ast_t* typeargs = ast_childidx(ast, 2);
if(!reify_defaults(typeparams, typeargs, true, opt))
return false;
if(is_maybe(ast))
{
// MaybePointer[A] must be bound to a struct.
assert(ast_childcount(typeargs) == 1);
ast_t* typeparam = ast_child(typeparams);
ast_t* typearg = ast_child(typeargs);
bool ok = false;
switch(ast_id(typearg))
{
case TK_NOMINAL:
{
ast_t* def = (ast_t*)ast_data(typearg);
ok = ast_id(def) == TK_STRUCT;
break;
}
case TK_TYPEPARAMREF:
{
ast_t* def = (ast_t*)ast_data(typearg);
ok = def == typeparam;
break;
}
default: {}
}
if(!ok)
{
ast_error(opt->check.errors, ast,
"%s is not allowed: "
"the type argument to MaybePointer must be a struct",
ast_print_type(ast));
return false;
}
return true;
}
return check_constraints(typeargs, typeparams, typeargs, true, opt);
}
