module environments;

import environment;
import formals;
import lqtools;
import lqtypes;

LqType s_current_environment(LqType[] args, kwdict kwargs, Environment env) {
    return new LqEnvironment(env);
}

LqType s_environment_parent(LqType[] args, kwdict kwargs, Environment env) {
    check_arg(args[0], 0, "environment", "environment-parent");
    auto e = cast(LqEnvironment)(args[0]);
    Environment p = e.env.parent();
    if (p is null)
        return LQ_FALSE();
    else
        return new LqEnvironment(p);
}

LqType s_environment_names(LqType[] args, kwdict kwargs, Environment env) {
    /* (environment-names env) 
       Returns a list of names defined in the given environment. The names
       are symbols rather than strings.
    */
    check_arglength(args, 1, 1, "environment-names");
    check_arg(args[0], 0, "environment", "environment-names");
    auto e = cast(LqEnvironment)(args[0]);
    string[] names = e.env.get_local_names();
    LqType[] lnames = [];
    foreach(string name; names)
        lnames ~= new LqSymbol(name);
    return LqList.from_list(lnames);
}

LqType s_environment_lookup(LqType[] args, kwdict kwargs, Environment env) {
    /* (environment-lookup env name) => (env value) or #f */
    check_arglength(args, 2, 2, "environment-lookup");
    check_arg(args[0], 0, "environment", "environment-lookup");
    check_arg(args[1], 1, "symbol", "environment-lookup");
    auto lenv = cast(LqEnvironment)(args[0]);
    auto lname= cast(LqSymbol)(args[1]);
    EnvLookupResult elr;
    try {
        elr = lenv.env.lookup(lname.lq_repr());
    }
    catch (Exception e) {
        return LQ_FALSE();
    }
    
    LqType[] result;
    result ~= new LqEnvironment(elr.env);
    result ~= elr.result;
    return LqList.from_list(result);
}

LqType s_environment_delete(LqType[] args, kwdict kwargs, Environment env) {
    /* (environment-delete! env <name>) 
       Looks up <name> in the given environment, or it parents, and deletes
       it. Raises an error if the name doesn't exist.
    */
    check_arglength(args, 2, 2, "environment-delete!");
    check_arg(args[0], 0, "environment", "environment-delete!");
    check_arg(args[1], 1, "symbol", "environment-delete!");
    auto lenv = cast(LqEnvironment)(args[0]);
    auto lname= cast(LqSymbol)(args[1]);
    lenv.env.delete_name(lname.lq_repr());
    return LQ_UNSPECIFIED();
}

LqType s_environment_bind(LqType[] args, kwdict kwargs, Environment env) {
    /* (environment-bind! env <name> <value>)
       Binds the name to the value in the *local* environment, possibly
       overwriting or shadowing existing names. */
    check_arglength(args, 3, 3, "environment-bind!");
    check_arg(args[0], 0, "environment", "environment-bind!");
    check_arg(args[1], 1, "symbol", "environment-bind!");
    auto lenv = cast(LqEnvironment)(args[0]);
    auto lname= cast(LqSymbol)(args[1]);
    lenv.env.bind(lname.lq_repr(), args[2]);
    return LQ_UNSPECIFIED();
}

LqType s_make_environment(LqType[] args, kwdict kwargs, Environment env) {
    /* (make-environment [parent]) => <new environment> */
    check_arglength(args, 0, 1, "make-environment");
    Environment e;
    if (args.length > 0) {
        check_arg(args[0], 0, "environment", "make-environment");
        Environment parent = (cast(LqEnvironment)(args[0])).env;
        e = new Environment(parent);
    }
    else {
        e = new Environment();
    }
    return new LqEnvironment(e);
}

bfun[string] get_builtins() {
    /* using an associative array literal here seems to have complications */
    bfun[string] z;
    z["current-environment"] = &s_current_environment;
    z["environment-parent"]  = &s_environment_parent;
    z["environment-names"]   = &s_environment_names;
    z["environment-lookup"]  = &s_environment_lookup;
    z["environment-delete!"] = &s_environment_delete;
    z["environment-bind!"]   = &s_environment_bind;
    z["make-environment"]    = &s_make_environment;
    return z;
}