1 #include "system/stacktrace.h"
8 #include "ebisp/expr.h"
10 #include "system/str.h"
12 struct Expr atom_as_expr(struct Atom *atom)
22 struct Expr cons_as_expr(struct Cons *cons)
32 struct Expr void_expr(void)
41 void print_atom_as_sexpr(FILE *stream, struct Atom *atom)
47 fprintf(stream, "%s", atom->sym);
51 fprintf(stream, "%ld", atom->num);
55 fprintf(stream, "\"%s\"", atom->str);
59 /* TODO(#649): Print LAMBDAs with arglists (and maybe bodies) in print_atom_as_sexpr and atom_as_sexpr */
60 fprintf(stream, "<lambda>");
64 fprintf(stream, "<native>");
69 static void print_atom_as_c(FILE *stream, struct Atom *atom)
76 fprintf(stream, "SYMBOL(gc, \"%s\")", atom->sym);
80 fprintf(stream, "NUMBER(gc, %ld)", atom->num);
84 fprintf(stream, "STRING(gc, \"%s\")", atom->str);
88 fprintf(stream, "CONS(gc, SYMBOL(gc, \"lambda\"), CONS(gc, ");
89 print_expr_as_c(stream, atom->lambda.args_list);
90 fprintf(stream, ", CONS(gc, ");
91 print_expr_as_c(stream, atom->lambda.body);
92 fprintf(stream, ")))");
96 fprintf(stream, "NIL(gc)");
101 void print_cons_as_sexpr(FILE *stream, struct Cons *head)
105 struct Cons *cons = head;
107 fprintf(stream, "(");
108 print_expr_as_sexpr(stream, cons->car);
110 while (cons->cdr.type == EXPR_CONS) {
111 cons = cons->cdr.cons;
112 fprintf(stream, " ");
113 print_expr_as_sexpr(stream, cons->car);
116 if (cons->cdr.atom->type != ATOM_SYMBOL ||
117 strcmp("nil", cons->cdr.atom->sym) != 0) {
118 fprintf(stream, " . ");
119 print_expr_as_sexpr(stream, cons->cdr);
122 fprintf(stream, ")");
125 static void print_cons_as_c(FILE *stream, struct Cons *cons)
127 trace_assert(stream);
130 fprintf(stream, "CONS(gc, ");
131 print_expr_as_c(stream, cons->car);
132 fprintf(stream, ", ");
133 print_expr_as_c(stream, cons->cdr);
134 fprintf(stream, ")");
137 void print_expr_as_sexpr(FILE *stream, struct Expr expr)
141 print_atom_as_sexpr(stream, expr.atom);
145 print_cons_as_sexpr(stream, expr.cons);
153 void print_expr_as_c(FILE *stream, struct Expr expr)
155 trace_assert(stream);
160 print_atom_as_c(stream, expr.atom);
164 print_cons_as_c(stream, expr.cons);
172 void destroy_expr(struct Expr expr)
176 destroy_atom(expr.atom);
180 destroy_cons(expr.cons);
188 struct Cons *create_cons(Gc *gc, struct Expr car, struct Expr cdr)
190 struct Cons *cons = malloc(sizeof(struct Cons));
198 if (gc_add_expr(gc, cons_as_expr(cons)) < 0) {
206 void destroy_cons(struct Cons *cons)
211 struct Atom *create_number_atom(Gc *gc, long int num)
213 struct Atom *atom = malloc(sizeof(struct Atom));
217 atom->type = ATOM_NUMBER;
220 if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
228 struct Atom *create_string_atom(Gc *gc, const char *str, const char *str_end)
230 struct Atom *atom = malloc(sizeof(struct Atom));
236 atom->type = ATOM_STRING;
237 atom->str = string_duplicate(str, str_end);
239 if (atom->str == NULL) {
243 if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
251 if (atom->str != NULL) {
260 struct Atom *create_symbol_atom(Gc *gc, const char *sym, const char *sym_end)
262 struct Atom *atom = malloc(sizeof(struct Atom));
268 atom->type = ATOM_SYMBOL;
269 atom->sym = string_duplicate(sym, sym_end);
271 if (atom->sym == NULL) {
275 if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
283 if (atom->sym != NULL) {
292 struct Atom *create_lambda_atom(Gc *gc, struct Expr args_list, struct Expr body, struct Expr envir)
294 struct Atom *atom = malloc(sizeof(struct Atom));
300 atom->type = ATOM_LAMBDA;
301 atom->lambda.args_list = args_list;
302 atom->lambda.body = body;
303 atom->lambda.envir = envir;
305 if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
319 struct Atom *create_native_atom(Gc *gc, NativeFunction fun, void *param)
321 struct Atom *atom = malloc(sizeof(struct Atom));
327 atom->type = ATOM_NATIVE;
328 atom->native.fun = fun;
329 atom->native.param = param;
331 if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
345 void destroy_atom(struct Atom *atom)
347 switch (atom->type) {
363 static int atom_as_sexpr(struct Atom *atom, char *output, size_t n)
366 trace_assert(output);
368 switch (atom->type) {
370 return snprintf(output, n, "%s", atom->sym);
373 return snprintf(output, n, "%ld", atom->num);
376 return snprintf(output, n, "\"%s\"", atom->str);
379 return snprintf(output, n, "<lambda>");
382 return snprintf(output, n, "<native>");
388 static int cons_as_sexpr(struct Cons *head, char *output, size_t n)
391 trace_assert(output);
393 /* TODO(#378): cons_as_sexpr does not handle encoding errors of snprintf */
395 struct Cons *cons = head;
399 int c = snprintf(output, n, "(");
404 c += expr_as_sexpr(cons->car, output + c, (size_t) (m - c));
409 while (cons->cdr.type == EXPR_CONS) {
410 cons = cons->cdr.cons;
412 c += snprintf(output + c, (size_t) (m - c), " ");
417 c += expr_as_sexpr(cons->car, output + c, (size_t) (m - c));
423 if (cons->cdr.atom->type != ATOM_SYMBOL ||
424 strcmp("nil", cons->cdr.atom->sym) != 0) {
426 c += snprintf(output + c, (size_t) (m - c), " . ");
431 c += expr_as_sexpr(cons->cdr, output + c, (size_t) (m - c));
437 c += snprintf(output + c, (size_t) (m - c), ")");
445 int expr_as_sexpr(struct Expr expr, char *output, size_t n)
449 return atom_as_sexpr(expr.atom, output, n);
452 return cons_as_sexpr(expr.cons, output, n);
461 const char *expr_type_as_string(enum ExprType expr_type)
464 case EXPR_ATOM: return "EXPR_ATOM";
465 case EXPR_CONS: return "EXPR_CONS";
466 case EXPR_VOID: return "EXPR_VOID";
472 const char *atom_type_as_string(enum AtomType atom_type)
475 case ATOM_SYMBOL: return "ATOM_SYMBOL";
476 case ATOM_NUMBER: return "ATOM_NUMBER";
477 case ATOM_STRING: return "ATOM_STRING";
478 case ATOM_LAMBDA: return "ATOM_LAMBDA";
479 case ATOM_NATIVE: return "ATOM_NATIVE";