%{

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

#define DO_PROTOS() _DO(assign) _DO(read) _DO(symbol) _DO(integer) _DO(string) _DO(binary) _DO(add) _DO(sub) _DO(mul) _DO(div) _DO(mod)

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"

// this is the global scope
oop globals;

oop apply(oop function, oop parameters)
{
    return get(function, Function, primitive)(parameters);
}

#define DO_SYMBOLS() DO_PROTOS() _DO(__proto__) _DO(__name__) _DO(value) _DO(lhs) _DO(rhs) _DO(scope) _DO(length)

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

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

oop newObject(oop proto)
{
    oop map = makeMap();
    map_set(map, __proto___symbol, proto);
    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");
    }
}

oop newAssign(oop scope, oop lhs, oop rhs)
{
    oop assign = newObject(assign_proto);
    map_set(assign, scope_symbol, scope);
    map_set(assign, lhs_symbol, lhs);
    map_set(assign, rhs_symbol, rhs);
    return assign;
}

oop newRead(oop scope, oop obj)
{
    oop read = newObject(read_proto);
    map_set(read, scope_symbol, scope);
    map_set(read, value_symbol, obj);
    return read;
}

// 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(int value)
{
    oop integer = newObject(integer_proto);
    map_set(integer, value_symbol, makeInteger(value));
    return integer;
}

oop newString(char *value)
{
    oop string = newObject(string_proto);
    oop primitive_string = makeString(value);
    map_set(string, value_symbol, primitive_string);
    map_set(string, length_symbol, makeInteger(get(primitive_string, String, size)));
    return string;
}

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

// this always creates the key in "object"
oop newMember(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 getMember(oop object, oop key)
{
    while (!map_hasKey(object, key)) {
        object = map_get(object, __proto___symbol);
        if (object == null) {
            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 setMember(oop object, oop key, oop value)
{
    oop firstObject = object;
    while (!map_hasKey(object, key)) {
        object = map_get(object, __proto___symbol);
        if (object == null) {
            newMember(firstObject, key, value);
        }
    }
    return map_set(object, key, value);
}

#define YYSTYPE oop

YYSTYPE yylval;

%}

start   = - e:exp               { yylval = e }

exp     =   l:IDENT                             EQUAL p:exp	{ $$ = newAssign(globals, newSymbol(l), p) }
            |   l:postfix DOT   i:IDENT         EQUAL p:exp	{ $$ = map_set(l, i, p) }
            |   l:postfix LBRAC i:exp   RBRAC   EQUAL p:exp	{ $$ = map_set(l, i, p) }
            |   s:sum                                       { $$ = s }

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  =   MINUS n:prefix              { set(n, Integer, value, -get(n, Integer, value));  $$ = n }
        |   PLUS  n:prefix              { $$ = n }
        |         n:postfix             { $$ = n }

postfix =   i:value ( DOT    s:IDENT        p:parameterList     { map_set(p, intern("this"), i);  i = apply(map_get(i, s), p) }
                    | DOT    s:IDENT        !EQUAL              { i = newRead(i, s) }
                    | LBRAC  p:exp   RBRAC  !EQUAL              { i = map_get(i, p) }
                    | p:parameterList                           { i = apply(i, p) }
                    ) *                                         { $$ = i }

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

value   =   n:NUMBER                { $$ = n }
        |   s:string                { $$ = s }
        |   s:symbol                { $$ = s }
        |   m:map                   { $$ = m }
        |   NULL                    { $$ = null }
        |   i:IDENT                 { $$ = newRead(globals, i) }
        |   LPAREN i:exp RPAREN     { $$ = i }

string  =   SQUOTE < (!SQUOTE .)* > SQUOTE      { $$ = newString(yytext) }
        |   DQUOTE < (!DQUOTE .)* > DQUOTE      { $$ = newString(yytext) }

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

map     =   LCB   m:makeMap
            (           k:IDENT COLON v:exp     { map_set(m, k, v) }
            (     COMMA k:IDENT COLON v:exp     { map_set(m, k, v) }
            ) *
            ) ?
            RCB                                 { $$ = m }

makeMap =   { $$ = makeMap() }

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

IDENT	=	< [a-zA-Z][a-zA-Z0-9_]* >   -   { $$ = intern(yytext) }
NUMBER	=	< [0-9]+ >	-                   { $$ = newInteger(atoi(yytext)) }
HASH	=	'#'			-
PLUS	=	'+'			-
MINUS	=	'-'			-
MULTI	=	'*'			-
DIVIDE	=	'/'			-
MODULO	=	'%'			-
EQUAL	=	'='			-
NULL	=	'null'		-
COLON	=	':'			-
COMMA	=	','			-
DOT		=	'.'			-
LCB		=	'{'			-
RCB		=	'}'			-
LBRAC	=	'['			-
RBRAC	=	']'			-
LPAREN	=	'('			-
RPAREN	=	')'			-
DQUOTE	=	'"'			-
SQUOTE	=	"'"			-

%%
;

int getInteger(oop obj)
{
    return get(obj, Integer, value);
}

oop eval(oop ast)
{
    oop proto = map_get(ast, __proto___symbol);
    // 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_assign: {
        oop lhs = eval(map_get(ast, lhs_symbol));
        oop rhs = map_get(ast, rhs_symbol);
        oop scope = map_get(ast, scope_symbol);
        // mmmmmmh
        return eval(map_set(scope, lhs, rhs));
    }
    case t_read: {
        oop scope = map_get(ast, scope_symbol);
        // mmmmmmh
        return eval(map_get(scope, map_get(ast, value_symbol)));
    }
    case t_symbol: {
        return map_get(ast, value_symbol);
    }
    case t_integer: {
        return map_get(ast, value_symbol);
    }
    case t_string: {
        return map_get(ast, value_symbol);
    }
    case t_binary: {
        oop lhs = eval(map_get(ast, lhs_symbol));
        oop rhs = eval(map_get(ast, rhs_symbol));
        proto_number = get(map_get(map_get(proto, __proto___symbol), __name___symbol), Symbol, prototype);
        switch (proto_number) {
        case t_add: {
            return makeInteger(getInteger(lhs) + getInteger(rhs));
            break;
        }
        case t_sub: {
            return makeInteger(getInteger(lhs) - getInteger(rhs));
            break;
        }
        case t_mul: {
            return makeInteger(getInteger(lhs) * getInteger(rhs));
            break;
        }
        case t_div: {
            return makeInteger(getInteger(lhs) / getInteger(rhs));
            break;
        }
        case t_mod: {
            return makeInteger(getInteger(lhs) % getInteger(rhs));
            break;
        }
        default: {
            assert(0);
            break;
        }
        }
    }
    default: {
        assert(0);
        break;
    }
    }
    return null;
}

int main(int argc, char **argv)
{
    symbol_table = makeMap();
    globals = makeMap();

    #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

    // instanciate protos with empty Map and fill their name
    #define _DO(NAME) NAME##_proto=makeMap(); map_set(NAME##_proto, __name___symbol, NAME##_symbol);
    DO_PROTOS()
    #undef _DO


    /*
    oop myInteger = newInteger(32);
    println(myInteger);
    oop myAddition = newBinary(add_proto, myInteger, myInteger);
    println(myAddition);

    printObjectName(myAddition);
    printObjectName(myInteger);
    */

    oop myFirst = newObject(null);
    oop myPizzaSymbol = makeSymbol("pizza");
    map_set(myFirst, myPizzaSymbol, makeInteger(3));
    oop mySecond = newObject(myFirst);
    oop myThird = newObject(mySecond);
    map_set(mySecond, myPizzaSymbol, makeInteger(4));
    println(myThird);
    println(getMember(mySecond, myPizzaSymbol));
    

    while (yyparse()) {
        println(yylval);
        println(eval(yylval));
    }

    return 0;

    (void)yyAccept;
}