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     case ATOM_NATIVE:
  29         return atom1->fun == atom2->fun;
  30     }
  31
  32     return false;
  33 }
  34
  35 static bool equal_cons(struct Cons *cons1, struct Cons *cons2)
  36 {
  37     assert(cons1);
  38     assert(cons2);
  39     return equal(cons1->car, cons2->car) && equal(cons1->cdr, cons2->cdr);
  40 }
  41
  42 bool equal(struct Expr obj1, struct Expr obj2)
  43 {
  44     if (obj1.type != obj2.type) {
  45         return false;
  46     }
  47
  48     switch (obj1.type) {
  49     case EXPR_ATOM:
  50         return equal_atoms(obj1.atom, obj2.atom);
  51
  52     case EXPR_CONS:
  53         return equal_cons(obj1.cons, obj2.cons);
  54
  55     case EXPR_VOID:
  56         return true;
  57     }
  58
  59     return true;
  60 }
  61
  62 bool nil_p(struct Expr obj)
  63 {
  64     return symbol_p(obj)
  65         && strcmp(obj.atom->sym, "nil") == 0;
  66 }
  67
  68 bool symbol_p(struct Expr obj)
  69 {
  70     return obj.type == EXPR_ATOM
  71         && obj.atom->type == ATOM_SYMBOL;
  72 }
  73
  74 bool cons_p(struct Expr obj)
  75 {
  76     return obj.type == EXPR_CONS;
  77 }
  78
  79 bool list_p(struct Expr obj)
  80 {
  81     if (nil_p(obj)) {
  82         return true;
  83     }
  84
  85     if (obj.type == EXPR_CONS) {
  86         return list_p(obj.cons->cdr);
  87     }
  88
  89     return false;
  90 }
  91
  92 bool list_of_symbols_p(struct Expr obj)
  93 {
  94     if (nil_p(obj)) {
  95         return true;
  96     }
  97
  98     if (obj.type == EXPR_CONS && symbol_p(obj.cons->car)) {
  99         return list_of_symbols_p(obj.cons->cdr);
 100     }
 101
 102     return false;
 103 }
 104
 105 bool lambda_p(struct Expr obj)
 106 {
 107     if (!list_p(obj)) {
 108         return false;
 109     }
 110
 111     if (length_of_list(obj) < 2) {
 112         return false;
 113     }
 114
 115     if (!symbol_p(obj.cons->car)) {
 116         return false;
 117     }
 118
 119     if (strcmp("lambda", obj.cons->car.atom->sym) != 0) {
 120         return false;
 121     }
 122
 123     if (!list_of_symbols_p(obj.cons->cdr.cons->car)) {
 124         return false;
 125     }
 126
 127     return true;
 128 }
 129
 130 long int length_of_list(struct Expr obj)
 131 {
 132     long int count = 0;
 133
 134     while (!nil_p(obj)) {
 135         count++;
 136         obj = obj.cons->cdr;
 137     }
 138
 139     return count;
 140 }
 141
 142 struct Expr assoc(struct Expr key, struct Expr alist)
 143 {
 144     while (cons_p(alist)) {
 145         if (cons_p(alist.cons->car) && equal(alist.cons->car.cons->car, key)) {
 146             return alist.cons->car;
 147         }
 148
 149         alist = alist.cons->cdr;
 150     }
 151
 152     return alist;
 153 }
 154
 155 static struct Expr list_rec(Gc *gc, size_t n, va_list args)
 156 {
 157     if (n == 0) {
 158         return NIL(gc);
 159     }
 160
 161     struct Expr obj = va_arg(args, struct Expr);
 162     return CONS(gc, obj, list_rec(gc, n - 1, args));
 163 }
 164
 165 struct Expr list(Gc *gc, size_t n, ...)
 166 {
 167     va_list args;
 168     va_start(args, n);
 169     struct Expr obj = list_rec(gc, n, args);
 170     va_end(args);
 171     return obj;
 172 }