armedbear/lisp/Function.java

/*
 * Function.java
 *
 * Copyright (C) 2002-2005 Peter Graves
 * $Id$
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
 *
 * As a special exception, the copyright holders of this library give you
 * permission to link this library with independent modules to produce an
 * executable, regardless of the license terms of these independent
 * modules, and to copy and distribute the resulting executable under
 * terms of your choice, provided that you also meet, for each linked
 * independent module, the terms and conditions of the license of that
 * module.  An independent module is a module which is not derived from
 * or based on this library.  If you modify this library, you may extend
 * this exception to your version of the library, but you are not
 * obligated to do so.  If you do not wish to do so, delete this
 * exception statement from your version.
 */

package org.armedbear.lisp;

import java.io.*;
import java.io.ByteArrayInputStream;
import java.io.ByteArrayOutputStream;

import static org.armedbear.lisp.Lisp.*;

public abstract class Function extends Operator implements Serializable {
    private LispObject propertyList = NIL;
    private int callCount;
    private int hotCount;
    /**
     * The value of *load-truename* which was current when this function
     * was loaded, used for fetching the class bytes in case of disassembly.
     */
    public final LispObject loadedFrom;

    protected Function() {
	LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValueNoThrow();
	LispObject loadTruenameFasl = Symbol.LOAD_TRUENAME_FASL.symbolValueNoThrow();
	loadedFrom = loadTruenameFasl != null ? loadTruenameFasl : (loadTruename != null ? loadTruename : NIL);
    }

    public Function(String name)
    {
        this(name, (String)null);
    }

    public Function(String name, String arglist)
    {
	this();
        if(arglist != null)
            setLambdaList(new SimpleString(arglist));
        if (name != null) {
            Symbol symbol = Symbol.addFunction(name.toUpperCase(), this);
            if (cold)
                symbol.setBuiltInFunction(true);
            setLambdaName(symbol);
        }
    }

    public Function(Symbol symbol)
    {
	this(symbol, null, null);
    }

    public Function(Symbol symbol, String arglist)
    {
	this(symbol, arglist, null);
    }

    public Function(Symbol symbol, String arglist, String docstring)
    {
	this();
        symbol.setSymbolFunction(this);
        if (cold)
            symbol.setBuiltInFunction(true);
        setLambdaName(symbol);
        if(arglist != null)
            setLambdaList(new SimpleString(arglist));
        if (docstring != null)
            symbol.setDocumentation(Symbol.FUNCTION,
                                    new SimpleString(docstring));
    }

    public Function(String name, Package pkg)
    {
        this(name, pkg, false);
    }

    public Function(String name, Package pkg, boolean exported)
    {
        this(name, pkg, exported, null, null);
    }

    public Function(String name, Package pkg, boolean exported,
                    String arglist)
    {
        this(name, pkg, exported, arglist, null);
    }

    public Function(String name, Package pkg, boolean exported,
                    String arglist, String docstring)
    {
	this();
        if (arglist instanceof String)
            setLambdaList(new SimpleString(arglist));
        if (name != null) {
            Symbol symbol;
            if (exported)
                symbol = pkg.internAndExport(name.toUpperCase());
            else
                symbol = pkg.intern(name.toUpperCase());
            symbol.setSymbolFunction(this);
            if (cold)
                symbol.setBuiltInFunction(true);
            setLambdaName(symbol);
            if (docstring != null)
                symbol.setDocumentation(Symbol.FUNCTION,
                                        new SimpleString(docstring));
        }
    }

    public Function(LispObject name)
    {
	this();
        setLambdaName(name);
    }

    public Function(LispObject name, LispObject lambdaList)
    {
	this();
        setLambdaName(name);
        setLambdaList(lambdaList);
    }

    @Override
    public LispObject typeOf()
    {
        return Symbol.FUNCTION;
    }

    @Override
    public LispObject classOf()
    {
        return BuiltInClass.FUNCTION;
    }

    @Override
    public LispObject typep(LispObject typeSpecifier)
    {
        if (typeSpecifier == Symbol.FUNCTION)
            return T;
        if (typeSpecifier == Symbol.COMPILED_FUNCTION)
            return T;
        if (typeSpecifier == BuiltInClass.FUNCTION)
            return T;
        return super.typep(typeSpecifier);
    }

    @Override
    public final LispObject getPropertyList()
    {
        if (propertyList == null)
            propertyList = NIL;
        return propertyList;
    }

    @Override
    public final void setPropertyList(LispObject obj)
    {
        if (obj == null)
            throw new NullPointerException();
        propertyList = obj;
    }

    public final void setClassBytes(byte[] bytes)
    {
        propertyList = putf(propertyList, Symbol.CLASS_BYTES,
                            new JavaObject(bytes));
    }

    public final LispObject getClassBytes() {
        LispObject o = getf(propertyList, Symbol.CLASS_BYTES, NIL);
        if(o != NIL) {
            return o;
        } else {
            ClassLoader c = getClass().getClassLoader();
            if(c instanceof JavaClassLoader) {
                final LispThread thread = LispThread.currentThread();
                SpecialBindingsMark mark = thread.markSpecialBindings();
                try {
                    thread.bindSpecial(Symbol.LOAD_TRUENAME, loadedFrom);
                    return new JavaObject(((JavaClassLoader) c).getFunctionClassBytes(this));
                } catch(Throwable t) {
                    //This is because unfortunately getFunctionClassBytes uses
                    //Debug.assertTrue(false) to signal errors
                    if(t instanceof ControlTransfer) {
                        throw (ControlTransfer) t;
                    } else {
                        return NIL;
                    }
                } finally {
                    thread.resetSpecialBindings(mark);
                }
            } else {
                return NIL;
            }
        }
    }

    public static final Primitive FUNCTION_CLASS_BYTES = new pf_function_class_bytes();
    public static final class pf_function_class_bytes extends Primitive {
	public pf_function_class_bytes() {
	    super("function-class-bytes", PACKAGE_SYS, false, "function");
        }
        @Override
        public LispObject execute(LispObject arg) {
            if (arg instanceof Function) {
                return ((Function) arg).getClassBytes();
	    }
            return type_error(arg, Symbol.FUNCTION);
        }
    }

    @Override
    public LispObject execute()
    {
        return error(new WrongNumberOfArgumentsException(this, 0));
    }

    @Override
    public LispObject execute(LispObject arg)
    {
        return error(new WrongNumberOfArgumentsException(this, 1));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second)

    {
        return error(new WrongNumberOfArgumentsException(this, 2));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second,
                              LispObject third)

    {
        return error(new WrongNumberOfArgumentsException(this, 3));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second,
                              LispObject third, LispObject fourth)

    {
        return error(new WrongNumberOfArgumentsException(this, 4));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second,
                              LispObject third, LispObject fourth,
                              LispObject fifth)

    {
        return error(new WrongNumberOfArgumentsException(this, 5));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second,
                              LispObject third, LispObject fourth,
                              LispObject fifth, LispObject sixth)

    {
        return error(new WrongNumberOfArgumentsException(this, 6));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second,
                              LispObject third, LispObject fourth,
                              LispObject fifth, LispObject sixth,
                              LispObject seventh)

    {
        return error(new WrongNumberOfArgumentsException(this, 7));
    }

    @Override
    public LispObject execute(LispObject first, LispObject second,
                              LispObject third, LispObject fourth,
                              LispObject fifth, LispObject sixth,
                              LispObject seventh, LispObject eighth)

    {
        return error(new WrongNumberOfArgumentsException(this, 8));
    }

    @Override
    public LispObject execute(LispObject[] args)
    {
        return error(new WrongNumberOfArgumentsException(this));
    }

    @Override
    public String printObject()
    {
        LispObject name = getLambdaName();
        if (name != null && name != NIL) {
            return unreadableString(name.princToString());
        }
        // No name.
        LispObject lambdaList = getLambdaList();
        if (lambdaList != null) {
            StringBuilder sb = new StringBuilder("FUNCTION ");
            sb.append("(LAMBDA ");
            if (lambdaList == NIL) {
                sb.append("()");
            } else {
                final LispThread thread = LispThread.currentThread();
                final SpecialBindingsMark mark = thread.markSpecialBindings();
                thread.bindSpecial(Symbol.PRINT_LENGTH, Fixnum.THREE);
                try {
                    sb.append(lambdaList.printObject());
                }
                finally {
                    thread.resetSpecialBindings(mark);
                }
            }
            sb.append(")");
            return unreadableString(sb.toString());
        }
        return unreadableString("FUNCTION");
    }

    // Used by the JVM compiler.
    public final void argCountError()
    {
        error(new WrongNumberOfArgumentsException(this));
    }

    // Profiling.
    @Override
    public final int getCallCount()
    {
        return callCount;
    }

    @Override
    public void setCallCount(int n)
    {
        callCount = n;
    }

    @Override
    public final void incrementCallCount()
    {
        ++callCount;
    }

    @Override
    public final int getHotCount()
    {
        return hotCount;
    }

    @Override
    public void setHotCount(int n)
    {
        hotCount = n;
    }

    @Override
    public final void incrementHotCount()
    {
        ++hotCount;
    }

    //Serialization
    public static class SerializedNamedFunction implements Serializable {
        private final Symbol name;
        public SerializedNamedFunction(Symbol name) {
            this.name = name;
        }

        public Object readResolve() {
            return name.getSymbolFunctionOrDie();
        }
    }

    public static class ObjectInputStreamWithClassLoader extends ObjectInputStream {
        private final ClassLoader classLoader;
        public ObjectInputStreamWithClassLoader(InputStream in, ClassLoader classLoader) throws IOException {
            super(in);
            this.classLoader = classLoader;
        }

        @Override
        protected Class<?> resolveClass(ObjectStreamClass desc) throws IOException, ClassNotFoundException {
            return Class.forName(desc.getName(), false, classLoader);
        }
    }

    public static class SerializedLocalFunction implements Serializable {
        final LispObject className;
        final LispObject classBytes;
        final byte[] serializedFunction;

        public SerializedLocalFunction(Function function) {
            this.className = new SimpleString(function.getClass().getName());
            this.classBytes = function.getClassBytes();
            serializingClosure.set(true);
            try {
                ByteArrayOutputStream baos = new ByteArrayOutputStream();
                new ObjectOutputStream(baos).writeObject(function);
                serializedFunction = baos.toByteArray();
            } catch (IOException e) {
                throw new RuntimeException(e);
            } finally {
                serializingClosure.remove();
            }
        }

        public Object readResolve() throws InvalidObjectException {
            MemoryClassLoader loader = new MemoryClassLoader();
            MemoryClassLoader.PUT_MEMORY_FUNCTION.execute(JavaObject.getInstance(loader), className, classBytes);
            try {
                ByteArrayInputStream in = new ByteArrayInputStream(serializedFunction);
                return new ObjectInputStreamWithClassLoader(in, loader).readObject();
            } catch (Exception e) {
                InvalidObjectException ex = new InvalidObjectException("Could not read the serialized function back");
                ex.initCause(e);
                throw ex;
            }
        }
    }

    private static final ThreadLocal<Boolean> serializingClosure = new ThreadLocal<Boolean>();

    public Object writeReplace() throws ObjectStreamException {
        if(shouldSerializeByName()) {
            return new SerializedNamedFunction((Symbol) getLambdaName());
        } else if(getClassBytes() == NIL || serializingClosure.get() != null) {
            return this;
        } else {
            return new SerializedLocalFunction(this);
        }
    }

    protected boolean shouldSerializeByName() {
        LispObject lambdaName = getLambdaName();
        return lambdaName instanceof Symbol && lambdaName.getSymbolFunction() == this;
    }
}