Code from Build Your Own Lisp

byol.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>

#include <editline/readline.h>

#include "mpc.h"

typedef enum {
  
  LVAL_NUM,

  LVAL_FLOAT,
  
  LVAL_ERR 

} lval_type;

typedef enum {
  
  LERR_DIV_ZERO,
  
  LERR_BAD_OP, 
  
  LERR_BAD_NUM 

} lval_error;

typedef struct {

  lval_type   type;

  lval_error  err;

  union {

    long      num;

    double    numf;
  };

} lval;

lval
lval_num(long x)
{
  lval v;

  v.type = LVAL_NUM;
  v.num  = x;

  return v;
}

lval
lval_float(double x)
{
  lval v;

  v.type = LVAL_FLOAT;
  v.numf = x;

  return v;
}

lval
lval_err(int x)
{
  lval v;

  v.type = LVAL_ERR;
  v.err  = x;

  return v;
}

void
lval_print(lval v)
{
  switch (v.type) {

    case LVAL_NUM:

      printf("%li", v.num);

      break;

    case LVAL_FLOAT:

      printf("%f", v.numf);

      break;
    
    case LVAL_ERR:
      
      if (v.err == LERR_DIV_ZERO) printf("Error: Division by zero");

      if (v.err == LERR_BAD_OP) printf("Error: Invalid operator");

      if (v.err == LERR_BAD_NUM) printf("Error: Invalid number");

      break;
  }
}

void
lval_println(lval v)
{
  lval_print(v);

  putchar('\n');
}

lval
eval_op(lval x, char *op, lval y)
{
  if (x.type == LVAL_ERR) return x;
  
  if (y.type == LVAL_ERR) return y;

  if (strcmp(op, "+") == 0) {

    if (x.type == LVAL_FLOAT || y.type == LVAL_FLOAT) {

      return lval_float(
          (x.type == LVAL_FLOAT ? x.numf : (double)x.num) +
          (y.type == LVAL_FLOAT ? y.numf : (double)y.num));
    }

    return lval_num(x.num + y.num);
  }

  if (strcmp(op, "-") == 0) {

    if (x.type == LVAL_FLOAT || y.type == LVAL_FLOAT) {

      return lval_float(
          (x.type == LVAL_FLOAT ? x.numf : (double)x.num) -
          (y.type == LVAL_FLOAT ? y.numf : (double)y.num));
    }

    return lval_num(x.num - y.num);
  }

  if (strcmp(op, "*") == 0) {

    if (x.type == LVAL_FLOAT || y.type == LVAL_FLOAT) {

      return lval_float(
          (x.type == LVAL_FLOAT ? x.numf : (double)x.num) *
          (y.type == LVAL_FLOAT ? y.numf : (double)y.num));
    }
  }

  if (strcmp(op, "/") == 0) {

    if (x.type == LVAL_FLOAT || y.type == LVAL_FLOAT) {

      if (y.num == 0 && y.numf == 0) return lval_err(LERR_DIV_ZERO);

      return lval_float(
          (x.type == LVAL_FLOAT ? x.numf : (double)x.num) /
          (y.type == LVAL_FLOAT ? y.numf : (double)y.num));
    }

    return y.num == 0
      ? lval_err(LERR_DIV_ZERO)
      : lval_num(x.num / y.num);
  }

  if (strcmp(op, "%") == 0) {

    if (x.type == LVAL_FLOAT || y.type == LVAL_FLOAT) {

      if (y.num == 0 && y.numf == 0) return lval_err(LERR_DIV_ZERO);

      return lval_float(
          (x.type == LVAL_FLOAT ? (long)x.numf : x.num) %
          (y.type == LVAL_FLOAT ? (long)y.numf : y.num));
    }

    return y.num == 0
      ? lval_err(LERR_DIV_ZERO)
      : lval_num(x.num % y.num);
  }

  if (strcmp(op, "^") == 0) return lval_num(pow(x.num, y.num));

  if (strcmp(op, "min") == 0) return lval_num(fmin(x.num, y.num));

  if (strcmp(op, "max") == 0) return lval_num(fmax(x.num, y.num));

  return lval_err(LERR_BAD_OP);
}

lval
eval(mpc_ast_t *t)
{
  char   *op;
  long   num;
  double numf;
  lval   x;
  int    i;

  if (strstr(t->tag, "number")) {

    errno = 0;

    if (strstr(t->contents, ".")) {

      numf = strtod(t->contents, NULL);

      return errno != ERANGE 
        ? lval_float(numf)
        : lval_err(LERR_BAD_NUM);
    }
    
    num = strtol(t->contents, NULL, 10);

    return errno != ERANGE 
      ? lval_num(num)
      : lval_err(LERR_BAD_NUM);
  }

  op = t->children[1]->contents;
  x  = eval(t->children[2]);
  i  = 3;

  while (strstr(t->children[i]->tag, "expr")) {

    x = eval_op(x, op, eval(t->children[i]));

    i++;
  }

  // For the expression (- x) return -x
  if (i == 3 && strcmp(op, "-") == 0) x.num = -x.num;
  
  return x;
}

int
num_leaves(mpc_ast_t *t)
{
  int i, num;

  if (t->children_num == 0) return 1;

  if (t->children_num >= 1) {

    num = 1;

    for (i = 0; i < t->children_num; i++) {

      num += num_leaves(t->children[i]);
    }

    return num;
  }

  return 0;
}

int
num_branches(mpc_ast_t *t)
{
  int i, num;

  if (t->children_num >= 1) {

    num = t->children_num;

    for (i = 0; i < t->children_num; i++) {

      num += num_branches(t->children[i]);
    }

    return num;
  }

  return 0;
}

int
main(int argc, char **argv)
{
  mpc_parser_t *Number, *Operator, *Expr, *Lispy;
  char         *input;
  lval         result;

  Number   = mpc_new("number");
  Operator = mpc_new("operator");
  Expr     = mpc_new("expr");
  Lispy    = mpc_new("lispy");

  mpca_lang(MPCA_LANG_DEFAULT,
      "                                                                    \
        number   : /-?[0-9]+(\\.[0-9])?/ ;                                 \
        operator : '+' | '-' | '*' | '/' | '%' | '^' | \"min\" | \"max\" ; \
        expr     : <number> | '(' <operator> <expr>+ ')' ;                 \
        lispy    : /^\\(?/ <operator> <expr>+ /\\)?$/ ;                    \
      ",
      Number, Operator, Expr, Lispy);

  puts("Lispy version 0.0.1");

  puts("Press Ctrl+C to exit\n");

  while (1) {

    input = readline("lispy> ");

    add_history(input);

    mpc_result_t r;

    if (mpc_parse("<stdin>", input, Lispy, &r)) {

      result = eval(r.output);

      lval_println(result);

      mpc_ast_delete(r.output);

    } else {

      mpc_err_print(r.error);

      mpc_err_delete(r.error);
    }

    free(input);
  }

  mpc_cleanup(4, Number, Operator, Expr, Lispy);

  return 0;
}