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 "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 void print_cons_as_sexpr(FILE *stream, struct Cons *head)
  70 {
  71     trace_assert(head);
  72
  73     struct Cons *cons = head;
  74
  75     fprintf(stream, "(");
  76     print_expr_as_sexpr(stream, cons->car);
  77
  78     while (cons->cdr.type == EXPR_CONS) {
  79         cons = cons->cdr.cons;
  80         fprintf(stream, " ");
  81         print_expr_as_sexpr(stream, cons->car);
  82     }
  83
  84     if (cons->cdr.atom->type != ATOM_SYMBOL ||
  85         strcmp("nil", cons->cdr.atom->sym) != 0) {
  86         fprintf(stream, " . ");
  87         print_expr_as_sexpr(stream, cons->cdr);
  88     }
  89
  90     fprintf(stream, ")");
  91 }
  92
  93 void print_expr_as_sexpr(FILE *stream, struct Expr expr)
  94 {
  95     switch (expr.type) {
  96     case EXPR_ATOM:
  97         print_atom_as_sexpr(stream, expr.atom);
  98         break;
  99
 100     case EXPR_CONS:
 101         print_cons_as_sexpr(stream, expr.cons);
 102         break;
 103
 104     case EXPR_VOID:
 105         break;
 106     }
 107 }
 108
 109 void destroy_expr(struct Expr expr)
 110 {
 111     switch (expr.type) {
 112     case EXPR_ATOM:
 113         destroy_atom(expr.atom);
 114         break;
 115
 116     case EXPR_CONS:
 117         destroy_cons(expr.cons);
 118         break;
 119
 120     case EXPR_VOID:
 121         break;
 122     }
 123 }
 124
 125 struct Cons *create_cons(Gc *gc, struct Expr car, struct Expr cdr)
 126 {
 127     struct Cons *cons = malloc(sizeof(struct Cons));
 128     if (cons == NULL) {
 129         return NULL;
 130     }
 131
 132     cons->car = car;
 133     cons->cdr = cdr;
 134
 135     if (gc_add_expr(gc, cons_as_expr(cons)) < 0) {
 136         free(cons);
 137         return NULL;
 138     }
 139
 140     return cons;
 141 }
 142
 143 void destroy_cons(struct Cons *cons)
 144 {
 145     free(cons);
 146 }
 147
 148 struct Atom *create_number_atom(Gc *gc, long int num)
 149 {
 150     struct Atom *atom = malloc(sizeof(struct Atom));
 151     if (atom == NULL) {
 152         return NULL;
 153     }
 154     atom->type = ATOM_NUMBER;
 155     atom->num = num;
 156
 157     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 158         free(atom);
 159         return NULL;
 160     }
 161
 162     return atom;
 163 }
 164
 165 struct Atom *create_string_atom(Gc *gc, const char *str, const char *str_end)
 166 {
 167     struct Atom *atom = malloc(sizeof(struct Atom));
 168
 169     if (atom == NULL) {
 170         goto error;
 171     }
 172
 173     atom->type = ATOM_STRING;
 174     atom->str = string_duplicate(str, str_end);
 175
 176     if (atom->str == NULL) {
 177         goto error;
 178     }
 179
 180     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 181         goto error;
 182     }
 183
 184     return atom;
 185
 186 error:
 187     if (atom != NULL) {
 188         if (atom->str != NULL) {
 189             free(atom->str);
 190         }
 191         free(atom);
 192     }
 193
 194     return NULL;
 195 }
 196
 197 struct Atom *create_symbol_atom(Gc *gc, const char *sym, const char *sym_end)
 198 {
 199     struct Atom *atom = malloc(sizeof(struct Atom));
 200
 201     if (atom == NULL) {
 202         goto error;
 203     }
 204
 205     atom->type = ATOM_SYMBOL;
 206     atom->sym = string_duplicate(sym, sym_end);
 207
 208     if (atom->sym == NULL) {
 209         goto error;
 210     }
 211
 212     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 213         goto error;
 214     }
 215
 216     return atom;
 217
 218 error:
 219     if (atom != NULL) {
 220         if (atom->sym != NULL) {
 221             free(atom->sym);
 222         }
 223         free(atom);
 224     }
 225
 226     return NULL;
 227 }
 228
 229 struct Atom *create_lambda_atom(Gc *gc, struct Expr args_list, struct Expr body, struct Expr environ)
 230 {
 231     struct Atom *atom = malloc(sizeof(struct Atom));
 232
 233     if (atom == NULL) {
 234         goto error;
 235     }
 236
 237     atom->type = ATOM_LAMBDA;
 238     atom->lambda.args_list = args_list;
 239     atom->lambda.body = body;
 240     atom->lambda.environ = environ;
 241
 242     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 243         goto error;
 244     }
 245
 246     return atom;
 247
 248 error:
 249     if (atom != NULL) {
 250         free(atom);
 251     }
 252
 253     return NULL;
 254 }
 255
 256 struct Atom *create_native_atom(Gc *gc, NativeFunction fun, void *param)
 257 {
 258     struct Atom *atom = malloc(sizeof(struct Atom));
 259
 260     if (atom == NULL) {
 261         goto error;
 262     }
 263
 264     atom->type = ATOM_NATIVE;
 265     atom->native.fun = fun;
 266     atom->native.param = param;
 267
 268     if (gc_add_expr(gc, atom_as_expr(atom)) < 0) {
 269         goto error;
 270     }
 271
 272     return atom;
 273
 274 error:
 275     if (atom != NULL) {
 276         free(atom);
 277     }
 278
 279     return NULL;
 280 }
 281
 282 void destroy_atom(struct Atom *atom)
 283 {
 284     switch (atom->type) {
 285     case ATOM_SYMBOL:
 286     case ATOM_STRING: {
 287         free(atom->str);
 288     } break;
 289
 290     case ATOM_LAMBDA:
 291     case ATOM_NATIVE:
 292     case ATOM_NUMBER: {
 293         /* Nothing */
 294     } break;
 295     }
 296
 297     free(atom);
 298 }
 299
 300 static int atom_as_sexpr(struct Atom *atom, char *output, size_t n)
 301 {
 302     trace_assert(atom);
 303     trace_assert(output);
 304
 305     switch (atom->type) {
 306     case ATOM_SYMBOL:
 307         return snprintf(output, n, "%s", atom->sym);
 308
 309     case ATOM_NUMBER:
 310         return snprintf(output, n, "%ld", atom->num);
 311
 312     case ATOM_STRING:
 313         return snprintf(output, n, "\"%s\"", atom->str);
 314
 315     case ATOM_LAMBDA:
 316         return snprintf(output, n, "<lambda>");
 317
 318     case ATOM_NATIVE:
 319         return snprintf(output, n, "<native>");
 320     }
 321
 322     return 0;
 323 }
 324
 325 static int cons_as_sexpr(struct Cons *head, char *output, size_t n)
 326 {
 327     trace_assert(head);
 328     trace_assert(output);
 329
 330     /* TODO(#378): cons_as_sexpr does not handle encoding errors of snprintf */
 331
 332     struct Cons *cons = head;
 333
 334     int m = (int) n;
 335
 336     int c = snprintf(output, n, "(");
 337     if (m - c <= c) {
 338         return c;
 339     }
 340
 341     c += expr_as_sexpr(cons->car, output + c, (size_t) (m - c));
 342     if (m - c <= 0) {
 343         return c;
 344     }
 345
 346     while (cons->cdr.type == EXPR_CONS) {
 347         cons = cons->cdr.cons;
 348
 349         c += snprintf(output + c, (size_t) (m - c), " ");
 350         if (m - c <= 0) {
 351             return c;
 352         }
 353
 354         c += expr_as_sexpr(cons->car, output + c, (size_t) (m - c));
 355         if (m - c <= 0) {
 356             return c;
 357         }
 358     }
 359
 360     if (cons->cdr.atom->type != ATOM_SYMBOL ||
 361         strcmp("nil", cons->cdr.atom->sym) != 0) {
 362
 363         c += snprintf(output + c, (size_t) (m - c), " . ");
 364         if (m - c <= 0) {
 365             return c;
 366         }
 367
 368         c += expr_as_sexpr(cons->cdr, output + c, (size_t) (m - c));
 369         if (m - c <= 0) {
 370             return c;
 371         }
 372     }
 373
 374     c += snprintf(output + c, (size_t) (m - c), ")");
 375     if (m - c <= 0) {
 376         return c;
 377     }
 378
 379     return c;
 380 }
 381
 382 int expr_as_sexpr(struct Expr expr, char *output, size_t n)
 383 {
 384     switch(expr.type) {
 385     case EXPR_ATOM:
 386         return atom_as_sexpr(expr.atom, output, n);
 387
 388     case EXPR_CONS:
 389         return cons_as_sexpr(expr.cons, output, n);
 390
 391     case EXPR_VOID:
 392         return 0;
 393     }
 394
 395     return 0;
 396 }
 397
 398 const char *expr_type_as_string(enum ExprType expr_type)
 399 {
 400     switch (expr_type) {
 401     case EXPR_ATOM: return "EXPR_ATOM";
 402     case EXPR_CONS: return "EXPR_CONS";
 403     case EXPR_VOID: return "EXPR_VOID";
 404     }
 405
 406     return "";
 407 }
 408
 409 const char *atom_type_as_string(enum AtomType atom_type)
 410 {
 411     switch (atom_type) {
 412     case ATOM_SYMBOL: return "ATOM_SYMBOL";
 413     case ATOM_NUMBER: return "ATOM_NUMBER";
 414     case ATOM_STRING: return "ATOM_STRING";
 415     case ATOM_LAMBDA: return "ATOM_LAMBDA";
 416     case ATOM_NATIVE: return "ATOM_NATIVE";
 417     }
 418
 419     return "";
 420 }