Browse Source

Sol Part 26: Yo Dawg, I Herd U Liek Languages...

master
Graham Northup 7 years ago
parent
commit
5aaa5396e8
  1. 12
      ast.h
  2. 222
      astprint.c
  3. 1
      build.sh
  4. 214
      builtins.c
  5. 42
      gc.c
  6. 10
      interp.sol
  7. 71
      lex.yy.c
  8. 472
      monty.sol
  9. 62
      object.c
  10. 34
      parser.output
  11. 1709
      parser.tab.c
  12. 162
      parser.tab.h
  13. 18
      parser.y
  14. 36
      runtime.c
  15. 54
      sol.h
  16. 4
      solrun.c
  17. 33
      state.c
  18. 15
      test.sol
  19. 10
      test_monty.sol

12
ast.h

@ -5,6 +5,11 @@
#include <stdio.h>
typedef struct {
size_t line;
size_t col;
} loc_t;
struct tag_expr_node;
typedef struct tag_expr_node expr_node;
@ -96,6 +101,7 @@ typedef struct {
typedef enum {EX_LIT, EX_LISTGEN, EX_MAPGEN, EX_BINOP, EX_UNOP, EX_INDEX, EX_SETINDEX, EX_ASSIGN, EX_REF, EX_CALL, EX_FUNCDECL} expr_t;
typedef struct tag_expr_node {
expr_t type;
loc_t loc;
union {
lit_node *lit;
listgen_node *listgen;
@ -140,6 +146,7 @@ typedef struct tag_stmtlist_node {
typedef enum {ST_EXPR, ST_IFELSE, ST_LOOP, ST_ITER, ST_LIST, ST_RET, ST_CONT, ST_BREAK} stmt_t;
typedef struct tag_stmt_node {
stmt_t type;
loc_t loc;
union {
expr_node *expr;
ifelse_node *ifelse;
@ -155,6 +162,7 @@ typedef struct tag_stmt_node {
#define AS(arg, tp) ((tp *) (arg))
#define NEW_ST() malloc(sizeof(stmt_node))
#define NEW_EX() malloc(sizeof(expr_node))
#define SET_LOC(node, l) do { (node)->loc.line = (l).first_line; (node)->loc.col = (l).first_column; } while(0)
#define NEW(arg) malloc(sizeof(arg))
#define MAKE_REF_BINOP(nd, tp, name, val) nd = NEW_EX(); \
nd->type = EX_BINOP; \
@ -191,8 +199,8 @@ void sol_compile_free(stmt_node *);
void st_free(stmt_node *);
void ex_free(expr_node *);
void st_print(stmt_node *);
void ex_print(expr_node *);
void st_print(sol_state_t *, stmt_node *);
void ex_print(sol_state_t *, expr_node *);
void ob_print(sol_object_t *);
sol_object_t *sol_eval(sol_state_t *, expr_node *);

222
astprint.c

@ -4,310 +4,310 @@
#include <stdarg.h>
#include <stdio.h>
void prlev(int lev, const char *fmt, ...) {
void prlev(sol_state_t *state, int lev, const char *fmt, ...) {
va_list vl;
int i;
for(i = 0; i < lev; i++) { putchar('|'); putchar(' '); }
for(i = 0; i < lev; i++) { sol_putchar(state, '|'); sol_putchar(state, ' '); }
va_start(vl, fmt);
vprintf(fmt, vl);
sol_vprintf(state, fmt, vl);
va_end(vl);
putchar('\n');
sol_putchar(state, '\n');
}
void prex(expr_node *, int);
void prex( sol_state_t *, expr_node *, int);
void prst(stmt_node *node, int lev) {
void prst(sol_state_t *state, stmt_node *node, int lev) {
if(!node) {
prlev(lev, "<NULL>");
prlev(state, lev, "<NULL>");
return;
}
switch(node->type) {
case ST_EXPR:
prlev(lev, "Stmt<Expr>:");
prex(node->expr, lev+1);
prlev(state, lev, "Stmt<Expr>:");
prex(state, node->expr, lev+1);
break;
case ST_IFELSE:
prlev(lev, "Stmt<IfElse>:");
prlev(state, lev, "Stmt<IfElse>:");
lev++;
prlev(lev, "Cond:");
prex(node->ifelse->cond, lev+1);
prlev(lev, "IfTrue:");
prst(node->ifelse->iftrue, lev+1);
prlev(lev, "IfFalse:");
prst(node->ifelse->iffalse, lev+1);
prlev(state, lev, "Cond:");
prex(state, node->ifelse->cond, lev+1);
prlev(state, lev, "IfTrue:");
prst(state, node->ifelse->iftrue, lev+1);
prlev(state, lev, "IfFalse:");
prst(state, node->ifelse->iffalse, lev+1);
break;
case ST_LOOP:
prlev(lev, "Stmt<Loop>:");
prlev(state, lev, "Stmt<Loop>:");
lev++;
prlev(lev, "Cond:");
prex(node->loop->cond, lev+1);
prlev(lev, "Loop:");
prst(node->loop->loop, lev+1);
prlev(state, lev, "Cond:");
prex(state, node->loop->cond, lev+1);
prlev(state, lev, "Loop:");
prst(state, node->loop->loop, lev+1);
break;
case ST_ITER:
prlev(lev, "Stmt<Iter>:");
prlev(state, lev, "Stmt<Iter>:");
lev++;
prlev(lev, "Var: %s", node->iter->var);
prlev(lev, "Iter:");
prex(node->iter->iter, lev+1);
prlev(lev, "Loop:");
prst(node->iter->loop, lev+1);
prlev(state, lev, "Var: %s", node->iter->var);
prlev(state, lev, "Iter:");
prex(state, node->iter->iter, lev+1);
prlev(state, lev, "Loop:");
prst(state, node->iter->loop, lev+1);
break;
case ST_LIST:
prlev(lev, "Stmt<List>:");
prlev(state, lev, "Stmt<List>:");
stmtlist_node *cur = node->stmtlist;
while(cur && cur->stmt) {
prst(cur->stmt, lev+1);
prst(state, cur->stmt, lev+1);
cur = cur->next;
}
break;
case ST_RET:
prlev(lev, "Stmt<Ret>:");
prex(node->ret->ret, lev+1);
prlev(state, lev, "Stmt<Ret>:");
prex(state, node->ret->ret, lev+1);
break;
case ST_CONT:
prlev(lev, "Stmt<Continue>");
prlev(state, lev, "Stmt<Continue>");
break;
case ST_BREAK:
prlev(lev, "Stmt<Break>");
prlev(state, lev, "Stmt<Break>");
break;
}
}
void prex(expr_node *node, int lev) {
void prex(sol_state_t *state, expr_node *node, int lev) {
assoclist_node *cura;
exprlist_node *cure;
identlist_node *curi;
if(!node) {
prlev(lev, "<NULL>");
prlev(state, lev, "<NULL>");
return;
}
switch(node->type) {
case EX_LIT:
prlev(lev, "Literal:");
prlev(state, lev, "Literal:");
lev++;
switch(node->lit->type) {
case LIT_INT:
prlev(lev, "Int: %ld", node->lit->ival);
prlev(state, lev, "Int: %ld", node->lit->ival);
break;
case LIT_FLOAT:
prlev(lev, "Float: %f", node->lit->fval);
prlev(state, lev, "Float: %f", node->lit->fval);
break;
case LIT_STRING:
prlev(lev, "String: %s", node->lit->str);
prlev(state, lev, "String: %s", node->lit->str);
break;
case LIT_NONE:
prlev(lev, "None");
prlev(state, lev, "None");
break;
}
break;
case EX_LISTGEN:
prlev(lev, "ListGen:");
prlev(state, lev, "ListGen:");
cure = node->listgen->list;
while(cure && cure->expr) {
prex(cure->expr, lev+1);
prex(state, cure->expr, lev+1);
cure = cure->next;
}
break;
case EX_MAPGEN:
prlev(lev, "MapGen:");
prlev(state, lev, "MapGen:");
lev++;
cura = node->mapgen->map;
while(cura && cura->item) {
prlev(lev, "<Key>:");
prex(cura->item->key, lev+1);
prlev(lev, "<Value>:");
prex(cura->item->value, lev+1);
prlev(state, lev, "<Key>:");
prex(state, cura->item->key, lev+1);
prlev(state, lev, "<Value>:");
prex(state, cura->item->value, lev+1);
cura = cura->next;
}
break;
case EX_BINOP:
prlev(lev, "BinOp:");
prlev(state, lev, "BinOp:");
lev++;
switch(node->binop->type) {
case OP_ADD:
prlev(lev, "Op: +");
prlev(state, lev, "Op: +");
break;
case OP_SUB:
prlev(lev, "Op: -");
prlev(state, lev, "Op: -");
break;
case OP_MUL:
prlev(lev, "Op: *");
prlev(state, lev, "Op: *");
break;
case OP_DIV:
prlev(lev, "Op: /");
prlev(state, lev, "Op: /");
break;
case OP_MOD:
prlev(lev, "Op: %");
prlev(state, lev, "Op: %");
break;
case OP_POW:
prlev(lev, "Op: **");
prlev(state, lev, "Op: **");
break;
case OP_BAND:
prlev(lev, "Op: &");
prlev(state, lev, "Op: &");
break;
case OP_BOR:
prlev(lev, "Op: |");
prlev(state, lev, "Op: |");
break;
case OP_BXOR:
prlev(lev, "Op: ^");
prlev(state, lev, "Op: ^");
break;
case OP_LAND:
prlev(lev, "Op: &&");
prlev(state, lev, "Op: &&");
break;
case OP_LOR:
prlev(lev, "Op: ||");
prlev(state, lev, "Op: ||");
break;
case OP_EQUAL:
prlev(lev, "Op: ==");
prlev(state, lev, "Op: ==");
break;
case OP_LESS:
prlev(lev, "Op: <");
prlev(state, lev, "Op: <");
break;
case OP_GREATER:
prlev(lev, "Op: >");
prlev(state, lev, "Op: >");
break;
case OP_LESSEQ:
prlev(lev, "Op: <=");
prlev(state, lev, "Op: <=");
break;
case OP_GREATEREQ:
prlev(lev, "Op: >=");
prlev(state, lev, "Op: >=");
break;
case OP_LSHIFT:
prlev(lev, "Op: <<");
prlev(state, lev, "Op: <<");
break;
case OP_RSHIFT:
prlev(lev, "Op: >>");
prlev(state, lev, "Op: >>");
break;
}
prlev(lev, "Left:");
prex(node->binop->left, lev+1);
prlev(lev, "Right:");
prex(node->binop->right, lev+1);
prlev(state, lev, "Left:");
prex(state, node->binop->left, lev+1);
prlev(state, lev, "Right:");
prex(state, node->binop->right, lev+1);
break;
case EX_UNOP:
prlev(lev, "UnOp:");
prlev(state, lev, "UnOp:");
lev++;
switch(node->unop->type) {
case OP_NEG:
prlev(lev, "Op: -");
prlev(state, lev, "Op: -");
break;
case OP_BNOT:
prlev(lev, "Op: ~");
prlev(state, lev, "Op: ~");
break;
case OP_LNOT:
prlev(lev, "Op: !");
prlev(state, lev, "Op: !");
break;
case OP_LEN:
prlev(lev, "Op: #");
prlev(state, lev, "Op: #");
break;
}
prlev(lev, "Expr:");
prex(node->unop->expr, lev+1);
prlev(state, lev, "Expr:");
prex(state, node->unop->expr, lev+1);
break;
case EX_INDEX:
prlev(lev, "Index:");
prlev(state, lev, "Index:");
lev++;
prlev(lev, "Expr:");
prex(node->index->expr, lev+1);
prlev(lev, "Index:");
prex(node->index->index, lev+1);
prlev(state, lev, "Expr:");
prex(state, node->index->expr, lev+1);
prlev(state, lev, "Index:");
prex(state, node->index->index, lev+1);
break;
case EX_SETINDEX:
prlev(lev, "SetIndex:");
prlev(state, lev, "SetIndex:");
lev++;
prlev(lev, "Expr:");
prex(node->setindex->expr, lev+1);
prlev(lev, "Index:");
prex(node->setindex->index, lev+1);
prlev(lev, "Value:");
prex(node->setindex->value, lev+1);
prlev(state, lev, "Expr:");
prex(state, node->setindex->expr, lev+1);
prlev(state, lev, "Index:");
prex(state, node->setindex->index, lev+1);
prlev(state, lev, "Value:");
prex(state, node->setindex->value, lev+1);
break;
case EX_ASSIGN:
prlev(lev, "Assign:");
prlev(state, lev, "Assign:");
lev++;
prlev(lev, "Ident: %s", node->assign->ident);
prlev(lev, "Value:");
prex(node->assign->value, lev+1);
prlev(state, lev, "Ident: %s", node->assign->ident);
prlev(state, lev, "Value:");
prex(state, node->assign->value, lev+1);
break;
case EX_REF:
prlev(lev, "Ref: %s", node->ref->ident);
prlev(state, lev, "Ref: %s", node->ref->ident);
break;
case EX_CALL:
prlev(lev, "Call:");
prlev(state, lev, "Call:");
lev++;
prlev(lev, "Expr:");
prex(node->call->expr, lev+1);
prlev(lev, "Args:");
prlev(state, lev, "Expr:");
prex(state, node->call->expr, lev+1);
prlev(state, lev, "Args:");
cure = node->call->args;
while(cure && cure->expr) {
prex(cure->expr, lev+1);
prex(state, cure->expr, lev+1);
cure = cure->next;
}
break;
case EX_FUNCDECL:
prlev(lev, "FuncDecl:");
prlev(state, lev, "FuncDecl:");
lev++;
prlev(lev, "Name: %s", node->funcdecl->name);
prlev(lev, "Args:");
prlev(state, lev, "Name: %s", node->funcdecl->name);
prlev(state, lev, "Args:");
curi = node->funcdecl->args;
while(curi && curi->ident) {
prlev(lev+1, curi->ident);
prlev(state, lev+1, curi->ident);
curi = curi->next;
}
prlev(lev, "Body:");
prst(node->funcdecl->body, lev+1);
prlev(state, lev, "Body:");
prst(state, node->funcdecl->body, lev+1);
break;
}
}
void st_print(stmt_node *stmt) {
prst(stmt, 0);
void st_print(sol_state_t *state, stmt_node *stmt) {
prst(state, stmt, 0);
}
void ex_print(expr_node *expr) {
prex(expr, 0);
void ex_print(sol_state_t *state, expr_node *expr) {
prex(state, expr, 0);
}
/*int main(int argc, char **argv) {
@ -318,11 +318,11 @@ void ex_print(expr_node *expr) {
if(yyparse(&program)) {
printf("Syntax error (somewhere)\n");
printf("Partial tree:\n");
prst(program, 0);
prst(state, program, 0);
return 1;
}
prst(program, 0);
prst(state, program, 0);
return 0;
}*/

1
build.sh

@ -6,6 +6,7 @@ gcc -c -g lex.yy.c
gcc -c -g parser.tab.c
gcc -c -g astprint.c
gcc -c -g runtime.c
gcc -c -g gc.c
gcc -c -g object.c
gcc -c -g state.c
gcc -c -g builtins.c

214
builtins.c

@ -95,6 +95,7 @@ sol_object_t *sol_f_try(sol_state_t *state, sol_object_t *args) {
sol_obj_free(err);
sol_list_insert(state, ls, 0, zero);
sol_obj_free(zero);
sol_list_insert(state, ls, 2, state->traceback);
return ls;
}
sol_list_insert(state, ls, 0, res);
@ -207,11 +208,11 @@ void ob_print(sol_object_t *obj) {
break;
case SOL_STMT:
st_print(obj->node);
st_print(NULL, obj->node); //TODO: FIXME
break;
case SOL_EXPR:
ex_print(obj->node);
ex_print(NULL, obj->node); //TODO: FIXME
break;
case SOL_BUFFER:
@ -235,14 +236,17 @@ void ob_print(sol_object_t *obj) {
sol_object_t *sol_f_prepr(sol_state_t *state, sol_object_t *args) {
int i, sz = sol_list_len(state, args);
sol_object_t *obj;
sol_object_t *obj, *str;
seen = dsl_seq_new_array(NULL, NULL);
for(i=0; i<sz; i++) {
obj = sol_list_get_index(state, args, i);
ob_print(obj);
printf(" ");
str = sol_cast_repr(state, obj);
sol_printf(state, "%s", str->str);
sol_printf(state, " ");
sol_obj_free(obj);
sol_obj_free(str);
}
sol_printf(state, "\n");
printf("\n");
dsl_free_seq(seen);
seen = NULL;
@ -375,6 +379,39 @@ sol_object_t *sol_f_parse(sol_state_t *state, sol_object_t *args) {
return sol_new_stmtnode(state, program);
}
sol_object_t *sol_f_ord(sol_state_t *state, sol_object_t *args) {
sol_object_t *arg = sol_list_get_index(state, args, 0), *str = sol_cast_string(state, arg);
sol_object_t *idx = sol_new_int(state, 0), *arg2, *iarg, *res;
size_t len = strlen(str->str);
sol_obj_free(arg);
if(sol_list_len(state, args)>1) {
arg2 = sol_list_get_index(state, args, 1);
iarg = sol_cast_int(state, arg2);
sol_obj_free(arg2);
idx->ival = iarg->ival;
sol_obj_free(iarg);
}
if(idx->ival < 0 || idx->ival >= len) {
sol_obj_free(str);
sol_obj_free(idx);
return sol_set_error_string(state, "Compute ord of out-of-bounds index");
}
res = sol_new_int(state, str->str[idx->ival]);
sol_obj_free(str);
sol_obj_free(idx);
return res;
}
sol_object_t *sol_f_chr(sol_state_t *state, sol_object_t *args) {
sol_object_t *arg = sol_list_get_index(state, args, 0), *iarg = sol_cast_int(state, arg);
char cbuf[2]={iarg->ival, 0};
sol_object_t *res = sol_new_string(state, cbuf);
sol_obj_free(arg);
sol_obj_free(iarg);
return res;
}
sol_object_t *sol_f_debug_getref(sol_state_t *state, sol_object_t *args) {
sol_object_t *obj = sol_list_get_index(state, args, 0);
sol_object_t *res = sol_new_int(state, obj->refcnt - 2); // NB: We grabbed a reference, and there's one in the arglist, so account for them.
@ -477,6 +514,17 @@ sol_object_t *sol_f_iter_map(sol_state_t *state, sol_object_t *args) {
return res;
}
sol_object_t *sol_f_ast_print(sol_state_t *state, sol_object_t *args) {
sol_object_t *obj = sol_list_get_index(state, args, 0);
if(sol_is_aststmt(obj)) {
st_print(state, obj->node);
} else {
ex_print(state, obj->node);
}
sol_obj_free(obj);
return sol_incref(state->None);
}
sol_object_t *sol_f_singlet_tostring(sol_state_t *state, sol_object_t *args) {
sol_object_t *obj = sol_list_get_index(state, args, 0), *res = sol_new_string(state, obj->str);
sol_obj_free(obj);
@ -845,6 +893,16 @@ sol_object_t *sol_f_str_split(sol_state_t *state, sol_object_t *args) {
return res;
}
sol_object_t *sol_f_str_find(sol_state_t *state, sol_object_t *args) {
sol_object_t *str = sol_list_get_index(state, args, 0), *substr = sol_list_get_index(state, args, 1), *ssubstr = sol_cast_string(state, substr);
char *ptr = strstr(str->str, ssubstr->str);
sol_object_t *res = sol_new_int(state, ptr?ptr-str->str:-1);
sol_obj_free(str);
sol_obj_free(substr);
sol_obj_free(ssubstr);
return res;
}
sol_object_t *sol_f_list_add(sol_state_t *state, sol_object_t *args) {
sol_object_t *a = sol_list_get_index(state, args, 0), *b = sol_list_get_index(state, args, 1), *ls;
if(!sol_is_list(b)) {
@ -1039,22 +1097,25 @@ sol_object_t *sol_f_map_index(sol_state_t *state, sol_object_t *args) {
sol_object_t *map = sol_list_get_index(state, args, 0), *b = sol_list_get_index(state, args, 1);
sol_object_t *indexf = sol_map_get_name(state, map, "__index");
sol_object_t *res = NULL, *newls;
if(!sol_is_none(state, indexf)) {
if(indexf->ops->call && (sol_is_func(indexf) || sol_is_cfunc(indexf)) && indexf->ops->call != sol_f_not_impl) {
newls = sol_new_list(state);
sol_list_insert(state, newls, 0, indexf);
sol_list_append(state, newls, args);
res = indexf->ops->call(state, newls);
sol_obj_free(newls);
} else if(indexf->ops->index && indexf->ops->index != sol_f_not_impl) {
newls = sol_new_list(state);
sol_list_insert(state, newls, 0, indexf);
sol_list_insert(state, newls, 1, b);
res = indexf->ops->index(state, newls);
sol_obj_free(newls);
res = sol_map_get(state, map, b);
if(sol_is_none(state, res)) {
if(!sol_is_none(state, indexf)) {
sol_obj_free(res);
if(indexf->ops->call && (sol_is_func(indexf) || sol_is_cfunc(indexf)) && indexf->ops->call != sol_f_not_impl) {
newls = sol_new_list(state);
sol_list_insert(state, newls, 0, indexf);
sol_list_append(state, newls, args);
res = indexf->ops->call(state, newls);
sol_obj_free(newls);
} else if(indexf->ops->index && indexf->ops->index != sol_f_not_impl) {
newls = sol_new_list(state);
sol_list_insert(state, newls, 0, indexf);
sol_list_insert(state, newls, 1, b);
res = indexf->ops->index(state, newls);
sol_obj_free(newls);
}
}
}
if(!res) res = sol_map_get(state, map, b);
sol_obj_free(indexf);
sol_obj_free(map);
sol_obj_free(b);
@ -1120,9 +1181,38 @@ sol_object_t *sol_f_map_iter(sol_state_t *state, sol_object_t *args) {
}
sol_object_t *sol_f_map_tostring(sol_state_t *state, sol_object_t *args) {
sol_object_t *cur = sol_new_string(state, "{"), *next, *str, *obj = sol_list_get_index(state, args, 0), *item;
dsl_seq_iter *iter = dsl_new_seq_iter(obj->seq);
sol_object_t *map = sol_list_get_index(state, args, 0), *res;
sol_object_t *tostrf = sol_map_get_name(state, map, "__tostring"), *fargs;
if(!sol_is_none(state, tostrf) && tostrf->ops->call) {
fargs = sol_new_list(state);
sol_list_insert(state, fargs, 0, tostrf);
sol_list_insert(state, fargs, 1, map);
res = tostrf->ops->call(state, fargs);
sol_obj_free(fargs);
} else {
res = sol_cast_repr(state, map);
}
sol_obj_free(tostrf);
sol_obj_free(map);
return res;
}
sol_object_t *sol_f_map_repr(sol_state_t *state, sol_object_t *args) {
sol_object_t *cur = sol_new_string(state, "{"), *next, *str, *obj = sol_list_get_index(state, args, 0), *item, *reprf = sol_map_get_name(state, obj, "__repr"), *fargs;
dsl_seq_iter *iter;
char s[64];
if(!sol_is_none(state, reprf) && reprf->ops->call) {
sol_obj_free(cur);
fargs = sol_new_list(state);
sol_list_insert(state, fargs, 0, reprf);
sol_list_insert(state, fargs, 1, obj);
cur = reprf->ops->call(state, fargs);
sol_obj_free(fargs);
sol_obj_free(obj);
sol_obj_free(reprf);
return cur;
}
iter = dsl_new_seq_iter(obj->seq);
while(!dsl_seq_iter_is_invalid(iter)) {
item = AS_OBJ(dsl_seq_iter_at(iter));
if(test_seen(item)) {
@ -1293,6 +1383,10 @@ sol_object_t *sol_f_astnode_index(sol_state_t *state, sol_object_t *args) {
if(sol_is_aststmt(obj)) {
if(sol_string_eq(state, str, "type")) {
res = sol_new_int(state, stmt->type);
} else if(sol_string_eq(state, str, "loc")) {
res = sol_new_map(state);
sol_map_set_name(state, res, "line", sol_new_int(state, stmt->loc.line));
sol_map_set_name(state, res, "col", sol_new_int(state, stmt->loc.col));
} else {
switch(stmt->type) {
case ST_EXPR:
@ -1350,6 +1444,10 @@ sol_object_t *sol_f_astnode_index(sol_state_t *state, sol_object_t *args) {
} else {
if(sol_string_eq(state, str, "type")) {
res = sol_new_int(state, expr->type);
} else if(sol_string_eq(state, str, "loc")) {
res = sol_new_map(state);
sol_map_set_name(state, res, "line", sol_new_int(state, expr->loc.line));
sol_map_set_name(state, res, "col", sol_new_int(state, expr->loc.col));
} else {
switch(expr->type) {
case EX_LIT:
@ -1482,15 +1580,26 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
stmt_node *stmt = (stmt_node *) obj->node;
stmtlist_node *curs, *prevs;
expr_node *expr = (expr_node *) obj->node;
exprlist_node *cure, *preve;
assoclist_node *cura, *preva;
identlist_node *curi, *previ;
exprlist_node *cure, *preve = NULL;
assoclist_node *cura, *preva = NULL;
identlist_node *curi, *previ = NULL;
int i=0, len;
if(sol_is_aststmt(obj)) {
if(sol_string_eq(state, str, "type")) {
ival = sol_cast_int(state, val);
stmt->type = ival->ival;
sol_obj_free(ival);
} else if(sol_string_eq(state, str, "loc") && sol_is_map(val)) {
pair = sol_map_get_name(state, val, "line");
ival = sol_cast_int(state, pair);
stmt->loc.line = ival->ival;
sol_obj_free(ival);
sol_obj_free(pair);
pair = sol_map_get_name(state, val, "col");
ival = sol_cast_int(state, pair);
stmt->loc.col = ival->ival;
sol_obj_free(ival);
sol_obj_free(pair);
} else {
switch(stmt->type) {
case ST_EXPR:
@ -1543,8 +1652,9 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
prevs->next = curs;
}
}
if(stmt->stmtlist == curs) stmt->stmtlist = NULL;
free(curs);
prevs->next = NULL;
if(prevs) prevs->next = NULL;
} else {
stmt->stmtlist = NULL;
}
@ -1563,6 +1673,17 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
ival = sol_cast_int(state, val);
expr->type = ival->ival;
sol_obj_free(ival);
} else if(sol_string_eq(state, str, "loc") && sol_is_map(val)) {
pair = sol_map_get_name(state, val, "line");
ival = sol_cast_int(state, pair);
expr->loc.line = ival->ival;
sol_obj_free(ival);
sol_obj_free(pair);
pair = sol_map_get_name(state, val, "col");
ival = sol_cast_int(state, pair);
expr->loc.col = ival->ival;
sol_obj_free(ival);
sol_obj_free(pair);
} else {
switch(expr->type) {
case EX_LIT:
@ -1592,15 +1713,16 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
cure = malloc(sizeof(exprlist_node));
expr->listgen->list = cure;
for(i=0; i<len; i++) {
if(sol_is_aststmt(sol_list_get_index(state, val, i))) {
if(sol_is_astexpr(sol_list_get_index(state, val, i))) {
cure->expr = sol_list_get_index(state, val, i)->node;
preve = cure;
cure = malloc(sizeof(exprlist_node));
preve->next = cure;
}
}
if(expr->listgen->list == cure) expr->listgen->list = NULL;
free(cure);
preve->next = NULL;
if(preve) preve->next = NULL;
} else {
expr->listgen->list = NULL;
}
@ -1626,8 +1748,9 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
}
}
}
if(expr->mapgen->map == cura) expr->mapgen->map = NULL;
free(cura);
preva->next = NULL;
if(preva) preva->next = NULL;
} else {
expr->mapgen->map = NULL;
}
@ -1701,15 +1824,16 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
cure = malloc(sizeof(exprlist_node));
expr->call->args= cure;
for(i=0; i<len; i++) {
if(sol_is_aststmt(sol_list_get_index(state, val, i))) {
if(sol_is_astexpr(sol_list_get_index(state, val, i))) {
cure->expr = sol_list_get_index(state, val, i)->node;
preve = cure;
cure = malloc(sizeof(exprlist_node));
preve->next = cure;
}
}
if(expr->call->args == cure) expr->call->args = NULL;
free(cure);
preve->next = NULL;
if(preve) preve->next = NULL;
} else {
expr->call->args = NULL;
}
@ -1727,17 +1851,16 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
curi = malloc(sizeof(identlist_node));
expr->funcdecl->args= curi;
for(i=0; i<len; i++) {
if(sol_is_aststmt(sol_list_get_index(state, val, i))) {
sval = sol_cast_string(state, sol_list_get_index(state, val, i));
curi->ident = strdup(sval->str);
sol_obj_free(sval);
previ = curi;
curi = malloc(sizeof(identlist_node));
previ->next = curi;
}
sval = sol_cast_string(state, sol_list_get_index(state, val, i));
curi->ident = strdup(sval->str);
sol_obj_free(sval);
previ = curi;
curi = malloc(sizeof(identlist_node));
previ->next = curi;
}
if(expr->funcdecl->args == curi) expr->funcdecl->args = NULL;
free(curi);
previ->next = NULL;
if(previ) previ->next = NULL;
} else {
expr->funcdecl->args = NULL;
}
@ -1751,11 +1874,10 @@ sol_object_t *sol_f_astnode_setindex(sol_state_t *state, sol_object_t *args) {
sol_obj_free(obj);
sol_obj_free(key);
sol_obj_free(str);
sol_obj_free(val);
return sol_incref(state->None);
return val;
}
static char *sol_StmtNames[]={"EXPR", "IFSELSE", "LOOP", "ITER", "RET", "CONT", "BREAK"};
static char *sol_StmtNames[]={"EXPR", "IFSELSE", "LOOP", "ITER", "LIST", "RET", "CONT", "BREAK"};
static char *sol_ExprNames[]={"LIT", "LISTGEN", "MAPGEN", "BINOP", "UNOP", "INDEX", "SETINDEX", "ASSIGN", "REF", "CALL", "FUNCDECL"};
sol_object_t *sol_f_astnode_tostring(sol_state_t *state, sol_object_t *args) {
@ -2161,7 +2283,7 @@ sol_object_t *sol_f_stream_read(sol_state_t *state, sol_object_t *args) {
iamt = sol_cast_int(state, amt);
s = malloc((iamt->ival + 1)*sizeof(char));
count = sol_stream_fread(state, stream, s, sizeof(char), iamt->ival);
s[iamt->ival]='\0';
s[count]='\0';
sol_obj_free(iamt);
}
if(s) {
@ -2201,6 +2323,12 @@ sol_object_t *sol_f_stream_flush(sol_state_t *state, sol_object_t *args) {
return res;
}
sol_object_t *sol_f_stream_eof(sol_state_t *state, sol_object_t *args) {
sol_object_t *stream = sol_list_get_index(state, args, 0), *res = sol_new_int(state, sol_stream_feof(state, stream));
sol_obj_free(stream);
return res;
}
static char *sol_FileModes[]={
NULL,
"r",

42
gc.c

@ -0,0 +1,42 @@
#include <stdlib.h>
#include "sol.h"
#ifdef DEBUG_GC
#else
sol_object_t *sol_alloc_object(sol_state_t *state) {
sol_object_t *res = malloc(sizeof(sol_object_t));
if(!res) {
sol_set_error(state, state->OutOfMemory);
return sol_incref(state->None);
}
res->refcnt = 0;
res->ops = &(state->NullOps);
return sol_incref(res);
}
sol_object_t *sol_obj_acquire(sol_object_t *obj) {
return sol_incref(obj);
}
void sol_obj_free(sol_object_t *obj) {
if(!obj) {
printf("WARNING: Attempt to free NULL\n");
return;
}
if(sol_decref(obj) <= 0) {
if(obj->refcnt < 0) {
printf("WARNING: Encountered refcnt < 0!\nObject %p type %d ref %d\n", obj, obj->type, obj->refcnt);
} else {
sol_obj_release(obj);
}
}
}
void sol_obj_release(sol_object_t *obj) {
if(obj->ops->free) obj->ops->free(NULL, obj);
free(obj);
}
#endif

10
interp.sol

@ -56,6 +56,16 @@ while __interp.running do
__interp.result = try(__interp.program[1])
if !__interp.result[0] then
print(__interp.result[1])
print(__interp.result[2])
for ent in __interp.result[2] do
st = ent[0]
scope = ent[1]
if st.type == ast.ST_LIST then continue end
print('In', st, 'at', st.loc.line, ',', st.loc.col, ':')
ast.print(st)
print(scope)
print('---')
end
else
if __interp.isexpr then
prepr(__interp.result[1])

71
lex.yy.c

@ -8,7 +8,7 @@
#define FLEX_SCANNER
#define YY_FLEX_MAJOR_VERSION 2
#define YY_FLEX_MINOR_VERSION 5
#define YY_FLEX_SUBMINOR_VERSION 39
#define YY_FLEX_SUBMINOR_VERSION 35
#if YY_FLEX_SUBMINOR_VERSION > 0
#define FLEX_BETA
#endif
@ -161,12 +161,7 @@ typedef unsigned int flex_uint32_t;
typedef struct yy_buffer_state *YY_BUFFER_STATE;
#endif
#ifndef YY_TYPEDEF_YY_SIZE_T
#define YY_TYPEDEF_YY_SIZE_T
typedef size_t yy_size_t;
#endif
extern yy_size_t yyleng;
extern int yyleng;
extern FILE *yyin, *yyout;
@ -175,7 +170,6 @@ extern FILE *yyin, *yyout;
#define EOB_ACT_LAST_MATCH 2
#define YY_LESS_LINENO(n)
#define YY_LINENO_REWIND_TO(ptr)
/* Return all but the first "n" matched characters back to the input stream. */
#define yyless(n) \
@ -193,6 +187,11 @@ extern FILE *yyin, *yyout;
#define unput(c) yyunput( c, (yytext_ptr) )
#ifndef YY_TYPEDEF_YY_SIZE_T
#define YY_TYPEDEF_YY_SIZE_T
typedef size_t yy_size_t;
#endif
#ifndef YY_STRUCT_YY_BUFFER_STATE
#define YY_STRUCT_YY_BUFFER_STATE
struct yy_buffer_state
@ -210,7 +209,7 @@ struct yy_buffer_state
/* Number of characters read into yy_ch_buf, not including EOB
* characters.
*/
yy_size_t yy_n_chars;
int yy_n_chars;
/* Whether we "own" the buffer - i.e., we know we created it,
* and can realloc() it to grow it, and should free() it to
@ -280,8 +279,8 @@ static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
/* yy_hold_char holds the character lost when yytext is formed. */
static char yy_hold_char;
static yy_size_t yy_n_chars; /* number of characters read into yy_ch_buf */
yy_size_t yyleng;
static int yy_n_chars; /* number of characters read into yy_ch_buf */
int yyleng;
/* Points to current character in buffer. */
static char *yy_c_buf_p = (char *) 0;
@ -309,7 +308,7 @@ static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len );
YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len );
void *yyalloc (yy_size_t );
void *yyrealloc (void *,yy_size_t );
@ -605,7 +604,7 @@ static void update_loc(YYLTYPE *yylloc, char *yytext){
<STRING>. { str_putc(*yytext); }
*/
#line 609 "lex.yy.c"
#line 608 "lex.yy.c"
#define INITIAL 0
@ -644,7 +643,7 @@ FILE *yyget_out (void );
void yyset_out (FILE * out_str );
yy_size_t yyget_leng (void );
int yyget_leng (void );
char *yyget_text (void );
@ -806,6 +805,11 @@ YY_DECL
YYLTYPE * yylloc;
#line 85 "tokenizer.lex"
#line 812 "lex.yy.c"
yylval = yylval_param;
yylloc = yylloc_param;
@ -836,12 +840,6 @@ YY_DECL
yy_load_buffer_state( );
}
{
#line 85 "tokenizer.lex"
#line 844 "lex.yy.c"
while ( 1 ) /* loops until end-of-file is reached */
{
yy_cp = (yy_c_buf_p);
@ -858,7 +856,7 @@ YY_DECL
yy_match:
do
{
register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ;
register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
if ( yy_accept[yy_current_state] )
{
(yy_last_accepting_state) = yy_current_state;
@ -1206,7 +1204,7 @@ YY_RULE_SETUP
#line 207 "tokenizer.lex"
ECHO;
YY_BREAK
#line 1210 "lex.yy.c"
#line 1208 "lex.yy.c"
case YY_STATE_EOF(INITIAL):
yyterminate();
@ -1337,7 +1335,6 @@ case YY_STATE_EOF(INITIAL):
"fatal flex scanner internal error--no action found" );
} /* end of action switch */
} /* end of scanning one token */
} /* end of user's declarations */
} /* end of yylex */
/* yy_get_next_buffer - try to read in a new buffer
@ -1393,21 +1390,21 @@ static int yy_get_next_buffer (void)
else
{
yy_size_t num_to_read =
int num_to_read =
YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
while ( num_to_read <= 0 )
{ /* Not enough room in the buffer - grow it. */
/* just a shorter name for the current buffer */
YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
int yy_c_buf_p_offset =
(int) ((yy_c_buf_p) - b->yy_ch_buf);
if ( b->yy_is_our_buffer )
{
yy_size_t new_size = b->yy_buf_size * 2;
int new_size = b->yy_buf_size * 2;
if ( new_size <= 0 )
b->yy_buf_size += b->yy_buf_size / 8;
@ -1438,7 +1435,7 @@ static int yy_get_next_buffer (void)
/* Read in more data. */
YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
(yy_n_chars), num_to_read );
(yy_n_chars), (size_t) num_to_read );
YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
}
@ -1533,7 +1530,7 @@ static int yy_get_next_buffer (void)
yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
yy_is_jam = (yy_current_state == 111);
return yy_is_jam ? 0 : yy_current_state;
return yy_is_jam ? 0 : yy_current_state;
}
static void yyunput (int c, register char * yy_bp )
@ -1548,7 +1545,7 @@ static int yy_get_next_buffer (void)
if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
{ /* need to shift things up to make room */
/* +2 for EOB chars. */
register yy_size_t number_to_move = (yy_n_chars) + 2;
register int number_to_move = (yy_n_chars) + 2;
register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
register char *source =
@ -1597,7 +1594,7 @@ static int yy_get_next_buffer (void)
else
{ /* need more input */
yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
int offset = (yy_c_buf_p) - (yytext_ptr);
++(yy_c_buf_p);
switch ( yy_get_next_buffer( ) )
@ -1757,6 +1754,10 @@ static void yy_load_buffer_state (void)
yyfree((void *) b );
}
#ifndef __cplusplus
extern int isatty (int );
#endif /* __cplusplus */
/* Initializes or reinitializes a buffer.
* This function is sometimes called more than once on the same buffer,
* such as during a yyrestart() or at EOF.
@ -1869,7 +1870,7 @@ void yypop_buffer_state (void)
*/
static void yyensure_buffer_stack (void)
{
yy_size_t num_to_alloc;
int num_to_alloc;
if (!(yy_buffer_stack)) {
@ -1966,12 +1967,12 @@ YY_BUFFER_STATE yy_scan_string (yyconst char * yystr )
*
* @return the newly allocated buffer state object.
*/
YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len )
YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, int _yybytes_len )
{
YY_BUFFER_STATE b;
char *buf;
yy_size_t n;
yy_size_t i;
int i;
/* Get memory for full buffer, including space for trailing EOB's. */
n = _yybytes_len + 2;
@ -2053,7 +2054,7 @@ FILE *yyget_out (void)
/** Get the length of the current token.
*
*/
yy_size_t yyget_leng (void)
int yyget_leng (void)
{
return yyleng;
}
@ -2201,7 +2202,7 @@ void yyfree (void * ptr )
#define YYTABLES_NAME "yytables"
#line 206 "tokenizer.lex"
#line 207 "tokenizer.lex"

472
monty.sol

@ -0,0 +1,472 @@
TOK = {LPAREN = 1, RPAREN = 2, INT = 3, BOOL = 4, NAME = 5, QUOTE = 6, EOF = 7}
keys = []
for k in TOK do keys:insert(#keys, k) end
for k in keys do TOK[TOK[k]]=k end
token = {
new = func (type, value)
return {type = type, value = value, __index = token}
end,
pretty = func(self)
tname = TOK[self.type]
tval = tostring(self.value)
return '{'+tname+':'+tval+'}'
end
}
tokenizer = {
WS = " "+chr(8)+chr(9)+chr(10),
NAMESET = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ=+-*/.<>?!@$%^~",
DIGITS = "0123456789",
EOF = {},
new = func (str)
res = {str = str, pushed = None, __index = tokenizer}
res:init()
return res
end,
init = func(self)
--print('In init, self is', self)
res.cur = res:token()
res.next = res:token()
end,
next_char = func(self)
if self.pushed == None then
--print('In next_char, self is', self)
--print('In next_char, self.str is', self.str)
if self.str:eof() then return self.EOF end
res = self.str:read(1)
else
--print('Retrieving from pushback', self.pushed)
res = self.pushed[0]
self.pushed = self.pushed:sub(1)
if self.pushed == "" then self.pushed = None end
end
--print(res)
return res
end,
push_back = func(self, s)
--print('Pushing back', s)
if s == self.EOF then print('WARNING: Attempted to push_back EOF'); return end
if self.pushed == None then
self.pushed = s
else
self.pushed = s + self.pushed
end
--print('self.pushed:', self.pushed)
end,
token = func (self)
--print('In token, self is', self)
--print('In token, self.str is', self.str)
c = self:next_char()
while !(c == self.EOF) do
if c == "" then return token.new(TOK.EOF, None) end
if c == "(" then return token.new(TOK.LPAREN, c) end
if c == ")" then return token.new(TOK.RPAREN, c) end
if self.NAMESET:find(c) >= 0 then
--print('{NAME}')
name = c
c = self:next_char()
while 1 do
found = 0
if self.NAMESET:find(c) >= 0 then found = 1 end
if self.DIGITS:find(c) >= 0 then found = 1 end
if !found then break end
name += c
c = self:next_char()
if c == self.EOF then continue end
end
self:push_back(c)
return token.new(TOK.NAME, name)
end
if self.DIGITS:find(c) >= 0 then
val = c
c = self:next_char()
while self.DIGITS:find(c) >= 0 do
val += c
c = self:next_char()
if c == self.EOF then continue end
end
self:push_back(c)
return token.new(TOK.INT, toint(val))
end
if c == "#" then
c = self:next_char()
if c == "t" then return token.new(TOK.BOOL, 1) end
if c == "f" then return token.new(TOK.BOOL, 0) end
error("Invalid value for bool literal: "+c)
end
if c == "'" then return token.new(TOK.QUOTE, c) end
if self.WS:find(c) >= 0 then
c = self:next_char()
continue
end
if c == ";" then
c = self:next_char()
while 1 do
if c == chr(10) then break end
c = self:next_char()
end
c = self:next_char()
continue
end
error("Invalid character in token stream: "+c)
end
return token.new(TOK.EOF, None)
end,
advance = func(self)
self.cur = self.next
self.next = self:token()
end
}
ttreegen = {
new = func(tok)
return {tok = tok, __index = ttreegen}
end,
generate = func(self, consume)
res = self.TT_DISPATCH[self.tok.cur.type](self, self.tok.cur)
if None == consume then self.tok:advance() end
return res