src/script/builtins.c

   1 #include <assert.h>
   2 #include <math.h>
   3 #include <stdarg.h>
   4 #include <stdio.h>
   5 #include <string.h>
   6
   7 #include "builtins.h"
   8
   9 #define FLOAT_EQUALS_MARGIN 1e-6
  10
  11 static bool equal_atoms(struct Atom *atom1, struct Atom *atom2)
  12 {
  13     assert(atom1);
  14     assert(atom2);
  15
  16     if (atom1->type != atom2->type) {
  17         return false;
  18     }
  19
  20     switch (atom1->type) {
  21     case ATOM_SYMBOL:
  22         return strcmp(atom1->sym, atom2->sym) == 0;
  23
  24     case ATOM_NUMBER:
  25         return fabsf(atom1->num - atom2->num) <= FLOAT_EQUALS_MARGIN;
  26
  27     case ATOM_STRING:
  28         return strcmp(atom1->str, atom2->str) == 0;
  29     }
  30
  31     return false;
  32 }
  33
  34 static bool equal_cons(struct Cons *cons1, struct Cons *cons2)
  35 {
  36     assert(cons1);
  37     assert(cons2);
  38     return equal(cons1->car, cons2->car) && equal(cons1->cdr, cons2->cdr);
  39 }
  40
  41 bool equal(struct Expr obj1, struct Expr obj2)
  42 {
  43     if (obj1.type != obj2.type) {
  44         return false;
  45     }
  46
  47     switch (obj1.type) {
  48     case EXPR_ATOM:
  49         return equal_atoms(obj1.atom, obj2.atom);
  50
  51     case EXPR_CONS:
  52         return equal_cons(obj1.cons, obj2.cons);
  53
  54     case EXPR_VOID:
  55         return true;
  56     }
  57
  58     return true;
  59 }
  60
  61 bool nil_p(struct Expr obj)
  62 {
  63     return symbol_p(obj)
  64         && strcmp(obj.atom->sym, "nil") == 0;
  65 }
  66
  67 bool symbol_p(struct Expr obj)
  68 {
  69     return obj.type == EXPR_ATOM
  70         && obj.atom->type == ATOM_SYMBOL;
  71 }
  72
  73 bool cons_p(struct Expr obj)
  74 {
  75     return obj.type == EXPR_CONS;
  76 }
  77
  78 struct Expr assoc(struct Expr key, struct Expr alist)
  79 {
  80     while (cons_p(alist)) {
  81         if (cons_p(alist.cons->car) && equal(alist.cons->car.cons->car, key)) {
  82             return alist.cons->car;
  83         }
  84
  85         alist = alist.cons->cdr;
  86     }
  87
  88     return alist;
  89 }
  90
  91 static struct Expr list_rec(Gc *gc, size_t n, va_list args)
  92 {
  93     if (n == 0) {
  94         return NIL(gc);
  95     }
  96
  97     struct Expr obj = va_arg(args, struct Expr);
  98     return CONS(gc, obj, list_rec(gc, n - 1, args));
  99 }
 100
 101 struct Expr list(Gc *gc, size_t n, ...)
 102 {
 103     va_list args;
 104     va_start(args, n);
 105     struct Expr obj = list_rec(gc, n, args);
 106     va_end(args);
 107     return obj;
 108 }