module special;

import environment;
import lqtools;
import lqtypes;
import stringtools;

/* some of these can eventually be replaced with pure-Liquid forms... */
const string[] SPECIAL_FORMS = [
    "quote", "lambda", "begin", "if", "define", "set!", "let", "let*"];

bool is_special_form(LqType expr) {
    if (expr.is_list() && !as_list(expr).is_null()) {
        LqType first = as_pair(expr).head();
        return (first.type_indicator() == "symbol" &&
                string_in_list(first.lq_repr(), SPECIAL_FORMS));
    }
    return false;
}

/* Result returned by sf_apply(), consisting of a result value, and a boolean
   <done> which indicates whether we are done evaluating. */
class SFApplyResult {
    LqType result;
    bool done;
    this(LqType result, bool done) {
        this.result = result;
        this.done = done;
    }
}

/* Determine whether the next element must be evaluated. */
bool sf_must_evaluate(LqType[] processed, int total_length) {
    int plen = processed.length;
    if (plen == 0) return false;
    string sfname = (cast(LqSymbol)processed[0]).lq_repr();
    
    switch (sfname) {
        case "begin":
            /* we evaluate all expressions in a BEGIN, except the last one,
               which will be TCO'd */
            if (plen == total_length-1) return false;
            else return true;
            break;
            
        case "define":
            /* two forms:
               (define <name> <expr>)
               (define (<name> ...) <expr>+) 
            */
            if (plen == 1) return false; /* name or formals */
            if (plen == 2) {
                if (processed[1].type_indicator == "symbol")
                    return true; /* (define <name> <expr>) */
                else return false;
            }
            if (plen > 2) {
                if (processed[1].type_indicator == "symbol")
                    throw new Exception("define: invalid syntax");
                return false;
            }
            break;
            
        case "if":
            if (plen == 1) return true;
            if (plen == 2 || plen == 3) return false; /* delay evaluation */
            if (plen > 3)
                throw new Exception("if: too many arguments");
            break;
            
        case "lambda":
            /* (lambda arglist exprs+) */
            if (plen == 1) return false; /* arglist */
            if (plen > 1) return false; /* body */
            break;
            
        case "let", "let*":
            /* (let (<definitions>*) <expr>+) */
            if (plen == 1) return false; /* definitions */
            if (plen > 1) return false; /* body */
            break;
            
        case "quote":
            if (plen == 1) return false;
            if (plen > 1) throw new Exception("quote: too many arguments");
            break;
            
        case "set!":
            /* (set! <name> <expr>) */
            if (plen == 1) return false;
            if (plen == 2) return true;
            if (plen > 2) throw new Exception("set!: too many arguments");
            break;
            
        default:
            throw new Exception("unknown special form");
    }
}

SFApplyResult sf_apply(LqType[] processed, Environment env) {
    string sfname = (cast(LqSymbol)processed[0]).lq_repr();
    
    switch (sfname) {
        case "begin":
            /* TCO */
            return new SFApplyResult(processed[processed.length-1], false);
            break;
            
        case "define":
            /* two versions:
               (define <name> <expr>)
               (define (<name> ..formals..) <expr>+)
               returns the value that was bound (unlike Scheme's DEFINE).
            */
            if (processed[1].type_indicator() == "symbol") {
                string name = processed[1].toString();
                env.bind(name, processed[2]);
                return new SFApplyResult(processed[2], true);
            } 
            else if (processed[1].is_list()) {
                string[] formals = lqtools.list_of_symbols(processed[1]);
                string name = formals[0];
                auto udf = new LqUserDefinedFunction(formals[1..formals.length],
                           processed[2..processed.length], env, name=name);
                env.bind(name, udf);
                return new SFApplyResult(udf, true);
            }
            else throw new Exception("define: invalid form");
            break;
            
        case "if":
            LqType result = (processed[1] is LQ_FALSE()) ? processed[3] : processed[2];
            return new SFApplyResult(result, false); /* TCO */
            break;
            
        case "lambda":
            string[] formals = lqtools.list_of_symbols(processed[1]);
            LqType[] fbody = processed[2..processed.length];
            auto udf = new LqUserDefinedFunction(formals, fbody, env);
            return new SFApplyResult(udf, true);
            break;
            
        case "let":
            return special.s_let(processed, env);
            break;
            
        case "let*":
            return special.s_let_star(processed, env);
            break;
            
        case "quote":
            return new SFApplyResult(processed[1], true);
            break;
            
        case "set!":
            assert(processed[1].type_indicator() == "symbol");
            string name = (cast(LqSymbol)processed[1]).toString();
            env.rebind(name, processed[2]);
            return new SFApplyResult(LQ_UNSPECIFIED(), true);
            break;
            
        default:
            throw new Exception("unknown special form: " ~ sfname);
    }
}

/* helper functions */

SFApplyResult s_let(LqType[] processed, Environment env) {
    /* converts let-expression to a lambda-expression. we cannot evaluate the
       expressions here as we go, so this transformation is necessary.
       so:
       (let ((a va) (b vb))
         ..body..)
       =>
       ((lambda (a b) ..body..) va vb)
    */
    LqType[] names = [];
    LqType[] exprs = [];
    foreach(LqType q; (cast(LqList)processed[1]).to_list()) {
        LqPair pair = cast(LqPair)q;
        LqType[] items = pair.to_list();
        names ~= items[0];
        exprs ~= items[1];
    }

    /* we need a lambda with processed[2] as the body and the names as
       the formals... */
    /* then call this lambda with the expressions... */
    LqType[] z = [];
    z ~= new LqSymbol("lambda");
    z ~= LqList.from_list(names);
    foreach(LqType q; processed[2..processed.length]) z ~= q;
    LqType lam = LqList.from_list(z); /* (lambda (..) ..) */

    /* make a list consisting of the lambda and arguments */
    LqType[] y = [lam];
    foreach(LqType q; exprs) y ~= q;
    LqType fcall = LqList.from_list(y);

    return new SFApplyResult(fcall, false);
}

SFApplyResult s_let_star(LqType[] processed, Environment env) {
    /* like let, but the transformation is different.
       rather than using nested lambdas, we use (begin) and (define).
       (let* ((a va) 
              (b (+ vb a)))
         ..body..)
       =>
       (begin
         (define a va)
         (define b (+ vb a))
         ..body..)
    */
    LqType[] fbody = [];
    fbody ~= new LqSymbol("begin");
    
    /* add defines */
    foreach(LqType q; (cast(LqList)processed[1]).to_list()) {
        LqPair y = new LqPair(new LqSymbol("define"), cast(LqPair)q);
        fbody ~= y;
    }
    
    /* add body */
    foreach(LqType q; processed[2..processed.length]) fbody ~= q;
    
    LqType beginexpr = LqList.from_list(fbody);
    return new SFApplyResult(beginexpr, false);
}