lambda

l.c

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

typedef enum {
  SUCCESS,     // parsed
  FAILURE,     // didn't parse
  ERROR        // bad syntax
} status;

char cur_char;
int got_char = 0;


char* input_buf = NULL;
int input_buf_sz = 0;
int input_buf_cap = 0;

int grow(int i) {
  return (i < 8) ? 8 : i * 1.5;
}

void consume() {
  cur_char = getchar();
  if(input_buf_sz >= input_buf_cap) {
    input_buf_cap = grow(input_buf_cap);
    input_buf = realloc(input_buf, input_buf_cap);
  }
  input_buf[input_buf_sz++] = cur_char;
  got_char = 1;
}

char peek() {
  if(!got_char) { consume(); }
  return cur_char;
}

void skip_whitespace() {
  while(isspace(peek())) {
    consume();
  }
}

void clear_input_buf() {
  input_buf_sz = 0;
}


#define OPCODES \
  X(JMP, 1) X(RET, 0) X(APPLY, 0)		\
  X(ENV_LOOKUP, 1)				\
  X(MK_CLOSURE, 3)


typedef enum {
#define X(n, o) n,
  OPCODES
#undef X
} opcode;

char* opcode_names[] = {
#define X(n, o) #n,
  OPCODES
  #undef X
};

int has_operand[] = {
#define X(n, o) o,
  OPCODES
#undef X
};


int code_buf_cap = 0;
int code_buf_sz = 0;
char *code_buf = NULL;

int add_to_code_buf(char c) {
  if(code_buf_sz >= code_buf_cap) {
    code_buf_cap = grow(code_buf_cap);
    code_buf = realloc(code_buf, code_buf_cap);
  }
  int ret = code_buf_sz;
  code_buf[code_buf_sz++] = c;
  return ret;
}

void patch_at(int tgt_addr, char val) {
  code_buf[tgt_addr] = val;
}
				     

void print_code_buf() {
  int i = 0;
  
  while (i < code_buf_sz) {
    int addr = i;
    printf("%i/%x ", addr, addr);
    opcode op = code_buf[i++];
    printf("%s", opcode_names[op]);
    int num_ops = has_operand[op];
    for(int j = 0; j < num_ops; j++) {
      int rand = code_buf[i++];
      printf(" %i", rand);
    }
    
    printf("\n");
  }
}

void clear_code_buf() {
  code_buf_sz = 0;
}


// syntax

// expr = lambda | application | symbol

// lambda = '\' symbol expr

// application = '(' expr expr ')'

// symbol = a-z[^\s\(\)\\]*


status parse_expr();

char reserved_chars[] = "(\\).";

int is_reserved(char c) {
  return strchr(reserved_chars, c) != NULL;
}



int sym_buf_cap = 0;
int sym_buf_sz = 0;
char* sym_buf = NULL;

void add_sym_char(char c) {
  if(sym_buf_sz >= sym_buf_cap) {
    sym_buf_cap = grow(sym_buf_cap); 
    sym_buf = realloc(sym_buf, sym_buf_cap);
  }
  sym_buf[sym_buf_sz++] = c;
}

void clear_sym_buf() {
  sym_buf_sz = 0;
  if(sym_buf != NULL) {
    sym_buf[0] = '\0';
  }
}



status parse_symbol() {
  skip_whitespace();
  char c = peek();

  clear_sym_buf();
  
  if(!isalpha(c)) {
    return FAILURE;
  }
  
  while(!isspace(c) && !is_reserved(c)) {
    add_sym_char(c);
    consume();
    c = peek();
  }
    
  add_sym_char('\0');

  return SUCCESS;
  
}


struct cenv {
  char* sym_name;
  struct cenv* next;
};

struct cenv* cur_cenv = NULL;


void extend_cenv(char* sym, int len) {
  struct cenv* ncenv = malloc(sizeof(struct cenv));
  char* syms = malloc(len);
  strcpy(syms, sym);
  ncenv->sym_name = syms;
  ncenv->next = cur_cenv;
  cur_cenv = ncenv;
}

void pop_cenv() {
  if(cur_cenv == NULL) {
    printf("Cannot pop environment!\n");
    exit(1);
  }
  free(cur_cenv->sym_name);
  struct cenv* parent = cur_cenv->next;
  free(cur_cenv);
  
  cur_cenv = parent;
}

void clear_cenv_helper(struct cenv* c) {
  if(c == NULL) {
    return;
  }
  
  clear_cenv_helper(c->next);
  free(c->sym_name);
  free(c);
  
}

void clear_cenv() {
  clear_cenv_helper(cur_cenv);
  cur_cenv = NULL;
}

status parse_lambda() {
  skip_whitespace();
  char c = peek();

  int start_string_idx = input_buf_sz-1;
  
  if(c != '\\') {
    return FAILURE;
  }

  consume();

  if(parse_symbol() != SUCCESS) {
    return ERROR;
  }

  extend_cenv(sym_buf, sym_buf_sz);

  add_to_code_buf(JMP);
  int jmp_tgt_addr = add_to_code_buf(0xFF);

  int lam_addr = code_buf_sz;
  
  if(parse_expr() != SUCCESS) {
    code_buf_sz -= 2;
    return ERROR;
  }

  int end_string_idx = input_buf_sz-1;

  pop_cenv();
  
  add_to_code_buf(RET);

  int after_lam_addr = code_buf_sz;

  patch_at(jmp_tgt_addr, after_lam_addr);
  add_to_code_buf(MK_CLOSURE);
  add_to_code_buf(lam_addr);
  add_to_code_buf(start_string_idx);
  add_to_code_buf(end_string_idx-start_string_idx);
  
  
  return SUCCESS;
}

status parse_application() {
  skip_whitespace();
  
  if(peek() != '(') {
    return FAILURE;
  }

  consume();

  if(parse_expr() != SUCCESS) {
    return ERROR;
  }


  if(parse_expr() != SUCCESS) {
    return ERROR;
  }  
  
  
  if(peek() != ')') {
    return ERROR;
  }
  consume();

  add_to_code_buf(APPLY);
  return SUCCESS;
}

int clookup(char* sym) {
  int offset = 0;
  struct cenv* tmp = cur_cenv;
  while(tmp) {
    if(strcmp(tmp->sym_name, sym) == 0) {
      return offset;
    }
    tmp = tmp->next;
    offset += 1;
  }
  return -1;
}

status parse_expr() {
  status lam_stat = parse_lambda();
  if(lam_stat != FAILURE) {
    return lam_stat;
  }
  
  status app_stat = parse_application();
  if (app_stat != FAILURE) {
    return app_stat;
  }

  status sym_stat = parse_symbol();
  
  if (sym_stat == SUCCESS) {
    int env_offset = clookup(sym_buf);
    if(env_offset == -1) {
      printf("Unbound symbol '%s'\n", sym_buf);
      return ERROR;
    }
    add_to_code_buf(ENV_LOOKUP);
    add_to_code_buf(env_offset);
    
    return SUCCESS;
  } else {
    return ERROR;
  }


}

struct renv {
  struct closure* value;
  struct renv* next;
};

struct closure {
  int code_addr;
  struct renv* bound_env;
  char* string;
  int string_len;
};

int cycles = 0;

#define STACK_SZ (65536*2)
struct renv* estack[STACK_SZ];
struct closure* vstack[STACK_SZ]; // value stack
int rstack[STACK_SZ];


status execute() {
  int pc = 0;
  cycles = 0;


  int esp = 0;
  estack[0] = NULL;
  
  int rsp = 0;
  int vsp = 0;
  
  while(pc < code_buf_sz) {
    //printf("pc %i\n", pc);
    opcode op = code_buf[pc++];
    cycles++;
    switch(op) {
    case JMP: do {
	char tgt = code_buf[pc];
	pc = tgt;
      } while(0);
      break;

    case APPLY: do {
	// get operand from stack
	if(vsp < 2) {
	  printf("Value stack underflow!\n");
	  return ERROR;
	}
	struct closure* operand = vstack[--vsp];
	// get operator closure
	struct closure* operator = vstack[--vsp];
	// extend closure environment
	struct renv* clos_env = operator->bound_env;

	//printf("applying closure at %i to closure at %i\n",
	//       operator->code_addr, operand->code_addr);
	struct renv* new_env = malloc(sizeof(struct renv));
	new_env->value = operand;
	new_env->next = clos_env;
	
	// set environment
	if(esp >= STACK_SZ) {
	  printf("Environment stack overflow!\n");
	  return ERROR;
	}
	estack[++esp] = new_env;
	
	// call closure
	if(rsp >= STACK_SZ) {
	  printf("Return stack overflow!\n");
	  return ERROR;
	}
	rstack[rsp++] = pc;
	pc = operator->code_addr;
      } while(0);
      break;

    case RET: do {
	// pop runtime environment
	if(esp == 0) {
	  printf("Environment stack underflow!\n");
	  return ERROR;
	}
	
	// return to
	if(rsp == 0) {
	  printf("Return stack underflow!\n");
	  return ERROR;
	}
	int ret = rstack[--rsp];
	pc = ret;
      } while(0);
      break;

    case MK_CLOSURE: do {
	// grab current environment
	struct renv *cur_env = estack[esp];
	// grab code addr
	int code_addr = code_buf[pc++];
	int string_idx = code_buf[pc++];
	
	int string_len = code_buf[pc++];
	
	// allocate closure
	struct closure* res = malloc(sizeof(struct closure));
	res->code_addr = code_addr;
	res->bound_env = cur_env;
	res->string = &(input_buf[string_idx]);
	res->string_len = string_len;
	vstack[vsp++] = res;
	
      } while(0);
      break;

    case ENV_LOOKUP: do {
	int off = code_buf[pc++];
	struct renv* lenv = estack[esp];

	while(off != 0) {
	  if(lenv == NULL) {
	    printf("Environment lookup failure!\n");
	    return ERROR;
	  }
	  lenv = lenv->next;
	  off--;
	}

	if(vsp >= STACK_SZ) {
	  printf("Value stack overflow!\n");
	  return ERROR;
	}
	vstack[vsp++] = lenv->value;
	
      } while(0);
      
    }
  }

  if(vsp != 1) {
    printf("Execution finished with too many items on the stack!\n");
    return FAILURE;
  }
  
  printf("%.*s\n", vstack[vsp-1]->string_len, vstack[vsp-1]->string);
  return SUCCESS;

}


int main() {
  skip_whitespace();
  while(peek() != EOF) {
    status stat = parse_expr();
    if(stat != SUCCESS) {
      printf("failed to parse!\n");
    } else {
      execute();
    }
    
    clear_code_buf();
    clear_sym_buf();
    clear_input_buf();
    clear_cenv();
    
    skip_whitespace();
  }

  return 0;
}