// Copyright (c) 1996-2002 Brian D. Carlstrom

package bdc.scheme.compiler;

import bdc.scheme.GlobalEnvironment;
import bdc.scheme.Log;
import bdc.scheme.Pair;
import bdc.scheme.Scheme;
import bdc.scheme.SchemeException;
import bdc.scheme.Stack;
import bdc.scheme.Symbol;
import bdc.scheme.SymbolArray;
import bdc.scheme.Variable;
import bdc.scheme.VariableArray;
import bdc.scheme.Writer;
import bdc.scheme.exception.ArgumentCountException;
import bdc.scheme.exception.ArgumentTypeException;
import bdc.scheme.exception.SyntaxException;
import bdc.scheme.expression.Application0;
import bdc.scheme.expression.Application1;
import bdc.scheme.expression.Application2;
import bdc.scheme.expression.Application3;
import bdc.scheme.expression.Application4;
import bdc.scheme.expression.ApplicationN;
import bdc.scheme.expression.Begin;
import bdc.scheme.expression.Definition;
import bdc.scheme.expression.Expression;
import bdc.scheme.expression.ExpressionArray;
import bdc.scheme.expression.GlobalAssignment;
import bdc.scheme.expression.GlobalVariable;
import bdc.scheme.expression.If;
import bdc.scheme.expression.Lambda;
import bdc.scheme.expression.LexicalAddress;
import bdc.scheme.expression.LexicalAssignment;
import bdc.scheme.expression.LocalAddress;
import bdc.scheme.expression.LocalAssignment;
import bdc.scheme.expression.NaryLambda;
import bdc.scheme.expression.Quoted;
import bdc.scheme.expression.Until;
import bdc.util.ArrayUtil;
import bdc.util.Fmt;
import java.util.logging.Level;

/**
    Compiler is the external interface to Scheme compiling.

    Special forms are handled by the interface SpecialFormCompiler.
    Derived syntax as well as user macros are handled with simple source
    to source translation and gensym. Function application is handled by
    Compiler itself and is special cased for 0 to 4 arguments.
*/
public final class Compiler
{
    static final Symbol Quote   = Symbol.get("quote");
    static final Symbol SetBang = Symbol.get("set!");
    static final Symbol Define  = Symbol.get("define");
    static final Symbol If      = Symbol.get("if");
    static final Symbol Lambda  = Symbol.get("lambda");
    static final Symbol Begin   = Symbol.get("begin");
    static final Symbol Until   = Symbol.get("until");

    /*
        Symbols used by some of the build in rewritters that are part
        of the scheme syntax, but we implement with rewritters
    */
    static final Symbol Let  = Symbol.get("let");
    static final Symbol And  = Symbol.get("and");
    static final Symbol Or   = Symbol.get("or");
    static final Symbol Cond = Symbol.get("cond");
    static final Symbol Else = Symbol.get("else");
    static final Symbol Do   = Symbol.get("do");

    /*
        Symbols used by some of the build in rewritters that won't
        conflict with normal variable names
    */
    static final Symbol X     = Symbol.get("-x");
    static final Symbol Thunk = Symbol.get("-thunk");

    private Scheme scheme;

    /**
        Create a compiler
    */
    public Compiler (Scheme scheme)
    {
        this.scheme = scheme;

        scheme.globalEnvironment.define(Quote,
                                        new QuoteCompiler(this),
                                        GlobalEnvironment.Special);
        scheme.globalEnvironment.define(SetBang,
                                        new SetBangCompiler(this),
                                        GlobalEnvironment.Special);
        scheme.globalEnvironment.define(Define,
                                        new DefineCompiler(this),
                                        GlobalEnvironment.Special);
        scheme.globalEnvironment.define(If,
                                        new IfCompiler(this),
                                        GlobalEnvironment.Special);
        scheme.globalEnvironment.define(Lambda,
                                        new LambdaCompiler(this),
                                        GlobalEnvironment.Special);
        scheme.globalEnvironment.define(Begin,
                                        new BeginCompiler(this),
                                        GlobalEnvironment.Special);
        scheme.globalEnvironment.define(Until,
                                        new UntilCompiler(this),
                                        GlobalEnvironment.Special);
    }

    public Object eval (Object object) throws SchemeException
    {
        return eval(object, new Stack(scheme));
    }
    
    /**
        Top level compile routine for outside callers.

        It wraps the compiled object up in a thunk, which is returned
        to the caller. The caller can then call apply0 to run the code.
    */
    public Object eval (Object object, Stack stack) throws SchemeException
    {
            // create environment for use by top level compiler passes
        CompileTimeEnvironment environment =
            new CompileTimeEnvironment(scheme.globalEnvironment);

            // main compiler pass
        ExpressionArray body = new ExpressionArray();
        body.addElement(compile(object, environment));

            // wrap expression e as ((lambda () e))
            // so that it will have a top level environment
        Expression expression =
            new Application0(new Lambda(environment,
                                        new Begin(body)));

            // second fixup compiler pass
        expression = expression.fixupVariables(environment);

            // actually evaluation
        return expression.eval(null, stack);
    }

    /**
        The main compile routine.

        Takes an object to be compiled which is an s-expression
        returned by the reader and the CompileTimeEnvironment used to
        support LexicalAddress compilation for non-GlobalVariables.
    */
    public Expression compile (Object                 object,
                               CompileTimeEnvironment environment)
      throws SchemeException
    {
        /*
            If it is a symbol then we have a variable on our hands.
        */
        if (object instanceof Symbol) {
            Symbol symbol = (Symbol)object;
            return environment.findVariable(symbol);
        }

        /*
            If it is not an Pair it is a self-evaluating object
        */
        if (!(object instanceof Pair)) {
            return new Quoted(object);
        }

        /*
            Compile the operator position.
        */
        Pair source = (Pair)object;
        Pair pair = source;

        /*
            Attempt to optimize let and friends

            Only an optimization, could be flushed.
        */
        Expression optimized = letOptimize(pair, environment);
        if (optimized != null) {
            return optimized;
        }

        /*
            We compile the operator position. If it's a GlobalVariable
            we have to check if it's a special form or a macro. If
            it's a special form we treat the value as a
            SpecialFormCompiler. If it's a macro we treat the value as
            the rewritter procedure and compile the resulting
            expression. If none of the above applies we fall through
            to procedure application.
        */
        Expression operator = compile(pair.car, environment);
        if (operator instanceof GlobalVariable) {
            GlobalVariable gv = (GlobalVariable)operator;
            if (gv.type == GlobalEnvironment.Special) {
                SpecialFormCompiler sfc = (SpecialFormCompiler)(gv.object);
                return debug(sfc.compileSpecial(pair,
                                                environment),
                             source);
            }
            if (gv.type == GlobalEnvironment.Macro) {
                Expression application = makeApplication(new Quoted(gv.object),
                                                         ArrayUtil.array(pair));
                Object expanded = application.eval(scheme);
                    //Log.scheme.log(Level.INFO, "*** MACRO EXPANSION ***");
                    //Log.scheme.log(Level.INFO, "before: {0}", Writer.write(pair));
                    //Log.scheme.log(Level.INFO, "after:  {0}", Writer.write(expanded));
                return debug(compile(expanded, environment),
                             source);
            }
        }

        /*
            Finish compiling the function application.

            We have already compiled the operator above so now we
            compile all the arguments.
        */
        ExpressionArray operands = new ExpressionArray();
        Object expression = pair.cdr;
        while (expression != Scheme.Null) {
            if (!(expression instanceof Pair)) {
                throw new SyntaxException("application contains non-pair",
                                          source);
            }
            Pair operand = (Pair)expression;
            operands.addElement(compile(operand.car,
                                        environment));
            expression = operand.cdr;
        }
        return makeApplication(operator, operands, pair);
    }

    /**
        public version of makeApplication
    */
    public static Expression makeApplication (Expression operator,
                                              Object[]   operandsArray)
    {
        ExpressionArray operands = new ExpressionArray();
        for (int i = 0; i < operandsArray.length; i++) {
            Object object = operandsArray[i];
            if (!(object instanceof Expression)) {
                object = new Quoted(object);
            }
            operands.addElement(object);
        }

        return makeApplication(operator, operands, null);
    }

    /**
        Special case function application.

        We do this to try and avoid consing an array to pass
        arguments. For the cases of between 0 and 4 arguments we
        pass on the Java stack. It turns out that this only helps
        in primitive application because compound procedures cons
        the array to use as the environment frame.
    */
    private static Expression makeApplication (Expression      operator,
                                               ExpressionArray operands,
                                               Pair            source)
    {
        switch (operands.inUse) {
          case 0:
            return debug(new Application0(operator),
                         source);
          case 1:
            return debug(new Application1(operator,
                                          operands.array()[0]),
                         source);
          case 2:
            return debug(new Application2(operator,
                                          operands.array()[0],
                                          operands.array()[1]),
                         source);
          case 3:
            return debug(new Application3(operator,
                                          operands.array()[0],
                                          operands.array()[1],
                                          operands.array()[2]),
                         source);
          case 4:
            return debug(new Application4(operator,
                                          operands.array()[0],
                                          operands.array()[1],
                                          operands.array()[2],
                                          operands.array()[3]),
                         source);
          default:
            return debug(new ApplicationN(operator,
                                          operands),
                         source);
        }
    }

    /**
        Add debugging information to expressions
    */
    private static Expression debug (Expression expression, Pair source)
    {
        expression.source = source;
        return expression;
    }

    /**
        Optimization

        If we are compiling a lambda in operator position such as

        ((lambda (a b c) &hellip;) x y z)

        we convert it to

        (begin (set&33; a x) (set&33; b y) (set&33; c z) &hellip;)

        before compiling and add the a, b, c to our enclosing frame
    */
    private Expression letOptimize (Pair                   pair,
                                    CompileTimeEnvironment environment)
      throws SchemeException
    {
        if (!(pair.car instanceof Pair)) {
            return null;
        }

        Pair operatorPair = ((Pair)pair.car);
        if (operatorPair.car != Lambda) {
            return null;
        }

        ParsedLambda lambda = new ParsedLambda(operatorPair);

        if (lambda.nary) {
            return null;
        }

        ExpressionArray expressions = new ExpressionArray();

        /*
            First compile the initializers in the old environment
        */
        Object object = pair.cdr;
        while (object != Scheme.Null) {
            if (!(object instanceof Pair)) {
                throw new SyntaxException("argument list contains non-pair",
                                          pair);
            }
            Pair expression = (Pair)object;

            expressions.addElement(compile(expression.car, environment));
            object = expression.cdr;
        }

            // Make sure we had enough operands
        if (expressions.inUse != lambda.args.inUse) {
            throw new ArgumentCountException(Compiler.Lambda,
                                             lambda.args.inUse,
                                             expressions.inUse,
                                             pair);
        }

        /*
            Add new variables to environment
        */
        Variable[] variables = lambda.args.array();
        for (int v = 0; v < lambda.args.inUse; v++) {
            environment.addLocal(variables[v]);
        }

        /*
            Compile target addresses in new environment
        */
        for (int v = 0; v < lambda.args.inUse; v++) {
            expressions.array[v] =
                SetBangCompiler.makeAssignment(
                    environment.findVariable(variables[v].name),
                    expressions.array()[v],
                    pair);
        }

        /*
            Compile the body in the new environment and add it after the set!s
        */
        expressions.addElement(compile(new Pair(Compiler.Begin,
                                                lambda.body),
                                       environment));

        /*
            Remove new variables from environment
        */
        environment.removeLocals(lambda.args.inUse);

        return new Begin(expressions);
    }
}

/**
    Each SpecialFormCompiler knows how to compile one type
    of kernel syntax into subclasses of Expression.
*/
interface SpecialFormCompiler
{
    /**
        compileSpecial compiles a special form.

        Pair is the s-expression to compile

        environment is the current lexical CompileTimeEnvironment
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException;
}

/**
    SpecialFormCompiler for (quote x)
*/
class QuoteCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    QuoteCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        (quote x) => new Quoted(x)
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        Pair source = pair;
        if (!(pair.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.Quote, 1, 0, source);
        }
        Pair rest = (Pair)pair.cdr;
        if (rest.cdr != Scheme.Null) {
            throw new ArgumentCountException(Compiler.Quote, 1, 2, source);
        }
        return new Quoted(rest.car);
    }
}

/**
    SpecialFormCompiler for (set&33; x y)
*/
class SetBangCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    SetBangCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        if X is a GlobalVariable
        then (set&33; x y) =>  new GlobalAssignment(x, y);
        else (set&33; x y) =>  new LexicalAssignment(x, y);
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        Pair source = pair;
        if (!(pair.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.SetBang, 2, 0, source);
        }
        Pair rest = (Pair)pair.cdr;
        if (!(rest.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.SetBang, 2, 1, source);
        }
        Pair restRest = (Pair)rest.cdr;

        return makeAssignment(compiler.compile(rest.car, environment),
                              compiler.compile(restRest.car, environment),
                              source);
    }

    static Expression makeAssignment(Expression address,
                                     Expression expression,
                                     Pair       source)
      throws ArgumentTypeException
    {
        if (address instanceof GlobalVariable) {
            GlobalVariable var = (GlobalVariable)address;
            if (var.object == Scheme.Undefined) {
                Log.scheme.log(Level.WARNING,
                               "Undefined variable: {0}",
                               var.name);
            }
            return new GlobalAssignment(var, expression);
        }
        if (address instanceof LexicalAddress) {
            return new LexicalAssignment(((LexicalAddress)address),
                                         expression);
        }
        if (address instanceof LocalAddress) {
            return new LocalAssignment(((LocalAddress)address),
                                       expression);
        }
        throw new ArgumentTypeException(Compiler.SetBang,
                                        "Variable",
                                        address,
                                        source);
    }
}

/**
    SpecialFormCompiler for (define x y)
*/
class DefineCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    DefineCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        (define x y) =>  new Definition(x, y);

        (define (x &hellip;) y) => (define x (lambda (&hellip;) y)) => see above

    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        Pair source = pair;
        if (!(pair.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.Define, 2, 0, source);
        }
        Pair rest = (Pair)pair.cdr;
        if (!(rest.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.Define, 2, 1, source);
        }
        Pair restRest = (Pair)rest.cdr;

        /*
            (define foo ...)
        */
        if (rest.car instanceof Symbol) {
            Object expression = compiler.compile(rest.car,
                                                 environment);
            if (!(expression instanceof GlobalVariable)) {
                throw new ArgumentTypeException(Compiler.Define,
                                                "Variable",
                                                expression,
                                                source);
            }
            if (restRest.cdr != Scheme.Null) {
                throw
                    new SyntaxException("define with more than two arguments",
                                        source);
            }
            return new Definition((GlobalVariable)expression,
                                  compiler.compile(restRest.car,
                                                   environment));
        }

        /*
            (define (foo ...) ...)
        */
        else if (rest.car instanceof Pair) {
            Pair list = (Pair)rest.car;
            Pair lambda =
                new Pair(Compiler.Lambda,
                         new Pair(list.cdr,
                                  restRest));
            Object expression = compiler.compile(list.car,
                                                 environment);
            if (!(expression instanceof GlobalVariable)) {
                throw new ArgumentTypeException(Compiler.Define,
                                                "Variable",
                                                expression,
                                                source);
            }
            return new Definition((GlobalVariable)expression,
                                  compiler.compile(lambda,
                                                   environment));
        }
        else {
            throw new SyntaxException("define with invalid name", source);
        }
    }
}

/**
    SpecialFormCompiler for (if x y z)
*/
class IfCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    IfCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        (if x y z) => new If(x, y, z)
        (if x y) => new If(x, y, Scheme.Unspecified)
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        Pair source = pair;
        if (!(pair.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.If, 2, 0, source);
        }
        Pair rest = (Pair)pair.cdr;
        if (!(rest.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.If, 2, 1, source);
        }
        Pair restRest = (Pair)rest.cdr;
        if (restRest.cdr instanceof Pair) {
            Pair restRestRest = (Pair)restRest.cdr;
            return new If(compiler.compile(rest.car,
                                           environment),
                          compiler.compile(restRest.car,
                                           environment),
                          compiler.compile(restRestRest.car,
                                           environment));
        }
        else {
            return new If(compiler.compile(rest.car,
                                           environment),
                          compiler.compile(restRest.car,
                                           environment),
                          new Quoted(Scheme.Unspecified));
        }
    }
}

/**
    SpecialFormCompiler for (lambda (x) &hellip;)
*/
class LambdaCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    LambdaCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        (lambda (x y z) &hellip;) =>
        new Lambda(ArrayUtil.array (x, y, z), new Begin(&hellip;);

        (lambda (x y &46; z) &hellip;) =>
        new NaryLambda(ArrayUtil.array (x, y, z), new Begin(&hellip;);
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        ParsedLambda lambda = new ParsedLambda(pair);

        environment = environment.extend(lambda.args);

        Begin body = (Begin)
            compiler.compile(new Pair(Compiler.Begin, lambda.body),
                             environment);

        if (lambda.nary) {
            return new NaryLambda(environment, body);
        }
        else {
            return new Lambda(environment, body);
        }
    }
}

/**
    ParsedLambda factors out the parsing logic from the LambdaCompiler
    so that it can also be used when optimizing let when compiling
    applications.
*/
class ParsedLambda
{
    VariableArray args;
    boolean       nary;
    Pair          body;

    ParsedLambda (Pair pair) throws SchemeException
    {
        Pair source = pair;
        /*
            rest ~ pair.cdr ~ ((arg1 arg2 ...) . body)
        */
        if (!(pair.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.Lambda, 2, 0, source);
        }
        Pair rest = (Pair)pair.cdr;

        if (!(rest.cdr instanceof Pair)) {
            throw new ArgumentCountException(Compiler.Lambda, 2, 1, source);
        }
        /*
            body ~ (body-expr-1 body-expr-2 ...)
        */
        body = (Pair)rest.cdr;

        args = new VariableArray();
        SymbolArray symbols = new SymbolArray();
        Object vars = rest.car;

        while (vars instanceof Pair) {
            if (!(((Pair)vars).car instanceof Symbol)) {
                throw new ArgumentTypeException(Compiler.Lambda,
                                                "Symbol",
                                                ((Pair)vars).car,
                                                source);
            }
            Symbol symbol = (Symbol)((Pair)vars).car;
            if (symbols.containsIdentical(symbol)) {
                throw
                    new SyntaxException(
                        Fmt.S(
                            "Variable list contains duplicate variable name %s",
                            symbol),
                        source);
            }
            args.addElement(new Variable(symbol));
            vars = ((Pair)vars).cdr;
        }

        if (vars == Scheme.Null) {
            nary = false;
        }
        else if (vars instanceof Symbol) {
            nary = true;
            Symbol symbol = (Symbol)vars;
            if (symbols.containsIdentical(symbol)) {
                throw
                    new SyntaxException(
                        Fmt.S(
                            "Variable list contains duplicate variable name %s",
                        symbol),
                        source);
            }
                // add nary arg to begining of argument list
                // we represent it that way for NaryCompound
            args.addElement(null);
            System.arraycopy(args.array, 0, args.array, 1, args.inUse-1);
            args.array[0] = new Variable(symbol);
        }
        else {
            throw
                new SyntaxException(
                    "Bound variable list must end with symbol or null",
                    source);
        }
    }
}

/**
    SpecialFormCompiler for (begin &hellip;)
*/
class BeginCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    BeginCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        (begin &hellip;) => new Begin(&hellip;);
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        Pair source = pair;
        ExpressionArray expressionArray = new ExpressionArray();
        Object object = pair.cdr;
        while (object != Scheme.Null) {
            if (!(object instanceof Pair)) {
                throw new SyntaxException("begin contains non-pair",
                                          source);
            }
            Pair expression = (Pair)object;
            expressionArray.addElement(compiler.compile(expression.car,
                                                        environment));
            object = expression.cdr;
        }
        return new Begin(expressionArray);
    }
}

/**
    SpecialFormCompiler for (until x &hellip;)
*/
class UntilCompiler implements SpecialFormCompiler
{
    private Compiler compiler;

    UntilCompiler (Compiler compiler)
    {
        this.compiler = compiler;
    }

    /**
        (until test &hellip;)
        =>
        new Until(test, Begin(&hellip;))
    */
    public Expression compileSpecial (Pair                   pair,
                                      CompileTimeEnvironment environment)
      throws SchemeException
    {
        Pair source = pair;
        if (!(pair.cdr instanceof Pair)) {
            throw new SyntaxException("'until' missing test", source);
        }
        pair = (Pair)pair.cdr;

        Object test = pair.car;
        Pair   body = new Pair(Compiler.Begin, pair.cdr);

        return new Until(compiler.compile(test, environment),
                         (Begin)compiler.compile(body, environment));
    }
}