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

package bdc.scheme.compiler;

import java.util.ArrayList;
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.exception.ArgumentTypeException;
import bdc.scheme.exception.SyntaxException;
import bdc.scheme.expression.Procedure1;
import bdc.util.Fmt;

/**
    Do2Until converts reduces derived Do syntax into another form.
*/
public class Do2Until extends Procedure1
{
    /**
        (do ((x y (+ x 1) (a b)) ((foo&34; x) …a) …)
        =>
        (let ((x y) (a b))
        (until (foo&34; x) … (set&33; -x (+ x 1)) (set&33; x -x))
        …a)
    */
    public Object apply1 (Stack stack) throws SchemeException
    {
        Object o1 = stack.array[stack.inUse-1];
        Pair pair = Scheme.pair(o1, this);

        Pair source = pair;
        if (!(pair.cdr instanceof Pair)) {
            throw new SyntaxException("'do' missing arguments", source);
        }
        pair = (Pair)pair.cdr;
        Object varClauses = pair.car;

        if (!(pair.cdr instanceof Pair)) {
            throw new SyntaxException("'do' missing test clause", source);
        }
        pair = (Pair)pair.cdr;

        if (!(pair.car instanceof Pair)) {
            throw new SyntaxException("'do' invalid test clause", source);
        }
        Pair testClause = (Pair)pair.car;
        Pair body = new Pair(Compiler.Begin, pair.cdr);

        Object test   = testClause.car;
        Object result = testClause.cdr;

        SymbolArray vars  = new SymbolArray();
        SymbolArray temps = new SymbolArray();
        ArrayList inits = new ArrayList();
        ArrayList steps = new ArrayList();

        if ((!(varClauses instanceof Pair)) &&
            (varClauses != Scheme.Null))
        {
            throw new SyntaxException("'do' missing bindings", source);
        }

        while (varClauses != Scheme.Null) {
            pair = (Pair)varClauses;

            if (pair.car == Scheme.Null) {
                throw new SyntaxException("'do' binding missing variable",
                                          source);
            }
            if (!(pair.car instanceof Pair)) {
                throw new SyntaxException("'do' binding invalid", source);
            }
            pair = (Pair)pair.car;

            if (!(pair.car instanceof Symbol)) {
                throw new ArgumentTypeException(Compiler.Do,
                                                "Symbol",
                                                pair.car,
                                                source);
            }
            Symbol var = (Symbol)pair.car;

            if (!(pair.cdr instanceof Pair)) {
                throw new SyntaxException("'do' binding missing initializer",
                                          source);
            }
            pair = (Pair)pair.cdr;
            Object init = pair.car;

            Object step;
            if (pair.cdr == Scheme.Null) {
                step = null;
            }
            else if (!(pair.cdr instanceof Pair)) {
                throw new SyntaxException("'do' binding step invalid",
                                          source);
            }
            else {
                pair = (Pair)pair.cdr;
                step = pair.car;
            }

            vars.addElement(var);
            temps.addElement(Symbol.get(Fmt.S("--%s", var)));
            inits.add(init);
            if (step == null) {
                steps.add(var);
            }
            else {
                steps.add(step);
            }
            varClauses = ((Pair)varClauses).cdr;
        }


        /*
            Done parsing do, now rewrite to let/until
        */

        Object bindings = Scheme.Null;
        for (int i = 0; i < vars.inUse; i++) {
            Object var  = vars.array[i];
            Object temp = temps.array[i];
            Object init = inits.get(i);
            bindings = new Pair(new Pair(var,
                                         new Pair(init,
                                                  Scheme.Null)),
                                bindings);
                // Don't need last temp to avoid parallel assignment problem
            if (i != 0) {
                bindings = new Pair(new Pair(temp,
                                             new Pair(Scheme.Undefined,
                                                      Scheme.Null)),
                                    bindings);
            }
        }

        Object setBangs = Scheme.Null;
        for (int i = 0; i < vars.inUse; i++) {
            Object var  = vars.array[i];
            Object temp = temps.array[i];
            Object step = steps.get(i);
            if (var != step) {
                    // Once again, don't need last temp
                if (i != 0) {
                    setBangs =
                        new Pair(new Pair(Compiler.SetBang,
                                          new Pair(var,
                                                   new Pair(temp,
                                                            Scheme.Null))),
                                        setBangs);
                }
            }
        }
        for (int i = 0; i < vars.inUse; i++) {
            Object var  = vars.array[i];
            Object temp = temps.array[i];
            Object step = steps.get(i);
            if (var != step) {
                    // if last step, assign directly
                Object target = (i == 0) ? var : temp;
                setBangs = new Pair(new Pair(Compiler.SetBang,
                                             new Pair(target,
                                                      new Pair(step,
                                                               Scheme.Null))),
                                    setBangs);
            }
        }

        /*
            Make a shallow copy of the body so we don't change the source

            bodyCopy/lastPair/newPair logic is based on Reader.read's
            root/pair/newPair
        */
        Pair bodyCopy = null;
        Pair lastPair = null;
        Object bodyPart = body;
        while (bodyPart instanceof Pair) {
            Pair bodyPair = (Pair)bodyPart;
            Pair newPair = new Pair(bodyPair.car, bodyPair.cdr);

            if (bodyCopy == null) {
                bodyCopy = newPair;
                lastPair = newPair;
            }
            else {
                lastPair.cdr = newPair;
                lastPair = (Pair)lastPair.cdr;
            }
            bodyPart = bodyPair.cdr;
        }
        if (lastPair.cdr != Scheme.Null) {
            throw new SyntaxException("'do' body contains non-pair",
                                      source);
        }
            // splice setBangs to end of copy of body
        lastPair.cdr = setBangs;

        Pair until = new Pair(Compiler.Until,
                              new Pair(test,
                                       new Pair(bodyCopy,
                                                Scheme.Null)));

        Pair let = new Pair(Compiler.Let,
                            new Pair(bindings,
                                     new Pair(until,
                                              result)));
        return let;
    }
}