/*
* CNF transformation one-level down.
*/
static expr_t cnf_expr_nextlevel(expr_t e, context_t context)
{
if (expr_gettype(e) != EXPRTYPE_OP)
return e;
switch (expr_op(e))
{
case EXPROP_NOT:
case EXPROP_OR:
{
expr_t or = expr_bool(false), k, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
k = cnf_arg(k, context);
if (v == expr_bool(true))
k = expr_not(k);
or = expr_or(k, or);
}
return or;
}
default:
e = cnf_arg(e, context);
return e;
}
}
/*
* CNF transformation on a Boolean argument.
*/
static expr_t cnf_arg(expr_t e, context_t context)
{
if (expr_gettype(e) != EXPRTYPE_OP)
return e;
expr_t b = cnf_new_var(context), nb = expr_not(b);
switch (expr_op(e))
{
case EXPROP_NOT:
case EXPROP_AND:
{
expr_t clause = expr_bool(false), k, nk, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
k = cnf_arg(k, context);
nk = expr_not(k);
if (v == expr_bool(true))
{
expr_t tmp = k;
k = nk;
nk = tmp;
}
clause = expr_or(nk, clause);
context_insertclause(context, expr_or(k, nb));
}
clause = expr_or(b, clause);
context_insertclause(context, clause);
return b;
}
case EXPROP_OR:
{
expr_t clause = expr_bool(false), k, nk, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
k = cnf_arg(k, context);
nk = expr_not(k);
if (v == expr_bool(true))
{
expr_t tmp = k;
k = nk;
nk = tmp;
}
clause = expr_or(k, clause);
context_insertclause(context, expr_or(nk, b));
}
clause = expr_or(nb, clause);
context_insertclause(context, clause);
return b;
}
default:
return context_insertiff(context, e, (expr_t)NULL);
}
}
/*
* Eliminate <->s from an expression.
*/
static expr_t iffelim_expr(expr_t e, bool c)
{
if (expr_gettype(e) != EXPRTYPE_OP)
return e;
exprop_t op = expr_op(e);
switch (op)
{
case EXPROP_NOT: case EXPROP_AND: case EXPROP_OR:
{
expr_t acc = (op == EXPROP_OR? expr_bool(false): expr_bool(true));
expr_t k, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
bool d = (op != EXPROP_OR);
d = (v == expr_bool(true)? !d: d);
k = iffelim_expr(k, d);
if (v == expr_bool(true))
k = expr_not(k);
acc = (op == EXPROP_OR? expr_or(acc, k): expr_and(acc, k));
}
return acc;
}
case EXPROP_IFF:
{
expr_t x = iffelim_expr(expr_arg(e, 0), c);
expr_t y = iffelim_expr(expr_arg(e, 1), c);
if (c)
{
expr_t c1 = expr_or(expr_not(x), y);
expr_t c2 = expr_or(x, expr_not(y));
return expr_and(c1, c2);
}
else
{
expr_t c1 = expr_and(x, y);
expr_t c2 = expr_and(expr_not(x), expr_not(y));
return expr_or(c1, c2);
}
}
default:
return e;
}
}
static expr *parse_rhs(expr *lhs, int priority)
{
for(;;){
int this_pri, next_pri;
e_op op;
expr *rhs;
op = tok_cur;
if(!is_op(op))
return lhs; /* eof, rparen and colon covered here */
this_pri = PRECEDENCE(op);
if(this_pri > priority)
return lhs;
/* eat the op */
tok_next();
/* special case for ternary */
if(op == tok_question){
expr *if_t = parse();
if(tok_cur != tok_colon)
CPP_DIE("colon expected for ternary-? operator");
tok_next();
rhs = parse();
lhs = expr_new_top(lhs, if_t, rhs);
}else{
rhs = parse_primary();
/* now on the next op, or eof (in which case, precedence returns -1 */
next_pri = PRECEDENCE(tok_cur);
if(next_pri < this_pri) {
/* next is tighter, give it our rhs as its lhs */
rhs = parse_rhs(rhs, next_pri);
}
lhs = expr_op(op, lhs, rhs);
}
}
}
/*
* CNF transformation. Assumes `e' is in NNF.
*/
extern void pass_cnf_expr(const char *filename, size_t lineno, expr_t e,
expr_t *b, expr_t *d)
{
if (expr_gettype(e) != EXPRTYPE_OP)
{
*b = e;
*d = expr_bool(true);
return;
}
struct context_s context0;
context_t context = &context0;
context->iffinfo = iffinfo_init();
context->clauses = expr_bool(true);
context->varid = 0;
exprop_t op = expr_op(e);
switch (op)
{
case EXPROP_NOT:
case EXPROP_AND:
{
expr_t and = expr_bool(true), k, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
k = cnf_expr_nextlevel(k, context);
if (v == expr_bool(true))
k = expr_not(k);
and = expr_and(k, and);
}
e = and;
break;
}
default:
e = cnf_expr_nextlevel(e, context);
break;
}
*b = expr_and(e, context->clauses);
*d = context_to_iffs(context);
return;
}
/*
* Flattening transformation.
*/
static expr_t flatten(expr_t e, bool toplevel, context_t cxt)
{
if (expr_gettype(e) != EXPRTYPE_OP)
return e;
exprop_t op = expr_op(e);
switch (op)
{
case EXPROP_EQ:
{
expr_t x, y;
if (expr_view_x_eq_func(e, &x, &y))
{
y = flatten(y, false, cxt);
return flatten_eq_to_builtin(exprop_atom_make(ATOM_INT_EQ),
x, y, toplevel, cxt);
}
// Fall-through:
}
case EXPROP_NEQ: case EXPROP_LT: case EXPROP_LEQ: case EXPROP_GT:
case EXPROP_GEQ:
{
// Check if already a flattened comparison:
exprop_t binop, cmp;
expr_t x, y, z;
if (expr_view_x_cmp_y(e, &x, &cmp, &y))
return flatten_x_cmp_y_to_builtin(x, cmp, y, cxt);
if (expr_view_x_cmp_y_op_z(e, &x, &cmp, &y, &binop, &z))
{
y = expr_make(binop, y, z);
return flatten_eq_to_builtin(exprop_atom_make(ATOM_INT_EQ),
x, y, toplevel, cxt);
}
e = expr_arg(e, 1);
if (!expr_view_plus_sign_partition(e, &x, &y))
panic("failed to partition (+) expression");
if (op == EXPROP_EQ)
{
expr_t x0, x1;
if (expr_view_plus_first_partition(x, &x0, &x1))
{
x1 = flatten_to_primitive(x1, cxt);
y = flatten_to_var(y, cxt);
e = expr_make(EXPROP_ADD, x0, x1);
return flatten_eq_to_builtin(exprop_atom_make(ATOM_INT_EQ),
y, e, toplevel, cxt);
}
expr_t y0, y1;
if (expr_view_plus_first_partition(y, &y0, &y1))
{
y1 = flatten_to_primitive(y1, cxt);
x = flatten_to_var(x, cxt);
e = expr_make(EXPROP_ADD, y0, y1);
return flatten_eq_to_builtin(exprop_atom_make(ATOM_INT_EQ),
x, e, toplevel, cxt);
}
x = flatten_to_primitive(x, cxt);
y = flatten_to_primitive(y, cxt);
return flatten_eq_to_builtin(exprop_atom_make(ATOM_INT_EQ),
x, y, toplevel, cxt);
}
else
{
x = flatten_to_primitive(x, cxt);
y = flatten_to_primitive(y, cxt);
if (expr_gettype(y) == EXPRTYPE_NUM)
{
num_t c = expr_getnum(y);
y = expr_num(c - 1);
e = flatten_x_cmp_y_to_builtin(x, cmp, y, cxt);
return expr_not(e);
}
else
return flatten_x_cmp_y_to_builtin(y, cmp, x, cxt);
}
}
case EXPROP_NOT:
{
expr_t arg = expr_arg(e, 0);
arg = flatten(arg, toplevel, cxt);
return expr_not(arg);
}
case EXPROP_IFF:
{
expr_t arg0 = flatten(expr_arg(e, 0), false, cxt);
expr_t arg1 = flatten(expr_arg(e, 1), false, cxt);
return expr_iff(arg0, arg1);
}
case EXPROP_AND:
{
expr_t and = expr_bool(true), k, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
k = flatten(k, toplevel, cxt);
if (v == expr_bool(true))
k = expr_not(k);
and = expr_and(k, and);
}
return and;
}
case EXPROP_OR:
{
expr_t or = expr_bool(false), k, v;
for (expritr_t i = expritr(e); expr_getpair(i, &k, &v);
expr_next(i))
{
k = flatten(k, false, cxt);
if (v == expr_bool(true))
k = expr_not(k);
or = expr_or(k, or);
}
return or;
}
case EXPROP_ADD: case EXPROP_MUL:
{
size_t a = expr_arity(e);
expr_t args[a];
expr_args(e, args);
for (size_t i = 0; i < a; i++)
args[i] = flatten_to_primitive(args[i], cxt);
e = expr(op, args);
return e;
}
case EXPROP_POW:
{
expr_t arg1 = expr_arg(e, 1);
if (expr_gettype(arg1) != EXPRTYPE_NUM)
{
flatten_bad_pow:
error("(%s: %zu) failed to flatten expression `!y%s!d'; "
"exponent must be a positive constant, found `!y%s!d'",
cxt->file, cxt->line, show(expr_term(e)),
show(expr_term(arg1)));
cxt->error = true;
return e;
}
num_t c = expr_getnum(arg1);
if (c <= 1)
goto flatten_bad_pow;
expr_t arg0 = flatten_to_primitive(expr_arg(e, 0), cxt);
expr_t e = expr_pow(arg0, arg1);
return e;
}
default:
{
atom_t atom = expr_sym(e);
if (atom == ATOM_NIL_EQ || atom == ATOM_STR_EQ ||
atom == ATOM_ATOM_EQ || is_eq(atom))
{
expr_t x = expr_arg(e, 0), y = expr_arg(e, 1);
x = flatten(x, false, cxt);
y = flatten(y, false, cxt);
return flatten_eq_to_builtin(expr_op(e), x, y, toplevel, cxt);
}
size_t a = expr_arity(e);
expr_t args[a];
expr_args(e, args);
typesig_t sig = typeinst_get_decl((atom_t)op);
for (size_t i = 0; i < a; i++)
{
typeinst_t t = typeinst_decl_arg(sig, i);
if (t != typeinst_make_ground(t))
args[i] = flatten_to_var(args[i], cxt);
else
{
// Note: type check does not check instances; we check
// here.
if (type(args[i]) == VAR || type(args[i]) == FUNC)
{
error("(%s: %zu) failed to flatten expression "
"`!y%s!d'; cannot flatten %s argument "
"`!y%s!d' to a ground term", cxt->file,
cxt->line, show(expr_term(e)),
(type(args[i]) == VAR? "variable":
"function call"),
show(expr_term(args[i])));
cxt->error = true;
}
}
}
e = expr(op, args);
return e;
}
}
}
/*
* Flatten an equality expression `x = y'. Assumes x and y are already
* flattened.
*/
static expr_t flatten_eq_to_builtin(exprop_t op, expr_t x, expr_t y,
bool toplevel, context_t cxt)
{
if (expr_gettype(x) == EXPRTYPE_VAR && expr_gettype(y) == EXPRTYPE_VAR)
return expr_make(op, x, y);
if (expr_gettype(y) == EXPRTYPE_VAR)
{
expr_t t = x;
x = y;
y = t;
}
if (expr_gettype(x) != EXPRTYPE_VAR)
x = context_update(cxt, x);
if (!toplevel)
y = context_update(cxt, y);
// Special-case handling of constants and variables:
switch (expr_gettype(y))
{
case EXPRTYPE_VAR:
if (expr_compare(x, y) < 0)
return expr_make(op, x, y);
else
return expr_make(op, y, x);
case EXPRTYPE_NUM:
return expr_make(exprop_atom_make(ATOM_INT_EQ_C), x, y);
case EXPRTYPE_NIL:
return expr_make(exprop_atom_make(ATOM_NIL_EQ_C), x, y);
case EXPRTYPE_STR:
return expr_make(exprop_atom_make(ATOM_STR_EQ_C), x, y);
case EXPRTYPE_ATOM:
return expr_make(exprop_atom_make(ATOM_ATOM_EQ_C), x, y);
case EXPRTYPE_OP:
break;
default:
panic("unexpected expr type (%d)", expr_gettype(y));
}
// Special-case handling of add/mul:
exprop_t fop = expr_op(y);
switch (fop)
{
case EXPROP_ADD:
{
expr_t a = expr_arg(y, 0);
expr_t b = expr_arg(y, 1);
if (expr_gettype(a) == EXPRTYPE_NUM)
{
expr_t t = a; a = b; b = t;
}
if (expr_gettype(b) == EXPRTYPE_NUM)
{
num_t c = expr_getnum(b);
if (c < 0)
return expr_make(exprop_atom_make(ATOM_INT_EQ_PLUS_C),
a, x, expr_num(-c));
else
return expr_make(exprop_atom_make(ATOM_INT_EQ_PLUS_C),
x, a, b);
}
else
return expr_make(exprop_atom_make(ATOM_INT_EQ_PLUS), x, a, b);
}
case EXPROP_MUL:
{
expr_t a = expr_arg(y, 0);
expr_t b = expr_arg(y, 1);
if (expr_gettype(a) == EXPRTYPE_NUM)
{
expr_t t = a; a = b; b = t;
}
if (expr_gettype(b) == EXPRTYPE_NUM)
return expr_make(exprop_atom_make(ATOM_INT_EQ_MUL_C), x, a, b);
else
return expr_make(exprop_atom_make(ATOM_INT_EQ_MUL), x, a, b);
}
case EXPROP_POW:
{
expr_t a = expr_arg(y, 0);
expr_t b = expr_arg(y, 1);
return expr_make(exprop_atom_make(ATOM_INT_EQ_POW_C), x, a, b);
}
default:
break;
}
// Generic function calls:
atom_t atom = expr_sym(y);
const char *name = atom_name(atom);
size_t arity = atom_arity(atom);
size_t len = strlen(name);
char buf[len + 32];
typesig_t sig = typeinst_lookup_typesig(atom);
typeinst_t type = (sig == TYPESIG_DEFAULT? TYPEINST_NUM:
typeinst_make_ground(sig->type));
const char *type_name = typeinst_show(type);
int r = snprintf(buf, sizeof(buf)-1, "%s_eq_call_%s", type_name, name);
if (r <= 0 || r >= sizeof(buf)-1)
panic("failed to create function constraint name");
op = exprop_make(buf, arity+1);
expr_t args[arity+1];
expr_args(y, args+1);
args[0] = x;
expr_t e = expr(op, args);
if (sig == TYPESIG_DEFAULT)
return e;
atom = expr_sym(e);
typeinst_t sig_args[arity+1];
memcpy(sig_args+1, sig->args, arity * sizeof(typeinst_t));
sig_args[0] = typeinst_make_var(sig->type);
sig = typeinst_make_typesig(arity+1, TYPEINST_BOOL, sig_args);
if (!typeinst_declare(atom, sig))
{
error("(%s: %zu) failed to declare implied type for %s/%zu",
cxt->file, cxt->line, atom_name(atom), atom_arity(arity));
cxt->error = true;
}
return e;
}
