src/script/builtins.c

   1 #include <assert.h>
   2 #include <math.h>
   3 #include <string.h>
   4
   5 #include "builtins.h"
   6
   7 #define FLOAT_EQUALS_MARGIN 1e-6
   8
   9 static bool equal_atoms(struct Atom *atom1, struct Atom *atom2)
  10 {
  11     assert(atom1);
  12     assert(atom2);
  13
  14     if (atom1->type != atom2->type) {
  15         return false;
  16     }
  17
  18     switch (atom1->type) {
  19     case ATOM_SYMBOL:
  20         return strcmp(atom1->sym, atom2->sym) == 0;
  21
  22     case ATOM_NUMBER:
  23         return fabsf(atom1->num - atom2->num) <= FLOAT_EQUALS_MARGIN;
  24
  25     case ATOM_STRING:
  26         return strcmp(atom1->str, atom2->str) == 0;
  27     }
  28
  29     return false;
  30 }
  31
  32 static bool equal_cons(struct Cons *cons1, struct Cons *cons2)
  33 {
  34     assert(cons1);
  35     assert(cons2);
  36     return equal(cons1->car, cons2->car) && equal(cons1->cdr, cons2->cdr);
  37 }
  38
  39 bool equal(struct Expr obj1, struct Expr obj2)
  40 {
  41     if (obj1.type != obj2.type) {
  42         return false;
  43     }
  44
  45     switch (obj1.type) {
  46     case EXPR_ATOM:
  47         return equal_atoms(obj1.atom, obj2.atom);
  48
  49     case EXPR_CONS:
  50         return equal_cons(obj1.cons, obj2.cons);
  51
  52     case EXPR_VOID:
  53         return true;
  54     }
  55
  56     return false;
  57 }
  58
  59 bool nil_p(struct Expr obj)
  60 {
  61     return obj.type == EXPR_ATOM
  62         && obj.atom->type == ATOM_SYMBOL
  63         && strcmp(obj.atom->sym, "nil");
  64 }
  65
  66 struct Expr assoc(struct Expr key, struct Expr alist)
  67 {
  68     /* TODO: assoc has a recursive implementation */
  69
  70     switch (alist.type) {
  71     case EXPR_CONS:
  72         switch (alist.cons->car.type) {
  73         case EXPR_CONS:
  74             if (equal(alist.cons->car.cons->car, key)) {
  75                 return alist.cons->car;
  76             } else {
  77                 return assoc(key, alist.cons->cdr);
  78             }
  79             break;
  80
  81         default:
  82             return assoc(key, alist.cons->cdr);
  83         }
  84
  85     default:
  86         return alist;
  87     }
  88 }