%{

/* compile:    leg -o parse.c parse.leg
 *        cc -o parse parse.c
 *
 * run:        echo "3+4"  | ./parse
 */

#define DO_PROTOS()                                                                                             \
    _DO(If) _DO(While) _DO(Do) _DO(For) _DO(Switch) _DO(Call) _DO(Invoke) _DO(Func) _DO(Block)                  \
    _DO(Declaration) _DO(Assign)                                                                                \
    _DO(Map) _DO(Symbol) _DO(Integer) _DO(String)                                                               \
    _DO(Logor) _DO(Logand) _DO(Bitor) _DO(Bitxor) _DO(Bitand)                                                   \
    _DO(Equal) _DO(Noteq) _DO(Less) _DO(Lesseq) _DO(Greater) _DO(Greatereq) _DO(Shleft) _DO(Shright)            \
    _DO(Add) _DO(Sub) _DO(Mul) _DO(Div) _DO(Mod) _DO(Not) _DO(Neg) _DO(Com)                                     \
    _DO(PreIncVariable) _DO(PreIncMember) _DO(PreIncIndex)                                                      \
    _DO(PostIncVariable) _DO(PostIncMember) _DO(PostIncIndex)                                                   \
    _DO(PreDecVariable) _DO(PreDecMember) _DO(PreDecIndex)                                                      \
    _DO(PostDecVariable) _DO(PostDecMember) _DO(PostDecIndex)                                                   \
    _DO(GetVariable) _DO(GetMember) _DO(SetMember) _DO(GetIndex) _DO(SetIndex)                                  \
    _DO(Return) _DO(Break) _DO(Continue) _DO(Throw)                                                             \
    _DO(Quasiquote) _DO(Unquote)

typedef enum {
t_UNDEFINED=0,
#define _DO(NAME) t_##NAME,
DO_PROTOS()
#undef _DO
} proto_t;

#define SYMBOL_PAYLOAD proto_t prototype;

#include "object.c"

#include <setjmp.h>

enum jb_t {
    j_return = 1,
    j_break,
    j_continue,
    j_throw,
};

typedef struct jb_record
{
    sigjmp_buf        jb;
    oop               result;
    struct jb_record *next;
} jb_record;

jb_record *jbs= NULL;

jb_record *jbRecPush() {
    jb_record *newJbRec = memcheck(malloc(sizeof(jb_record)));
    newJbRec->result = null;
    newJbRec->next = jbs;
    jbs = newJbRec;
    return newJbRec;
}

jb_record *jbRecPop() {
    assert(jbs);
    jb_record *head = jbs;
    jbs = head->next;
    return head;
}


// this is the global scope
oop globals= 0;

#define DO_SYMBOLS()                                                                                            \
     DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(__default__) _DO(__arguments__)                               \
    _DO(name) _DO(body) _DO(param) _DO(key) _DO(value) _DO(condition) _DO(consequent) _DO(alternate)            \
    _DO(lhs) _DO(rhs) _DO(scope) _DO(args) _DO(expression) _DO(labels) _DO(statements) _DO(initialise)          \
    _DO(update) _DO(this) _DO(fixed) _DO(operator) _DO(map) _DO(func) _DO(__line__) _DO(__file__)

#define _DO(NAME) oop NAME##_symbol;
DO_SYMBOLS()
#undef _DO

#define _DO(NAME) oop NAME##_proto;
DO_PROTOS()
#undef _DO

int opt_v = 0;

typedef struct input_t
{
    oop             name;
    FILE           *file;
    struct input_t *next;
    int             lineNumber;
} input_t;

input_t *inputStack= NULL;

void inputStackPush(char *name) {
    FILE *file = stdin;
    if (NULL != name) {
        file= fopen(name, "rb");
        if (NULL == file) {
            perror(name);
            exit(1);
        }
    } else {
        name= "<stdin>";
    }
    input_t *input = memcheck(malloc(sizeof(input_t)));
    input->name= makeString(name);
    input->lineNumber= 1;
    input->file= file;
    input->next= inputStack;
    inputStack= input;
    return;
}

input_t *inputStackPop(void) {
    assert(inputStack);
    input_t *first= inputStack;
    inputStack= first->next;
    return first;
}

int isFalse(oop obj)
{
    return obj == null || (isInteger(obj) && (0 == getInteger(obj)));
}

int isTrue(oop obj)
{
    return !isFalse(obj);
}

oop newObject(oop proto)
{
    oop map = makeMap();
    map_set(map, __proto___symbol, proto);
    // set context (file and line) for runtime error msg
    map_set(map, __line___symbol, makeInteger(inputStack->lineNumber));
    map_set(map, __file___symbol, inputStack->name);
    return map;
}

void printObjectName(oop object)
{
    assert(is(Map, object));
    oop name = map_get(object, __name___symbol);
    if (name != null) {
        println(name);
        return;
    }

    oop proto = map_get(object, __proto___symbol);
    if (proto != null) {
        printObjectName(proto);
    } else {
        fprintf(stderr, "\nThis map has no name\n");
    }
}

// this always creates the key in "object"
oop newVariable(oop object, oop key, oop value)
{
    map_set(object, key, value);
    return value;
}

// this looks in object and everything in the __proto__ chain until it finds the key
oop getVariable(oop object, oop key)
{
    while (!map_hasKey(object, key)) {
        object = map_get(object, __proto___symbol);
        if (null == object) {
        printf("\nUndefined: ");
        println(key);
        exit(1);
            return null;
        }
    }
    return map_get(object, key);
}

// this follows the __proto__ chain until it finds the key, if it fails it behaves like newMember
oop setVariable(oop object, oop key, oop value)
{
    oop obj= object;
    while (!map_hasKey(obj, key)) {
        obj= map_get(obj, __proto___symbol);
        if (null == obj) {
            return map_set(object, key, value);
        }
    }
    return map_set(obj, key, value);
}

oop getMember(oop object, oop key)
{
    if (!map_hasKey(object, key)) {
        printf("\nUndefined: .");
        println(key);
        exit(1);
        return null;
    }
    return map_get(object, key);
}

oop newMap(oop value)
{
    oop map = newObject(Map_proto);
    map_set(map, value_symbol, value);
    return map;
}

oop newDeclaration(oop name, oop exp)
{
    oop declaration = newObject(Declaration_proto);
    map_set(declaration, lhs_symbol, name);
    map_set(declaration, rhs_symbol, exp);
    return declaration;
}

oop newIf(oop cond, oop cons, oop alt)
{
    oop obj = newObject(If_proto);
    map_set(obj, condition_symbol,  cond);
    map_set(obj, consequent_symbol, cons);
    map_set(obj, alternate_symbol,  alt);
    return obj;
}

oop newWhile(oop cond, oop body)
{
    oop obj = newObject(While_proto);
    map_set(obj, condition_symbol, cond);
    map_set(obj, body_symbol,      body);
    return obj;
}

oop newDo(oop body, oop cond)
{
    oop obj= newObject(Do_proto);
    map_set(obj, body_symbol,      body);
    map_set(obj, condition_symbol, cond);
    return obj;
}

oop newFor(oop init, oop cond, oop step, oop body)
{
    oop obj= newObject(For_proto);
    map_set(obj, initialise_symbol, init);
    map_set(obj, condition_symbol,  cond);
    map_set(obj, update_symbol,     step);
    map_set(obj, body_symbol,       body);
    return obj;
}

oop newSwitch(oop expression, oop labels, oop statements)
{
    oop obj= newObject(Switch_proto);
    map_set(obj, expression_symbol, expression);
    map_set(obj, labels_symbol,     labels);
    map_set(obj, statements_symbol, statements);
    return obj;
}

// take char *name or oop already interned?
oop newSymbol(oop name)
{
    oop symbol = newObject(Symbol_proto);
    // what is the less confusing, name or value? maybe another word like identifier?
    map_set(symbol, value_symbol, name);
    return symbol;
}

oop newInteger(oop value)
{
    oop integer = newObject(Integer_proto);
    map_set(integer, value_symbol, value);
    return integer;
}

int digitValue(int c)
{
    if (c < '0') return -1;
    if ('a' <= c && c <= 'z') c -= ('a' - 'A'); // tolower(c)
    if ('9' < c && c < 'A') return -1;
    if ('Z' < c) return -1;
    if (c >= 'A') c -= ('A' - 10); else c -= '0';
    return c;
}

int isradix(int r, int c)
{
    c= digitValue(c);
    return 0 <= c && c < r;
}

char *unescape(char *s)
{
    char *t= strdup(s);
    int in= 0, out= 0, c= 0;
    while (0 != (c= t[in++])) {
    if ('\\' == c && 0 != (c= t[in])) {
        ++in;
        switch (c) {
        case 'a': c= '\a'; break;
        case 'b': c= '\b'; break;
        case 'e': c= '\e'; break;
        case 'f': c= '\f'; break;
        case 'n': c= '\n'; break;
        case 'r': c= '\r'; break;
        case 't': c= '\t'; break;
        case 'v': c= '\v'; break;
        case '0'...'7': {
            c -= '0';
            if (isradix(8, t[in])) c= c * 8 + t[in++] - '0';
            if (isradix(8, t[in])) c= c * 8 + t[in++] - '0';
            break;
        }
        case 'x': {
            c= 0;
            if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
            if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
            break;
        }
        case 'u': {
            c= 0;
            if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
            if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
            if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
            if (isradix(16, t[in])) c= c * 16 + digitValue(t[in++]);
            break;
        }
        }
    }
    t[out++]= c;
    }
    t[out]= 0;
    return t;
}

oop newString(oop str)
{                                                       assert(is(String, str));
    oop string = newObject(String_proto);
    map_set(string, value_symbol, str);
    return string;
}

oop newPreIncrement(oop rhs)
{                                                       assert(is(Map, rhs));
    oop proto= map_get(rhs, __proto___symbol);          assert(null != proto);
    oop name=  map_get(proto, __name___symbol);         assert(null != name);
    proto_t type= get(name, Symbol, prototype);
    switch (type) {
        case t_GetVariable:     proto= PreIncVariable_proto;    break;
        case t_GetMember:       proto= PreIncMember_proto;      break;
        case t_GetIndex:        proto= PreIncIndex_proto;       break;
        default: {
            printf("\nNon-lvalue after ++: ");
            println(rhs);
            exit(1);
        }
    }
    map_set(rhs, __proto___symbol, proto);
    return rhs;
}

oop newPostIncrement(oop rhs)
{                                                       assert(is(Map, rhs));
    oop proto= map_get(rhs, __proto___symbol);          assert(null != proto);
    oop name=  map_get(proto, __name___symbol);         assert(null != name);
    proto_t type= get(name, Symbol, prototype);
    switch (type) {
        case t_GetVariable:     proto= PostIncVariable_proto;   break;
        case t_GetMember:       proto= PostIncMember_proto;     break;
        case t_GetIndex:        proto= PostIncIndex_proto;      break;
        default: {
            printf("\nNon-lvalue before ++: ");
            println(rhs);
            exit(1);
        }
    }
    map_set(rhs, __proto___symbol, proto);
    return rhs;
}

oop newPreDecrement(oop rhs)
{                                                       assert(is(Map, rhs));
    oop proto= map_get(rhs, __proto___symbol);          assert(null != proto);
    oop name=  map_get(proto, __name___symbol);         assert(null != name);
    proto_t type= get(name, Symbol, prototype);
    switch (type) {
        case t_GetVariable:     proto= PreDecVariable_proto;    break;
        case t_GetMember:       proto= PreDecMember_proto;      break;
        case t_GetIndex:        proto= PreDecIndex_proto;       break;
        default: {
            printf("\nNon-lvalue after ++: ");
            println(rhs);
            exit(1);
        }
    }
    map_set(rhs, __proto___symbol, proto);
    return rhs;
}

oop newPostDecrement(oop rhs)
{                                                       assert(is(Map, rhs));
    oop proto= map_get(rhs, __proto___symbol);          assert(null != proto);
    oop name=  map_get(proto, __name___symbol);         assert(null != name);
    proto_t type= get(name, Symbol, prototype);
    switch (type) {
        case t_GetVariable:     proto= PostDecVariable_proto;   break;
        case t_GetMember:       proto= PostDecMember_proto;     break;
        case t_GetIndex:        proto= PostDecIndex_proto;      break;
        default: {
            printf("\nNon-lvalue before ++: ");
            println(rhs);
            exit(1);
        }
    }
    map_set(rhs, __proto___symbol, proto);
    return rhs;
}

oop newUnary(oop proto, oop rhs)
{
    oop obj = newObject(proto);
    map_set(obj, rhs_symbol, rhs);
    return obj;
}

oop newBinary(oop proto, oop lhs, oop rhs)
{
    oop obj = newObject(proto);
    map_set(obj, lhs_symbol, lhs);
    map_set(obj, rhs_symbol, rhs);
    return obj;
}

oop newAssign(oop proto, oop lhs, oop operator, oop rhs)
{
    oop obj = newObject(proto);
    map_set(obj, lhs_symbol,      lhs);
    map_set(obj, operator_symbol, operator);
    map_set(obj, rhs_symbol,      rhs);
    return obj;
}

oop newSetMap(oop proto, oop map, oop key, oop operator, oop value)
{
    oop obj = newObject(proto);
    map_set(obj, map_symbol,       map);
    map_set(obj, key_symbol,       key);
    map_set(obj, operator_symbol, operator);
    map_set(obj, value_symbol,    value);
    return obj;
}

oop newGetMap(oop proto, oop map, oop key)
{
    oop obj = newObject(proto);
    map_set(obj, map_symbol, map);
    map_set(obj, key_symbol, key);
    return obj;
}

oop newGetVariable(oop name)
{
    oop id= newObject(GetVariable_proto);
    map_set(id, key_symbol, name);
    return id;
}

oop newFunc(oop name, oop param, oop body, oop fixed)
{
    oop func = newObject(Func_proto);
    map_set(func, name_symbol,  name);
    map_set(func, param_symbol, param);
    map_set(func, body_symbol,  body);
    map_set(func, fixed_symbol, fixed);
    return func;
}

oop apply(oop func, oop args);

oop getSyntaxId(int n, oop key)
{
    oop val = map_get(globals, key);
    if (!is(Function, val)) return null;
    oop fix = get(val, Function, fixed);
    if (!isInteger(fix)) return null;
    if (n != getInteger(fix)) return null;
    return val;
}

oop getSyntax(int n, oop func)
{
    if (map_get(func, __proto___symbol) != GetVariable_proto) return null;
    oop key = map_get(func, key_symbol);
    return getSyntaxId(n, key);
}

oop newCall(oop func, oop args)
{
    oop call = newObject(Call_proto);
    map_set(call, func_symbol, func);
    map_set(call, args_symbol, args);
    return call;
}

oop newInvoke(oop this, oop name, oop args)
{
    oop obj = newObject(Invoke_proto);
    map_set(obj, this_symbol, this);
    map_set(obj, name_symbol, name);
    map_set(obj, args_symbol, args);
    return obj;
}

oop newBlock(oop statements)
{
    oop obj = newObject(Block_proto);
    map_set(obj, statements_symbol, statements);
    return obj;
}

oop newReturn(oop exp)
{
    oop obj = newObject(Return_proto);
    map_set(obj, value_symbol, exp);
    return obj;
}

oop newBreak(void)
{
    oop obj = newObject(Break_proto);
    return obj;
}

oop newContinue(void)
{
    oop obj = newObject(Continue_proto);
    return obj;
}

oop fold(oop ast);

#define YY_INPUT(buf, result, max_size)        \
{                                              \
int yyc= getc(inputStack->file);               \
result= (EOF == yyc) ? 0 : (*(buf)= yyc, 1);   \
}

#define YYSTYPE oop

YYSTYPE yylval;

int errorLine= 1;

void syntaxError(char *text)
{
    fprintf(stderr, "\nSyntax error in %s near line %i:\n%s\n", get(inputStack->name, String, value), errorLine, text);
    exit(1);
}

oop eval(oop scope, oop ast);

struct _yycontext;

int yyparsefrom(int (*yystart)(struct _yycontext *yy));

%}

start   = - ( IMPORT s:STRING                                { yylval = null; inputStackPush(get(s, String, value)) }
            | e:stmt                                         { yylval = e }
            | !.                                             { yylval = 0 }
            | error
            )

error   =                                                    { errorLine= inputStack->lineNumber }
            eol* < (!eol .)* eol* (!eol .)* >                { syntaxError(yytext) }

stmt    =   e:exp SEMICOLON*                                 { $$ = e }
        |   s:block                                          { $$ = s }

block   = LCB  m:makeMap
              ( s:stmt                                       { map_append(m, s) }
              ) *
          RCB                                                { $$ = newBlock(m) }

exp     =   VAR l:ident                        ASSIGN e:exp  { $$ = newDeclaration(l, e) }
        |   VAR l:IDENT                                      { $$ = newDeclaration(l, null) }
        |   FUN l:IDENT    p:paramList         e:block       { $$ = newFunc(l, p, e, null) }
        |   FUN            p:paramList         e:block       { $$ = newFunc(null, p, e, null) }
        |   SYNTAX l:IDENT p:paramList q:IDENT e:block       { $$ = (map_append(p, q), newFunc(l,    p, e, makeInteger(2))) }
        |   SYNTAX         p:paramList q:IDENT e:block       { $$ = (map_append(p, q), newFunc(null, p, e, makeInteger(2))) }
        |   SYNTAX l:IDENT p:paramList         e:block       { $$ =                    newFunc(l,    p, e, makeInteger(1))  }
        |   SYNTAX         p:paramList         e:block       { $$ =                    newFunc(null, p, e, makeInteger(1))  }
        |   IF        LPAREN c:exp RPAREN t:stmt ELSE f:stmt { $$ = newIf(c, t, f   ) }
        |   IF        LPAREN c:exp RPAREN t:stmt             { $$ = newIf(c, t, null) }
        |   WHILE LPAREN c:exp RPAREN s:stmt                 { $$ = newWhile(c, s) }
        |   DO s:stmt WHILE LPAREN c:exp RPAREN              { $$ = newDo(s, c) }
        |   FOR LPAREN i:stmt c:stmt u:exp RPAREN s:stmt     { $$ = newFor(i, c, u, s) }
        |   s:switch                                         { $$ = s }
        |   RETURN                                   e:exp   { $$ = newReturn(e) }
        |   RETURN                                           { $$ = newReturn(null) }
        |   BREAK                                            { $$ = newBreak() }
        |   CONTINUE                                         { $$ = newContinue() }
        |   THROW                                    e:exp   { $$ = newUnary(Throw_proto, e) }
        |   l:IDENT                       o:assignOp e:exp   { $$ = newAssign(Assign_proto,    l,    o, e) }
        |   l:postfix DOT   i:IDENT       o:assignOp e:exp   { $$ = newSetMap(SetMember_proto, l, i, o, e) }
        |   l:postfix LBRAC i:exp   RBRAC o:assignOp e:exp   { $$ = newSetMap(SetIndex_proto,  l, i, o, e) }
        |   l:syntax2 a:argumentList s:block                 { $$ = (map_append(a, s), apply(l, a)) }
        |   c:cond                                           { $$ = c }

ident   =   l:IDENT                                          { $$ = l }
        |   AT         n:prefix                              { $$ = newUnary(Unquote_proto, n) }

syntax2  = < [a-zA-Z_][a-zA-Z0-9_]* >
           &{ null != getSyntaxId(2, intern(yytext)) }   -   { $$ = getSyntaxId(2, intern(yytext)) }

assignOp = ASSIGN                 { $$= null }
         | ASSIGNADD              { $$= Add_symbol }
         | ASSIGNSUB              { $$= Sub_symbol }
         | ASSIGNMUL              { $$= Mul_symbol }
         | ASSIGNDIV              { $$= Div_symbol }
         | ASSIGNMOD              { $$= Mod_symbol }
         | ASSIGNBITOR            { $$= Bitor_symbol }
         | ASSIGNBITXOR           { $$= Bitxor_symbol }
         | ASSIGNBITAND           { $$= Bitand_symbol }
         | ASSIGNSHLEFT           { $$= Shleft_symbol }
         | ASSIGNSHRIGHT          { $$= Shright_symbol }

switch  = SWITCH LPAREN e:exp RPAREN
          LCB statements:makeMap labels:makeMap
              ( CASE    l:exp  COLON                         { map_set(labels, fold(l), makeInteger(map_size(statements))) }
              | DEFAULT        COLON                         { map_set(labels, __default___symbol, makeInteger(map_size(statements))) }
              |         s:stmt                               { map_append(statements, s) }
              )*
          RCB                                                { $$= newSwitch(e, labels, statements) }

cond    =   c:logor QUERY t:exp COLON f:cond                 { $$ = newIf(c, t, f) }
        |   logor

logor   =   l:logand
        ( LOGOR r:logand        { l = newBinary(Logor_proto,        l, r) }
        )*                { $$ = l }

logand  =   l:bitor
        ( LOGAND r:bitor        { l = newBinary(Logand_proto,       l, r) }
        )*                { $$ = l }

bitor   =   l:bitxor
        ( BITOR r:bitxor        { l = newBinary(Bitor_proto,       l, r) }
        )*                { $$ = l }

bitxor  =   l:bitand
        ( BITXOR r:bitand        { l = newBinary(Bitxor_proto,       l, r) }
        )*                { $$ = l }

bitand  =   l:eq
        ( BITAND r:eq            { l = newBinary(Bitand_proto,       l, r) }
        )*                { $$ = l }

eq      =   l:ineq
            ( EQUAL r:ineq              { l = newBinary(Equal_proto,      l, r) }
            | NOTEQ r:ineq              { l = newBinary(Noteq_proto,      l, r) }
            )*                          { $$ = l }

ineq    =   l:shift
            ( LESS      r:shift         { l = newBinary(Less_proto,      l, r) }
            | LESSEQ    r:shift         { l = newBinary(Lesseq_proto,    l, r) }
            | GREATEREQ r:shift         { l = newBinary(Greatereq_proto, l, r) }
            | GREATER   r:shift         { l = newBinary(Greater_proto,   l, r) }
            )*                          { $$ = l }

shift   =   l:sum
            ( SHLEFT  r:sum             { l = newBinary(Shleft_proto,  l, r) }
            | SHRIGHT r:sum             { l = newBinary(Shright_proto, l, r) }
            )*                          { $$ = l }

sum     =   l:prod
            ( PLUS  r:prod            { l = newBinary(Add_proto, l, r) }
            | MINUS r:prod            { l = newBinary(Sub_proto, l, r) }
            )*                          { $$ = l }

prod    =   l:prefix
            ( MULTI     r:prefix        { l = newBinary(Mul_proto, l, r) }
            | DIVIDE    r:prefix        { l = newBinary(Div_proto, l, r) }
            | MODULO    r:prefix        { l = newBinary(Mod_proto, l, r) }
            )*                          { $$ = l }

prefix  =   PLUS       n:prefix         { $$= n }
        |   MINUS      n:prefix         { $$= newUnary(Neg_proto, n) }
        |   TILDE      n:prefix         { $$= newUnary(Com_proto, n) }
        |   PLING      n:prefix         { $$= newUnary(Not_proto, n) }
        |   PLUSPLUS   n:prefix         { $$= newPreIncrement(n) }
        |   MINUSMINUS n:prefix         { $$= newPreDecrement(n) }
        |   BACKTICK   n:prefix         { $$ = newUnary(Quasiquote_proto, n) }
        |   AT         n:prefix         { $$ = newUnary(Unquote_proto, n) }
        |              n:postfix        { $$= n }

postfix =   i:value ( DOT    s:IDENT        a:argumentList      { i = newInvoke(i, s, a) }
                    | DOT    s:IDENT        !assignOp           { i = newGetMap(GetMember_proto, i, s) }
                    | LBRAC  p:exp   RBRAC  !assignOp           { i = newGetMap(GetIndex_proto, i, p) }
                    | a:argumentList                            { i = (null != getSyntax(1, i)) ? apply(getSyntax(1, i), a) : newCall(i, a) }
                    | PLUSPLUS                                  { i = newPostIncrement(i) }
                    | MINUSMINUS                                { i = newPostDecrement(i) }
                    ) *                                         { $$ = i }

paramList    = LPAREN  m:makeMap
                ( i:IDENT           { map_append(m, i) }
                ( COMMA i:IDENT     { map_append(m, i) }
                ) *
                ) ?
                RPAREN              { $$ = m }

argumentList = LPAREN  m:makeMap
                ( e:exp             { map_append(m, e) }
                ( COMMA e:exp       { map_append(m, e) }
                ) *
                ) ?
                RPAREN              { $$ = m }

value   =   n:NUMBER                { $$ = newInteger(n) }
        |   s:string                { $$ = newString(s) }
        |   s:symbol                { $$ = s }
        |   m:map                   { $$ = newMap(m) }
        |   NULL                    { $$ = null }
        |   i:IDENT                 { $$ = newGetVariable(i) }
        |   LPAREN i:stmt  RPAREN   { $$ = i }

string  =   s:STRING -              { $$ = s }

STRING  =   DQUOTE < (!DQUOTE char)* > DQUOTE     { $$ = makeString(unescape(yytext)) }

char    =   '\\' . | .

symbol  =   HASH    ( i:IDENT                   { $$ = newSymbol(i) }
                    | i:string                  { $$ = newSymbol(intern(get(i, String, value))) }
                    )

map     =   LCB   m:makeMap
            (           k:key COLON v:exp       { map_set(m, k, v) }
            (     COMMA k:key COLON v:exp       { map_set(m, k, v) }
            ) *
            ) ?
            RCB                                 { $$ = m }
        |   LBRAC m:makeMap
            (                         v:exp     { map_append(m, v) }
            (     COMMA               v:exp     { map_append(m, v) }
            ) *
            ) ?
        RBRAC                               { $$ = m }

makeMap = { $$ = makeMap() }

key     = IDENT | NUMBER

-       =  (blank | comment)*

blank   =  space | eol
space   =  [ \t]
eol     =  ( "\n""\r"*
           | "\r""\n"*
           )                      { inputStack->lineNumber++ }

comment =  "//"  ( ![\n\r] . )*
        |  "/*"  ( !"*/"   . )* "*/"

keyword = FUN | SYNTAX | VAR | SWITCH | CASE | DEFAULT | DO | FOR | WHILE | IF | ELSE | NULL | RETURN | BREAK | CONTINUE | THROW

IDENT   =    !keyword < [a-zA-Z_][a-zA-Z0-9_]* >   -   { $$ = intern(yytext) }

NUMBER  =    '0b' < [01]+        >                 -   { $$ = makeInteger(strtol(yytext, 0,  2)) }
        |    '0x' < [0-9a-fA-F]+ >                 -   { $$ = makeInteger(strtol(yytext, 0, 16)) }
        |    '0'  < [0-7]+       >                 -   { $$ = makeInteger(strtol(yytext, 0,  8)) }
        |         < [0-9]+       >                 -   { $$ = makeInteger(strtol(yytext, 0, 10)) }
        |    SQUOTE < (!SQUOTE char)  > SQUOTE     -   { $$ = makeInteger(unescape(yytext)[0]) }

FUN     =    'fun'      ![a-zA-Z0-9_] -
SYNTAX  =    'syntax'   ![a-zA-Z0-9_] -
VAR     =    'var'      ![a-zA-Z0-9_] -
SWITCH  =    'switch'   ![a-zA-Z0-9_] -
CASE    =    'case'     ![a-zA-Z0-9_] -
DEFAULT =    'default'  ![a-zA-Z0-9_] -
DO      =    'do'       ![a-zA-Z0-9_] -
FOR     =    'for'      ![a-zA-Z0-9_] -
WHILE   =    'while'    ![a-zA-Z0-9_] -
IF      =    'if'       ![a-zA-Z0-9_] -
ELSE    =    'else'     ![a-zA-Z0-9_] -
NULL    =    'null'     ![a-zA-Z0-9_] -
RETURN  =    'return'   ![a-zA-Z0-9_] -
BREAK   =    'break'    ![a-zA-Z0-9_] -
CONTINUE =   'continue' ![a-zA-Z0-9_] -
THROW   =    'throw'    ![a-zA-Z0-9_] -
IMPORT  =    'import'   ![a-zA-Z0-9_] -
HASH    =    '#'                      -
LOGOR   =    '||'                     -
LOGAND  =    '&&'                     -
BITOR   =    '|'        ![|=]         -
BITXOR  =    '^'        ![=]          -
BITAND  =    '&'        ![&=]         -
EQUAL   =    '=='                     -
NOTEQ   =    '!='                     -
LESS    =    '<'        ![<=]         -
LESSEQ  =    '<='                     -
GREATEREQ =  '>='                     -
GREATER =    '>'        ![>=]         -
SHLEFT  =    '<<'       ![=]          -
SHRIGHT =    '>>'       ![=]          -
PLUS    =    '+'        ![+=]         -
MINUS   =    '-'        ![-=]         -
PLUSPLUS =   '++'                     -
MINUSMINUS = '--'                     -
TILDE   =    '~'                      -
PLING   =    '!'        ![=]          -
MULTI   =    '*'        ![=]          -
DIVIDE  =    '/'        ![/=]         -
MODULO  =    '%'        ![=]          -
ASSIGN  =    '='        ![=]          -
ASSIGNADD =  '+='                     -
ASSIGNSUB =  '-='                     -
ASSIGNMUL =  '*='                     -
ASSIGNDIV =  '/='                     -
ASSIGNMOD =  '%='                     -
ASSIGNBITOR ='|='                     -
ASSIGNBITXOR='^='                     -
ASSIGNBITAND='&='                     -
ASSIGNSHLEFT='<<='                    -
ASSIGNSHRIGHT='>>='                   -
QUERY   =    '?'                      -
COLON   =    ':'                      -
SEMICOLON =  ';'                      -
COMMA   =    ','                      -
DOT     =    '.'                      -
BACKTICK=    '`'                      -
AT      =    '@'                      -
LCB     =    '{'                      -
RCB     =    '}'                      -
LBRAC   =    '['                      -
RBRAC   =    ']'                      -
LPAREN  =    '('                      -
RPAREN  =    ')'                      -
DQUOTE  =    '"'
SQUOTE  =    "'"

%%
;


oop map_zip(oop keys, oop values)
{
    assert(is(Map, keys));
    assert(is(Map, values));
    oop map= makeMap();
    size_t sk= map_size(keys), sv= map_size(values);
    if (sk < sv) sk= sv;
    for (size_t i= 0;  i < sk;  ++i) {
        oop key   = i < sk && map_hasIntegerKey(keys,   i) ? get(keys,   Map, elements)[i].value : makeInteger(i);
        oop value = i < sv && map_hasIntegerKey(values, i) ? get(values, Map, elements)[i].value : null;
        map_set(map, key, value);
    }
    return map;
}

oop clone(oop obj)
{
    switch(getType(obj)) {
        case Undefined:
        case Integer:
        case Function:
        case Symbol:
            return obj;
        case String:
            return makeString(get(obj, String, value));
        case Map: {
            struct Pair *elements= malloc(sizeof(struct Pair) * get(obj, Map, capacity));
            memcpy(elements, get(obj, Map, elements), sizeof(struct Pair) * get(obj, Map, capacity));
            oop map= malloc(sizeof(*obj));
            memcpy(map, obj, sizeof(*obj));
            set(map, Map, elements, elements);
            return map;
        }
    }
    return obj;
}

void runtimeError(oop ast, char *msg)
{
    char *fileName= get(map_get(ast, __file___symbol), String, value);
    fprintf(stderr, "\nRuntime error in %s near line %i:\nError: %s\n", fileName, getInteger(map_get(ast, __line___symbol)), msg);
    exit(1);
}

oop addOperation(oop ast, oop lhs, oop rhs)
{
    if (getType(lhs) == Integer && getType(rhs) == Integer) {
        return makeInteger(getInteger(lhs) + getInteger(rhs));
    } else if (getType(lhs) == String && getType(rhs) == String) {
        return string_concat(lhs, rhs);
    } else {
        runtimeError(ast, "addition between two incompatible types");
        assert(0); // to prevent: control may reach end of non-void function
    }
}

oop mulOperation(oop ast, oop lhs, oop rhs)
{
    if (getType(lhs) == Integer && getType(rhs) == Integer) {
        return makeInteger(getInteger(lhs) * getInteger(rhs));
    } else if (getType(lhs) == String && getType(rhs) == Integer) {
        return string_mul(lhs, rhs);
    } else if (getType(lhs) == Integer && getType(rhs) == String) {
        return string_mul(rhs, lhs);
    } else {
        runtimeError(ast, "multiplication between two incompatible types");
        assert(0);
    }
}

oop expandUnquotes(oop scope, oop obj)
{
    obj = clone(obj);
    if (!is(Map, obj)) {
        return obj;
    }
    if (map_get(obj, __proto___symbol) == Unquote_proto) {
        return eval(scope, map_get(obj, rhs_symbol));
    }
    for (size_t i= 0;  i < map_size(obj);  ++i) {
        struct Pair *pair= &get(obj, Map, elements)[i];
        if (__proto___symbol != pair->key) {
            pair->value= expandUnquotes(scope, pair->value);
        }
    }
    return obj;
}

oop fold(oop ast)
{
    if (is(Map, ast)) {
    oop proto= map_get(ast, __proto___symbol);
    if (null != proto) {
        proto_t proto_number= get(map_get(proto, __name___symbol), Symbol, prototype);
        switch (proto_number) {
        case t_Integer:
        case t_String:
        case t_Symbol: {
            return map_get(ast, value_symbol);
        }
        case t_Logor: {
            oop lhs= map_get(ast, lhs_symbol);
            oop rhs= map_get(ast, rhs_symbol);
            if (isTrue(fold(lhs))) return makeInteger(1);
            if (isTrue(fold(rhs))) return makeInteger(1);
            return makeInteger(0);
        }
        case t_Logand: {
            oop lhs= map_get(ast, lhs_symbol);
            oop rhs= map_get(ast, rhs_symbol);
            if (isFalse(fold(lhs))) return makeInteger(0);
            if (isFalse(fold(rhs))) return makeInteger(0);
            return makeInteger(1);
        }
#             define BINARY(NAME, OPERATOR)                                 \
        case t_##NAME: {                                                    \
            oop lhs= fold(map_get(ast, lhs_symbol));                        \
            oop rhs= fold(map_get(ast, rhs_symbol));                        \
            return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs));   \
        }
        BINARY(Bitor,     | );
        BINARY(Bitxor,    ^ );
        BINARY(Bitand,    & );
        BINARY(Equal,     ==);
        BINARY(Noteq,     !=);
        BINARY(Less,      < );
        BINARY(Lesseq,    <=);
        BINARY(Greatereq, >=);
        BINARY(Greater,   > );
        BINARY(Shleft,    <<);
        BINARY(Shright,   >>);
        BINARY(Add,       + );
        BINARY(Sub,       - );
        BINARY(Mul,       * );
        BINARY(Div,       / );
        BINARY(Mod,       % );
#             undef BINARY
#             define UNARY(NAME, OPERATOR)                  \
        case t_##NAME: {                                    \
            oop rhs = fold(map_get(ast, rhs_symbol));       \
            return makeInteger(OPERATOR getInteger(rhs));   \
        }
        UNARY(Not, !);
        UNARY(Neg, -);
        UNARY(Com, ~);
#             undef UNARY
            default:
                break;
        }
    }
    }
    printf("illegal value in constant expression: ");
    println(ast);
    assert(0);
    return null;
}

oop applyOperator(oop ast, oop op, oop lhs, oop rhs)
{
    if (null != op) {                                                           assert(is(Symbol, op));
    switch (get(op, Symbol, prototype)) {
        case t_Add:     return addOperation(ast, lhs, rhs);
        case t_Sub:     return makeInteger(getInteger(lhs)  - getInteger(rhs));
        case t_Mul:     return mulOperation(ast, lhs, rhs);
        case t_Div:     return makeInteger(getInteger(lhs)  / getInteger(rhs));
        case t_Mod:     return makeInteger(getInteger(lhs)  % getInteger(rhs));
        case t_Bitor:   return makeInteger(getInteger(lhs)  | getInteger(rhs));
        case t_Bitxor:  return makeInteger(getInteger(lhs)  ^ getInteger(rhs));
        case t_Bitand:  return makeInteger(getInteger(lhs)  & getInteger(rhs));
        case t_Shleft:  return makeInteger(getInteger(lhs) << getInteger(rhs));
        case t_Shright: return makeInteger(getInteger(lhs) >> getInteger(rhs));
        default: {
            fprintf(stderr, "\nIllegal operator %i\n", get(op, Symbol, prototype));
            exit(1);
        }
    }
    }
    return rhs;
}

oop evalArgs(oop scope, oop args);

oop eval(oop scope, oop ast)
{
    if (opt_v > 3) {
        printf("EVAL: ");
        println(ast);
    }

    switch(getType(ast)) {
    case Undefined:
    case Integer:
    case String:
    case Function:
        return ast;
    case Symbol:
        return getVariable(scope, ast);
    case Map:
        break;
    }

    assert(is(Map, ast));

    oop proto = map_get(ast, __proto___symbol);
    if (proto == null) {
        return ast;
    }
    // proto_number is the enum version of the proto symbol
    proto_t proto_number = get(map_get(proto, __name___symbol), Symbol, prototype);
    switch (proto_number) {
    case t_UNDEFINED: {
        assert(0);
        return 0;
    }
    case t_Map: {
        oop map= clone(map_get(ast, value_symbol));
        for (size_t i= 0;  i < map_size(map);  ++i) {
            struct Pair *pair= &get(map, Map, elements)[i];
            pair->value= eval(scope, pair->value);
        }
        return map;
    }
    case t_Quasiquote: {
        oop obj = map_get(ast, rhs_symbol);
        return expandUnquotes(scope, obj);
    }
    case t_Unquote: {
        runtimeError(ast, "@ outside of `");
    }
    case t_Declaration: {
        oop lhs = map_get(ast, lhs_symbol);
        oop rhs = eval(scope, map_get(ast, rhs_symbol));
        return newVariable(scope, lhs, rhs);
    }
    case t_If: {
        oop condition  = map_get(ast, condition_symbol );
        oop consequent = map_get(ast, consequent_symbol);
        oop alternate  = map_get(ast, alternate_symbol );
    return eval(scope, isTrue(eval(scope, condition)) ? consequent : alternate);
    }
    case t_While: {
        oop condition = map_get(ast, condition_symbol );
        oop body      = map_get(ast, body_symbol);
        oop result    = null;

        jbRecPush();
        int jbt = sigsetjmp(jbs->jb, 0);
        switch (jbt) {
            case j_return:
            case j_throw: {
                oop result = jbs->result;
                jbRecPop();
                assert(jbs);
                jbs->result = result;
                siglongjmp(jbs->jb, jbt);
                assert(0);
            }
            case j_break: {
                jbRecPop();
                return null;
            }
            case j_continue: {
                break;
            }
        }

        while (isTrue(eval(scope, condition))) result= eval(scope, body);
        jbRecPop();
        return result;
    }
    case t_Do: {
        oop body      = map_get(ast, body_symbol);
        oop condition = map_get(ast, condition_symbol );
        oop result    = null;

        jbRecPush();
        int jbt = sigsetjmp(jbs->jb, 0);
        switch (jbt) {
            case j_return:
            case j_throw: {
                oop result = jbs->result;
                jbRecPop();
                assert(jbs);
                jbs->result = result;
                siglongjmp(jbs->jb, jbt);
                assert(0);
            }
            case j_break: {
                jbRecPop();
                return null;
            }
            case j_continue: {
                goto restart_do;
            }
        }

        do {
            result= eval(scope, body);
        restart_do:;
        } while (isTrue(eval(scope, condition)));
        jbRecPop();
        return result;
    }
    case t_For: {
        oop initialise = map_get(ast, initialise_symbol );
        oop condition  = map_get(ast, condition_symbol );
        oop update     = map_get(ast, update_symbol );
        oop body       = map_get(ast, body_symbol);
        oop result     = null;
        oop localScope = newObject(scope);

        jbRecPush();
        int jbt = sigsetjmp(jbs->jb, 0);
        switch (jbt) {
            case j_return:
            case j_throw: {
                oop result = jbs->result;
                jbRecPop();
                assert(jbs);
                jbs->result = result;
                siglongjmp(jbs->jb, jbt);
                assert(0);
            }
            case j_break: {
                jbRecPop();
                return null;
            }
            case j_continue: {
                goto restart_for;
            }
        }

        for (eval(localScope, initialise);  isTrue(eval(localScope, condition));  eval(localScope, update)) {
            result= eval(localScope, body);
        restart_for:;
        }
        jbRecPop();
        return result;
    }
    case t_Switch: {
        oop expression = map_get(ast, expression_symbol );
        oop labels     = map_get(ast, labels_symbol );
        oop statements = map_get(ast, statements_symbol );
        oop result     = eval(scope, expression);
        oop label      = map_get(labels, result);
        if (null == label) label= map_get(labels, __default___symbol);
        if (null == label) return result;
        assert(isInteger(label));
        int limit= map_size(statements);

        jbRecPush();
        int jbt = sigsetjmp(jbs->jb, 0);
        switch (jbt) {
            case j_return:
            case j_throw: {
                oop result = jbs->result;
                jbRecPop();
                assert(jbs);
                jbs->result = result;
                siglongjmp(jbs->jb, jbt);
                assert(0);
            }
            case j_break: {
                jbRecPop();
                return null;
            }
            case j_continue: {
                jbRecPop();
                assert(jbs);
                siglongjmp(jbs->jb, j_continue);
                assert(0);
            }
        }

        for (int i= getInteger(label);  i < limit;  ++i) {
            assert(map_hasIntegerKey(statements, i));
            result= eval(scope, get(statements, Map, elements)[i].value);
        }
        jbRecPop();
        return result;
    }
    case t_Assign: {
        oop lhs = map_get(ast, lhs_symbol);
        oop op  = map_get(ast, operator_symbol);
        oop rhs = eval(scope, map_get(ast, rhs_symbol));
        if (null != op) rhs= applyOperator(ast, op, getVariable(scope, lhs), rhs);
        setVariable(scope, lhs, rhs);
        if (is(Function, rhs) && null == get(rhs, Function, name)) {
            set(rhs, Function, name, lhs);
        }
        return rhs;
    }
    case t_Func: {
        oop name  = map_get(ast, name_symbol);
        oop param = map_get(ast, param_symbol);
        oop body  = map_get(ast, body_symbol);
        oop fixed = map_get(ast, fixed_symbol);
        oop func  = makeFunction(NULL, name, param, body, scope, fixed);
        if (opt_v > 4) {
            printf("funcscope: ");
            println(scope);
            printf("globalScope: ");
            println(scope);
        }
        if (name != null) newVariable(scope, name, func);
        return func;
    }
    case t_Call: {
        oop func = eval(scope, map_get(ast, func_symbol));
        if (!is(Function, func)) {
            // TODO better error printing
            // Please search for ISSUE1 in parse.leg
            printf("cannot call ");
            println(func);
            exit(1);
        }

        oop args = map_get(ast, args_symbol);
        if (isFalse(get(func, Function, fixed))) {
            args = evalArgs(scope, args);
        }
        if (get(func, Function, primitive) == NULL) {
            oop param = get(func, Function, param);
            oop localScope = map_zip(param, args);
            map_set(localScope, __arguments___symbol, args);
            map_set(localScope, __proto___symbol, get(func, Function, parentScope));
            if (opt_v > 4) {
                printf("parentScope: ");
                println(get(func, Function, parentScope));
                printf("localScope: ");
                println(localScope);
            }

            jbRecPush();
            int jbt = sigsetjmp(jbs->jb, 0);
            switch (jbt) {
                case j_return: {
                    oop result = jbs->result;
                    jbRecPop();
                    return result;
                }
                case j_break: {
                    runtimeError(ast, "break outside of a loop");
                }
                case j_continue: {
                    runtimeError(ast, "continue outside of a loop");
                }
                case j_throw: {
                    oop res= jbs->result;
                    jbRecPop();
                    jbs->result= res;
                    siglongjmp(jbs->jb, j_throw);
                }
            }

            oop result = eval(localScope, get(func, Function, body));
            jbRecPop();
            return result;
        }
        return get(func, Function, primitive)(args);
    }
    case t_Invoke: {
        // this is what differs from t_call
        oop this = eval(scope, map_get(ast, this_symbol));
        oop func = getVariable(this, map_get(ast, name_symbol));
        if (!is(Function, func)) {
            printf("cannot invoke ");
            println(func);
            exit(1);
        }

        oop args = evalArgs(scope, map_get(ast, args_symbol));
        if (NULL != get(func, Function, primitive)) {
            return get(func, Function, primitive)(args);
        }
        oop param = get(func, Function, param);
        oop localScope = map_zip(param, args);
        // and set this in the local scope
        map_set(localScope, this_symbol, this);
        map_set(localScope, __arguments___symbol, args);
        map_set(localScope, __proto___symbol, get(func, Function, parentScope));
        if (opt_v > 4) {
            printf("parentScope: ");
            println(get(func, Function, parentScope));
            printf("localScope: ");
            println(localScope);
        }

        jbRecPush();
        int jbt = sigsetjmp(jbs->jb, 0);
        switch (jbt) {
            case j_return: {
                oop result = jbs->result;
                jbRecPop();
                return result;
            }
            case j_break: {
                runtimeError(ast, "break outside of a loop");
            }
            case j_continue: {
                runtimeError(ast, "continue outside of a loop");
            }
            case j_throw: {
                oop res= jbs->result;
                jbRecPop();
                jbs->result= res;
                siglongjmp(jbs->jb, j_throw);
            }
        }

        oop result = eval(localScope, get(func, Function, body));
        jbRecPop();
        return result;
    }

    case t_Return: {
        assert(jbs);
        jbs->result = eval(scope, map_get(ast, value_symbol));
        siglongjmp(jbs->jb, j_return);
    }
    case t_Break: {
        assert(jbs);
        siglongjmp(jbs->jb, j_break);
    }
    case t_Continue: {
        assert(jbs);
        siglongjmp(jbs->jb, j_continue);
    }
    case t_Throw: {
        assert(jbs);
        jbs->result = eval(scope, map_get(ast, rhs_symbol));
        siglongjmp(jbs->jb, j_throw);
    }
    case t_Block: {
        oop statements = map_get(ast, statements_symbol);
        int i = 0;
        oop index;
        oop statement, res;
        oop localScope = newObject(scope);
        while ((index = makeInteger(i)), map_hasKey(statements, index)) {
            statement = map_get(statements, index);
            res = eval(localScope, statement);
            i++;
        }
        return res;
    }
    case t_GetVariable: {
        return getVariable(scope, map_get(ast, key_symbol));
    }
    case t_GetMember: {
        oop map = eval(scope, map_get(ast, map_symbol));
        oop key = map_get(ast, key_symbol);
        return getVariable(map, key);
    }
    case t_SetMember: {
        oop map = eval(scope, map_get(ast, map_symbol));
        oop key = map_get(ast, key_symbol);
        oop op  = map_get(ast, operator_symbol);
        oop value = eval(scope, map_get(ast, value_symbol));
        if (null != op) value= applyOperator(ast, op, getMember(map, key), value);
        if (is(Function, value) && null == get(value, Function, name)) {
            set(value, Function, name, key);
        }
        return map_set(map, key, value);
    }
    case t_GetIndex: {
        oop map = eval(scope, map_get(ast, map_symbol));
        oop key = eval(scope, map_get(ast, key_symbol));
        switch (getType(map)) {
            case String:
                if (getInteger(key) >= get(map, String, size)) {
                    runtimeError(ast, "GetIndex out of range on String");
                }
                return makeInteger(unescape(get(map, String, value))[getInteger(key)]);
            case Map:
                return map_get(map, key);
            default:
                runtimeError(ast, "GetIndex on non Map or String");
        }
    }
    case t_SetIndex: {
        oop map = eval(scope, map_get(ast, map_symbol));
        oop key = eval(scope, map_get(ast, key_symbol));
        oop op  = map_get(ast, operator_symbol);
        oop value = eval(scope, map_get(ast, value_symbol));
        switch (getType(map)) {
            case String:
                if (getInteger(key) >= get(map, String, size)) {
                    runtimeError(ast, "SetIndex out of range on String");
                }
                get(map, String, value)[getInteger(key)] = getInteger(value);
                return value;
            case Map:
                if (null != op) value= applyOperator(ast, op, map_get(map, key), value);
                return map_set(map, key, value);
            default:
                runtimeError(ast, "SetIndex on non Map or String");
        }

    }
    case t_Symbol:
    case t_Integer:
    case t_String: {
        return map_get(ast, value_symbol);
    }
    case t_Logor: {
        oop lhs = map_get(ast, lhs_symbol);
        oop rhs = map_get(ast, rhs_symbol);
        if (isTrue(eval(scope, lhs))) return makeInteger(1);
        if (isTrue(eval(scope, rhs))) return makeInteger(1);
        return makeInteger(0);
    }
    case t_Logand: {
        oop lhs = map_get(ast, lhs_symbol);
        oop rhs = map_get(ast, rhs_symbol);
        if (isFalse(eval(scope, lhs))) return makeInteger(0);
        if (isFalse(eval(scope, rhs))) return makeInteger(0);
        return makeInteger(1);
    }
# define BINARY(NAME, OPERATOR)                                         \
    case t_##NAME: {                                                    \
        oop lhs = eval(scope, map_get(ast, lhs_symbol));                \
        oop rhs = eval(scope, map_get(ast, rhs_symbol));                \
        return makeInteger(getInteger(lhs) OPERATOR getInteger(rhs));   \
    }
    BINARY(Bitor,     | );
    BINARY(Bitxor,    ^ );
    BINARY(Bitand,    & );
    BINARY(Equal,     ==);
    BINARY(Noteq,     !=);
    BINARY(Less,      < );
    BINARY(Lesseq,    <=);
    BINARY(Greatereq, >=);
    BINARY(Greater,   > );
    BINARY(Shleft,    <<);
    BINARY(Shright,   >>);
//  BINARY(Add,       + );
    case t_Add: {
        oop lhs = eval(scope, map_get(ast, lhs_symbol));
        oop rhs = eval(scope, map_get(ast, rhs_symbol));
        return addOperation(ast, lhs, rhs);
    }
    BINARY(Sub,       - );
//  BINARY(Mul,       * );
    case t_Mul: {
        oop lhs = eval(scope, map_get(ast, lhs_symbol));
        oop rhs = eval(scope, map_get(ast, rhs_symbol));
        return mulOperation(ast, lhs, rhs);
    }
    BINARY(Div,       / );
    BINARY(Mod,       % );
# undef BINARY
    case t_Not: {
        oop rhs = eval(scope, map_get(ast, rhs_symbol));
        return makeInteger(isFalse(rhs));
    }
# define UNARY(NAME, OPERATOR)                              \
    case t_##NAME: {                                        \
        oop rhs = eval(scope, map_get(ast, rhs_symbol));    \
        return makeInteger(OPERATOR getInteger(rhs));       \
    }
    UNARY(Neg, -);
    UNARY(Com, ~);
# undef UNARY
    case t_PreIncVariable: {
        oop key= map_get(ast, key_symbol);
        oop val= getVariable(scope, key);
        val= makeInteger(getInteger(val) + 1);
        return setVariable(scope, key, val);
    }
    case t_PreDecVariable: {
        oop key= map_get(ast, key_symbol);
        oop val= getVariable(scope, key);
        val= makeInteger(getInteger(val) - 1);
        return setVariable(scope, key, val);
    }
    case t_PreIncMember: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= map_get(ast, key_symbol);
        oop val= map_get(map, key);
        val= makeInteger(getInteger(val) + 1);
        return map_set(map, key, val);
    }
    case t_PreDecMember: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= map_get(ast, key_symbol);
        oop val= map_get(map, key);
        val= makeInteger(getInteger(val) - 1);
        return map_set(map, key, val);
    }
    case t_PreIncIndex: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= eval(scope, map_get(ast, key_symbol));
        oop val= map_get(map, key);
        val= makeInteger(getInteger(val) + 1);
        return map_set(map, key, val);
    }
    case t_PreDecIndex: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= eval(scope, map_get(ast, key_symbol));
        oop val= map_get(map, key);
        val= makeInteger(getInteger(val) - 1);
        return map_set(map, key, val);
    }
    case t_PostIncVariable: {
        oop key= map_get(ast, key_symbol);
        oop val= getVariable(scope, key);
        oop inc= makeInteger(getInteger(val) + 1);
        setVariable(scope, key, inc);
        return val;
    }
    case t_PostDecVariable: {
        oop key= map_get(ast, key_symbol);
        oop val= getVariable(scope, key);
        oop inc= makeInteger(getInteger(val) - 1);
        setVariable(scope, key, inc);
        return val;
    }
    case t_PostIncMember: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= map_get(ast, key_symbol);
        oop val= map_get(map, key);
        oop inc= makeInteger(getInteger(val) + 1);
        map_set(map, key, inc);
        return val;
    }
    case t_PostDecMember: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= map_get(ast, key_symbol);
        oop val= map_get(map, key);
        oop inc= makeInteger(getInteger(val) - 1);
        map_set(map, key, inc);
        return val;
    }
    case t_PostIncIndex: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= eval(scope, map_get(ast, key_symbol));
        oop val= map_get(map, key);
        oop inc= makeInteger(getInteger(val) + 1);
        map_set(map, key, inc);
        return val;
    }
    case t_PostDecIndex: {
        oop map= eval(scope, map_get(ast, map_symbol));
        oop key= eval(scope, map_get(ast, key_symbol));
        oop val= map_get(map, key);
        oop inc= makeInteger(getInteger(val) - 1);
        map_set(map, key, inc);
        return val;
    }
    }
    printf("EVAL ");
    println(ast);
    assert(0);
    return null;
}

oop prim_exit(oop params)
{
    int status= 0;
    if (map_hasIntegerKey(params, 0)) {
    oop arg= get(params, Map, elements)[0].value;
    if (isInteger(arg)) status= getInteger(arg);
    }
    exit(status);
}

oop prim_keys(oop params)
{
    if (map_hasIntegerKey(params, 0)) {
    oop arg= get(params, Map, elements)[0].value;
    if (is(Map, arg)) return map_keys(arg);
    }
    return null;
}

oop prim_values(oop params)
{
    if (map_hasIntegerKey(params, 0)) {
    oop arg= get(params, Map, elements)[0].value;
    if (is(Map, arg)) return map_values(arg);
    }
    return null;
}

oop prim_length(oop params)
{
    if (map_hasIntegerKey(params, 0)) {
        oop arg= get(params, Map, elements)[0].value;
        switch (getType(arg)) {
            case String: return makeInteger(string_size(arg));
            case Symbol: return makeInteger(strlen(get(arg, Symbol, name)));
            case Map:    return makeInteger(map_size(arg));
            default:     break;
        }
    }
    return null;
}

// TODO
// ISSUE1: how can I handle the "cannot invoke " with nice printing the func name and its args
// it would be really nice to have a toString() function (that would be directly used in print())
// but it seems that it's really complicated to write a toString() for integer, function and maps...
// please see the draft line 490 in object.c

// ISSUE2: how can I tackle the 2 fprintf(stderr, "\nbreak/continue oustide of a loop\n") in prim_invoke and prim_apply
// in this situation it seems that I don't have access to any AST
oop prim_invoke(oop params)
{
    oop this= null;      if (map_hasIntegerKey(params, 0)) this=  get(params, Map, elements)[0].value;
    oop func= null;      if (map_hasIntegerKey(params, 1)) func=  get(params, Map, elements)[1].value;
    oop args= null;      if (map_hasIntegerKey(params, 2)) args=  get(params, Map, elements)[2].value;
    if (!is(Function, func)) {
        printf("cannot invoke ");
        println(func);
        exit(1);
    }
    if (NULL != get(func, Function, primitive)) {
        return get(func, Function, primitive)(args);
    }
    oop param = get(func, Function, param);
    oop localScope = map_zip(param, args);
    map_set(localScope, this_symbol, this);
    map_set(localScope, __arguments___symbol, args);
    map_set(localScope, __proto___symbol, get(func, Function, parentScope));
    jbRecPush();
    int jbt = sigsetjmp(jbs->jb, 0);
    switch (jbt) {
        case j_return: {
            oop result = jbs->result;
            jbRecPop();
            return result;
        }
        case j_break: {
            fprintf(stderr, "\nbreak outside of a loop\n");
            exit(1);
        }
        case j_continue: {
            fprintf(stderr, "\ncontinue outside of a loop\n");
            exit(1);
        }
        case j_throw: {
            oop res= jbs->result;
            jbRecPop();
            jbs->result= res;
            siglongjmp(jbs->jb, j_throw);
        }
    }
    oop result= eval(localScope, get(func, Function, body));
    jbRecPop();
    return result;
}

oop apply(oop func, oop args)
{
    if (!is(Function, func)) {
        printf("cannot apply ");
        println(func);
        exit(1);
    }
    if (NULL != get(func, Function, primitive)) {
        return get(func, Function, primitive)(args);
    }
    oop param = get(func, Function, param);
    oop localScope = map_zip(param, args);
    map_set(localScope, __arguments___symbol, args);
    map_set(localScope, __proto___symbol, get(func, Function, parentScope));
    jbRecPush();
    int jbt = sigsetjmp(jbs->jb, 0);
    switch (jbt) {
        case j_return: {
            oop result = jbs->result;
            jbRecPop();
            return result;
        }
        case j_break: {
            fprintf(stderr, "\nbreak outside of a loop\n");
            exit(1);
        }
        case j_continue: {
            fprintf(stderr, "\ncontinue outside of a loop\n");
            exit(1);
        }
        case j_throw: {
            oop res= jbs->result;
            jbRecPop();
            jbs->result= res;
            siglongjmp(jbs->jb, j_throw);
        }
    }
    oop result= eval(localScope, get(func, Function, body));
    jbRecPop();
    return result;
}

oop prim_apply(oop params) {
    oop func= null;      if (map_hasIntegerKey(params, 0)) func=  get(params, Map, elements)[0].value;
    oop args= null;      if (map_hasIntegerKey(params, 1)) args=  get(params, Map, elements)[1].value;
    return apply(func, args);
}

oop prim_clone(oop params)
{
    if (map_hasIntegerKey(params, 0)) return clone(get(params, Map, elements)[0].value);
    return null;
}

oop prim_print(oop params)
{
    assert(is(Map, params));
    for (int i= 0;  map_hasIntegerKey(params, i);  ++i) {
        print(get(params, Map, elements)[i].value);
    }
    return params;
}

oop evalArgs(oop scope, oop args)
{
   int i = 0;
   oop params = makeMap();
   oop index;
   while ((index = makeInteger(i)), map_hasKey(args, index)) {
       map_set(params, index, eval(scope, map_get(args, index)));
       i++;
   }
   return params;
}

oop AST= NULL;

void readEvalPrint(char *fileName) {
    inputStackPush(fileName);
    jbRecPush();
    jb_record *jtop= jbs;
    int jbt= sigsetjmp(jbs->jb, 0);

    if (0 == jbt) {
        while (inputStack && yyparse()) {
            if (opt_v > 1) printf("%s:%i: ", inputStack->name, inputStack->lineNumber);
            if (!yylval) {
                fclose(inputStack->file);
                inputStackPop();
                continue;
            }             // EOF
            if (opt_v > 1) println(yylval);
            oop res = eval(globals, yylval);
            if (opt_v > 0) println(res);
            assert(jbs == jtop);
        }
        jbRecPop();
        return;
    }

    assert(jbs == jtop);
    oop res = jbs->result;
    jbRecPop();
    switch (jbt) {
        case j_return:
            fprintf(stderr, "\nreturn outside of a function\n");
            exit(1);
        case j_break:
            fprintf(stderr, "\nbreak outside of a loop or switch\n");
            exit(1);
        case j_continue:
            fprintf(stderr, "\ncontinue outside of a loop\n");
            exit(1);
        case j_throw:
            printf("\nunhandled exception: ");
            println(res);
            exit(1);
    }
}

oop prim_import(oop params)
{
    if (map_hasIntegerKey(params, 0)) {
        char *file= get(get(params, Map, elements)[0].value, String, value);
        if (yyctx->__pos < yyctx->__limit) {
            yyctx->__limit--;
            ungetc(yyctx->__buf[yyctx->__limit], inputStack->file);
        }
        readEvalPrint(file);
    }
    return null;
}

#include <sys/resource.h>

oop prim_millis(oop params)
{
    struct rusage ru;
    getrusage(RUSAGE_SELF, &ru);
    return makeInteger(ru.ru_utime.tv_sec * 1000 + ru.ru_utime.tv_usec / 1000);
}

int main(int argc, char **argv)
{
# if (USE_GC)
    GC_INIT();
# endif

    symbol_table= makeMap();
    globals= makeMap();

    map_set(globals, intern("exit")  , makeFunction(prim_exit,   intern("exit"),   null, null, globals, null));
    map_set(globals, intern("keys")  , makeFunction(prim_keys,   intern("keys"),   null, null, globals, null));
    map_set(globals, intern("values"), makeFunction(prim_values, intern("values"), null, null, globals, null));
    map_set(globals, intern("length"), makeFunction(prim_length, intern("length"), null, null, globals, null));
    map_set(globals, intern("print") , makeFunction(prim_print,  intern("print"),  null, null, globals, null));
    map_set(globals, intern("invoke"), makeFunction(prim_invoke, intern("invoke"), null, null, globals, null));
    map_set(globals, intern("apply") , makeFunction(prim_apply,  intern("apply"),  null, null, globals, null));
    map_set(globals, intern("clone") , makeFunction(prim_clone,  intern("clone"),  null, null, globals, null));
    map_set(globals, intern("import"), makeFunction(prim_import, intern("import"), null, null, globals, null));
    map_set(globals, intern("millis"), makeFunction(prim_millis, intern("millis"), null, null, globals, null));

    #define _DO(NAME) NAME##_symbol=intern(#NAME);
    DO_SYMBOLS()
    #undef _DO

    #define _DO(NAME) set(NAME##_symbol, Symbol, prototype, t_##NAME);
    DO_PROTOS()
    #undef _DO

    #define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol);
    DO_PROTOS()
    #undef _DO

    AST = makeMap();
    map_set(globals, intern("AST"), AST);
    #define _DO(NAME) map_set(AST, NAME##_symbol, NAME##_proto);
    DO_PROTOS()
    #undef _DO

    int repled = 0;
    while (argc-- > 1) {
        ++argv;
        if (!strcmp(*argv, "-v"))  ++opt_v;
        else if (!strcmp(*argv, "-")) {
            readEvalPrint(NULL);
            repled= 1;
        }
        else {
            readEvalPrint(*argv);
            repled= 1;
        }
    }
    if (!repled) {
        readEvalPrint(NULL);
    }

    return 0;

    (void)yyAccept;
}

// Local Variables:
// indent-tabs-mode: nil
// End: