src/ebisp/expr.c

   1 #include "system/stacktrace.h"
   2 #include <ctype.h>
   3 #include <stdarg.h>
   4 #include <stdio.h>
   5 #include <stdlib.h>
   6 #include <string.h>
   7
   8 #include "ebisp/expr.h"
   9 #include "ebisp/gc.h"
  10 #include "system/str.h"
  11
  12 struct Expr atom_as_expr(struct Atom *atom)
  13 {
  14     struct Expr expr = {
  15         .type = EXPR_ATOM,
  16         .atom = atom
  17     };
  18
  19     return expr;
  20 }
  21
  22 struct Expr cons_as_expr(struct Cons *cons)
  23 {
  24     struct Expr expr = {
  25         .type = EXPR_CONS,
  26         .cons = cons
  27     };
  28
  29     return expr;
  30 }
  31
  32 struct Expr void_expr(void)
  33 {
  34     struct Expr expr = {
  35         .type = EXPR_VOID
  36     };
  37
  38     return expr;
  39 }
  40
  41 void print_atom_as_sexpr(FILE *stream, struct Atom *atom)
  42 {
  43     trace_assert(atom);
  44
  45     switch (atom->type) {
  46     case ATOM_SYMBOL:
  47         fprintf(stream, "%s", atom->sym);
  48         break;
  49
  50     case ATOM_NUMBER:
  51         fprintf(stream, "%ld", atom->num);
  52         break;
  53
  54     case ATOM_STRING:
  55         fprintf(stream, "\"%s\"", atom->str);
  56         break;
  57
  58     case ATOM_LAMBDA:
  59         /* TODO(#649): Print LAMBDAs with arglists (and maybe bodies) in print_atom_as_sexpr and atom_as_sexpr */
  60         fprintf(stream, "<lambda>");
  61         break;
  62
  63     case ATOM_NATIVE:
  64         fprintf(stream, "<native>");
  65         break;
  66     }
  67 }
  68
  69 static void print_atom_as_c(FILE *stream, struct Atom *atom)
  70 {
  71     trace_assert(stream);
  72     trace_assert(atom);
  73
  74     switch(atom->type) {
  75     case ATOM_SYMBOL:
  76         fprintf(stream, "SYMBOL(gc, \"%s\")", atom->sym);
  77         break;
  78
  79     case ATOM_NUMBER:
  80         fprintf(stream, "NUMBER(gc, %ld)", atom->num);
  81         break;
  82
  83     case ATOM_STRING:
  84         fprintf(stream, "STRING(gc, \"%s\")", atom->str);
  85         break;
  86
  87     case ATOM_LAMBDA:
  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, ")))");
  93         break;
  94
  95     case ATOM_NATIVE:
  96         fprintf(stream, "NIL(gc)");
  97         break;
  98     }
  99 }
 100
 101 void print_cons_as_sexpr(FILE *stream, struct Cons *head)
 102 {
 103     trace_assert(head);
 104
 105     struct Cons *cons = head;
 106
 107     fprintf(stream, "(");
 108     print_expr_as_sexpr(stream, cons->car);
 109
 110     while (cons->cdr.type == EXPR_CONS) {
 111         cons = cons->cdr.cons;
 112         fprintf(stream, " ");
 113         print_expr_as_sexpr(stream, cons->car);
 114     }
 115
 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);
 120     }
 121
 122     fprintf(stream, ")");
 123 }
 124
 125 static void print_cons_as_c(FILE *stream, struct Cons *cons)
 126 {
 127     trace_assert(stream);
 128     trace_assert(cons);
 129
 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, ")");
 135 }
 136
 137 void print_expr_as_sexpr(FILE *stream, struct Expr expr)
 138 {
 139     switch (expr.type) {
 140     case EXPR_ATOM:
 141         print_atom_as_sexpr(stream, expr.atom);
 142         break;
 143
 144     case EXPR_CONS:
 145         print_cons_as_sexpr(stream, expr.cons);
 146         break;
 147
 148     case EXPR_VOID:
 149         break;
 150     }
 151 }
 152
 153 void print_expr_as_c(FILE *stream, struct Expr expr)
 154 {
 155     trace_assert(stream);
 156     (void) expr;
 157
 158     switch (expr.type) {
 159     case EXPR_ATOM:
 160         print_atom_as_c(stream, expr.atom);
 161         break;
 162
 163     case EXPR_CONS:
 164         print_cons_as_c(stream, expr.cons);
 165         break;
 166
 167     case EXPR_VOID:
 168         break;
 169     }
 170 }
 171
 172 void destroy_expr(struct Expr expr)
 173 {
 174     switch (expr.type) {
 175     case EXPR_ATOM:
 176         destroy_atom(expr.atom);
 177         break;
 178
 179     case EXPR_CONS:
 180         destroy_cons(expr.cons);
 181         break;
 182
 183     case EXPR_VOID:
 184         break;
 185     }
 186 }
 187
 188 struct Cons *create_cons(Gc *gc, struct Expr car, struct Expr cdr)
 189 {
 190     struct Cons *cons = malloc(sizeof(struct Cons));
 191     if (cons == NULL) {
 192         return NULL;
 193     }
 194
 195     cons->car = car;
 196     cons->cdr = cdr;
 197
 198     if (gc_add_expr(gc, cons_as_expr(cons)) < 0) {
 199         free(cons);
 200         return NULL;
 201     }
 202
 203     return cons;
 204 }
 205
 206 void destroy_cons(struct Cons *cons)
 207 {
 208     free(cons);
 209 }
 210
 211 struct Atom *create_number_atom(Gc *gc, long int num)
 212 {
 213     struct Atom *atom = malloc(sizeof(struct Atom));
 214     if (atom == NULL) {
 215         return NULL;
 216     }
 217     atom->type = ATOM_NUMBER;
 218     atom->num = num;
 219
 220     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 221         free(atom);
 222         return NULL;
 223     }
 224
 225     return atom;
 226 }
 227
 228 struct Atom *create_string_atom(Gc *gc, const char *str, const char *str_end)
 229 {
 230     struct Atom *atom = malloc(sizeof(struct Atom));
 231
 232     if (atom == NULL) {
 233         goto error;
 234     }
 235
 236     atom->type = ATOM_STRING;
 237     atom->str = string_duplicate(str, str_end);
 238
 239     if (atom->str == NULL) {
 240         goto error;
 241     }
 242
 243     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 244         goto error;
 245     }
 246
 247     return atom;
 248
 249 error:
 250     if (atom != NULL) {
 251         if (atom->str != NULL) {
 252             free(atom->str);
 253         }
 254         free(atom);
 255     }
 256
 257     return NULL;
 258 }
 259
 260 struct Atom *create_symbol_atom(Gc *gc, const char *sym, const char *sym_end)
 261 {
 262     struct Atom *atom = malloc(sizeof(struct Atom));
 263
 264     if (atom == NULL) {
 265         goto error;
 266     }
 267
 268     atom->type = ATOM_SYMBOL;
 269     atom->sym = string_duplicate(sym, sym_end);
 270
 271     if (atom->sym == NULL) {
 272         goto error;
 273     }
 274
 275     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 276         goto error;
 277     }
 278
 279     return atom;
 280
 281 error:
 282     if (atom != NULL) {
 283         if (atom->sym != NULL) {
 284             free(atom->sym);
 285         }
 286         free(atom);
 287     }
 288
 289     return NULL;
 290 }
 291
 292 struct Atom *create_lambda_atom(Gc *gc, struct Expr args_list, struct Expr body, struct Expr envir)
 293 {
 294     struct Atom *atom = malloc(sizeof(struct Atom));
 295
 296     if (atom == NULL) {
 297         goto error;
 298     }
 299
 300     atom->type = ATOM_LAMBDA;
 301     atom->lambda.args_list = args_list;
 302     atom->lambda.body = body;
 303     atom->lambda.envir = envir;
 304
 305     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 306         goto error;
 307     }
 308
 309     return atom;
 310
 311 error:
 312     if (atom != NULL) {
 313         free(atom);
 314     }
 315
 316     return NULL;
 317 }
 318
 319 struct Atom *create_native_atom(Gc *gc, NativeFunction fun, void *param)
 320 {
 321     struct Atom *atom = malloc(sizeof(struct Atom));
 322
 323     if (atom == NULL) {
 324         goto error;
 325     }
 326
 327     atom->type = ATOM_NATIVE;
 328     atom->native.fun = fun;
 329     atom->native.param = param;
 330
 331     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 332         goto error;
 333     }
 334
 335     return atom;
 336
 337 error:
 338     if (atom != NULL) {
 339         free(atom);
 340     }
 341
 342     return NULL;
 343 }
 344
 345 void destroy_atom(struct Atom *atom)
 346 {
 347     switch (atom->type) {
 348     case ATOM_SYMBOL:
 349     case ATOM_STRING: {
 350         free(atom->str);
 351     } break;
 352
 353     case ATOM_LAMBDA:
 354     case ATOM_NATIVE:
 355     case ATOM_NUMBER: {
 356         /* Nothing */
 357     } break;
 358     }
 359
 360     free(atom);
 361 }
 362
 363 static int atom_as_sexpr(struct Atom *atom, char *output, size_t n)
 364 {
 365     trace_assert(atom);
 366     trace_assert(output);
 367
 368     switch (atom->type) {
 369     case ATOM_SYMBOL:
 370         return snprintf(output, n, "%s", atom->sym);
 371
 372     case ATOM_NUMBER:
 373         return snprintf(output, n, "%ld", atom->num);
 374
 375     case ATOM_STRING:
 376         return snprintf(output, n, "\"%s\"", atom->str);
 377
 378     case ATOM_LAMBDA:
 379         return snprintf(output, n, "<lambda>");
 380
 381     case ATOM_NATIVE:
 382         return snprintf(output, n, "<native>");
 383     }
 384
 385     return 0;
 386 }
 387
 388 static int cons_as_sexpr(struct Cons *head, char *output, size_t n)
 389 {
 390     trace_assert(head);
 391     trace_assert(output);
 392
 393     /* TODO(#378): cons_as_sexpr does not handle encoding errors of snprintf */
 394
 395     struct Cons *cons = head;
 396
 397     int m = (int) n;
 398
 399     int c = snprintf(output, n, "(");
 400     if (m - c <= c) {
 401         return c;
 402     }
 403
 404     c += expr_as_sexpr(cons->car, output + c, (size_t) (m - c));
 405     if (m - c <= 0) {
 406         return c;
 407     }
 408
 409     while (cons->cdr.type == EXPR_CONS) {
 410         cons = cons->cdr.cons;
 411
 412         c += snprintf(output + c, (size_t) (m - c), " ");
 413         if (m - c <= 0) {
 414             return c;
 415         }
 416
 417         c += expr_as_sexpr(cons->car, output + c, (size_t) (m - c));
 418         if (m - c <= 0) {
 419             return c;
 420         }
 421     }
 422
 423     if (cons->cdr.atom->type != ATOM_SYMBOL ||
 424         strcmp("nil", cons->cdr.atom->sym) != 0) {
 425
 426         c += snprintf(output + c, (size_t) (m - c), " . ");
 427         if (m - c <= 0) {
 428             return c;
 429         }
 430
 431         c += expr_as_sexpr(cons->cdr, output + c, (size_t) (m - c));
 432         if (m - c <= 0) {
 433             return c;
 434         }
 435     }
 436
 437     c += snprintf(output + c, (size_t) (m - c), ")");
 438     if (m - c <= 0) {
 439         return c;
 440     }
 441
 442     return c;
 443 }
 444
 445 int expr_as_sexpr(struct Expr expr, char *output, size_t n)
 446 {
 447     switch(expr.type) {
 448     case EXPR_ATOM:
 449         return atom_as_sexpr(expr.atom, output, n);
 450
 451     case EXPR_CONS:
 452         return cons_as_sexpr(expr.cons, output, n);
 453
 454     case EXPR_VOID:
 455         return 0;
 456     }
 457
 458     return 0;
 459 }
 460
 461 const char *expr_type_as_string(enum ExprType expr_type)
 462 {
 463     switch (expr_type) {
 464     case EXPR_ATOM: return "EXPR_ATOM";
 465     case EXPR_CONS: return "EXPR_CONS";
 466     case EXPR_VOID: return "EXPR_VOID";
 467     }
 468
 469     return "";
 470 }
 471
 472 const char *atom_type_as_string(enum AtomType atom_type)
 473 {
 474     switch (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";
 480     }
 481
 482     return "";
 483 }