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 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 atom1->num == atom2->num;
  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 true;
  57 }
  58
  59 bool nil_p(struct Expr obj)
  60 {
  61     return symbol_p(obj)
  62         && strcmp(obj.atom->sym, "nil") == 0;
  63 }
  64
  65 bool symbol_p(struct Expr obj)
  66 {
  67     return obj.type == EXPR_ATOM
  68         && obj.atom->type == ATOM_SYMBOL;
  69 }
  70
  71 bool cons_p(struct Expr obj)
  72 {
  73     return obj.type == EXPR_CONS;
  74 }
  75
  76 bool list_p(struct Expr obj)
  77 {
  78     if (nil_p(obj)) {
  79         return true;
  80     }
  81
  82     if (obj.type == EXPR_CONS) {
  83         return list_p(obj.cons->cdr);
  84     }
  85
  86     return false;
  87 }
  88
  89 bool list_of_symbols_p(struct Expr obj)
  90 {
  91     if (nil_p(obj)) {
  92         return true;
  93     }
  94
  95     if (obj.type == EXPR_CONS && symbol_p(obj.cons->car)) {
  96         return list_of_symbols_p(obj.cons->cdr);
  97     }
  98
  99     return false;
 100 }
 101
 102 bool callable_p(struct Expr obj)
 103 {
 104     if (!list_p(obj)) {
 105         return false;
 106     }
 107
 108     if (length_of_list(obj) < 2) {
 109         return false;
 110     }
 111
 112     if (!symbol_p(obj.cons->car)) {
 113         return false;
 114     }
 115
 116     if (strcmp("lambda", obj.cons->car.atom->sym) != 0) {
 117         return false;
 118     }
 119
 120     if (!list_of_symbols_p(obj.cons->cdr.cons->car)) {
 121         return false;
 122     }
 123
 124     return true;
 125 }
 126
 127 long int length_of_list(struct Expr obj)
 128 {
 129     long int count = 0;
 130
 131     while (!nil_p(obj)) {
 132         count++;
 133         obj = obj.cons->cdr;
 134     }
 135
 136     return count;
 137 }
 138
 139 struct Expr assoc(struct Expr key, struct Expr alist)
 140 {
 141     while (cons_p(alist)) {
 142         if (cons_p(alist.cons->car) && equal(alist.cons->car.cons->car, key)) {
 143             return alist.cons->car;
 144         }
 145
 146         alist = alist.cons->cdr;
 147     }
 148
 149     return alist;
 150 }
 151
 152 static struct Expr list_rec(Gc *gc, size_t n, va_list args)
 153 {
 154     if (n == 0) {
 155         return NIL(gc);
 156     }
 157
 158     struct Expr obj = va_arg(args, struct Expr);
 159     return CONS(gc, obj, list_rec(gc, n - 1, args));
 160 }
 161
 162 struct Expr list(Gc *gc, size_t n, ...)
 163 {
 164     va_list args;
 165     va_start(args, n);
 166     struct Expr obj = list_rec(gc, n, args);
 167     va_end(args);
 168     return obj;
 169 }