path: root/src/bootstrap/primitives.c

bool display(Object *root);

void
display_pair(Object *root) {
    display(root->car);
    if (root->cdr->type == OBJ_TYPE_PAIR) {
        printf(" ");
        display_pair(root->cdr);
    } else if (root->cdr == obj_nil) {
        return;
    } else {
        printf(" . ");
        display(root->cdr);
    }
}

bool
display(Object *root) {
    if (root == NULL) {
        return false;
    }

    switch (root->type) {
        case OBJ_TYPE_FIXNUM: {
            printf("%zd", root->fixnum);
        } break;
        case OBJ_TYPE_BOOL: {
            if (root->boolean) {
                printf("true");
            } else {
                printf("false");
            }
        } break;
        case OBJ_TYPE_NIL: {
            printf("()");
        } break;
        case OBJ_TYPE_STRING: {
            printf("\"%.*s\"", (int)root->string_n, root->string);
        } break;
        case OBJ_TYPE_SYMBOL: {
            printf(":%.*s", (int)root->symbol_n, root->symbol);
        } break;
        case OBJ_TYPE_PAIR: {
            printf("(");
            display_pair(root);
            printf(")");
        } break;
        case OBJ_TYPE_PROCEDURE: {
            printf("#{procedure}");
        } break;
    }
    return true;
}

Object *
eval(Object *root) {
    switch (root->type) {
        case OBJ_TYPE_FIXNUM:
        case OBJ_TYPE_BOOL:
        case OBJ_TYPE_NIL:
        case OBJ_TYPE_STRING: {
            return root;
        } break;
        case OBJ_TYPE_SYMBOL: {
            Object *value = find_environment_symbol(root);
            if (value == NULL) {
                printf("error: symbol not found: `");
                display(root);
                printf("`\n");
                return obj_nil;
            }
            return value;
        } break;
        case OBJ_TYPE_PAIR: {
            if (root->car->type == OBJ_TYPE_SYMBOL) {
                Object *value = find_environment_symbol(root->car);
                if (value == NULL) {
                    printf("error: symbol not found: `");
                    display(root->car);
                    printf("`\n");
                    return obj_nil;
                }
                if (value->type == OBJ_TYPE_PROCEDURE) {
                    return value->proc(root->cdr);
                }
            }
        } break;
        default: {
            printf("error: can't eval type %d.\n", root->type);
        } break;
    }
    return obj_nil;
}

Object *
proc_add(Object *args) {
    // Extract first parameter.
    Object *car = eval(args->car);
    if (car == NULL) {
        fprintf(stderr, "error: not enough arguments\n");
        return obj_nil;
    }
    if (car->type != OBJ_TYPE_FIXNUM) {
        fprintf(stderr, "addition not supported for type %d\n", car->type);
        return obj_nil;
    }
    args = args->cdr;
    ssize_t tot = car->fixnum;

    while (args->type == OBJ_TYPE_PAIR) {
        Object *car = eval(args->car);
        if (car == NULL) {
            car = obj_nil;
        }
        if (car->type != OBJ_TYPE_FIXNUM) {
            fprintf(stderr, "addition not supported for type %d\n", car->type);
            return obj_nil;
        }
        tot += car->fixnum;
        args = args->cdr;
    }
    return make_fixnum(tot);
}

Object *
proc_sub(Object *args) {
    // Extract first parameter.
    Object *car = eval(args->car);
    if (car == NULL) {
        fprintf(stderr, "error: not enough arguments\n");
        return obj_nil;
    }
    if (car->type != OBJ_TYPE_FIXNUM) {
        fprintf(stderr, "error: sub not supported for type %d\n", car->type);
        return obj_nil;
    }
    args = args->cdr;
    ssize_t tot = car->fixnum;

    while (args->type == OBJ_TYPE_PAIR) {
        car = eval(args->car);
        if (car == NULL) {
            car = obj_nil;
        }
        if (car->type != OBJ_TYPE_FIXNUM) {
            fprintf(stderr, "error: sub not supported for type %d\n", car->type);
            return obj_nil;
        }
        tot -= car->fixnum;
        args = args->cdr;
    }
    return make_fixnum(tot);
}

Object *
proc_mul(Object *args) {
    // Extract first parameter.
    Object *car = eval(args->car);
    if (car == NULL) {
        fprintf(stderr, "error: not enough arguments\n");
        return obj_nil;
    }
    if (car->type != OBJ_TYPE_FIXNUM) {
        fprintf(stderr, "error: mult not supported for type %d\n", car->type);
        return obj_nil;
    }
    args = args->cdr;
    ssize_t tot = car->fixnum;

    while (args->type == OBJ_TYPE_PAIR) {
        Object *car = eval(args->car);
        if (car == NULL) {
            car = obj_nil;
        }
        if (car->type != OBJ_TYPE_FIXNUM) {
            fprintf(stderr, "error: mult not supported for type %d\n", car->type);
            return obj_nil;
        }
        tot *= car->fixnum;
        args = args->cdr;
    }
    return make_fixnum(tot);
}

Object *
proc_div(Object *args) {
    // Extract first parameter.
    Object *car = eval(args->car);
    if (car == NULL) {
        fprintf(stderr, "error: not enough arguments\n");
        return obj_nil;
    }
    args = args->cdr;
    ssize_t tot = car->fixnum;

    while (args->type == OBJ_TYPE_PAIR) {
        Object *car = eval(args->car);
        if (car == NULL) {
            car = obj_nil;
        }
        if (car->type != OBJ_TYPE_FIXNUM) {
            fprintf(stderr, "error: div not supported for type %d\n", car->type);
            return obj_nil;
        }
        if (car->fixnum == 0) {
            fprintf(stderr, "error: division by zero\n");
            return obj_nil;
        }
        tot /= car->fixnum;
        args = args->cdr;
    }
    return make_fixnum(tot);
}

Object *
proc_display(Object *args) {
    if (args == NULL) {
        return obj_nil;
    }
    if (args->type == OBJ_TYPE_PAIR) {
        display(eval(args->car));
    }
    return obj_nil;
}

Object *
proc_print(Object *args) {
    if (args == NULL) {
        return NULL;
    }
    if (args->type == OBJ_TYPE_PAIR) {
        Object *obj = args->car;
        if (obj->type == OBJ_TYPE_STRING) {
            StringView scanner = (StringView) {
                .start = obj->string,
                .n = obj->string_n,
            };
            while (scanner.n != 0) {
                char c = sv_next(&scanner);
                if (c == '\\' && sv_peek(&scanner) == 'n') {
                    putchar('\n');
                    sv_next(&scanner);
                    continue;
                }
                if (c == '\\' && sv_peek(&scanner) == '"') {
                    putchar('"');
                    sv_next(&scanner);
                    continue;
                }
                putchar(c);
            }
        } else {
            fprintf(stderr, "error: print requires a string argument\n");
        }
    }
    return NULL;
}

Object *
proc_is_boolean(Object *args) {
    Object *obj = NULL;
    if (args->type == OBJ_TYPE_PAIR) {
        obj = eval(args->car);
    } else {
        obj = eval(args);
    }
    return (obj == obj_true || obj == obj_false) ? obj_true : obj_false;
}

Object *
proc_not(Object *args) {
    if (args->type == OBJ_TYPE_PAIR) {
        return eval(args->car) == obj_false ? obj_true : obj_false;
    }
    return eval(args) == obj_false ? obj_true : obj_false;
}

Object *
proc_and(Object *args) {
    while (args != NULL && args != obj_nil) {
        Object *obj = args->car;
        if (args->car->type == OBJ_TYPE_PAIR) {
            obj = eval(args->car);
        }
        if (proc_not(obj) == obj_true) {
            return obj_false;
        }
        args = args->cdr;
    }
    return obj_true;
}

Object *
proc_or(Object *args) {
    if (args->type != OBJ_TYPE_PAIR) {
        return obj_false;
    }

    while (args != NULL && args != obj_nil) {
        Object *obj = args->car;
        if (args->car->type == OBJ_TYPE_PAIR) {
            obj = eval(args->car);
        }
        if (proc_not(obj) == obj_false) {
            return obj_true;
        }
        args = args->cdr;
    }
    return obj_false;
}

Object *
proc_if(Object *args) {
    if (args->type != OBJ_TYPE_PAIR || args->cdr->type != OBJ_TYPE_PAIR) {
        fprintf(stderr, "error: wrong number of arguments.\n");
        return NULL;
    }

    Object *condition = eval(args->car);
    if (condition == obj_true) {
        Object *ret = eval(args->cdr->car);
        return ret;
    }
    if (args->cdr->cdr != obj_nil) {
        Object *ret = eval(args->cdr->cdr->car);
        return ret;
    }

    return obj_nil;
}

Object *
proc_cond(Object *args) {
    if (args->type != OBJ_TYPE_PAIR) {
        fprintf(stderr, "error: wrong number of arguments.\n");
        return NULL;
    }

    if (args->car->type != OBJ_TYPE_PAIR) {
        fprintf(stderr, "error: wrong argument type.\n");
        return NULL;
    }

    while (args != obj_nil) {
        Object *clause = args->car;
        if (eval(clause->car) == obj_true) {
            return eval(clause->cdr->car);
        }

        args = args->cdr;
        clause = args->car;
    }

    return obj_nil;
}

// TODO: equality greater than smaller than...
// TODO: fixnum left/right shift, mask, invert