src/script/builtins.c

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