Commit 10033056 authored by ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar ehuelsmann@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Merge StandardObjectFunctions into StandardObject: the former defines

a single Primitive while  the latter defines multiple.

Also, add all the defined primitives to the java-autoloader.
parent aa95ff18
......@@ -564,6 +564,8 @@ public class Autoload extends Function
autoload(PACKAGE_SYS, "%run-shell-command", "ShellCommand");
autoload(PACKAGE_SYS, "%server-socket-close", "server_socket_close");
autoload(PACKAGE_SYS, "%set-arglist", "arglist");
autoload(PACKAGE_CL, "find-class", "LispClass", true);
autoload(PACKAGE_SYS, "%set-find-class", "LispClass", true);
autoload(PACKAGE_SYS, "%set-class-direct-slots", "SlotClass", true);
autoload(PACKAGE_SYS, "%set-function-info", "function_info");
autoload(PACKAGE_SYS, "%set-generic-function-lambda-list", "StandardGenericFunction", true);
......@@ -618,7 +620,7 @@ public class Autoload extends Function
autoload(PACKAGE_SYS, "cache-slot-location", "StandardGenericFunction", true);
autoload(PACKAGE_SYS, "canonicalize-logical-host", "LogicalPathname", true);
autoload(PACKAGE_SYS, "class-direct-slots", "SlotClass");
autoload(PACKAGE_SYS, "%float-bits", "FloatFunctions");
autoload(PACKAGE_SYS, "%float-bits", "FloatFunctions");
autoload(PACKAGE_SYS, "coerce-to-double-float", "FloatFunctions");
autoload(PACKAGE_SYS, "coerce-to-single-float", "FloatFunctions");
autoload(PACKAGE_SYS, "compute-class-direct-slots", "SlotClass", true);
......@@ -683,7 +685,16 @@ public class Autoload extends Function
autoload(PACKAGE_SYS, "set-slot-definition-writers", "SlotDefinition", true);
autoload(PACKAGE_SYS, "simple-list-remove-duplicates", "simple_list_remove_duplicates");
autoload(PACKAGE_SYS, "single-float-bits", "FloatFunctions", true);
autoload(PACKAGE_SYS, "%std-allocate-instance", "StandardObjectFunctions", true);
autoload(PACKAGE_SYS, "%std-allocate-instance", "StandardObject", true);
autoload(PACKAGE_SYS, "swap-slots", "StandardObject", true);
autoload(PACKAGE_SYS, "std-instance-layout", "StandardObject", true);
autoload(PACKAGE_SYS, "%set-std-instance-layout", "StandardObject", true);
autoload(PACKAGE_SYS, "std-instance-class", "StandardObject", true);
autoload(PACKAGE_SYS, "standard-instance-access", "StandardObject", true);
autoload(PACKAGE_SYS, "%set-standard-instance-access", "StandardObject", true);
autoload(PACKAGE_SYS, "std-slot-boundp", "StandardObject", true);
autoload(PACKAGE_SYS, "std-slot-value", "StandardObject", true);
autoload(PACKAGE_SYS, "set-std-slot-value", "StandardObject", true);
autoload(PACKAGE_SYS, "%allocate-funcallable-instance", "FuncallableStandardObject", true);
autoload(PACKAGE_SYS, "unzip", "unzip", true);
autoload(PACKAGE_SYS, "zip", "zip", true);
......
......@@ -615,4 +615,33 @@ public class StandardObject extends LispObject
return third;
}
};
private static final Primitive _STD_ALLOCATE_INSTANCE
= new pf__std_allocate_instance();
@DocString(name="%std-allocate-instance",
args="class",
returns="instance")
private static final class pf__std_allocate_instance extends Primitive
{
pf__std_allocate_instance()
{
super("%std-allocate-instance", PACKAGE_SYS, true, "class");
}
@Override
public LispObject execute(LispObject arg)
{
if (arg == StandardClass.STANDARD_CLASS)
return new StandardClass();
if (arg instanceof StandardClass)
return ((StandardClass)arg).allocateInstance();
if (arg.typep(StandardClass.STANDARD_CLASS) != NIL) {
LispObject l = Symbol.CLASS_LAYOUT.execute(arg);
if (! (l instanceof Layout))
return error(new ProgramError("Invalid standard class layout for: " + arg.princToString()));
return new StandardObject((Layout)l);
}
return type_error(arg, Symbol.STANDARD_CLASS);
}
};
}
/*
* StandardObjectFunctions.java
*
* Copyright (C) 2003-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 static org.armedbear.lisp.Lisp.*;
public class StandardObjectFunctions
{
private static final Primitive _STD_ALLOCATE_INSTANCE
= new pf__std_allocate_instance();
@DocString(name="%std-allocate-instance",
args="class",
returns="instance")
private static final class pf__std_allocate_instance extends Primitive
{
pf__std_allocate_instance()
{
super("%std-allocate-instance", PACKAGE_SYS, true, "class");
}
@Override
public LispObject execute(LispObject arg)
{
if (arg == StandardClass.STANDARD_CLASS)
return new StandardClass();
if (arg instanceof StandardClass)
return ((StandardClass)arg).allocateInstance();
if (arg.typep(StandardClass.STANDARD_CLASS) != NIL) {
LispObject l = Symbol.CLASS_LAYOUT.execute(arg);
if (! (l instanceof Layout))
return error(new ProgramError("Invalid standard class layout for: " + arg.princToString()));
return new StandardObject((Layout)l);
}
return type_error(arg, Symbol.STANDARD_CLASS);
}
};
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment