int g(void); // get next unicode character.
void back(void); // forget I got last character.
void loc(void); // report where I am in source.
// The lines above are prototypes for file g.c
#include <stdio.h>
#include <stdlib.h>
#include <setjmp.h>
#include <termios.h>
#define codesize 5000
#define worksize 100000
#define md 100
// md may not exceed 252!
typedef unsigned short us;
typedef unsigned char uchar;
typedef unsigned int ui;
typedef unsigned long long int li;
uchar code[codesize];
typedef uchar * cp;
struct envS;
typedef struct{struct envS * e; cp c;} fun;
typedef struct valS pf(li);
typedef struct valS{uchar tag; union{li i; fun f; pf * p;}  u;} val;
// tag=0 for i; tag=1 for f; tag=2 for p.
typedef struct envS {struct envS * out; val v;} env;
// void pev(cp, env*); void prv(val); extern int cc; // debugging stuff
static jmp_buf again;
static int od;
static void Bye(char *) __dead2;
// '__dead2' is unrecognized by earlier gccs.
// It declares that routine never returns and thus eliminates some warnings and dead code.
void Bye(char * d){loc(); printf("%s\n", d); tcflush(1, TCIFLUSH); longjmp(again, 42);}
static env work[worksize];
static int wp = worksize;
env * gw(){if(!wp) {wp=worksize; Bye("Exhausted!");} return &work[--wp];}
static void crsh(char*) __dead2; void crsh(char* d){
    printf("%s: compiler bug!", d); exit(0);}

static val eval(cp x, env * e){ // Use the stack at first
  uchar op = *x;
  if (op < 253) {int j = op;
     while(j--) if (e) e = e->out; else crsh("bad sym\n"); return e->v;}
  if(op == 254) {cp argE = 3+x+*(us *)(x+1); // Where exp for argument is at.
     val f = eval(x+3, e); // function to apply
     val a = eval(argE, e); // argument to apply it to
     if(f.tag == 2) {
         if(a.tag) Bye("Numeric operator applied to function");
         return f.u.p(a.u.i);}
     {env * e2 = gw(); *e2 = (env){f.u.f.e, a};
      if (f.tag) return eval(f.u.f.c, e2);
      Bye("number as function");}}
  if(op == 255) return (val){1, {.f = {e, x+1}}};
  if(op == 253) {li y = 0; ++x;
     do y = y<<7 | (*x & 0x7f); while(*(x++) < 0x80) ;
     return (val){0, { .i = y }};}
  crsh("Invalid code\n");}

static cp cx = code;
static void cb(ui o) {if(o>255) crsh("invalid op %x\n");
     if(cx-code >= codesize) Bye("Too much code");
     *(cx++) = o;}
ui symbols[md];
int cd = 0; // current depth
static int const lp = '(', rp =  ')';
static int let(ui c){return (c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z'
    || c >= 0xa000 & c < 0xa490);}

static void compile(){ui c;
  ui gc(){c = g(); return c;}
  ui gu(){while(1){if(gc()==';') while(gc()!=10) ; else return c;}} // filter comments
  ui sl(){while(gu() == ' ' || c==10) ; return c;} // filter white space
  if(sl() == lp) {
    void nrp(char * c){printf("%s didn't end with a right paren.", c); Bye("");};
    if(sl() == 0x3bb){ // 0x3bb is code point for lambda
        if(cd >= md) Bye("Too many nested levels");
        symbols[cd++] = sl(); cb(255); compile(); --cd;
        if(sl() != rp) nrp("Lambda");}
    else {back(); {cp twoth = cx+1; cb(254); cx+=2; compile();
        {ui siz = cx - (twoth+2);
         if (siz > 1<<16) Bye("Program too big to compile");
        *(us*)twoth = siz;} compile(); 
        if(sl() != rp) nrp("function application");}}}
  else if(c <= '9' && c >= '0') {li x = c - '0';
     while (gc() <= '9' && c >= '0') {x = 10*x + c - '0';}
      cb(253); back();
      {void pb7(li w, uchar e) {if(w>127) pb7(w>>7, 0); cb(w & 0x7f | e);}
      pb7(x, 128);}}
  else if(let(c)) {int j = cd;
      while(j--) if(c == symbols[j]) {cb(cd-j-1); return;}
      printf("Free variable %d deep, 0x%x, %c\n", cd-od, c, c); Bye("");}
  else {printf("Screwy text, expecting expression: 0x%x, %c\n", c, c);
        Bye("");}}

static uchar false[] = {255, 0}; // (λx(λyy))
static uchar true [] = {255, 1}; // (λx(λyx))
static val increment(li w){return (val){0, { .i = w+1}};}
static val decrement(li w){return (val){0, { .i = w-1}};}
static val zeropred (li w){return (val){1, { .f = {0, !w?true:false}}};}
static val Putchar(li w){putchar(w); return (val){0, { .i = w}};}

int main(){setjmp(again);
 {env * prime_env = 0; cd=0;
  void makeVal(uchar nm, val v){env * p =  gw();
    p->out = prime_env; prime_env = p; p->v = v; symbols[cd++] = nm;}
  {void make_prim_fun(uchar nm, pf f){makeVal(nm, (val){2, { .p = f}});}
    make_prim_fun('i', increment);
    make_prim_fun('d', decrement);
    make_prim_fun('P', Putchar);
    make_prim_fun('z', zeropred);}
  {void make_first_fun(uchar nm, cp f) {makeVal(nm, (val){1, { .f = {0, f}}});}
    make_first_fun('H', false); make_first_fun('K', true);}
  
  while(1) {cx = code; od=cd; compile();
    printf("code ="); {uchar * j;
       for(j = code; j<cx; ++j) printf(" %02x", *j); printf("\n");}
    {val v = eval(code, prime_env);
     if(v.tag) printf("can't print function.\n");
     else printf("val = %lld\n", v.u.i);}}}}