static int is_simple(EXPRESSION *expr)
{
if (is_atomic(expr))
return 1;
if (is_binary_op(expr))
{
return is_atomic(tree_get_child(expr, 0)) && is_atomic(tree_get_child(expr, 1));
}
if (tree_is_type(expr, EXPR_CALL))
{
return is_atomic(tree_get_child(expr, 1));
}
if (tree_is_type(expr, EXPR_TUPLE))
{
int i;
for (i = 0; i < tree_num_children(expr); i++)
if (!is_simple(tree_get_child(expr, i)))
return 0;
return 1;
}
return 0;
}
p1_expr(expptr expr)
#endif
{
/* An opcode of 0 means a null entry */
if (expr == ENULL) {
p1putdd (P1_EXPR, 0, TYUNKNOWN); /* Should this be TYERROR? */
return;
} /* if (expr == ENULL) */
switch (expr -> tag) {
case TNAME:
p1_name ((Namep) expr);
return;
case TCONST:
p1_const(&expr->constblock);
return;
case TEXPR:
/* Fall through the switch */
break;
case TADDR:
p1_addr (&(expr -> addrblock));
goto freeup;
case TPRIM:
warn ("p1_expr: got TPRIM");
return;
case TLIST:
p1_list (&(expr->listblock));
frchain( &(expr->listblock.listp) );
return;
case TERROR:
return;
default:
erri ("p1_expr: bad tag '%d'", (int) (expr -> tag));
return;
}
/* Now we know that the tag is TEXPR */
if (is_unary_op (expr -> exprblock.opcode))
p1_unary (&(expr -> exprblock));
else if (is_binary_op (expr -> exprblock.opcode))
p1_binary (&(expr -> exprblock));
else
erri ("p1_expr: bad opcode '%d'", (int) expr -> exprblock.opcode);
freeup:
free((char *)expr);
} /* p1_expr */
EXPRESSION *optimise_expression(MODULE *module, FUNCTION *func, EXPRESSION *expr)
{
int i;
for (i = 0; i < tree_num_children(expr); i++)
{
NODE *subexpr = tree_get_child(expr, i);
subexpr = optimise_expression(module, func, subexpr);
tree_get_child(expr, i) = subexpr;
}
if (is_binary_op(expr))
{
expr = optimise_binary_expression(module, func, expr);
}
return expr;
}
static int i386ify_assignment(MODULE *module, FUNCTION *func, NODE *vertex)
{
int changed = 0;
GRAPH *graph = func->graph;
VARIABLE *dest = tree_get_child(vertex, 0);
EXPRESSION *expr = tree_get_child(vertex, 1);
int source_line = CAST_TO_AST(vertex)->source_line;
if (is_unary_op(expr))
changed |= i386ify_unary_operation(module, func, vertex);
if (is_binary_op(expr))
changed |= i386ify_binary_operation(module, func, vertex);
/* Expand tuple assignments. */
if (tree_is_type(dest, EXPR_TUPLE) && tree_num_children(dest) >= 1)
{
int i;
NODE *last = NULL;
if (tree_num_children(dest) != tree_num_children(expr))
error("Source and destinations have different cardinality!");
for (i = 0; i < tree_num_children(dest); i++)
{
VARIABLE *dest2 = tree_get_child(dest, i);
VARIABLE *src2 = tree_get_child(expr, i);
STATEMENT *new_assign = make_assignment(CAST_TO_EXPRESSION(dest2), CAST_TO_EXPRESSION(src2), source_line);
add_vertex(graph, CAST_TO_NODE(new_assign));
if (last)
add_edge(graph, last, CAST_TO_NODE(new_assign), 0);
else
replace_backward(graph, vertex, CAST_TO_NODE(new_assign), 0);
last = CAST_TO_NODE(new_assign);
}
replace_forward(graph, vertex, last, 0);
remove_vertex(graph, vertex);
changed |= 1;
}
return changed;
}
Expression* Parser::parse_expression_impl(const expr_iter& begin, const expr_iter& end)
{
for (auto match: binary_operator_matches) {
size_t level = 0;
for (auto p = end - 1; p != begin - 1; --p) {
if (p->tid == TokenIR::Type::Symbol) {
if (closing_symbols.count(p->token) == 1) {
level++;
} else if (opening_symbols.count(p->token) == 1) {
level--;
} else if (level == 0) {
if (match(p->token)) {
if (unary_operators.count(p->token) == 1) {
if (p == begin) {
return parse_atom_impl(begin, end);
} else if (is_binary_op((p - 1)->token)) {
continue;
} else {
goto else__;
}
} else {
else__:
return make_binary_expr(p->token,
parse_expression_impl(begin, p),
parse_expression_impl(p + 1, end));
}
}
}
}
}
if (level != 0) {
error(begin->line_number, "Unmatched parenthesis.");
}
}
return parse_atom_impl(begin, end);
}
EE* eval_expr(Node* expr)
{
if (is_unary_op(expr))
return ee_new(UNTYPED,
mem_asprintf("%s(%s)",
unary_op_map(expr->type),
eval_Value(node_get_child(expr, 0))));
if (is_binary_op(expr))
return ee_new (UNTYPED,
mem_asprintf("%s(%s, %s)",
binary_op_map(expr->type),
eval_Value(node_get_child(expr, 0)),
eval_Value(node_get_child(expr, 1))));
switch(expr->type){
case K_TRUE:
return ee_new("Bool", "VALUE_TRUE");
case K_FALSE:
return ee_new("Bool", "VALUE_FALSE");
case K_NIL:
return ee_new("Nil", "VALUE_NIL");
case K_EOF:
return ee_new("Eof", "VALUE_EOF");
case ID:
if (context_block != NULL){
// If it's a block param, then OK.
if (var_query_kind(expr->text) == VAR_BLOCK_PARAM)
return ee_new(var_query_type(expr->text), var_query_c_name(expr->text));
else
return ee_new(var_query_type(expr->text),
closure_add(expr->text, var_query_c_name(expr->text)));
} else return ee_new(var_query_type(expr->text), var_query_c_name(expr->text));
case SYMBOL:
return ee_new("Integer", cache_dsym(expr->text + 1));
case INT:
return ee_new("Integer", mem_asprintf("int64_to_val(%s)", expr->text));
case DOUBLE:
return ee_new("Double", mem_asprintf("double_to_val(%s)", expr->text));
case STRING:
{
const char* str = expr->text;
return ee_new("String", mem_asprintf("string_to_val(\"%s\")", str));
}
break;
case CHARACTER:
{
const char* str = expr->text;
return ee_new("Integer", mem_asprintf("int64_to_val(%d)", (int) str[1]));
}
break;
case EXPR_ARRAY:
{
Node* expr_list = node_get_child(expr, 0);
return ee_new("Array", mem_asprintf("array1_to_val2(%u %s)",
expr_list->children.size,
eval_expr_list(expr_list, true)));
}
case EXPR_MAP:
{
Node* m_list = node_get_child(expr, 0);
bool is_map = false, is_set = false;
const char* args = "";
const int num_ms = node_num_children(m_list);
assert(num_ms > 0);
for (int i = 0; i < num_ms; i++){
Node* m = node_get_child(m_list, i);
switch (node_num_children(m)){
case 2:
is_map = true;
args = mem_asprintf("%s, %s, %s", args,
eval_Value(node_get_child(m, 0)),
eval_Value(node_get_child(m, 1)));
break;
case 1:
is_set = true;
args = mem_asprintf("%s, %s", args,
eval_Value(node_get_child(m, 0)));
break;
default:
assert_never();
break;
}
}
if (is_map and is_set){
fatal_node(expr, "invalid curly braces: is this a set or a map?");
}
if (is_map) return ee_new("Map",
mem_asprintf("ht_new_map(%d%s)", num_ms, args));
if (is_set) return ee_new("Set",
mem_asprintf("ht_new_set(%d%s)", num_ms, args));
assert_never();
}
break;
case EXPR_INDEX:
return ee_new(UNTYPED,
eval_index(node_get_child(expr, 0), node_get_child(expr, 1), NULL));
case EXPR_CALL:
{
Node* callee = node_get_node(expr, "callee");
Node* args = node_get_node(expr, "args");
// If callee is a field, then we must check if its a method call.
if (callee->type == EXPR_FIELD){
const char* field_name = node_get_string(callee, "name");
Node* left = node_get_child(callee, 0);
const char* s = eval_expr_as_id(left);
if (s == NULL or var_query(s))
return ee_new(UNTYPED, eval_obj_call(left, field_name, args));
}
const char* s = eval_expr_as_id(callee);
if (s != NULL){
// Could be a tuple constructor.
if (strequal(s, "tuple")){
return ee_new("Tuple", mem_asprintf("tuple_to_val(%u %s)",
node_num_children(args),
eval_expr_list(args, true)));
}
// If all of callee can be evaluated as an id, then it must be a static
// call.
return ee_new(UNTYPED, eval_static_call(s, args));
}
return ee_new(UNTYPED, mem_asprintf("func_call%d(%s %s)",
node_num_children(args),
eval_Value(callee),
eval_expr_list(args, true)));
}
case EXPR_RANGE_BOUNDED:
{
Node* left = node_get_child(expr, 0);
Node* right = node_get_child(expr, 1);
return ee_new("Range",
mem_asprintf("range_to_val(RANGE_BOUNDED, "
"val_to_int64(%s), val_to_int64(%s))",
eval_Value(left),
eval_Value(right)));
}
case EXPR_RANGE_BOUNDED_LEFT:
return ee_new("Range",
mem_asprintf("range_to_val(RANGE_BOUNDED_LEFT, "
"val_to_int64(%s), 0)",
eval_Value(node_get_child(expr, 0))));
case EXPR_RANGE_BOUNDED_RIGHT:
return ee_new("Range",
mem_asprintf("range_to_val(RANGE_BOUNDED_RIGHT, "
"0, val_to_int64(%s))",
eval_Value(node_get_child(expr, 0))));
case EXPR_RANGE_UNBOUNDED:
return ee_new("Range", "range_to_val(RANGE_UNBOUNDED, 0, 0)");
case EXPR_FIELD:
{
// Attempt to evaluate this field as a static symbol.
Node* left = node_get_child(expr, 0);
const char* s = eval_expr_as_id(left);
if (s == NULL or var_query(s)){
// Dynamic field.
const char* field = node_get_string(expr, "name");
return ee_new(UNTYPED,
mem_asprintf("field_get(%s, %s)",
eval_Value(left),
cache_dsym(field)));
} else {
// Could be a global variable.
s = eval_expr_as_id(expr);
if (context_block != NULL){
return ee_new(var_query_type(s), closure_add(s, var_query_c_name(s)));
} else return ee_new(var_query_type(s), var_query_c_name(s));
}
}
break;
case EXPR_AT_VAR:
{
const char* name = node_get_string(expr, "name");
if (context_ci == NULL){
fatal_node(expr, "'@%s' in something that's not a class", name);
}
if (context_ci->type != CLASS_FIELD){
fatal_node(expr, "'@%s' in a class that's not a field class", name);
}
return ee_new(UNTYPED,
mem_asprintf("field_get(__self, %s)", cache_dsym(name)));
}
case C_CODE:
{
const char* str = util_trim_ends(expr->text);
if (strstr(expr->text, "return")){
fatal_warn("careless return in C code may disrupt the stack (use RRETURN)");
}
if (context_fi != NULL){
if (context_fi->type == METHOD
or context_fi->type == CONSTRUCTOR
or context_fi->type == VIRTUAL_GET
or context_fi->type == VIRTUAL_SET){
if (strchr(str, '@') != NULL and context_ci->type != CLASS_CDATA)
fatal_node(expr, "@ in C code in a class that is not cdata");
str = util_replace(str, '@', "_c_data->");
}
}
return ee_new(UNTYPED, str);
}
case EXPR_IS_TYPE:
{
const char* type = eval_type(node_get_child(expr, 1));
if (var_query(type)){
fatal_node(expr, "type '%s' in 'is' expression is a variable", type);
}
return ee_new("Bool",
mem_asprintf("pack_bool(obj_klass(%s) == %s)",
eval_Value(node_get_child(expr, 0)),
cache_type(type)));
}
case EXPR_BLOCK:
{
fatal_push("in anonymous block");
if (context_block != NULL){
fatal_node(expr, "nested blocks are not implemented yet");
}
// Initialize context_block
context_block = mem_new(BlockContext);
sbuf_init(&(context_block->sbuf_code), "");
sarray_init(&(context_block->closure_names));
sarray_init(&(context_block->closure_exprs));
static int counter = 0; counter++;
context_block->func_name = mem_asprintf("ripe_blk%d", counter);
Node* param_list = node_get_node(expr, "param_list");
Node* stmt_list = node_get_node(expr, "stmt_list");
var_push();
// Print out the header of the anonymous function
sbuf_printf(&(context_block->sbuf_code), "static Value %s(Value __block",
context_block->func_name);
for (int i = 0; i < node_num_children(param_list); i++){
Node* param = node_get_child(param_list, i);
const char* name = node_get_string(param, "name");
const char* c_name = util_c_name(name);
if (node_has_string(param, "array"))
fatal_node(expr,
"array parameters for blocks are not implemented yet");
const char* type = "?"; // TODO: Deal with type.
var_add_local2(name, c_name, type, VAR_BLOCK_PARAM);
sbuf_printf(&(context_block->sbuf_code), ", Value %s", c_name);
}
sbuf_printf(&(context_block->sbuf_code), ")\n");
// Generate block code
sbuf_printf(&(context_block->sbuf_code), "{\n");
sbuf_printf(&(context_block->sbuf_code),
" Func* _c_data = obj_c_data(__block);\n");
sbuf_printf(&(context_block->sbuf_code),
" stack_annot_push(\"anonymous function\");\n");
sbuf_printf(&(context_block->sbuf_code), "%s", gen_block(stmt_list));
sbuf_printf(&(context_block->sbuf_code), "}\n");
// Now, print out the block function to WR_HEADER
wr_print(WR_HEADER, "%s", context_block->sbuf_code.str);
const char* result = mem_asprintf("block_to_val(%s, %d, %d",
context_block->func_name,
node_num_children(param_list),
context_block->closure_names.size);
for (uint i = 0; i < context_block->closure_names.size; i++){
const char* evaluated = sarray_get_ptr(&(context_block->closure_exprs),
i);
result = mem_asprintf("%s, %s", result, evaluated);
}
result = mem_asprintf("%s)", result);
// End EXPR_BLOCK
var_pop();
context_block = NULL;
fatal_pop();
return ee_new("Function", result);
}
default:
assert_never();
}
return NULL;
}
void print_expression(EXPRESSION *expr, DAA_SET *set)
{
if (expr == NULL)
{
printf("?null?");
}
else if (tree_is_type(expr, EXPR_VARIABLE))
{
VARIABLE *var = CAST_TO_VARIABLE(expr);
int defined = !set || find_in_hash(set->set, var->name, strlen(var->name));
if (set)
printf("<font color=\"%s\">", get_colour(var->decl->colour));
printf("%s", var->name);
if (set)
printf("</font>");
}
else if (tree_is_type(expr, EXPR_INTEGER))
{
INTEGER *integer = CAST_TO_INTEGER(expr);
printf("%d", integer->value);
}
else if (tree_is_type(expr, EXPR_STRING))
{
STRING *str = CAST_TO_STRING(expr);
printf("\"%s\"", str->value);
}
else if (tree_is_type(expr, EXPR_TUPLE))
{
printf("(");
if (tree_num_children(expr) >= 1)
{
print_expression(tree_get_child(expr, 0), set);
}
int i;
for (i = 1; i < tree_num_children(expr); i++)
{
printf(", ");
print_expression(tree_get_child(expr, i), set);
}
printf(")");
}
else if (is_unary_op(expr))
{
printf("%s", get_escaped_op_symbol(expr));
print_expression(tree_get_child(expr, 0), set);
}
else if (is_binary_op(expr))
{
print_expression(tree_get_child(expr, 0), set);
printf(" %s ", get_escaped_op_symbol(expr));
print_expression(tree_get_child(expr, 1), set);
}
else if (tree_is_type(expr, STMT_ASSIGN))
{
printf("assign ");
print_expression(tree_get_child(expr, 0), set);
printf(" = ");
print_expression(tree_get_child(expr, 1), set);
}
else if (tree_is_type(expr, STMT_TEST))
{
printf("test ");
print_expression(tree_get_child(expr, 0), set);
}
else if (tree_is_type(expr, EXPR_CALL))
{
VARIABLE *var = tree_get_child(expr, 0);
printf("%s(", var->name);
print_expression(tree_get_child(expr, 1), set);
printf(")");
}
else if (tree_is_type(expr, STMT_RETURN))
{
printf("return ");
print_expression(tree_get_child(expr, 0), set);
}
else if (tree_is_type(expr, STMT_ENTER))
{
printf("enter");
}
else if (tree_is_type(expr, STMT_EXIT))
{
printf("exit");
}
else
{
printf("?expr %p %s?", expr, tree_get_name(expr));
}
}
