Source Circular Meta-evaluator

circular.js

/**
 * This file implements a circular meta-evaluator for a subset of js used
 * by Source Academy: https://sourceacademy.org/sicpjs/
 * It is very simple evaluator that recursively evaluates the AST
 *
 * This is by no means efficient and serves as a means for me to learn
 * about interpreters.
 */

/*
 * Shitty error handling
 */

function myerror(ctx, msg) {
    // Didn't know source had an `error`
    error(msg, "[" + ctx + "]");
    return undefined;
}


/*
 * Literal
 */

function is_literal(ast) {
    return gettype_ast(ast) === "literal";
}

function eval_literal(expr) {
    return head(tail(expr));
}


/*
 * Op utils
 */

function getopstr_op(expr) {
    return head(tail(expr));
}

function getop1_op(expr) {
    return head(tail(tail(expr)));
}

function getop2_op(expr) {
    return head(tail(tail(tail(expr))));
}


/*
 * Unary op
 */

function str2unaryop(str) {
    return str === "-unary" ? x => -x
        : str === "!" ? x => !x
        : myerror("str2unaryop", "Unknown operand `" + str + "`");
}

function is_unaryop(ast) {
    return gettype_ast(ast) === "unary_operator_combination";
}

function eval_unaryop(expr, env) {
    const op = str2unaryop(getopstr_op(expr));
    const x = getop1_op(expr);
    return op(evaluate(x, env));
}


/*
 * Binary op
 */

function str2binaryop(str) {
    return str === "+"  ? (x,y) => x+y
        : str === "-"   ? (x,y) => x-y
        : str === "*"   ? (x,y) => x*y
        : str === "/"   ? (x,y) => x/y
        : str === "%"   ? (x,y) => x%y
        : str === "===" ? (x,y) => x===y
        : str === "!==" ? (x,y) => x!==y
        : str === ">"   ? (x,y) => x>y
        : str === "<"   ? (x,y) => x<y
        : str === ">="  ? (x,y) => x>=y
        : str === "<="  ? (x,y) => x<=y
        : myerror("str2binaryop", "Unknown operand `" + str + "`");
}

function is_binaryop(ast) {
    return gettype_ast(ast) === "binary_operator_combination";
}

function eval_binaryop(expr, env) {
    const op = str2binaryop(getopstr_op(expr));
    const x = getop1_op(expr);
    const y = getop2_op(expr);
    return op(
        evaluate(x, env),
        evaluate(y, env)
    );
}


/*
 * Logical composition
 */

function str2logicalcomp(str) {
    return str === "&&" ? (x,y) => x && y
        : str === "||"  ? (x,y) => x || y
        : myerror("str2logicalcomp", "Unknown operand `" + str + "`");
}

function is_logicalcomp(ast) {
    return gettype_ast(ast) === "logical_composition";
}

function eval_logicalcomp(expr) {
    const op = str2logicalcomp(getopstr_op(expr));
    const x = getop1_op(expr);
    const y = getop2_op(expr);
    return op(
        evaluate(x, env),
        evaluate(y, env)
    );
}


/*
 * Conditional expression
 */

function is_conditionalexpr(ast) {
    return gettype_ast(ast) === "conditional_expression";
}

function getpred_conditionalexpr(expr) {
    return head(tail(expr));
}

function getbranch1_conditionalexpr(expr) {
    return head(tail(tail(expr)));
}

function getbranch2_conditionalexpr(expr) {
    return head(tail(tail(tail(expr))));
}

function eval_conditionalexpr(expr, env) {
    return evaluate(getpred_conditionalexpr(expr), env) // lazy
        ? evaluate(getbranch1_conditionalexpr(expr), env)
        : evaluate(getbranch2_conditionalexpr(expr), env);
}


/*
 * Sequence
 */

function is_seq(ast) {
    return gettype_ast(ast) === "sequence";
}

function getseqlist_seq(seq) {
    return head(tail(seq));
}

function isempty_seqlist(seqlist) {
    return is_null(seqlist);
}

function firstexpr_seqlist(seqlist) {
    return head(seqlist);
}

function restexpr_seqlist(seqlist) {
    return tail(seqlist);
}

function islastexpr_seqlist(seqlist) {
    return is_null(tail(seqlist));
}

function eval_seqlist(seqlist, env) {
    
    function helper1() {
        // evaluate expression in case of side effects
        const expr = firstexpr_seqlist(seqlist);
        const res = evaluate(expr, env);
        return eval_seqlist(restexpr_seqlist(seqlist), env);
    }

    return isempty_seqlist(seqlist) ? undefined
        : islastexpr_seqlist(seqlist) // TODO: Check if within function scope
        ? evaluate(firstexpr_seqlist(seqlist), env)
        : helper1();
}

function eval_seq(seq, env) {
    return eval_seqlist(getseqlist_seq(seq), env);
}


/*
 * Names
 */

function is_name(ast) {
    return gettype_ast(ast) === "name";
}

function getstr_name(name) {
    return head(tail(name));
}

function eval_name(name, env) {
    const namestr = getstr_name(name);
    const variable = getsymbol_env(env, namestr);
    return is_null(variable)
        ? myerror("eval_name", "name doesn't exist! `" + namestr + "`")
        : getval_symbol(variable);
}


/*
 * Declaration utils
 */

function getname_decl(decl) {
    return head(tail(decl));
}

function getval_decl(decl) {
    return head(tail(tail(decl)));
}


/*
 * Constant declaration
 */

function is_constdecl(ast) {
    return gettype_ast(ast) === "constant_declaration";
}

function eval_constdecl(constdecl, env) {
    const name = getname_decl(constdecl);
    const namestr = getstr_name(name);
    const val = evaluate(getval_decl(constdecl), env);
    setconst_env(env, namestr, val);
    return undefined;
}


/*
 * Variable declaration
 */

function is_vardecl(ast) {
    return gettype_ast(ast) === "variable_declaration";
}

function eval_vardecl(vardecl, env) {
    const name = getname_decl(vardecl);
    const namestr = getstr_name(name);
    const val = evaluate(getval_decl(vardecl), env);
    setvar_env(env, namestr, val);
    return undefined;
}


/*
 * Assignment
 */

function is_assignment(ast) {
    return gettype_ast(ast) === "assignment";
}

function eval_assignment(assignment, env) {
    const name = getname_decl(assignment);
    const namestr = getstr_name(name);
    const variable = getsymbol_env(env, namestr);
    return is_null(variable)
        ? myerror("eval_assignment", "name doesn't exist! `" + namestr + "`")
        : !isvariable_symbol(variable)
        ? myerror("eval_assignment", "name isn't declared a variable! `" + namestr + "`")
        : setval_symbol(
            variable, 
            evaluate(getval_decl(assignment), env));
}


/*
 * Blocks
 */

function is_block(ast) {
    return gettype_ast(ast) === "block";
}

function getcode_block(block) {
    return head(tail(block));
}

function eval_block(block, env) {
    const new_env = extend_env(env);
    return evaluate(getcode_block(block), new_env);
}


/*
 * Conditional statements
 */

function is_conditionalstatement(ast) {
    return gettype_ast(ast) === 'conditional_statement';
}

function getpred_conditionalstatement(cond) {
    return head(tail(cond));
}

function getbranches_conditionalstatement(cond) {
    return tail(tail(cond));
}

function getbranch1_branches(branches) {
    return head(branches);
} 

function getbranch2_branches(branches) {
    return head(tail(branches));
}

function eval_conditionalstatement(cond, env) {
    const branches = getbranches_conditionalstatement(cond);
    const new_env = extend_env(env);
    return evaluate(getpred_conditionalstatement(cond), env)
        ? evaluate(getbranch1_branches(branches), new_env)
        : evaluate(getbranch2_branches(branches), new_env);

}


/*
 * Lambda expressions
 */

function is_lambdaexpr(ast) {
    return gettype_ast(ast) === "lambda_expression";
}

function eval_lambdaexpr(lambda, env) {
    // Package environment together.
    // This will collectively be known as lambdaenv
    return pair(lambda, env);
}

function getenv_lambdaenv(lambdaenv) {
    return tail(lambdaenv);
}

function getargnames_lambdaenv(lambdaenv) {
    return head(tail(head(lambdaenv)));
}

function getimpl_lambdaenv(lambdaenv) {
    return head(tail(tail(head(lambdaenv))));
}


/*
 * Function declaration
 */

function is_funcdecl(ast) {
    return gettype_ast(ast) === "function_declaration";
}

function getname_funcdecl(funcdecl) {
    return head(tail(funcdecl));
}

function getimpl_funcdecl(funcdecl) {
    return pair(
        gettype_ast(funcdecl), 
        tail(tail(funcdecl)));
}

function eval_funcdecl(funcdecl, env) {
    const name = getname_funcdecl(funcdecl);
    const namestr = getstr_name(name);
    // Package env with impl (func, env)
    const lambdaenv = pair(getimpl_funcdecl(funcdecl), env);
    setconst_env(env, namestr, lambdaenv);
}


/*
 * Return statement
 */

function is_return(ast) {
    return gettype_ast(ast) === "return_statement";
}

function getbody_return(ret) {
    return head(tail(ret));
}

function eval_return(ret, env) {
    const result = evaluate(getbody_return(ret), env);
    if (!iswithinfunc_env(env)) {
        myerror("eval_return", "return statement isn't in function scope!");
    }
    const e = top_callstack(getcallstack_env(env));
    set_head(e, true);
    set_tail(e, result);
    return result;
}


/*
 * Application
 */

function is_application(ast) {
    return gettype_ast(ast) === "application";
}

function getname_application(appl) {
    return head(tail(appl));
}

function getargsvals_application(appl) {
    return head(tail(tail(appl)));
}

function eval_application(appl, env) {

    function init_application_env(new_env, argnames, argvals){

        if (is_null(argvals) || is_null(argnames)) {
            if (!is_null(argvals) || !is_null(argnames)) {
                myerror(
                    "eval_application", 
                    "Expected `" + stringify(length(argnames))
                    + "` arguments, got `" 
                    + stringify(length(argvals)) + "` instead");
            }
            return undefined;
        }

        // Not lazy, evaluate the args
        const v = evaluate(head(argvals), env);
        const k = getstr_name(head(argnames));
        setvar_env(new_env, k, v);
        init_application_env(new_env, tail(argnames), tail(argvals));
    }

    const lambdaenv = evaluate(getname_application(appl), env);
    const saved_env = getenv_lambdaenv(lambdaenv);
    const argnames = getargnames_lambdaenv(lambdaenv);
    const argvals = getargsvals_application(appl);

    const new_env = extendfunc_env(saved_env);
    init_application_env(new_env, argnames, argvals);

    const impl = getimpl_lambdaenv(lambdaenv);
    evaluate(impl, new_env);
    const ret = tail(top_callstack(getcallstack_env(new_env)));
    setcallstack_env(
        new_env, pop_callstack(getcallstack_env(new_env))
    );
    return ret;
}


/*
 * Environment
 */

const SYMBOLTYPE_CONST = "const";
const SYMBOLTYPE_VAR = "var";

function create_symbol(namestr, val, attribute) {
    // (symbolname, (value, attribute))
    return pair(namestr, pair(val, attribute));
}

function getname_symbol(symbol) {
    return head(symbol);
}

function getval_symbol(symbol) {
    return head(tail(symbol));
}

function isvariable_symbol(symbol) {
    return tail(tail(symbol)) === SYMBOLTYPE_VAR;
}

function setval_symbol(symbol, val) {
    set_head(tail(symbol), val);
    return undefined;
}

function empty_symbollist() {
    return null;
}

function current_symbollist(symbollist) {
    return head(symbollist);
}

function rest_symbollist(symbollist) {
    return tail(symbollist);
}

function search_symbollist(symbollist, namestr) {
    return is_null(symbollist) 
        ? null
        : getname_symbol(current_symbollist(symbollist)) === namestr
        ? current_symbollist(symbollist)
        : search_symbollist(rest_symbollist(symbollist), namestr);
}

function empty_callstack() {
    return null;
}

function push_callstack(callstack, isdone, ret) {
    return pair(
        // (isdone, return)
        pair(isdone, ret), 
        // next in the callstack
        callstack
    );
}

function top_callstack(callstack) {
    return head(callstack);
}

function pop_callstack(callstack) {
    return tail(callstack);
}

function empty_env() {
    // Structure: (parent_env, (symbollist, callstack))
    // `callstack` is ((isdone, ret2), ((isdone, ret2), ...(null)...)
    return pair(null, // parent_env
        pair(
            empty_symbollist(), // symbollist
            empty_callstack() // callstack
    ));
}

function getparent_env(env) {
    return head(env);
}

function getsymbollist_env(env) {
    return head(tail(env));
}

function getcallstack_env(env) {
    return tail(tail(env));
}

function setcallstack_env(env, callstack) {
    return set_tail(tail(env), callstack);
}

function iswithinfunc_env(env) {
    return !is_null(getcallstack_env(env));
}

function getsymbol_env(env, namestr) {
    if (is_null(env)) {return null;}
    const syms = getsymbollist_env(env);
    const variable = search_symbollist(syms, namestr);
    return is_null(variable)
        ? getsymbol_env(getparent_env(env), namestr)
        : variable;
}

function setsymbol_env(env, namestr, val, attribute) {
    if (!is_null(
        search_symbollist(
            getsymbollist_env(env), 
            namestr))) {
        error("setsymbol_env", 
            "identifier `" + namestr 
            + "` has already been declared!");
    }
    const syms = getsymbollist_env(env);
    set_head(
        tail(env), 
        pair(create_symbol(namestr, val, attribute), syms)
    );
}

function setconst_env(env, namestr, val) {
    setsymbol_env(env, namestr, val, SYMBOLTYPE_CONST);
}

function setvar_env(env, namestr, val) {
    setsymbol_env(env, namestr, val, SYMBOLTYPE_VAR);
}

function extend_env(env) {
    return pair(env, pair(empty_symbollist(), getcallstack_env(env)));
}

function extendfunc_env(env) {
    return pair(
        env, // parent env
        pair(
            empty_symbollist(), // symbollist
            // callstack
            push_callstack(getcallstack_env(env), false, undefined)
        )
    );
}

function isglobal_env(env) {
    return is_null(getparent_env(env));
}


/*
 * Final eval
 */

function gettype_ast(ast) {
    return head(ast);
}

function evaluate(ast, env) {

    if (iswithinfunc_env(env)) {
        const e = top_callstack(getcallstack_env(env));
        if (head(e)) { // is done with current application
            return tail(e);
        }
    }

    return is_literal(ast) ? eval_literal(ast)
        : is_binaryop(ast) ? eval_binaryop(ast, env)
        : is_unaryop(ast) ? eval_unaryop(ast, env)
        : is_conditionalexpr(ast) ? eval_conditionalexpr(ast, env)
        : is_logicalcomp(ast) ? eval_logicalcomp(ast, env)
        : is_seq(ast) ? eval_seq(ast, env)
        : is_constdecl(ast) ? eval_constdecl(ast, env)
        : is_vardecl(ast) ? eval_vardecl(ast, env)
        : is_name(ast) ? eval_name(ast, env)
        : is_assignment(ast) ? eval_assignment(ast, env)
        : is_block(ast) ? eval_block(ast, env)
        : is_conditionalstatement(ast) ? eval_conditionalstatement(ast, env)
        : is_lambdaexpr(ast) ? eval_lambdaexpr(ast, env)
        : is_funcdecl(ast) ? eval_funcdecl(ast, env)
        : is_return(ast) ? eval_return(ast, env)
        : is_application(ast) ? eval_application(ast, env)
        : myerror("evaluate", "Unknown ast type `" + gettype_ast(ast) + "`");
}



let code = `
const pair = (x,y) => k => k(x,y);
const head = p => p((x,_) => x);
const tail = p => p((_,y) => y);

function create_testers() {
    const mod1 = 3;
    const mod2 = 5;
    return pair(
        n => n % mod1 === 0 ? "fizz" : "",
        n => n % mod2 === 0 ? "buzz" : ""
    );
}

function int2str(n) {

    if (n < 1) { return "0"; }

    function digit2str(d) {
        return d < 1 ? "0"
            : d < 2 ? "1"
            : d < 3 ? "2"
            : d < 4 ? "3"
            : d < 5 ? "4"
            : d < 6 ? "5"
            : d < 7 ? "6"
            : d < 8 ? "7"
            : d < 9 ? "8"
            : d < 10 ? "9"
            : "";
    }

    let acc = ""; // testing let
    function helper(m) {
        if (m >= 1) {
            acc = digit2str(m % 10) + acc;
            helper(m / 10);
        }
    }

    helper(n);
    return acc;
}

function fizzbuzz(n) {

    const testers = create_testers();
    
    function helper(s, n, acc) {
        const fb = head(testers)(s) + tail(testers)(s);
        return s > n
            ? acc
            : helper(
                s+1, n, 
                acc + "\\n" + int2str(s) + ": " + fb);
    }

    return helper(0, n, "") + "\\n";
}

fizzbuzz(30);
`;

const ast = parse(code);
const env = empty_env();
//display(evaluate(ast, env));
display("^-^", evaluate(ast, env));
undefined;
//ast;