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

package bdc.scheme;

import bdc.scheme.compiler.Compiler;
import bdc.scheme.exception.ArgumentTypeException;
import bdc.scheme.exception.PrimitiveException;
import bdc.scheme.expression.Expression;
import bdc.scheme.expression.GlobalVariable;
import bdc.scheme.expression.Procedure;
import bdc.scheme.expression.Quoted;
import bdc.util.Fmt;
import bdc.util.InternCharToString;
import bdc.util.SystemUtil;
import bdc.util.URLUtil;
import java.io.PrintWriter;
import java.io.PushbackReader;
import java.io.StringReader;
import java.lang.reflect.Method;
import java.net.URL;
import java.util.Date;
import java.util.Enumeration;
import java.util.Hashtable;
import java.util.List;
import java.util.Map;
import java.util.List;
import java.util.logging.Level;

/**
    Scheme contains contants and helper functions for BDC Scheme.

    For historical reasons, when run it will create an interactive
    Read Eval Print Loop. The code that implements it is now in REPL.
*/
public final class Scheme
{
    //--- Constants -----------------------------------------------------------

    /**
        Filename extension for Scheme files
    */
    public static final String Extension = ".scm";

    /**
        Null value that can be stored in vectors etc
    */
    public static final Constant Null =
        new Constant("()");

    /**
        End of file marker
    */
    public static final Constant EOFObject =
        new Constant("#{EOF}");

    /**
        When a global is implicitly defined as a forward reference it
        is initialized to Undefined so that it can't be set&33; or
        evaluated
    */
    public static final Constant Undefined =
        new Constant("#{undefined}");

    /**
        Expressions sometimes do not return a value. Examples are
        define and set! and (if #f 1) effects and if's with no else.
        Instead this an Unspecifed value is returned. The REPL doesn't
        print anything in this case.
    */
    public static final Constant Unspecified =
        new Constant("#{unspecified}");

    /**
        Rewriters return this to signal an error

        possibly they could just construct a
    */
    public static final Constant MacroError =
        new Constant("#{macro-error}");

    /**
        If you get this value then something has gone wrong.
    */
    public static final Constant NotReached =
        new Constant("#{not-reached}");


    /**
        The base url for the loader to use for relative urls
    */
    private URL base;

    /**
        resolve a url relative to the base of the Scheme system
    */
    public URL url (String relative)
    {
        return URLUtil.asURL(base, relative);
    }


    public final GlobalEnvironment globalEnvironment = new GlobalEnvironment();

    public final Compiler compiler = new Compiler(this);

    private final Loader loader = new Loader(compiler);

    /*
        Create a Scheme system
    */
    public Scheme (URL base)
    {
        this.base = base;
        /*
            With a minimally functioning compiler and a way to
            register macros and primitves with "new" we load the rest
            from this special system file
        */
            // For some reason the compiler does not work with a +
            // here. dmitri
        load(Fmt.S("bdc/scheme/system%s", Extension));
    }

    //--- Helpers for null conversion -----------------------------------------


    /**
        Convert a potential Scheme.Null to null
    */
    public static Object schemeNullToNull (Object object)
    {
        return (object == Scheme.Null) ? null : object;
    }

    /**
        Convert a potential null to a Scheme.Null
    */
    public static Object nullToSchemeNull (Object object)
    {
        return (object == null) ? Scheme.Null : object;
    }


    //--- Helpers for booleans ------------------------------------------------

    /**
        Convert a potential Boolean.FALSE to false, otherwise true
    */
    public static boolean bool (Object object)
    {
        return (object != Boolean.FALSE);
    }


    //--- Helpers for checking type in primitive procedures -------------------

    /**
        Convert possible char[]'s and Scheme.Null's used at runtime
        to Java Strings and nulls.
    */
    public static Object object (Object object)
    {
        return Scheme.schemeNullToNull(maybeString(object));
    }

    /**
        Convert possible char[]'s used at runtime to Strings
    */
    public static Object maybeString (Object object)
    {
        if (object instanceof char[]) {
            char [] chars = ((char[])object);
                // since 95% of uses of objects are repeated
                // frequently, intern them
            return InternCharToString.intern(chars);
        }
        return object;
    }

    /**
        Object should be a String, otherwise throw ArgumentTypeException
    */
    public static String string (Object    object,
                                 Procedure procedure)
      throws ArgumentTypeException
    {
        Object o = object(object);
        if (o instanceof String) {
            return (String)o;
        }
        throw new ArgumentTypeException(procedure,
                                        "String or char[]",
                                        object);
    }

    /**
        Object should be a String or null,
        otherwise throw ArgumentTypeException
    */
    public static String stringOrNull (Object    object,
                                       Procedure procedure)
      throws ArgumentTypeException
    {
        Object o = object(object);
        if (o == null) {
            return null;
        }
        if (o instanceof String) {
            return (String)o;
        }
        throw new ArgumentTypeException(procedure,
                                        "String or char[] or null",
                                        object);
    }

    /**
        Object should be a Character, otherwise throw ArgumentTypeException
    */
    public static char character (Object    object,
                                  Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Character) {
            return ((Character)object).charValue();
        }
        throw new ArgumentTypeException(procedure,
                                        "Character",
                                        object);
    }

    /**
        Object should be a List, otherwise throw ArgumentTypeException
    */
    public static List list (Object    object,
                             Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof List) {
            return (List)object;
        }
        throw new ArgumentTypeException(procedure, "List", object);
    }

    /**
        Object should be a Throwable, otherwise throw ArgumentTypeException
    */
    public static Throwable throwable (Object    object,
                                       Procedure procedure)
      throws ArgumentTypeException
    {
        Object o = object(object);
        if (o instanceof Throwable) {
            return (Throwable)o;
        }
        throw new ArgumentTypeException(procedure,
                                        "Throwable",
                                        object);
    }

    /**
        Object should be a URL, otherwise throw ArgumentTypeException
    */
    public static URL url (Object    object,
                           Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof URL) {
            return (URL)object;
        }
        throw new ArgumentTypeException(procedure, "URL", object);
    }

    /**
        Object should be a Number, otherwise throw ArgumentTypeException
    */
    public static Number number (Object    object,
                                 Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Number) {
            return (Number)object;
        }
        throw new ArgumentTypeException(procedure, "Number", object);
    }

    /**
        Object should be a Integer, otherwise throw ArgumentTypeException
    */
    public static int integer (Object    object,
                               Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Integer) {
            return ((Integer)object).intValue();
        }
        throw new ArgumentTypeException(procedure, "Integer", object);
    }

    /**
        Object should be a procedure, otherwise throw ArgumentTypeException
    */
    public static Procedure procedure (Object    object,
                                       Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Procedure) {
            return (Procedure)object;
        }
        throw new ArgumentTypeException(procedure, "Procedure", object);
    }

    /**
        Object should be a Symbol, otherwise throw ArgumentTypeException
    */
    public static Symbol symbol (Object    object,
                                 Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Symbol) {
            return (Symbol)object;
        }
        throw new ArgumentTypeException(procedure, "Symbol", object);
    }

    /**
        Object should be a Pair, otherwise throw ArgumentTypeException
    */
    public static Pair pair (Object    object,
                             Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Pair) {
            return (Pair)object;
        }
        throw new ArgumentTypeException(procedure, "Pair", object);
    }

    /**
        Object should be a Map, otherwise throw ArgumentTypeException
    */
    public static Map map (Object    object,
                           Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Map) {
            return (Hashtable)object;
        }
        throw new ArgumentTypeException(procedure, "Map", object);
    }

    /**
        Object should be a Hashtable, otherwise throw ArgumentTypeException
    */
    public static Hashtable hashtable (Object    object,
                                       Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Hashtable) {
            return (Hashtable)object;
        }
        throw new ArgumentTypeException(procedure, "Hashtable", object);
    }

    /**
        Object should be an Enumeration, otherwise throw ArgumentTypeException
    */
    public static Enumeration enumeration (Object    object,
                                           Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Enumeration) {
            return (Enumeration)object;
        }
        throw new ArgumentTypeException(procedure, "Enumeration", object);
    }

    /**
        Object should be a Date, otherwise throw ArgumentTypeException
    */
    public static Date date (Object    object,
                             Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Date) {
            return (Date)object;
        }
        throw new ArgumentTypeException(procedure, "Date", object);
    }


    /**
        Object should be a PushbackReader, otherwise throw
        ArgumentTypeException
    */
    public static PushbackReader pushbackReader (Object    object,
                                                 Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof PushbackReader) {
            return (PushbackReader)object;
        }
        throw new ArgumentTypeException(procedure, "PushbackReader", object);
    }

    /**
        Object should be a PrintWriter, otherwise throw
        ArgumentTypeException
    */
    public static PrintWriter printWriter (Object    object,
                                           Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof PrintWriter) {
            return (PrintWriter)object;
        }
        throw new ArgumentTypeException(procedure, "PrintWriter", object);
    }

    /**
        Object should be a Class, otherwise throw
        ArgumentTypeException
    */
    public static Class clazz (Object    object,
                               Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Class) {
            return (Class)object;
        }
        throw new ArgumentTypeException(procedure, "Class", object);
    }

    /**
        Object should be a Method, otherwise throw
        ArgumentTypeException
    */
    public static Method method (Object    object,
                                 Procedure procedure)
      throws ArgumentTypeException
    {
        if (object instanceof Method) {
            return (Method)object;
        }
        throw new ArgumentTypeException(procedure, "Method", object);
    }


    //--- helpers to get per thread I/O context -------------------------------

    //--- Rethrown Exceptions -------------------------------------------------

    /**
        List of exception prototypes to rethrow if thrown during
        Scheme evaluation.

        @see #setRethrownExceptions
    */
    private List rethrownExceptions;

    /**
        Specifies a List of Exceptions that should be re-thrown
        when evaluating file.  The List contains prototype
        instances of the Throwable classes, and any throwables
        thrown during Scheme evaluation that are of the same class
        (and derived classes) will be rethrown.

        Currently the Exceptions must be subclasses of RuntimeException
    */
    public void setRethrownExceptions (List exceptions)
    {
        rethrownExceptions = exceptions;
    }

    /**
        Returns true if the specified Throwable should be rethrown.
        Checks the exceptions set with setRethrownExceptions as
        well as derived classes.

        @see #setRethrownExceptions
    */
    public boolean shouldRethrow (RuntimeException exception)
    {
        if (rethrownExceptions == null) {
            return false;
        }

        Class eClass = exception.getClass();

        for (int i = 0, count = rethrownExceptions.size(); i < count; i++) {
            Throwable prototype = (Throwable)rethrownExceptions.get(i);
            Class pClass = prototype.getClass();

            while (eClass != null) {
                if (eClass.equals(pClass)) {
                    return true;
                }

                eClass = eClass.getSuperclass();
            }

        }

        return false;
    }

    //--- Evaluating Strings --------------------------------------------------

    /**

        Evaluate a string as Scheme return the value of the last expression
        location is used for debugging purposes
        this variant throws SchemeException for better error handling
    */
    public Object evalWithException (String source, String location)
      throws SchemeException
    {
        location = (location == null) ? "<unknown source>" : location;
        try {
            return loader.load(new StringReader(source),
                               location,
                               new Stack(this));
        }
        catch (SchemeException e) {
            if (e instanceof PrimitiveException) {
                PrimitiveException primitiveException = (PrimitiveException)e;
                Throwable throwable = primitiveException.throwable;
                if (throwable instanceof RuntimeException &&
                    shouldRethrow((RuntimeException)throwable))
                {
                    throw (RuntimeException)throwable;
                }
            }
            throw e;
        }
    }

    /**
        Evaluate a string as Scheme return the value of the last expression
        location is used for debugging purposes
    */
    public Object eval (String source, String location)
    {
        location = (location == null) ? "<unknown source>" : location;
        try {
            return evalWithException(source, location);
        }
        catch (SchemeException e) {
             Log.scheme.log(Level.SEVERE,
                            "{0} problem evaluating source ''{1}''\n{2}",
                            new Object[] {
                                location,
                                source,
                                SystemUtil.stackTrace(e)}
                            );
            return null;
        }
    }

    /**
        Evaluate a string as Scheme return the value of the last expression
    */
    public Object eval (String source)
    {
        return eval(source, source);
    }

    //--- Evaluating Expressions ----------------------------------------------

    public Object evalWithException (Expression expression)
      throws SchemeException
    {
        try {
            return expression.eval(this);
        }
        catch (SchemeException e) {
            if (e instanceof PrimitiveException) {
                PrimitiveException primitiveException = (PrimitiveException)e;
                Throwable throwable = primitiveException.throwable;
                if (throwable instanceof RuntimeException &&
                    shouldRethrow((RuntimeException)throwable))
                {
                    throw (RuntimeException)throwable;
                }
            }
            throw e;
        }
    }

    public Object eval (Expression expression, String location)
    {
        location = (location == null) ? "<unknown source>" : location;
        try {
            return evalWithException(expression);
        }
        catch (SchemeException e) {
            Log.scheme.log(Level.SEVERE,
                           "{0} problem evaulating {1}\n{2}",
                           new Object[] {
                               location,
                               expression,
                               SystemUtil.stackTrace(e)}
                           );
            return null;
        }
    }


    /**
        evaluate an expression
    */
    public Object eval (Expression expression)
    {
        return eval(expression, null);
    }

    //--- Misc External Helpers -----------------------------------------------

    /**
        load a Scheme file and evaluate its contents
    */
    public Object load (String relative)
    {
        URL url = url(relative);
        Stack stack = new Stack(this);
        try {
            return loader.load(url, relative, stack);
        }
        catch (SchemeException e) {
            Log.scheme.log(
                Level.SEVERE,
                "problem loading from {0}\n{1}",
                new Object[] {url, e}
                );
            return null;
        }
    }

    /**
        Compile the specified Scheme string, raising exceptions on
        errors.
    */
    public void compile (String source)
      throws SchemeException
    {
        loader.load(new StringReader(source), null, new Stack(this));
    }


    /**
        lookup a variable
    */
    public Object lookup (String name)
    {
        GlobalVariable globalVariable = globalEnvironment.lookup(name);
        if (globalVariable == null) {
            Log.scheme.log(Level.WARNING,
                           "{0} variable is not defined",
                           name);
            return null;
        }
        return globalVariable.object;
    }

    /**
        lookup a variable expecting a procedure
    */
    public Procedure lookupProcedure (String name)
    {
        Object object = lookup(name);
        if (object == null) {
            return null;
        }
        if (!(object instanceof Procedure)) {
            Log.scheme.log(Level.WARNING,
                           "{0} variable is not a Procedure",
                           name);
            return null;
        }
        return (Procedure)object;
    }

    /**
        call a procedure by name with arguments
    */
    public Object call (String name, List args)
    {
        Procedure procedure = lookupProcedure(name);
        if (procedure == null) {
            return null;
        }
        return call(procedure, args);
    }

    /**
        call a procedure with a list of arguments
    */
    public Object call (Procedure procedure, List args)
    {
        return call(procedure, args.toArray());
    }

    /**
        call a procedure with an array of arguments
    */
    public Object call (Procedure procedure, Object[] args)
    {
        return eval(Compiler.makeApplication(new Quoted(procedure),
                                             args));
    }

    //--- main ----------------------------------------------------------------

    /**
        REPL for interactive use
    */
    public static void main (String[] args)
    {
        Scheme scheme = new Scheme(URLUtil.url());

        if (args.length == 1) {
            scheme.load(args[0]);
            return;
        }

        if (args.length == 2) {
            if (args[0].equals("-e")) {
                scheme.eval(args[1]);
                return;
            }
            if (args[0].equals("-p")) {
                SystemUtil.out().println(Writer.write(scheme.eval(args[1])));
                return;
            }
        }

        REPL repl = new REPL(scheme,
                             args,
                             new PushbackReader(SystemUtil.in()),
                             System.out,
                             System.err);
        repl.run();
    }

    //-------------------------------------------------------------------------
}

/**
    A simple helper class for constants so that we can control toString
*/
final class Constant
{
    /**
        the value to print in toString
    */
    String toString;

    /**
        create a constant
    */
    Constant (String toString)
    {
        this.toString = toString;
    }

    /**
        toString prints the specialize print value
    */
    public String toString ()
    {
        return toString;
    }
}