bool file_getLine_delim(FILE *file, string_t *str, char delim)
{
string_clear(str);
bool v = file_readLine_delim(file, str, delim);
string_cstr(str);
return v;
}
bool file_getLine(FILE *file, string_t *str)
{
string_clear(str);
bool v = file_readLine(file, str);
string_cstr(str);
return v;
}
/**
Initialize the runtime
*/
void init_runtime()
{
// Parse the global unit
ast_fun_t* unit_fun = parse_check_error(parse_file("global.zeta"));
// Get the list of expressions in the function body
assert (get_shape(unit_fun->body_expr) == SHAPE_AST_SEQ);
array_t* exprs = ((ast_seq_t*)unit_fun->body_expr)->expr_list;
// Initialize the host function wrappers
array_t* host_fns = init_api_core();
// Prepend wrapper function definitions to the unit
for (size_t i = 0; i < host_fns->len; ++i)
{
hostfn_t* fn = array_get(host_fns, i).word.hostfn;
value_t fn_val;
fn_val.word.hostfn = fn;
fn_val.tag = TAG_HOSTFN;
// Prepend a $ character to the function name
char name[64];
sprintf(name, "$%s", string_cstr(fn->name));
heapptr_t decl = ast_decl_alloc((heapptr_t)vm_get_cstr(name), true);
heapptr_t cst = ast_const_alloc(fn_val);
heapptr_t assg = ast_binop_alloc(&OP_ASSIGN, decl, cst);
array_prepend_obj(exprs, assg);
}
// Resolve all variables in the global unit
var_res_pass(unit_fun, NULL);
// Initialize the global unit
// This returns a closure which captures all global variables
value_t global_clos = eval_unit(unit_fun);
assert (global_clos.tag == TAG_CLOS);
// Store a pointer to the global unit closure in the VM object
vm.global_clos = global_clos.word.clos;
}
/**
Evaluate a property read
*/
value_t eval_get_prop(
value_t base,
value_t prop_name
)
{
if (prop_name.tag != TAG_STRING)
{
printf("non-string property name in property read\n");
exit(-1);
}
string_t* name_str = prop_name.word.string;
if (base.tag == TAG_OBJECT)
{
return object_get_prop(base.word.object, name_str);
}
if (base.tag == TAG_STRING)
{
if (name_str == vm_get_cstr("length"))
return value_from_int64(base.word.string->len);
assert (false);
}
if (base.tag == TAG_ARRAY)
{
if (name_str == vm_get_cstr("length"))
return value_from_int64(base.word.array->len);
assert (false);
}
printf(
"invalid base in property read with key \"%s\"\n",
string_cstr(name_str)
);
exit(-1);
}
/**
Evaluate an expression in a given frame
*/
value_t eval_expr(
heapptr_t expr,
clos_t* clos,
value_t* locals
)
{
//printf("eval_expr\n");
// Get the shape of the AST node
// Note: AST nodes must match the shapes defined in init_parser,
// otherwise this interpreter can't handle it
shapeidx_t shape = get_shape(expr);
// Variable or constant declaration (let/var)
if (shape == SHAPE_AST_DECL)
{
ast_decl_t* decl = (ast_decl_t*)expr;
// Let declarations should be initialized
assert (decl->cst == false);
return VAL_FALSE;
}
// Variable reference (read)
if (shape == SHAPE_AST_REF)
{
ast_ref_t* ref = (ast_ref_t*)expr;
assert (ref->decl != NULL);
//printf("evaluating ref to %s\n", string_cstr(ref->name));
// If this is a variable from an outer function
if (ref->decl->fun != clos->fun)
{
//printf("ref from outer fun\n");
assert (ref->idx < clos->fun->free_vars->len);
cell_t* cell = clos->cells[ref->idx];
assert (cell != NULL);
value_t value;
value.word = cell->word;
value.tag = cell->tag;
return value;
}
// Check that the ref index is valid
if (ref->idx > clos->fun->local_decls->len)
{
printf("invalid variable reference\n");
printf("ref->name=%s\n", string_cstr(ref->name));
printf("ref->idx=%d\n", ref->idx);
printf("local_decls->len=%d\n", clos->fun->local_decls->len);
exit(-1);
}
// If this an escaping variable (captured by a closure)
if (ref->decl->esc)
{
// Free variables are stored in mutable cells
// Pointers to the cells are found on the closure object
cell_t* cell = locals[ref->idx].word.cell;
value_t value;
value.word = cell->word;
value.tag = cell->tag;
//printf("read value from cell\n");
return value;
}
/*
printf("reading normal local\n");
string_print(ref->name);
printf("\n");
*/
// Read directly from the stack frame
return locals[ref->idx];
}
if (shape == SHAPE_AST_CONST)
{
//printf("constant\n");
ast_const_t* cst = (ast_const_t*)expr;
return cst->val;
}
if (shape == SHAPE_STRING)
{
return value_from_heapptr(expr, TAG_STRING);
}
// Array literal expression
if (shape == SHAPE_ARRAY)
{
array_t* array_expr = (array_t*)expr;
// Array of values to be produced
array_t* val_array = array_alloc(array_expr->len);
for (size_t i = 0; i < array_expr->len; ++i)
{
heapptr_t expr = array_get(array_expr, i).word.heapptr;
value_t value = eval_expr(expr, clos, locals);
array_set(val_array, i, value);
}
return value_from_heapptr((heapptr_t)val_array, TAG_ARRAY);
}
// Object literal expression
if (shape == SHAPE_AST_OBJ)
{
//printf("obj literal expr\n");
ast_obj_t* obj_expr = (ast_obj_t*)expr;
object_t* obj = object_alloc(OBJ_MIN_CAP);
// TODO: set prototype
// Do this in object_alloc?
for (size_t i = 0; i < obj_expr->name_strs->len; ++i)
{
string_t* prop_name = array_get(obj_expr->name_strs, i).word.string;
heapptr_t val_expr = array_get(obj_expr->val_exprs, i).word.heapptr;
value_t value = eval_expr(val_expr, clos, locals);
object_set_prop(
obj,
prop_name,
value,
ATTR_DEFAULT
);
}
return value_from_obj((heapptr_t)obj);
}
// Binary operator (e.g. a + b)
if (shape == SHAPE_AST_BINOP)
{
//printf("binop\n");
ast_binop_t* binop = (ast_binop_t*)expr;
// Assignment
if (binop->op == &OP_ASSIGN)
{
value_t val = eval_expr(binop->right_expr, clos, locals);
return eval_assign(
binop->left_expr,
val,
clos,
locals
);
}
value_t v0 = eval_expr(binop->left_expr, clos, locals);
value_t v1 = eval_expr(binop->right_expr, clos, locals);
int64_t i0 = v0.word.int64;
int64_t i1 = v1.word.int64;
string_t* s0 = v0.word.string;
string_t* s1 = v1.word.string;
if (binop->op == &OP_MEMBER)
return eval_get_prop(v0, v1);
if (binop->op == &OP_INDEX)
return eval_get_index(v0, v1);
if (binop->op == &OP_ADD)
return value_from_int64(i0 + i1);
if (binop->op == &OP_SUB)
return value_from_int64(i0 - i1);
if (binop->op == &OP_MUL)
return value_from_int64(i0 * i1);
if (binop->op == &OP_DIV)
return value_from_int64(i0 / i1);
if (binop->op == &OP_MOD)
return value_from_int64(i0 % i1);
if (binop->op == &OP_LT)
return (i0 < i1)? VAL_TRUE:VAL_FALSE;
if (binop->op == &OP_LE)
{
if (v0.tag == TAG_STRING && v1.tag == TAG_STRING)
return (strcmp(string_cstr(s0), string_cstr(s1)) <= 0)? VAL_TRUE:VAL_FALSE;
if (v0.tag == TAG_INT64 && v1.tag == TAG_INT64)
return (i0 <= i1)? VAL_TRUE:VAL_FALSE;
assert (false);
}
if (binop->op == &OP_GT)
return (i0 > i1)? VAL_TRUE:VAL_FALSE;
if (binop->op == &OP_GE)
{
if (v0.tag == TAG_STRING && v1.tag == TAG_STRING)
return (strcmp(string_cstr(s0), string_cstr(s1)) >= 0)? VAL_TRUE:VAL_FALSE;
if (v0.tag == TAG_INT64 && v1.tag == TAG_INT64)
return (i0 >= i1)? VAL_TRUE:VAL_FALSE;
assert (false);
}
if (binop->op == &OP_EQ)
return value_equals(v0, v1)? VAL_TRUE:VAL_FALSE;
if (binop->op == &OP_NE)
return value_equals(v0, v1)? VAL_FALSE:VAL_TRUE;
printf("unimplemented binary operator: %s\n", binop->op->str);
return VAL_FALSE;
}
// Unary operator (e.g.: -x, not a)
if (shape == SHAPE_AST_UNOP)
{
ast_unop_t* unop = (ast_unop_t*)expr;
value_t v0 = eval_expr(unop->expr, clos, locals);
if (unop->op == &OP_NEG)
return value_from_int64(-v0.word.int64);
if (unop->op == &OP_NOT)
return eval_truth(v0)? VAL_FALSE:VAL_TRUE;
printf("unimplemented unary operator: %s\n", unop->op->str);
return VAL_FALSE;
}
// Sequence/block expression
if (shape == SHAPE_AST_SEQ)
{
ast_seq_t* seqexpr = (ast_seq_t*)expr;
array_t* expr_list = seqexpr->expr_list;
value_t value = VAL_TRUE;
for (size_t i = 0; i < expr_list->len; ++i)
{
heapptr_t expr = array_get(expr_list, i).word.heapptr;
value = eval_expr(expr, clos, locals);
}
// Return the value of the last expression
return value;
}
// If expression
if (shape == SHAPE_AST_IF)
{
ast_if_t* ifexpr = (ast_if_t*)expr;
value_t t = eval_expr(ifexpr->test_expr, clos, locals);
if (eval_truth(t))
return eval_expr(ifexpr->then_expr, clos, locals);
else
return eval_expr(ifexpr->else_expr, clos, locals);
}
// Function/closure expression
if (shape == SHAPE_AST_FUN)
{
//printf("creating closure\n");
ast_fun_t* nested = (ast_fun_t*)expr;
// Allocate a closure of the nested function
clos_t* new_clos = clos_alloc(nested);
// For each free (closure) variable of the nested function
for (size_t i = 0; i < nested->free_vars->len; ++i)
{
ast_decl_t* decl = array_get(nested->free_vars, i).word.decl;
// If the variable is from this function
if (decl->fun == clos->fun)
{
new_clos->cells[i] = locals[decl->idx].word.cell;
}
else
{
uint32_t free_idx = array_indexof_ptr(clos->fun->free_vars, (heapptr_t)decl);
assert (free_idx < clos->fun->free_vars->len);
new_clos->cells[i] = clos->cells[free_idx];
}
}
assert (new_clos->fun == nested);
return value_from_heapptr((heapptr_t)new_clos, TAG_CLOS);
}
// Call expression
if (shape == SHAPE_AST_CALL)
{
//printf("evaluating call\n");
ast_call_t* callexpr = (ast_call_t*)expr;
// Evaluate the closure expression
value_t callee_clos = eval_expr(callexpr->fun_expr, clos, locals);
if (callee_clos.tag == TAG_CLOS)
{
return eval_call(
callee_clos.word.clos,
callexpr->arg_exprs,
clos,
locals
);
}
if (callee_clos.tag == TAG_HOSTFN)
{
return eval_host_call(
callee_clos.word.hostfn,
callexpr->arg_exprs,
clos,
locals
);
}
printf("invalid callee in function call\n");
exit(-1);
}
printf("eval error, unknown expression type, shapeidx=%d\n", get_shape(expr));
exit(-1);
}
/**
Evaluate a host function call
*/
value_t eval_host_call(
hostfn_t* callee,
array_t* arg_exprs,
clos_t* caller,
value_t* caller_locals
)
{
value_t* arg_vals = alloca(sizeof(value_t) * arg_exprs->len);
if (arg_exprs->len != callee->num_params)
{
printf(
"argument count mismatch in call to %s, got %d, expected %d\n",
string_cstr(callee->name),
arg_exprs->len,
callee->num_params
);
exit(-1);
}
// Evaluate the argument values
for (size_t i = 0; i < arg_exprs->len; ++i)
{
//printf("evaluating arg %ld\n", i);
// Evaluate the parameter value
arg_vals[i] = eval_expr(
array_get_ptr(arg_exprs, i),
caller,
caller_locals
);
}
// Type test signature
if (callee->sig_str == vm_get_cstr("bool(tag)"))
{
bool (*fptr)(tag_t) = callee->fptr;
return fptr(arg_vals[0].tag)? VAL_TRUE:VAL_FALSE;
}
if (callee->sig_str == vm_get_cstr("void(int)"))
{
void (*fptr)(int) = callee->fptr;
fptr(arg_vals[0].word.int32);
return VAL_TRUE;
}
if (callee->sig_str == vm_get_cstr("void(int64)"))
{
void (*fptr)(int64_t) = callee->fptr;
fptr(arg_vals[0].word.int64);
return VAL_TRUE;
}
if (callee->sig_str == vm_get_cstr("void(string)"))
{
void (*fptr)(string_t*) = callee->fptr;
fptr(arg_vals[0].word.string);
return VAL_TRUE;
}
if (callee->sig_str == vm_get_cstr("string()"))
{
string_t* (*fptr)() = callee->fptr;
string_t* str = fptr();
return value_from_heapptr((heapptr_t)str, TAG_STRING);
}
if (callee->sig_str == vm_get_cstr("string(string)"))
{
string_t* (*fptr)(string_t*) = callee->fptr;
string_t* str = fptr(arg_vals[0].word.string);
return value_from_heapptr((heapptr_t)str, TAG_STRING);
}
printf("unsupported host function signature\n");
exit(-1);
}
void var_res(heapptr_t expr, ast_fun_t* fun)
{
// Get the shape of the AST node
shapeidx_t shape = get_shape(expr);
// Constants and strings, do nothing
if (shape == SHAPE_AST_CONST ||
shape == SHAPE_STRING)
{
return;
}
// Array literal expression
if (shape == SHAPE_ARRAY)
{
array_t* array_expr = (array_t*)expr;
for (size_t i = 0; i < array_expr->len; ++i)
var_res(array_get(array_expr, i).word.heapptr, fun);
return;
}
// Object literal expression
if (shape == SHAPE_AST_OBJ)
{
ast_obj_t* obj_expr = (ast_obj_t*)expr;
if (obj_expr->proto_expr)
var_res(obj_expr->proto_expr, fun);
for (size_t i = 0; i < obj_expr->val_exprs->len; ++i)
var_res(array_get(obj_expr->val_exprs, i).word.heapptr, fun);
return;
}
// Variable declaration, do nothing
if (shape == SHAPE_AST_DECL)
{
return;
}
// Variable reference
if (shape == SHAPE_AST_REF)
{
ast_ref_t* ref = (ast_ref_t*)expr;
// Find the declaration for this reference
ast_decl_t* decl = find_decl(ref, fun);
if (decl == NULL)
{
printf("unresolved reference to \"%s\"\n", string_cstr(ref->name));
exit(-1);
}
// Store the declaration on the reference
assert (decl->fun != NULL);
ref->decl = decl;
// If the variable is from this scope
if (decl->fun == fun)
{
// Store the index of this local
assert (decl->idx < fun->local_decls->len);
ref->idx = decl->idx;
}
else
{
// Mark the variable as escaping
decl->esc = true;
// Thread the escaping variable through nested functions
thread_esc_var(ref, fun, fun);
// Find the mutable cell index for the variable
ref->idx = array_indexof_ptr(fun->free_vars, (heapptr_t)ref->decl);
assert (ref->idx < fun->free_vars->len);
}
return;
}
// Sequence/block expression
if (shape == SHAPE_AST_SEQ)
{
ast_seq_t* seqexpr = (ast_seq_t*)expr;
array_t* expr_list = seqexpr->expr_list;
for (size_t i = 0; i < expr_list->len; ++i)
var_res(array_get_ptr(expr_list, i), fun);
return;
}
// Binary operator (e.g. a + b)
if (shape == SHAPE_AST_BINOP)
{
ast_binop_t* binop = (ast_binop_t*)expr;
var_res(binop->left_expr, fun);
var_res(binop->right_expr, fun);
return;
}
// Unary operator (e.g. -a)
if (shape == SHAPE_AST_UNOP)
{
ast_unop_t* unop = (ast_unop_t*)expr;
var_res(unop->expr, fun);
return;
}
// If expression
if (shape == SHAPE_AST_IF)
{
ast_if_t* ifexpr = (ast_if_t*)expr;
var_res(ifexpr->test_expr, fun);
var_res(ifexpr->then_expr, fun);
var_res(ifexpr->else_expr, fun);
return;
}
// Function/closure expression
if (shape == SHAPE_AST_FUN)
{
ast_fun_t* child_fun = (ast_fun_t*)expr;
// Resolve variable references in the nested child function
var_res_pass(child_fun, fun);
return;
}
// Function call
if (shape == SHAPE_AST_CALL)
{
ast_call_t* callexpr = (ast_call_t*)expr;
array_t* arg_exprs = callexpr->arg_exprs;
var_res(callexpr->fun_expr, fun);
for (size_t i = 0; i < arg_exprs->len; ++i)
var_res(array_get_ptr(arg_exprs, i), fun);
return;
}
// Unsupported AST node type
assert (false);
}
void color_print_package (void * p, printpkgfn f)
{
string_t *cstr;
static int number=0;
const char *info, *lver;
char *ver=NULL;
int aur=(f == aur_get_str);
int grp=(f == alpm_grp_get_str);
cstr=string_new ();
/* Numbering list */
if (config.numbering)
cstr = string_fcat (cstr, "%s%d%s ",
color (C_NB), ++number, color (C_NO));
/* repo/name */
if (config.aur_foreign)
info = f(p, 'r');
else
info = f(p, 's');
if (info)
{
if (config.get_res) dprintf (FD_RES, "%s/", info);
cstr = string_fcat (cstr, "%s%s/%s",
color_repo (info), info, color(C_NO));
}
info=f(p, 'n');
if (config.get_res) dprintf (FD_RES, "%s\n", info);
cstr = string_fcat (cstr, "%s%s%s ", color(C_PKG), info, color(C_NO));
if (grp)
{
/* no more output for groups */
fprintf (stdout, "%s\n", string_cstr (cstr));
string_free (cstr);
return;
}
/* Version
* different colors:
* C_ORPHAN if package exists in AUR and is orphaned
* C_OD if package exists and is out of date
* C_VER otherwise
*/
lver = alpm_local_pkg_get_str (info, 'l');
info = f(p, (config.aur_upgrades) ? 'V' : 'v');
ver = STRDUP (info);
info = (aur) ? f(p, 'm') : NULL;
if (config.aur_foreign)
{
/* Compare foreign package with AUR */
if (aur)
{
const char *lver_color = NULL;
if (!info)
lver_color=color(C_ORPHAN);
else
{
info = f(p, 'o');
if (info && info[0]=='1')
lver_color=color(C_OD);
}
cstr = string_fcat (cstr, "%s%s%s",
(lver_color) ? lver_color : color(C_VER),
lver, color (C_NO));
if (alpm_pkg_vercmp (ver, lver)>0)
cstr = string_fcat (cstr, " ( aur: %s )", ver);
fprintf (stdout, "%s\n", string_cstr (cstr));
FREE (ver);
}
else
fprintf (stdout, "%s %s%s%s\n", string_cstr (cstr),
color(C_VER), lver, color(C_NO));
string_free (cstr);
return;
}
if (aur && !info)
cstr = string_fcat (cstr, "%s%s%s", color(C_ORPHAN), ver, color (C_NO));
else
cstr = string_fcat (cstr, "%s%s%s", color(C_VER), ver, color (C_NO));
/* show size */
if (config.show_size)
{
info = f(p, 'r');
if (info)
{
if (strcmp (info, "aur")!=0)
cstr = string_fcat (cstr, " [%.2f M]",
(double) get_size_pkg (p) / (1024.0 * 1024));
}
}
if (config.aur_upgrades)
{
fprintf (stdout, "%s\n", string_cstr (cstr));
string_free (cstr);
FREE (ver);
return;
}
/* show groups */
info = f(p, 'g');
if (info)
{
cstr = string_fcat (cstr, " %s(%s)%s", color(C_GRP), info, color(C_NO));
}
/* show install information */
if (lver)
{
info = f(p, 'r');
if (info && strcmp (info, "local")!=0)
{
cstr = string_fcat (cstr, " %s[%s",
color(C_INSTALLED), _("installed"));
if (strcmp (ver, lver)!=0)
{
cstr = string_fcat (cstr, ": %s%s%s%s",
color(C_LVER), lver, color (C_NO), color(C_INSTALLED));
}
cstr = string_fcat (cstr, "]%s", color(C_NO));
}
}
/* ver no more needed */
FREE (ver);
/* Out of date status & votes */
if (aur)
{
info = f(p, 'o');
if (info && info[0]=='1')
{
cstr = string_fcat (cstr, " %s(%s)%s",
color(C_OD), _("Out of Date"), color(C_NO));
}
info = f(p, 'w');
if (info)
{
cstr = string_fcat (cstr, " %s(%s)%s",
color(C_VOTES), info, color(C_NO));
}
}
/* Display computed string */
fprintf (stdout, "%s\n", string_cstr (cstr));
string_free (cstr);
/* Description
* if -Q or -Sl or -Sg <target>, don't display description
*/
if (config.op != OP_SEARCH && config.op != OP_LIST_REPO_S) return;
fprintf (stdout, "%s", color(C_DSC));
indent (f(p, 'd'));
fprintf (stdout, "%s", color(C_NO));
}
