Source Code Cross Referenced for Primitives.java in  » IDE » J » org » armedbear » lisp » Java Source Code / Java DocumentationJava Source Code and Java Documentation

Java Source Code / Java Documentation
1. 6.0 JDK Core
2. 6.0 JDK Modules
3. 6.0 JDK Modules com.sun
4. 6.0 JDK Modules com.sun.java
5. 6.0 JDK Modules sun
6. 6.0 JDK Platform
7. Ajax
8. Apache Harmony Java SE
9. Aspect oriented
10. Authentication Authorization
11. Blogger System
12. Build
13. Byte Code
14. Cache
15. Chart
16. Chat
17. Code Analyzer
18. Collaboration
19. Content Management System
20. Database Client
21. Database DBMS
22. Database JDBC Connection Pool
23. Database ORM
24. Development
25. EJB Server geronimo
26. EJB Server GlassFish
27. EJB Server JBoss 4.2.1
28. EJB Server resin 3.1.5
29. ERP CRM Financial
30. ESB
31. Forum
32. GIS
33. Graphic Library
34. Groupware
35. HTML Parser
36. IDE
37. IDE Eclipse
38. IDE Netbeans
39. Installer
40. Internationalization Localization
41. Inversion of Control
42. Issue Tracking
43. J2EE
44. JBoss
45. JMS
46. JMX
47. Library
48. Mail Clients
49. Net
50. Parser
51. PDF
52. Portal
53. Profiler
54. Project Management
55. Report
56. RSS RDF
57. Rule Engine
58. Science
59. Scripting
60. Search Engine
61. Security
62. Sevlet Container
63. Source Control
64. Swing Library
65. Template Engine
66. Test Coverage
67. Testing
68. UML
69. Web Crawler
70. Web Framework
71. Web Mail
72. Web Server
73. Web Services
74. Web Services apache cxf 2.0.1
75. Web Services AXIS2
76. Wiki Engine
77. Workflow Engines
78. XML
79. XML UI
Java
Java Tutorial
Java Open Source
Jar File Download
Java Articles
Java Products
Java by API
C# / C Sharp
C# / CSharp Tutorial
ASP.Net
JavaScript DHTML
JavaScript Tutorial
JavaScript Reference
HTML / CSS
HTML CSS Reference
C / ANSI-C
C Tutorial
C++
C++ Tutorial
PHP
Python
SQL Server / T-SQL
Oracle PL / SQL
Oracle PL/SQL Tutorial
PostgreSQL
SQL / MySQL
MySQL Tutorial
VB.Net
VB.Net Tutorial
Flash / Flex / ActionScript
VBA / Excel / Access / Word
Microsoft Office PowerPoint 2007 Tutorial
Microsoft Office Excel 2007 Tutorial
Microsoft Office Word 2007 Tutorial
Java Source Code / Java Documentation » IDE » J » org.armedbear.lisp 
Source Cross Referenced  Class Diagram Java Document (Java Doc) 


0001:        /*
0002:         * Primitives.java
0003:         *
0004:         * Copyright (C) 2002-2004 Peter Graves
0005:         * $Id: Primitives.java,v 1.681 2004/09/21 18:14:45 piso Exp $
0006:         *
0007:         * This program is free software; you can redistribute it and/or
0008:         * modify it under the terms of the GNU General Public License
0009:         * as published by the Free Software Foundation; either version 2
0010:         * of the License, or (at your option) any later version.
0011:         *
0012:         * This program is distributed in the hope that it will be useful,
0013:         * but WITHOUT ANY WARRANTY; without even the implied warranty of
0014:         * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
0015:         * GNU General Public License for more details.
0016:         *
0017:         * You should have received a copy of the GNU General Public License
0018:         * along with this program; if not, write to the Free Software
0019:         * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
0020:         */
0021:
0022:        package org.armedbear.lisp;
0023:
0024:        import java.io.File;
0025:        import java.math.BigInteger;
0026:        import java.util.ArrayList;
0027:
0028:        public final class Primitives extends Lisp {
0029:            // ### *
0030:            public static final Primitive MULTIPLY = new Primitive("*",
0031:                    "&rest numbers") {
0032:                public LispObject execute() {
0033:                    return Fixnum.ONE;
0034:                }
0035:
0036:                public LispObject execute(LispObject arg)
0037:                        throws ConditionThrowable {
0038:                    if (arg.numberp())
0039:                        return arg;
0040:                    signal(new TypeError(arg, "number"));
0041:                    return NIL;
0042:                }
0043:
0044:                public LispObject execute(LispObject first, LispObject second)
0045:                        throws ConditionThrowable {
0046:                    return first.multiplyBy(second);
0047:                }
0048:
0049:                public LispObject execute(LispObject[] args)
0050:                        throws ConditionThrowable {
0051:                    LispObject result = Fixnum.ONE;
0052:                    for (int i = 0; i < args.length; i++)
0053:                        result = result.multiplyBy(args[i]);
0054:                    return result;
0055:                }
0056:            };
0057:
0058:            // ### /
0059:            public static final Primitive DIVIDE = new Primitive("/",
0060:                    "numerator &rest denominators") {
0061:                public LispObject execute() throws ConditionThrowable {
0062:                    signal(new WrongNumberOfArgumentsException("/"));
0063:                    return NIL;
0064:                }
0065:
0066:                public LispObject execute(LispObject arg)
0067:                        throws ConditionThrowable {
0068:                    return Fixnum.ONE.divideBy(arg);
0069:                }
0070:
0071:                public LispObject execute(LispObject first, LispObject second)
0072:                        throws ConditionThrowable {
0073:                    return first.divideBy(second);
0074:                }
0075:
0076:                public LispObject execute(LispObject[] args)
0077:                        throws ConditionThrowable {
0078:                    LispObject result = args[0];
0079:                    for (int i = 1; i < args.length; i++)
0080:                        result = result.divideBy(args[i]);
0081:                    return result;
0082:                }
0083:            };
0084:
0085:            // ### min
0086:            public static final Primitive MIN = new Primitive("min",
0087:                    "&rest reals") {
0088:                public LispObject execute() throws ConditionThrowable {
0089:                    signal(new WrongNumberOfArgumentsException("min"));
0090:                    return NIL;
0091:                }
0092:
0093:                public LispObject execute(LispObject arg)
0094:                        throws ConditionThrowable {
0095:                    if (arg.realp())
0096:                        return arg;
0097:                    signal(new TypeError(arg, "real number"));
0098:                    return NIL;
0099:                }
0100:
0101:                public LispObject execute(LispObject[] args)
0102:                        throws ConditionThrowable {
0103:                    LispObject result = args[0];
0104:                    if (!result.realp())
0105:                        signal(new TypeError(result, "real number"));
0106:                    for (int i = 1; i < args.length; i++) {
0107:                        if (args[i].isLessThan(result))
0108:                            result = args[i];
0109:                    }
0110:                    return result;
0111:                }
0112:            };
0113:
0114:            // ### max
0115:            public static final Primitive MAX = new Primitive("max",
0116:                    "&rest reals") {
0117:                public LispObject execute() throws ConditionThrowable {
0118:                    signal(new WrongNumberOfArgumentsException("max"));
0119:                    return NIL;
0120:                }
0121:
0122:                public LispObject execute(LispObject arg)
0123:                        throws ConditionThrowable {
0124:                    if (arg.realp())
0125:                        return arg;
0126:                    signal(new TypeError(arg, "real number"));
0127:                    return NIL;
0128:                }
0129:
0130:                public LispObject execute(LispObject[] args)
0131:                        throws ConditionThrowable {
0132:                    LispObject result = args[0];
0133:                    if (!result.realp())
0134:                        signal(new TypeError(result, "real number"));
0135:                    for (int i = 1; i < args.length; i++) {
0136:                        if (args[i].isGreaterThan(result))
0137:                            result = args[i];
0138:                    }
0139:                    return result;
0140:                }
0141:            };
0142:
0143:            // ### identity
0144:            private static final Primitive1 IDENTITY = new Primitive1(
0145:                    "identity", "object") {
0146:                public LispObject execute(LispObject arg)
0147:                        throws ConditionThrowable {
0148:                    return arg;
0149:                }
0150:            };
0151:
0152:            // ### compiled-function-p
0153:            private static final Primitive1 COMPILED_FUNCTION_P = new Primitive1(
0154:                    "compiled-function-p", "object") {
0155:                public LispObject execute(LispObject arg)
0156:                        throws ConditionThrowable {
0157:                    return arg.typep(Symbol.COMPILED_FUNCTION);
0158:                }
0159:            };
0160:
0161:            // ### consp
0162:            private static final Primitive1 CONSP = new Primitive1("consp",
0163:                    "object") {
0164:                public LispObject execute(LispObject arg)
0165:                        throws ConditionThrowable {
0166:                    return arg instanceof  Cons ? T : NIL;
0167:                }
0168:            };
0169:
0170:            // ### listp
0171:            private static final Primitive1 LISTP = new Primitive1("listp",
0172:                    "object") {
0173:                public LispObject execute(LispObject arg)
0174:                        throws ConditionThrowable {
0175:                    return arg.LISTP();
0176:                }
0177:            };
0178:
0179:            // ### abs
0180:            private static final Primitive1 ABS = new Primitive1("abs",
0181:                    "number") {
0182:                public LispObject execute(LispObject arg)
0183:                        throws ConditionThrowable {
0184:                    return arg.ABS();
0185:                }
0186:            };
0187:
0188:            // ### arrayp
0189:            private static final Primitive1 ARRAYP = new Primitive1("arrayp",
0190:                    "object") {
0191:                public LispObject execute(LispObject arg)
0192:                        throws ConditionThrowable {
0193:                    return arg instanceof  AbstractArray ? T : NIL;
0194:                }
0195:            };
0196:
0197:            // ### array-has-fill-pointer-p
0198:            private static final Primitive1 ARRAY_HAS_FILL_POINTER_P = new Primitive1(
0199:                    "array-has-fill-pointer-p", "array") {
0200:                public LispObject execute(LispObject arg)
0201:                        throws ConditionThrowable {
0202:                    try {
0203:                        return ((AbstractArray) arg).hasFillPointer() ? T : NIL;
0204:                    } catch (ClassCastException e) {
0205:                        return signal(new TypeError(arg, Symbol.ARRAY));
0206:                    }
0207:                }
0208:            };
0209:
0210:            // ### vectorp
0211:            private static final Primitive1 VECTORP = new Primitive1("vectorp",
0212:                    "object") {
0213:                public LispObject execute(LispObject arg)
0214:                        throws ConditionThrowable {
0215:                    return arg.VECTORP();
0216:                }
0217:            };
0218:
0219:            // ### simple-vector-p
0220:            private static final Primitive1 SIMPLE_VECTOR_P = new Primitive1(
0221:                    "simple-vector-p", "object") {
0222:                public LispObject execute(LispObject arg)
0223:                        throws ConditionThrowable {
0224:                    return arg instanceof  SimpleVector ? T : NIL;
0225:                }
0226:            };
0227:
0228:            // ### bit-vector-p
0229:            private static final Primitive1 BIT_VECTOR_P = new Primitive1(
0230:                    "bit-vector-p", "object") {
0231:                public LispObject execute(LispObject arg)
0232:                        throws ConditionThrowable {
0233:                    return arg.BIT_VECTOR_P();
0234:                }
0235:            };
0236:
0237:            // ### simple-bit-vector-p
0238:            private static final Primitive1 SIMPLE_BIT_VECTOR_P = new Primitive1(
0239:                    "simple-bit-vector-p", "object") {
0240:                public LispObject execute(LispObject arg)
0241:                        throws ConditionThrowable {
0242:                    return arg.typep(Symbol.SIMPLE_BIT_VECTOR);
0243:                }
0244:            };
0245:
0246:            // ### %eval
0247:            private static final Primitive1 _EVAL = new Primitive1("%eval",
0248:                    PACKAGE_SYS, false, "form") {
0249:                public LispObject execute(LispObject arg)
0250:                        throws ConditionThrowable {
0251:                    return eval(arg, new Environment(), LispThread
0252:                            .currentThread());
0253:                }
0254:            };
0255:
0256:            // ### eq
0257:            private static final Primitive2 EQ = new Primitive2("eq", "x y") {
0258:                public LispObject execute(LispObject first, LispObject second)
0259:                        throws ConditionThrowable {
0260:                    return first == second ? T : NIL;
0261:                }
0262:            };
0263:
0264:            // ### eql
0265:            private static final Primitive2 EQL = new Primitive2("eql", "x y") {
0266:                public LispObject execute(LispObject first, LispObject second)
0267:                        throws ConditionThrowable {
0268:                    return first.eql(second) ? T : NIL;
0269:                }
0270:            };
0271:
0272:            // ### equal
0273:            private static final Primitive2 EQUAL = new Primitive2("equal",
0274:                    "x y") {
0275:                public LispObject execute(LispObject first, LispObject second)
0276:                        throws ConditionThrowable {
0277:                    return first.equal(second) ? T : NIL;
0278:                }
0279:            };
0280:
0281:            // ### equalp
0282:            private static final Primitive2 EQUALP = new Primitive2("equalp",
0283:                    "x y") {
0284:                public LispObject execute(LispObject first, LispObject second)
0285:                        throws ConditionThrowable {
0286:                    return first.equalp(second) ? T : NIL;
0287:                }
0288:            };
0289:
0290:            // ### values
0291:            private static final Primitive VALUES = new Primitive("values",
0292:                    "&rest object") {
0293:                public LispObject execute() throws ConditionThrowable {
0294:                    return LispThread.currentThread().setValues();
0295:                }
0296:
0297:                public LispObject execute(LispObject arg)
0298:                        throws ConditionThrowable {
0299:                    return LispThread.currentThread().setValues(arg);
0300:                }
0301:
0302:                public LispObject execute(LispObject first, LispObject second)
0303:                        throws ConditionThrowable {
0304:                    return LispThread.currentThread().setValues(first, second);
0305:                }
0306:
0307:                public LispObject execute(LispObject first, LispObject second,
0308:                        LispObject third) throws ConditionThrowable {
0309:                    return LispThread.currentThread().setValues(first, second,
0310:                            third);
0311:                }
0312:
0313:                public LispObject execute(LispObject[] args)
0314:                        throws ConditionThrowable {
0315:                    return LispThread.currentThread().setValues(args);
0316:                }
0317:            };
0318:
0319:            // ### values-list
0320:            // values-list list => element*
0321:            // Returns the elements of the list as multiple values.
0322:            private static final Primitive1 VALUES_LIST = new Primitive1(
0323:                    "values-list", "list") {
0324:                public LispObject execute(LispObject arg)
0325:                        throws ConditionThrowable {
0326:                    return LispThread.currentThread().setValues(
0327:                            arg.copyToArray());
0328:                }
0329:            };
0330:
0331:            // ### cons
0332:            private static final Primitive2 CONS = new Primitive2("cons",
0333:                    "object-1 object-2") {
0334:                public LispObject execute(LispObject first, LispObject second)
0335:                        throws ConditionThrowable {
0336:                    return new Cons(first, second);
0337:                }
0338:            };
0339:
0340:            // ### length
0341:            private static final Primitive1 LENGTH = new Primitive1("length",
0342:                    "sequence") {
0343:                public LispObject execute(LispObject arg)
0344:                        throws ConditionThrowable {
0345:                    return arg.LENGTH();
0346:                }
0347:            };
0348:
0349:            // ### elt
0350:            private static final Primitive2 ELT = new Primitive2("elt",
0351:                    "sequence index") {
0352:                public LispObject execute(LispObject first, LispObject second)
0353:                        throws ConditionThrowable {
0354:                    try {
0355:                        return first.elt(((Fixnum) second).value);
0356:                    } catch (ClassCastException e) {
0357:                        return signal(new TypeError(second, Symbol.FIXNUM));
0358:                    }
0359:                }
0360:            };
0361:
0362:            // ### atom
0363:            private static final Primitive1 ATOM = new Primitive1("atom",
0364:                    "object") {
0365:                public LispObject execute(LispObject arg)
0366:                        throws ConditionThrowable {
0367:                    return arg instanceof  Cons ? NIL : T;
0368:                }
0369:            };
0370:
0371:            // ### constantp
0372:            private static final Primitive CONSTANTP = new Primitive(
0373:                    "constantp", "form &optional environment") {
0374:                public LispObject execute(LispObject arg)
0375:                        throws ConditionThrowable {
0376:                    return arg.constantp() ? T : NIL;
0377:                }
0378:
0379:                public LispObject execute(LispObject first, LispObject second)
0380:                        throws ConditionThrowable {
0381:                    return first.constantp() ? T : NIL;
0382:                }
0383:            };
0384:
0385:            // ### functionp
0386:            private static final Primitive1 FUNCTIONP = new Primitive1(
0387:                    "functionp", "object") {
0388:                public LispObject execute(LispObject arg)
0389:                        throws ConditionThrowable {
0390:                    return (arg instanceof  Function || arg instanceof  GenericFunction) ? T
0391:                            : NIL;
0392:                }
0393:            };
0394:
0395:            // ### special-operator-p
0396:            private static final Primitive1 SPECIAL_OPERATOR_P = new Primitive1(
0397:                    "special-operator-p", "symbol") {
0398:                public LispObject execute(LispObject arg)
0399:                        throws ConditionThrowable {
0400:                    return arg.getSymbolFunction() instanceof  SpecialOperator ? T
0401:                            : NIL;
0402:                }
0403:            };
0404:
0405:            // ### symbolp
0406:            private static final Primitive1 SYMBOLP = new Primitive1("symbolp",
0407:                    "object") {
0408:                public LispObject execute(LispObject arg)
0409:                        throws ConditionThrowable {
0410:                    return arg instanceof  Symbol ? T : NIL;
0411:                }
0412:            };
0413:
0414:            // ### endp
0415:            private static final Primitive1 ENDP = new Primitive1("endp",
0416:                    "list") {
0417:                public LispObject execute(LispObject arg)
0418:                        throws ConditionThrowable {
0419:                    return arg.endp() ? T : NIL;
0420:                }
0421:            };
0422:
0423:            // ### null
0424:            private static final Primitive1 NULL = new Primitive1("null",
0425:                    "object") {
0426:                public LispObject execute(LispObject arg)
0427:                        throws ConditionThrowable {
0428:                    return arg == NIL ? T : NIL;
0429:                }
0430:            };
0431:
0432:            // ### not
0433:            private static final Primitive1 NOT = new Primitive1("not", "x") {
0434:                public LispObject execute(LispObject arg)
0435:                        throws ConditionThrowable {
0436:                    return arg == NIL ? T : NIL;
0437:                }
0438:            };
0439:
0440:            // ### plusp
0441:            private static final Primitive1 PLUSP = new Primitive1("plusp",
0442:                    "real") {
0443:                public LispObject execute(LispObject arg)
0444:                        throws ConditionThrowable {
0445:                    return arg.PLUSP();
0446:                }
0447:            };
0448:
0449:            // ### minusp
0450:            private static final Primitive1 MINUSP = new Primitive1("minusp",
0451:                    "real") {
0452:                public LispObject execute(LispObject arg)
0453:                        throws ConditionThrowable {
0454:                    return arg.MINUSP();
0455:                }
0456:            };
0457:
0458:            // ### zerop
0459:            private static final Primitive1 ZEROP = new Primitive1("zerop",
0460:                    "number") {
0461:                public LispObject execute(LispObject arg)
0462:                        throws ConditionThrowable {
0463:                    return arg.ZEROP();
0464:                }
0465:            };
0466:
0467:            // ### fixnump
0468:            private static final Primitive1 FIXNUMP = new Primitive1("fixnump",
0469:                    PACKAGE_EXT, true) {
0470:                public LispObject execute(LispObject arg)
0471:                        throws ConditionThrowable {
0472:                    return arg instanceof  Fixnum ? T : NIL;
0473:                }
0474:            };
0475:
0476:            // ### symbol-value
0477:            private static final Primitive1 SYMBOL_VALUE = new Primitive1(
0478:                    "symbol-value", "symbol") {
0479:                public LispObject execute(LispObject arg)
0480:                        throws ConditionThrowable {
0481:                    final Symbol symbol = checkSymbol(arg);
0482:                    LispObject value = LispThread.currentThread()
0483:                            .lookupSpecial(symbol);
0484:                    if (value == null) {
0485:                        value = symbol.symbolValue();
0486:                        if (value instanceof  SymbolMacro)
0487:                            signal(new LispError(arg.writeToString()
0488:                                    + " has no dynamic value."));
0489:                    }
0490:                    return value;
0491:                }
0492:            };
0493:
0494:            // ### set
0495:            // set symbol value => value
0496:            private static final Primitive2 SET = new Primitive2("set",
0497:                    "symbol value") {
0498:                public LispObject execute(LispObject first, LispObject second)
0499:                        throws ConditionThrowable {
0500:                    Symbol symbol = checkSymbol(first);
0501:                    Environment dynEnv = LispThread.currentThread()
0502:                            .getDynamicEnvironment();
0503:                    if (dynEnv != null) {
0504:                        Binding binding = dynEnv.getBinding(symbol);
0505:                        if (binding != null) {
0506:                            binding.value = second;
0507:                            return second;
0508:                        }
0509:                    }
0510:                    symbol.setSymbolValue(second);
0511:                    return second;
0512:                }
0513:            };
0514:
0515:            // ### rplaca
0516:            private static final Primitive2 RPLACA = new Primitive2("rplaca",
0517:                    "cons object") {
0518:                public LispObject execute(LispObject first, LispObject second)
0519:                        throws ConditionThrowable {
0520:                    first.setCar(second);
0521:                    return first;
0522:                }
0523:            };
0524:
0525:            // ### rplacd
0526:            private static final Primitive2 RPLACD = new Primitive2("rplacd",
0527:                    "cons object") {
0528:                public LispObject execute(LispObject first, LispObject second)
0529:                        throws ConditionThrowable {
0530:                    first.setCdr(second);
0531:                    return first;
0532:                }
0533:            };
0534:
0535:            // ### +
0536:            private static final Primitive ADD = new Primitive("+",
0537:                    "&rest numbers") {
0538:                public LispObject execute(LispObject first, LispObject second)
0539:                        throws ConditionThrowable {
0540:                    return first.add(second);
0541:                }
0542:
0543:                public LispObject execute(LispObject[] args)
0544:                        throws ConditionThrowable {
0545:                    LispObject result = Fixnum.ZERO;
0546:                    final int length = args.length;
0547:                    for (int i = 0; i < length; i++)
0548:                        result = result.add(args[i]);
0549:                    return result;
0550:                }
0551:            };
0552:
0553:            // ### 1+
0554:            private static final Primitive1 ONE_PLUS = new Primitive1("1+",
0555:                    "number") {
0556:                public LispObject execute(LispObject arg)
0557:                        throws ConditionThrowable {
0558:                    return arg.incr();
0559:                }
0560:            };
0561:
0562:            // ### -
0563:            private static final Primitive SUBTRACT = new Primitive("-",
0564:                    "minuend &rest subtrahends") {
0565:                public LispObject execute(LispObject first, LispObject second)
0566:                        throws ConditionThrowable {
0567:                    return first.subtract(second);
0568:                }
0569:
0570:                public LispObject execute(LispObject[] args)
0571:                        throws ConditionThrowable {
0572:                    switch (args.length) {
0573:                    case 0:
0574:                        signal(new WrongNumberOfArgumentsException("-"));
0575:                    case 1:
0576:                        return Fixnum.ZERO.subtract(args[0]);
0577:                    case 2:
0578:                        Debug.assertTrue(false);
0579:                        return args[0].subtract(args[1]);
0580:                    default: {
0581:                        LispObject result = args[0];
0582:                        for (int i = 1; i < args.length; i++)
0583:                            result = result.subtract(args[i]);
0584:                        return result;
0585:                    }
0586:                    }
0587:                }
0588:            };
0589:
0590:            // ### 1-
0591:            private static final Primitive1 ONE_MINUS = new Primitive1("1-",
0592:                    "number") {
0593:                public LispObject execute(LispObject arg)
0594:                        throws ConditionThrowable {
0595:                    return arg.decr();
0596:                }
0597:            };
0598:
0599:            // ### when
0600:            private static final SpecialOperator WHEN = new SpecialOperator(
0601:                    "when") {
0602:                public LispObject execute(LispObject args, Environment env)
0603:                        throws ConditionThrowable {
0604:                    if (args == NIL)
0605:                        signal(new WrongNumberOfArgumentsException(this ));
0606:                    final LispThread thread = LispThread.currentThread();
0607:                    if (eval(args.car(), env, thread) != NIL) {
0608:                        args = args.cdr();
0609:                        LispObject result = NIL;
0610:                        while (args != NIL) {
0611:                            result = eval(args.car(), env, thread);
0612:                            args = args.cdr();
0613:                        }
0614:                        return result;
0615:                    } else
0616:                        return thread.setValues(NIL);
0617:                }
0618:            };
0619:
0620:            // ### unless
0621:            private static final SpecialOperator UNLESS = new SpecialOperator(
0622:                    "unless") {
0623:                public LispObject execute(LispObject args, Environment env)
0624:                        throws ConditionThrowable {
0625:                    if (args == NIL)
0626:                        signal(new WrongNumberOfArgumentsException(this ));
0627:                    final LispThread thread = LispThread.currentThread();
0628:                    if (eval(args.car(), env, thread) == NIL) {
0629:                        args = args.cdr();
0630:                        LispObject result = NIL;
0631:                        while (args != NIL) {
0632:                            result = eval(args.car(), env, thread);
0633:                            args = args.cdr();
0634:                        }
0635:                        return result;
0636:                    } else
0637:                        return thread.setValues(NIL);
0638:                }
0639:            };
0640:
0641:            // ### %output-object object stream => object
0642:            private static final Primitive2 _OUTPUT_OBJECT = new Primitive2(
0643:                    "%output-object", PACKAGE_SYS, false) {
0644:                public LispObject execute(LispObject first, LispObject second)
0645:                        throws ConditionThrowable {
0646:                    outSynonymOf(second)._writeString(first.writeToString());
0647:                    return first;
0648:                }
0649:            };
0650:
0651:            // ### %write-to-string object => string
0652:            private static final Primitive1 _WRITE_TO_STRING = new Primitive1(
0653:                    "%write-to-string", PACKAGE_SYS, false) {
0654:                public LispObject execute(LispObject arg)
0655:                        throws ConditionThrowable {
0656:                    return new SimpleString(arg.writeToString());
0657:                }
0658:            };
0659:
0660:            // ### princ-to-string
0661:            private static final Primitive1 PRINC_TO_STRING = new Primitive1(
0662:                    "princ-to-string", "object") {
0663:                public LispObject execute(LispObject arg)
0664:                        throws ConditionThrowable {
0665:                    LispThread thread = LispThread.currentThread();
0666:                    Environment oldDynEnv = thread.getDynamicEnvironment();
0667:                    thread.bindSpecial(_PRINT_ESCAPE_, NIL);
0668:                    thread.bindSpecial(_PRINT_READABLY_, NIL);
0669:                    SimpleString string = new SimpleString(arg.writeToString());
0670:                    thread.setDynamicEnvironment(oldDynEnv);
0671:                    return string;
0672:                }
0673:            };
0674:
0675:            // ### prin1-to-string
0676:            private static final Primitive1 PRIN1_TO_STRING = new Primitive1(
0677:                    "prin1-to-string", "object") {
0678:                public LispObject execute(LispObject arg)
0679:                        throws ConditionThrowable {
0680:                    LispThread thread = LispThread.currentThread();
0681:                    Environment oldDynEnv = thread.getDynamicEnvironment();
0682:                    thread.bindSpecial(_PRINT_ESCAPE_, T);
0683:                    SimpleString string = new SimpleString(arg.writeToString());
0684:                    thread.setDynamicEnvironment(oldDynEnv);
0685:                    return string;
0686:                }
0687:            };
0688:
0689:            // ### %terpri
0690:            // %terpri output-stream => nil
0691:            private static final Primitive1 _TERPRI = new Primitive1("%terpri",
0692:                    PACKAGE_SYS, false, "output-stream") {
0693:                public LispObject execute(LispObject arg)
0694:                        throws ConditionThrowable {
0695:                    return outSynonymOf(arg).terpri();
0696:                }
0697:            };
0698:
0699:            // ### %fresh-line
0700:            // %fresh-line &optional output-stream => generalized-boolean
0701:            private static final Primitive1 _FRESH_LINE = new Primitive1(
0702:                    "%fresh-line", PACKAGE_SYS, false, "output-stream") {
0703:                public LispObject execute(LispObject arg)
0704:                        throws ConditionThrowable {
0705:                    return outSynonymOf(arg).freshLine();
0706:                }
0707:            };
0708:
0709:            // ### boundp
0710:            // Determines only whether a symbol has a value in the global environment;
0711:            // any lexical bindings are ignored.
0712:            private static final Primitive1 BOUNDP = new Primitive1("boundp",
0713:                    "symbol") {
0714:                public LispObject execute(LispObject obj)
0715:                        throws ConditionThrowable {
0716:                    Symbol symbol = checkSymbol(obj);
0717:                    // PROGV: "If too few values are supplied, the remaining symbols
0718:                    // are bound and then made to have no value." So BOUNDP must
0719:                    // explicitly check for a binding with no value.
0720:                    Environment dynEnv = LispThread.currentThread()
0721:                            .getDynamicEnvironment();
0722:                    if (dynEnv != null) {
0723:                        Binding binding = dynEnv.getBinding(symbol);
0724:                        if (binding != null)
0725:                            return binding.value != null ? T : NIL;
0726:                    }
0727:                    // No binding.
0728:                    return symbol.getSymbolValue() != null ? T : NIL;
0729:                }
0730:            };
0731:
0732:            // ### fboundp
0733:            private static final Primitive1 FBOUNDP = new Primitive1("fboundp",
0734:                    "name") {
0735:                public LispObject execute(LispObject arg)
0736:                        throws ConditionThrowable {
0737:                    if (arg instanceof  Symbol)
0738:                        return arg.getSymbolFunction() != null ? T : NIL;
0739:                    if (arg instanceof  Cons && arg.car() == Symbol.SETF) {
0740:                        LispObject f = get(checkSymbol(arg.cadr()),
0741:                                Symbol._SETF_FUNCTION);
0742:                        return f != null ? T : NIL;
0743:                    }
0744:                    signal(new TypeError(arg, "valid function name"));
0745:                    return NIL;
0746:                }
0747:            };
0748:
0749:            // ### fmakunbound
0750:            private static final Primitive1 FMAKUNBOUND = new Primitive1(
0751:                    "fmakunbound", "name") {
0752:                public LispObject execute(LispObject arg)
0753:                        throws ConditionThrowable {
0754:                    if (arg instanceof  Symbol) {
0755:                        ((Symbol) arg).setSymbolFunction(null);
0756:                    } else if (arg instanceof  Cons && arg.car() == Symbol.SETF) {
0757:                        remprop(checkSymbol(arg.cadr()), Symbol._SETF_FUNCTION);
0758:                    } else
0759:                        signal(new TypeError(arg, "valid function name"));
0760:                    return arg;
0761:                }
0762:            };
0763:
0764:            // ### remprop
0765:            private static final Primitive2 REMPROP = new Primitive2("remprop",
0766:                    "symbol indicator") {
0767:                public LispObject execute(LispObject first, LispObject second)
0768:                        throws ConditionThrowable {
0769:                    return remprop(checkSymbol(first), second);
0770:                }
0771:            };
0772:
0773:            // ### append
0774:            public static final Primitive APPEND = new Primitive("append",
0775:                    "&rest lists") {
0776:                public LispObject execute() {
0777:                    return NIL;
0778:                }
0779:
0780:                public LispObject execute(LispObject arg) {
0781:                    return arg;
0782:                }
0783:
0784:                public LispObject execute(LispObject first, LispObject second)
0785:                        throws ConditionThrowable {
0786:                    if (first == NIL)
0787:                        return second;
0788:                    // APPEND is required to copy its first argument.
0789:                    Cons result = new Cons(first.car());
0790:                    Cons splice = result;
0791:                    first = first.cdr();
0792:                    while (first != NIL) {
0793:                        Cons temp = new Cons(first.car());
0794:                        splice.setCdr(temp);
0795:                        splice = temp;
0796:                        first = first.cdr();
0797:                    }
0798:                    splice.setCdr(second);
0799:                    return result;
0800:                }
0801:
0802:                public LispObject execute(LispObject[] args)
0803:                        throws ConditionThrowable {
0804:                    Cons result = null;
0805:                    Cons splice = null;
0806:                    final int limit = args.length - 1;
0807:                    int i;
0808:                    for (i = 0; i < limit; i++) {
0809:                        LispObject top = args[i];
0810:                        if (top == NIL)
0811:                            continue;
0812:                        result = new Cons(top.car());
0813:                        splice = result;
0814:                        top = top.cdr();
0815:                        while (top != NIL) {
0816:                            Cons temp = new Cons(top.car());
0817:                            splice.setCdr(temp);
0818:                            splice = temp;
0819:                            top = top.cdr();
0820:                        }
0821:                        break;
0822:                    }
0823:                    if (result == null)
0824:                        return args[i];
0825:                    for (++i; i < limit; i++) {
0826:                        LispObject top = args[i];
0827:                        while (top != NIL) {
0828:                            Cons temp = new Cons(top.car());
0829:                            splice.setCdr(temp);
0830:                            splice = temp;
0831:                            top = top.cdr();
0832:                        }
0833:                    }
0834:                    splice.setCdr(args[i]);
0835:                    return result;
0836:                }
0837:            };
0838:
0839:            // ### nconc
0840:            private static final Primitive NCONC = new Primitive("nconc",
0841:                    "&rest lists") {
0842:                public LispObject execute(LispObject[] array)
0843:                        throws ConditionThrowable {
0844:                    switch (array.length) {
0845:                    case 0:
0846:                        return NIL;
0847:                    case 1:
0848:                        return array[0];
0849:                    default: {
0850:                        LispObject result = null;
0851:                        LispObject splice = null;
0852:                        final int limit = array.length - 1;
0853:                        int i;
0854:                        for (i = 0; i < limit; i++) {
0855:                            LispObject list = array[i];
0856:                            if (list == NIL)
0857:                                continue;
0858:                            if (list instanceof  Cons) {
0859:                                if (splice != null) {
0860:                                    splice.setCdr(list);
0861:                                    splice = list;
0862:                                }
0863:                                while (list instanceof  Cons) {
0864:                                    if (result == null) {
0865:                                        result = list;
0866:                                        splice = result;
0867:                                    } else {
0868:                                        splice = list;
0869:                                    }
0870:                                    list = list.cdr();
0871:                                }
0872:                            } else
0873:                                signal(new TypeError(list, "list"));
0874:                        }
0875:                        if (result == null)
0876:                            return array[i];
0877:                        splice.setCdr(array[i]);
0878:                        return result;
0879:                    }
0880:                    }
0881:                }
0882:            };
0883:
0884:            // ### =
0885:            // Numeric equality.
0886:            private static final Primitive EQUALS = new Primitive("=",
0887:                    "&rest numbers") {
0888:                public LispObject execute(LispObject first, LispObject second)
0889:                        throws ConditionThrowable {
0890:                    return first.isEqualTo(second) ? T : NIL;
0891:                }
0892:
0893:                public LispObject execute(LispObject[] array)
0894:                        throws ConditionThrowable {
0895:                    final int length = array.length;
0896:                    if (length < 1)
0897:                        signal(new WrongNumberOfArgumentsException(this ));
0898:                    final LispObject obj = array[0];
0899:                    for (int i = 1; i < length; i++) {
0900:                        if (array[i].isNotEqualTo(obj))
0901:                            return NIL;
0902:                    }
0903:                    return T;
0904:                }
0905:            };
0906:
0907:            // Returns true if no two numbers are the same; otherwise returns false.
0908:            private static final Primitive NOT_EQUALS = new Primitive("/=",
0909:                    "&rest numbers") {
0910:                public LispObject execute(LispObject first, LispObject second)
0911:                        throws ConditionThrowable {
0912:                    return first.isNotEqualTo(second) ? T : NIL;
0913:                }
0914:
0915:                public LispObject execute(LispObject[] array)
0916:                        throws ConditionThrowable {
0917:                    final int length = array.length;
0918:                    if (length == 2)
0919:                        return array[0].isNotEqualTo(array[1]) ? T : NIL;
0920:                    if (length < 1)
0921:                        signal(new WrongNumberOfArgumentsException(this ));
0922:                    for (int i = 0; i < length; i++) {
0923:                        final LispObject obj = array[i];
0924:                        for (int j = i + 1; j < length; j++) {
0925:                            if (array[j].isEqualTo(obj))
0926:                                return NIL;
0927:                        }
0928:                    }
0929:                    return T;
0930:                }
0931:            };
0932:
0933:            // ### <
0934:            // Numeric comparison.
0935:            private static final Primitive LESS_THAN = new Primitive("<",
0936:                    "&rest numbers") {
0937:                public LispObject execute(LispObject first, LispObject second)
0938:                        throws ConditionThrowable {
0939:                    return first.isLessThan(second) ? T : NIL;
0940:                }
0941:
0942:                public LispObject execute(LispObject[] array)
0943:                        throws ConditionThrowable {
0944:                    final int length = array.length;
0945:                    if (length < 1)
0946:                        signal(new WrongNumberOfArgumentsException(this ));
0947:                    for (int i = 1; i < length; i++) {
0948:                        if (array[i].isLessThanOrEqualTo(array[i - 1]))
0949:                            return NIL;
0950:                    }
0951:                    return T;
0952:                }
0953:            };
0954:
0955:            // ### <=
0956:            private static final Primitive LE = new Primitive("<=",
0957:                    "&rest numbers") {
0958:                public LispObject execute(LispObject first, LispObject second)
0959:                        throws ConditionThrowable {
0960:                    return first.isLessThanOrEqualTo(second) ? T : NIL;
0961:                }
0962:
0963:                public LispObject execute(LispObject[] array)
0964:                        throws ConditionThrowable {
0965:                    switch (array.length) {
0966:                    case 0:
0967:                        signal(new WrongNumberOfArgumentsException(this ));
0968:                    case 1:
0969:                        return T;
0970:                    case 2:
0971:                        Debug.assertTrue(false);
0972:                        return array[0].isLessThanOrEqualTo(array[1]) ? T : NIL;
0973:                    default: {
0974:                        final int length = array.length;
0975:                        for (int i = 1; i < length; i++) {
0976:                            if (array[i].isLessThan(array[i - 1]))
0977:                                return NIL;
0978:                        }
0979:                        return T;
0980:                    }
0981:                    }
0982:                }
0983:            };
0984:
0985:            // ### >
0986:            private static final Primitive GREATER_THAN = new Primitive(">",
0987:                    "&rest numbers") {
0988:                public LispObject execute(LispObject first, LispObject second)
0989:                        throws ConditionThrowable {
0990:                    return first.isGreaterThan(second) ? T : NIL;
0991:                }
0992:
0993:                public LispObject execute(LispObject[] array)
0994:                        throws ConditionThrowable {
0995:                    final int length = array.length;
0996:                    if (length < 1)
0997:                        signal(new WrongNumberOfArgumentsException(this ));
0998:                    for (int i = 1; i < length; i++) {
0999:                        if (array[i].isGreaterThanOrEqualTo(array[i - 1]))
1000:                            return NIL;
1001:                    }
1002:                    return T;
1003:                }
1004:            };
1005:
1006:            // ### >=
1007:            private static final Primitive GE = new Primitive(">=",
1008:                    "&rest numbers") {
1009:                public LispObject execute(LispObject first, LispObject second)
1010:                        throws ConditionThrowable {
1011:                    return first.isGreaterThanOrEqualTo(second) ? T : NIL;
1012:                }
1013:
1014:                public LispObject execute(LispObject[] array)
1015:                        throws ConditionThrowable {
1016:                    final int length = array.length;
1017:                    switch (length) {
1018:                    case 0:
1019:                        signal(new WrongNumberOfArgumentsException(this ));
1020:                    case 1:
1021:                        return T;
1022:                    case 2:
1023:                        Debug.assertTrue(false);
1024:                        return array[0].isGreaterThanOrEqualTo(array[1]) ? T
1025:                                : NIL;
1026:                    default:
1027:                        for (int i = 1; i < length; i++) {
1028:                            if (array[i].isGreaterThan(array[i - 1]))
1029:                                return NIL;
1030:                        }
1031:                        return T;
1032:                    }
1033:                }
1034:            };
1035:
1036:            // ### assoc
1037:            // assoc item alist &key key test test-not => entry
1038:            // This is the bootstrap version (needed for %set-documentation).
1039:            // Redefined properly in assoc.lisp.
1040:            private static final Primitive ASSOC = new Primitive("assoc",
1041:                    "item alist &key key test test-not") {
1042:                public LispObject execute(LispObject[] args)
1043:                        throws ConditionThrowable {
1044:                    if (args.length != 2)
1045:                        signal(new WrongNumberOfArgumentsException(this ));
1046:                    LispObject item = args[0];
1047:                    LispObject alist = args[1];
1048:                    while (alist != NIL) {
1049:                        LispObject cons = alist.car();
1050:                        if (cons instanceof  Cons) {
1051:                            if (cons.car().eql(item))
1052:                                return cons;
1053:                        } else if (cons != NIL)
1054:                            signal(new TypeError(cons, "list"));
1055:                        alist = alist.cdr();
1056:                    }
1057:                    return NIL;
1058:                }
1059:            };
1060:
1061:            // ### nth
1062:            // nth n list => object
1063:            private static final Primitive2 NTH = new Primitive2("nth",
1064:                    "n list") {
1065:                public LispObject execute(LispObject first, LispObject second)
1066:                        throws ConditionThrowable {
1067:                    int index = Fixnum.getValue(first);
1068:                    if (index < 0)
1069:                        signal(new TypeError("NTH: invalid index " + index
1070:                                + "."));
1071:                    int i = 0;
1072:                    while (true) {
1073:                        if (i == index)
1074:                            return second.car();
1075:                        second = second.cdr();
1076:                        if (second == NIL)
1077:                            return NIL;
1078:                        ++i;
1079:                    }
1080:                }
1081:            };
1082:
1083:            // ### %set-nth
1084:            // %setnth n list new-object => new-object
1085:            private static final Primitive3 _SET_NTH = new Primitive3(
1086:                    "%set-nth", PACKAGE_SYS, false) {
1087:                public LispObject execute(LispObject first, LispObject second,
1088:                        LispObject third) throws ConditionThrowable {
1089:                    int index = Fixnum.getValue(first);
1090:                    if (index < 0)
1091:                        signal(new TypeError("(SETF NTH): invalid index "
1092:                                + index + "."));
1093:                    int i = 0;
1094:                    while (true) {
1095:                        if (i == index) {
1096:                            second.setCar(third);
1097:                            return third;
1098:                        }
1099:                        second = second.cdr();
1100:                        if (second == NIL) {
1101:                            return signal(new LispError(
1102:                                    "(SETF NTH): the index " + index
1103:                                            + "is too large."));
1104:                        }
1105:                        ++i;
1106:                    }
1107:                }
1108:            };
1109:
1110:            // ### nthcdr
1111:            private static final Primitive2 NTHCDR = new Primitive2("nthcdr",
1112:                    "n list") {
1113:                public LispObject execute(LispObject first, LispObject second)
1114:                        throws ConditionThrowable {
1115:                    final int index = Fixnum.getValue(first);
1116:                    if (index < 0)
1117:                        signal(new TypeError("NTHCDR: invalid index " + index
1118:                                + "."));
1119:                    for (int i = 0; i < index; i++) {
1120:                        second = second.cdr();
1121:                        if (second == NIL)
1122:                            return NIL;
1123:                    }
1124:                    return second;
1125:                }
1126:            };
1127:
1128:            // ### error
1129:            private static final Primitive ERROR = new Primitive("error",
1130:                    "datum &rest arguments") {
1131:                public LispObject execute(LispObject[] args)
1132:                        throws ConditionThrowable {
1133:                    if (args.length < 1) {
1134:                        signal(new WrongNumberOfArgumentsException(this ));
1135:                        return NIL;
1136:                    }
1137:                    LispObject datum = args[0];
1138:                    if (datum instanceof  Condition) {
1139:                        signal((Condition) datum);
1140:                        return NIL;
1141:                    }
1142:                    if (datum instanceof  Symbol) {
1143:                        LispObject initArgs = NIL;
1144:                        for (int i = 1; i < args.length; i++)
1145:                            initArgs = new Cons(args[i], initArgs);
1146:                        initArgs = initArgs.nreverse();
1147:                        Condition condition;
1148:                        if (datum == Symbol.FILE_ERROR)
1149:                            condition = new FileError(initArgs);
1150:                        else if (datum == Symbol.PACKAGE_ERROR)
1151:                            condition = new PackageError(initArgs);
1152:                        else if (datum == Symbol.PARSE_ERROR)
1153:                            condition = new ParseError(initArgs);
1154:                        else if (datum == Symbol.PROGRAM_ERROR)
1155:                            condition = new ProgramError(initArgs);
1156:                        else if (datum == Symbol.SIMPLE_CONDITION)
1157:                            condition = new SimpleCondition(initArgs);
1158:                        else if (datum == Symbol.SIMPLE_WARNING)
1159:                            condition = new SimpleWarning(initArgs);
1160:                        else if (datum == Symbol.UNBOUND_SLOT)
1161:                            condition = new UnboundSlot(initArgs);
1162:                        else if (datum == Symbol.WARNING)
1163:                            condition = new Warning(initArgs);
1164:                        else if (datum == Symbol.SIMPLE_ERROR)
1165:                            condition = new SimpleError(initArgs);
1166:                        else if (datum == Symbol.SIMPLE_TYPE_ERROR)
1167:                            condition = new SimpleTypeError(initArgs);
1168:                        else if (datum == Symbol.CONTROL_ERROR)
1169:                            condition = new ControlError(initArgs);
1170:                        else if (datum == Symbol.TYPE_ERROR)
1171:                            condition = new TypeError(initArgs);
1172:                        else if (datum == Symbol.UNDEFINED_FUNCTION)
1173:                            condition = new UndefinedFunction(initArgs);
1174:                        else
1175:                            // Default.
1176:                            condition = new SimpleError(initArgs);
1177:                        signal(condition);
1178:                        return NIL;
1179:                    }
1180:                    // Default is SIMPLE-ERROR.
1181:                    LispObject formatControl = args[0];
1182:                    LispObject formatArguments = NIL;
1183:                    for (int i = 1; i < args.length; i++)
1184:                        formatArguments = new Cons(args[i], formatArguments);
1185:                    formatArguments = formatArguments.nreverse();
1186:                    signal(new SimpleError(formatControl, formatArguments));
1187:                    return NIL;
1188:                }
1189:            };
1190:
1191:            // ### signal
1192:            private static final Primitive SIGNAL = new Primitive("signal",
1193:                    "datum &rest arguments") {
1194:                public LispObject execute(LispObject[] args)
1195:                        throws ConditionThrowable {
1196:                    if (args.length < 1)
1197:                        throw new ConditionThrowable(
1198:                                new WrongNumberOfArgumentsException(this ));
1199:                    if (args[0] instanceof  Condition)
1200:                        throw new ConditionThrowable((Condition) args[0]);
1201:                    throw new ConditionThrowable(new SimpleCondition());
1202:                }
1203:            };
1204:
1205:            // ### %format
1206:            private static final Primitive _FORMAT = new Primitive("%format",
1207:                    PACKAGE_SYS, false, "destination control-string &rest args") {
1208:                public LispObject execute(LispObject[] args)
1209:                        throws ConditionThrowable {
1210:                    if (args.length < 2)
1211:                        signal(new WrongNumberOfArgumentsException(this ));
1212:                    LispObject destination = args[0];
1213:                    // Copy remaining arguments.
1214:                    LispObject[] _args = new LispObject[args.length - 1];
1215:                    for (int i = 0; i < _args.length; i++)
1216:                        _args[i] = args[i + 1];
1217:                    String s = _format(_args);
1218:                    if (destination == T) {
1219:                        checkCharacterOutputStream(
1220:                                _STANDARD_OUTPUT_.symbolValue())
1221:                                ._writeString(s);
1222:                        return NIL;
1223:                    }
1224:                    if (destination == NIL)
1225:                        return new SimpleString(s);
1226:                    if (destination instanceof  TwoWayStream) {
1227:                        Stream out = ((TwoWayStream) destination)
1228:                                .getOutputStream();
1229:                        if (out instanceof  Stream) {
1230:                            ((Stream) out)._writeString(s);
1231:                            return NIL;
1232:                        }
1233:                        signal(new TypeError(destination,
1234:                                "character output stream"));
1235:                    }
1236:                    if (destination instanceof  Stream) {
1237:                        ((Stream) destination)._writeString(s);
1238:                        return NIL;
1239:                    }
1240:                    return NIL;
1241:                }
1242:            };
1243:
1244:            private static final String _format(LispObject[] args)
1245:                    throws ConditionThrowable {
1246:                LispObject formatControl = args[0];
1247:                LispObject formatArguments = NIL;
1248:                for (int i = 1; i < args.length; i++)
1249:                    formatArguments = new Cons(args[i], formatArguments);
1250:                formatArguments = formatArguments.nreverse();
1251:                return format(formatControl, formatArguments);
1252:            }
1253:
1254:            private static final Symbol _SIMPLE_FORMAT_FUNCTION_ = internSpecial(
1255:                    "*SIMPLE-FORMAT-FUNCTION*", PACKAGE_SYS, _FORMAT);
1256:
1257:            // ### %defun
1258:            // %defun name arglist body &optional environment => name
1259:            private static final Primitive _DEFUN = new Primitive("%defun",
1260:                    PACKAGE_SYS, false,
1261:                    "function-name lambda-list body &optional environment") {
1262:                public LispObject execute(LispObject first, LispObject second,
1263:                        LispObject third) throws ConditionThrowable {
1264:                    return execute(first, second, third, new Environment());
1265:                }
1266:
1267:                public LispObject execute(LispObject first, LispObject second,
1268:                        LispObject third, LispObject fourth)
1269:                        throws ConditionThrowable {
1270:                    Environment env;
1271:                    if (fourth != NIL)
1272:                        env = checkEnvironment(fourth);
1273:                    else
1274:                        env = new Environment();
1275:                    final Symbol symbol;
1276:                    if (first instanceof  Symbol) {
1277:                        symbol = (Symbol) first;
1278:                        if (symbol.getSymbolFunction() instanceof  SpecialOperator) {
1279:                            String message = symbol.getName()
1280:                                    + " is a special operator and may not be redefined.";
1281:                            return signal(new ProgramError(message));
1282:                        }
1283:                    } else if (first instanceof  Cons
1284:                            && first.car() == Symbol.SETF) {
1285:                        symbol = checkSymbol(first.cadr());
1286:                    } else
1287:                        return signal(new TypeError(first.writeToString()
1288:                                + " is not a valid function name."));
1289:                    LispObject arglist = checkList(second);
1290:                    LispObject body = checkList(third);
1291:                    if (body.car() instanceof  AbstractString
1292:                            && body.cdr() != NIL) {
1293:                        // Documentation.
1294:                        if (first instanceof  Symbol)
1295:                            symbol.setFunctionDocumentation(body.car());
1296:                        else
1297:                            ; // FIXME Support documentation for SETF functions!
1298:                        body = body.cdr();
1299:                    }
1300:                    LispObject decls = NIL;
1301:                    while (body.car() instanceof  Cons
1302:                            && body.car().car() == Symbol.DECLARE) {
1303:                        decls = new Cons(body.car(), decls);
1304:                        body = body.cdr();
1305:                    }
1306:                    body = new Cons(symbol, body);
1307:                    body = new Cons(Symbol.BLOCK, body);
1308:                    body = new Cons(body, NIL);
1309:                    while (decls != NIL) {
1310:                        body = new Cons(decls.car(), body);
1311:                        decls = decls.cdr();
1312:                    }
1313:                    Closure closure = new Closure(
1314:                            first instanceof  Symbol ? symbol : null, arglist,
1315:                            body, env);
1316:                    closure.setArglist(arglist);
1317:                    if (first instanceof  Symbol) {
1318:                        symbol.setSymbolFunction(closure);
1319:                    } else {
1320:                        // SETF function
1321:                        put(symbol, Symbol._SETF_FUNCTION, closure);
1322:                    }
1323:                    // Clear function table entry (if any).
1324:                    if (FUNCTION_TABLE != null) {
1325:                        FUNCTION_TABLE.remhash(first);
1326:                    }
1327:                    return first;
1328:                }
1329:            };
1330:
1331:            // ### macro-function
1332:            // Need to support optional second argument specifying environment.
1333:            private static final Primitive MACRO_FUNCTION = new Primitive(
1334:                    "macro-function", "symbol &optional environment") {
1335:                public LispObject execute(LispObject arg)
1336:                        throws ConditionThrowable {
1337:                    LispObject obj = arg.getSymbolFunction();
1338:                    if (obj instanceof  AutoloadMacro) {
1339:                        ((AutoloadMacro) obj).load();
1340:                        obj = arg.getSymbolFunction();
1341:                    }
1342:                    if (obj instanceof  MacroObject)
1343:                        return ((MacroObject) obj).getExpander();
1344:                    if (obj instanceof  SpecialOperator) {
1345:                        obj = get((Symbol) arg, Symbol.MACROEXPAND_MACRO, NIL);
1346:                        if (obj instanceof  AutoloadMacro) {
1347:                            ((AutoloadMacro) obj).load();
1348:                            obj = get((Symbol) arg, Symbol.MACROEXPAND_MACRO,
1349:                                    NIL);
1350:                        }
1351:                        if (obj instanceof  MacroObject)
1352:                            return ((MacroObject) obj).getExpander();
1353:                    }
1354:                    return NIL;
1355:                }
1356:            };
1357:
1358:            // ### defmacro
1359:            private static final SpecialOperator DEFMACRO = new SpecialOperator(
1360:                    "defmacro") {
1361:                public LispObject execute(LispObject args, Environment env)
1362:                        throws ConditionThrowable {
1363:                    Symbol symbol = checkSymbol(args.car());
1364:                    LispObject lambdaList = checkList(args.cadr());
1365:                    LispObject body = args.cddr();
1366:                    LispObject block = new Cons(Symbol.BLOCK, new Cons(symbol,
1367:                            body));
1368:                    LispObject toBeApplied = list2(Symbol.FUNCTION, list3(
1369:                            Symbol.LAMBDA, lambdaList, block));
1370:                    LispObject formArg = gensym("FORM-");
1371:                    LispObject envArg = gensym("ENV-"); // Ignored.
1372:                    LispObject expander = list3(Symbol.LAMBDA, list2(formArg,
1373:                            envArg), list3(Symbol.APPLY, toBeApplied, list2(
1374:                            Symbol.CDR, formArg)));
1375:                    Closure expansionFunction = new Closure(expander.cadr(),
1376:                            expander.cddr(), env);
1377:                    MacroObject macroObject = new MacroObject(expansionFunction);
1378:                    if (symbol.getSymbolFunction() instanceof  SpecialOperator)
1379:                        put(symbol, Symbol.MACROEXPAND_MACRO, macroObject);
1380:                    else
1381:                        symbol.setSymbolFunction(macroObject);
1382:                    macroObject.setArglist(lambdaList);
1383:                    LispThread.currentThread().clearValues();
1384:                    return symbol;
1385:                }
1386:            };
1387:
1388:            // ### make-macro
1389:            private static final Primitive1 MAKE_MACRO = new Primitive1(
1390:                    "make-macro", PACKAGE_SYS, false) {
1391:                public LispObject execute(LispObject arg)
1392:                        throws ConditionThrowable {
1393:                    return new MacroObject(arg);
1394:                }
1395:            };
1396:
1397:            // ### %defparameter
1398:            private static final Primitive3 _DEFPARAMETER = new Primitive3(
1399:                    "%defparameter", PACKAGE_SYS, false) {
1400:                public LispObject execute(LispObject first, LispObject second,
1401:                        LispObject third) throws ConditionThrowable {
1402:                    Symbol symbol = checkSymbol(first);
1403:                    if (third instanceof  AbstractString)
1404:                        symbol.setVariableDocumentation(third);
1405:                    else if (third != NIL)
1406:                        signal(new TypeError(third, "string"));
1407:                    symbol.setSymbolValue(second);
1408:                    symbol.setSpecial(true);
1409:                    return symbol;
1410:                }
1411:            };
1412:
1413:            // ### %defvar
1414:            private static final Primitive1 _DEFVAR = new Primitive1("%defvar",
1415:                    PACKAGE_SYS, false) {
1416:                public LispObject execute(LispObject arg)
1417:                        throws ConditionThrowable {
1418:                    Symbol symbol = checkSymbol(arg);
1419:                    symbol.setSpecial(true);
1420:                    return symbol;
1421:                }
1422:            };
1423:
1424:            // ### %defconstant
1425:            private static final Primitive3 _DEFCONSTANT = new Primitive3(
1426:                    "%defconstant", PACKAGE_SYS, false) {
1427:                public LispObject execute(LispObject first, LispObject second,
1428:                        LispObject third) throws ConditionThrowable {
1429:                    Symbol symbol = checkSymbol(first);
1430:                    if (third instanceof  AbstractString)
1431:                        symbol.setVariableDocumentation(third);
1432:                    else if (third != NIL)
1433:                        signal(new TypeError(third, "string"));
1434:                    symbol.setSymbolValue(second);
1435:                    symbol.setSpecial(true);
1436:                    symbol.setConstant(true);
1437:                    return symbol;
1438:                }
1439:            };
1440:
1441:            // ### cond
1442:            private static final SpecialOperator COND = new SpecialOperator(
1443:                    "cond", "&rest clauses") {
1444:                public LispObject execute(LispObject args, Environment env)
1445:                        throws ConditionThrowable {
1446:                    final LispThread thread = LispThread.currentThread();
1447:                    LispObject result = NIL;
1448:                    while (args != NIL) {
1449:                        LispObject clause = args.car();
1450:                        result = eval(clause.car(), env, thread);
1451:                        thread.clearValues();
1452:                        if (result != NIL) {
1453:                            LispObject body = clause.cdr();
1454:                            while (body != NIL) {
1455:                                result = eval(body.car(), env, thread);
1456:                                body = body.cdr();
1457:                            }
1458:                            return result;
1459:                        }
1460:                        args = args.cdr();
1461:                    }
1462:                    return result;
1463:                }
1464:            };
1465:
1466:            // ### case
1467:            private static final SpecialOperator CASE = new SpecialOperator(
1468:                    "case", "keyform &body cases") {
1469:                public LispObject execute(LispObject args, Environment env)
1470:                        throws ConditionThrowable {
1471:                    final LispThread thread = LispThread.currentThread();
1472:                    LispObject key = eval(args.car(), env, thread);
1473:                    args = args.cdr();
1474:                    while (args != NIL) {
1475:                        LispObject clause = args.car();
1476:                        LispObject keys = clause.car();
1477:                        boolean match = false;
1478:                        if (keys.listp()) {
1479:                            while (keys != NIL) {
1480:                                LispObject candidate = keys.car();
1481:                                if (key.eql(candidate)) {
1482:                                    match = true;
1483:                                    break;
1484:                                }
1485:                                keys = keys.cdr();
1486:                            }
1487:                        } else {
1488:                            LispObject candidate = keys;
1489:                            if (candidate == T || candidate == Symbol.OTHERWISE)
1490:                                match = true;
1491:                            else if (key.eql(candidate))
1492:                                match = true;
1493:                        }
1494:                        if (match) {
1495:                            return progn(clause.cdr(), env, thread);
1496:                        }
1497:                        args = args.cdr();
1498:                    }
1499:                    return NIL;
1500:                }
1501:            };
1502:
1503:            // ### ecase
1504:            private static final SpecialOperator ECASE = new SpecialOperator(
1505:                    "ecase", "keyform &body cases") {
1506:                public LispObject execute(LispObject args, Environment env)
1507:                        throws ConditionThrowable {
1508:                    final LispThread thread = LispThread.currentThread();
1509:                    LispObject key = eval(args.car(), env, thread);
1510:                    args = args.cdr();
1511:                    while (args != NIL) {
1512:                        LispObject clause = args.car();
1513:                        LispObject keys = clause.car();
1514:                        boolean match = false;
1515:                        if (keys.listp()) {
1516:                            while (keys != NIL) {
1517:                                LispObject candidate = keys.car();
1518:                                if (key.eql(candidate)) {
1519:                                    match = true;
1520:                                    break;
1521:                                }
1522:                                keys = keys.cdr();
1523:                            }
1524:                        } else {
1525:                            LispObject candidate = keys;
1526:                            if (key.eql(candidate))
1527:                                match = true;
1528:                        }
1529:                        if (match) {
1530:                            return progn(clause.cdr(), env, thread);
1531:                        }
1532:                        args = args.cdr();
1533:                    }
1534:                    signal(new TypeError("ECASE: no match for " + key));
1535:                    return NIL;
1536:                }
1537:            };
1538:
1539:            // ### upgraded-array-element-type
1540:            // upgraded-array-element-type typespec &optional environment
1541:            // => upgraded-typespec
1542:            private static final Primitive UPGRADED_ARRAY_ELEMENT_TYPE = new Primitive(
1543:                    "upgraded-array-element-type",
1544:                    "typespec &optional environment") {
1545:                public LispObject execute(LispObject arg)
1546:                        throws ConditionThrowable {
1547:                    return getUpgradedArrayElementType(arg);
1548:                }
1549:
1550:                public LispObject execute(LispObject first, LispObject second)
1551:                        throws ConditionThrowable {
1552:                    // Ignore environment.
1553:                    return getUpgradedArrayElementType(first);
1554:                }
1555:            };
1556:
1557:            // ### array-rank
1558:            // array-rank array => rank
1559:            private static final Primitive1 ARRAY_RANK = new Primitive1(
1560:                    "array-rank", "array") {
1561:                public LispObject execute(LispObject arg)
1562:                        throws ConditionThrowable {
1563:                    return new Fixnum(checkArray(arg).getRank());
1564:                }
1565:            };
1566:
1567:            // ### array-dimensions
1568:            // array-dimensions array => dimensions
1569:            // Returns a list of integers. Fill pointer (if any) is ignored.
1570:            private static final Primitive1 ARRAY_DIMENSIONS = new Primitive1(
1571:                    "array-dimensions", "array") {
1572:                public LispObject execute(LispObject arg)
1573:                        throws ConditionThrowable {
1574:                    return checkArray(arg).getDimensions();
1575:                }
1576:            };
1577:
1578:            // ### array-dimension
1579:            // array-dimension array axis-number => dimension
1580:            private static final Primitive2 ARRAY_DIMENSION = new Primitive2(
1581:                    "array-dimension", "array axis-number") {
1582:                public LispObject execute(LispObject first, LispObject second)
1583:                        throws ConditionThrowable {
1584:                    return new Fixnum(checkArray(first).getDimension(
1585:                            Fixnum.getValue(second)));
1586:                }
1587:            };
1588:
1589:            // ### array-total-size
1590:            // array-total-size array => size
1591:            private static final Primitive1 ARRAY_TOTAL_SIZE = new Primitive1(
1592:                    "array-total-size", "array") {
1593:                public LispObject execute(LispObject arg)
1594:                        throws ConditionThrowable {
1595:                    return new Fixnum(checkArray(arg).getTotalSize());
1596:                }
1597:            };
1598:
1599:            // ### array-element-type
1600:            // array-element-type array => typespec
1601:            private static final Primitive1 ARRAY_ELEMENT_TYPE = new Primitive1(
1602:                    "array-element-type", "array") {
1603:                public LispObject execute(LispObject arg)
1604:                        throws ConditionThrowable {
1605:                    return checkArray(arg).getElementType();
1606:                }
1607:            };
1608:
1609:            // ### adjustable-array-p
1610:            private static final Primitive1 ADJUSTABLE_ARRAY_P = new Primitive1(
1611:                    "adjustable-array-p", "array") {
1612:                public LispObject execute(LispObject arg)
1613:                        throws ConditionThrowable {
1614:                    try {
1615:                        return ((AbstractArray) arg).isAdjustable() ? T : NIL;
1616:                    } catch (ClassCastException e) {
1617:                        return signal(new TypeError(arg, Symbol.ARRAY));
1618:                    }
1619:                }
1620:            };
1621:
1622:            // ### array-displacement
1623:            // array-displacement array => displaced-to, displaced-index-offset
1624:            private static final Primitive1 ARRAY_DISPLACEMENT = new Primitive1(
1625:                    "array-displacement", "array") {
1626:                public LispObject execute(LispObject arg)
1627:                        throws ConditionThrowable {
1628:                    return checkArray(arg).arrayDisplacement();
1629:                }
1630:            };
1631:
1632:            // ### array-in-bounds-p
1633:            // array-in-bounds-p array &rest subscripts => generalized-boolean
1634:            private static final Primitive ARRAY_IN_BOUNDS_P = new Primitive(
1635:                    "array-in-bounds-p", "array &rest subscripts") {
1636:                public LispObject execute(LispObject[] args)
1637:                        throws ConditionThrowable {
1638:                    if (args.length < 1)
1639:                        signal(new WrongNumberOfArgumentsException(this ));
1640:                    AbstractArray array = checkArray(args[0]);
1641:                    int rank = array.getRank();
1642:                    if (rank != args.length - 1) {
1643:                        StringBuffer sb = new StringBuffer(
1644:                                "ARRAY-IN-BOUNDS-P: ");
1645:                        sb.append("wrong number of subscripts (");
1646:                        sb.append(args.length - 1);
1647:                        sb.append(") for array of rank ");
1648:                        sb.append(rank);
1649:                        signal(new ProgramError(sb.toString()));
1650:                    }
1651:                    for (int i = 0; i < rank; i++) {
1652:                        LispObject arg = args[i + 1];
1653:                        if (arg instanceof  Fixnum) {
1654:                            int subscript = ((Fixnum) arg).getValue();
1655:                            if (subscript < 0
1656:                                    || subscript >= array.getDimension(i))
1657:                                return NIL;
1658:                        } else if (arg instanceof  Bignum) {
1659:                            return NIL;
1660:                        } else
1661:                            signal(new TypeError(arg, "integer"));
1662:                    }
1663:                    return T;
1664:                }
1665:            };
1666:
1667:            // ### %array-row-major-index
1668:            // %array-row-major-index array subscripts => index
1669:            private static final Primitive2 _ARRAY_ROW_MAJOR_INDEX = new Primitive2(
1670:                    "%array-row-major-index", PACKAGE_SYS, false) {
1671:                public LispObject execute(LispObject first, LispObject second)
1672:                        throws ConditionThrowable {
1673:                    AbstractArray array = checkArray(first);
1674:                    LispObject[] subscripts = second.copyToArray();
1675:                    return number(array.getRowMajorIndex(subscripts));
1676:                }
1677:            };
1678:
1679:            // ### aref
1680:            // aref array &rest subscripts => element
1681:            private static final Primitive AREF = new Primitive("aref",
1682:                    "array &rest subscripts") {
1683:                public LispObject execute() throws ConditionThrowable {
1684:                    return signal(new WrongNumberOfArgumentsException(this ));
1685:                }
1686:
1687:                public LispObject execute(LispObject arg)
1688:                        throws ConditionThrowable {
1689:                    AbstractArray array = checkArray(arg);
1690:                    if (array.getRank() == 0)
1691:                        return array.getRowMajor(0);
1692:                    StringBuffer sb = new StringBuffer(
1693:                            "Wrong number of subscripts (0) for array of rank ");
1694:                    sb.append(array.getRank());
1695:                    sb.append('.');
1696:                    signal(new ProgramError(sb.toString()));
1697:                    return NIL;
1698:                }
1699:
1700:                public LispObject execute(LispObject first, LispObject second)
1701:                        throws ConditionThrowable {
1702:                    return first.AREF(second);
1703:                }
1704:
1705:                public LispObject execute(LispObject first, LispObject second,
1706:                        LispObject third) throws ConditionThrowable {
1707:                    final AbstractArray array;
1708:                    try {
1709:                        array = checkArray(first);
1710:                    } catch (ClassCastException e) {
1711:                        return signal(new TypeError(first, Symbol.ARRAY));
1712:                    }
1713:                    final int[] subs = new int[2];
1714:                    try {
1715:                        subs[0] = ((Fixnum) second).value;
1716:                    } catch (ClassCastException e) {
1717:                        return signal(new TypeError(second, Symbol.FIXNUM));
1718:                    }
1719:                    try {
1720:                        subs[1] = ((Fixnum) third).value;
1721:                    } catch (ClassCastException e) {
1722:                        return signal(new TypeError(third, Symbol.FIXNUM));
1723:                    }
1724:                    return array.get(subs);
1725:                }
1726:
1727:                public LispObject execute(LispObject[] args)
1728:                        throws ConditionThrowable {
1729:                    final AbstractArray array;
1730:                    try {
1731:                        array = checkArray(args[0]);
1732:                    } catch (ClassCastException e) {
1733:                        return signal(new TypeError(args[0], Symbol.ARRAY));
1734:                    }
1735:                    final int[] subs = new int[args.length - 1];
1736:                    for (int i = subs.length; i-- > 0;) {
1737:                        try {
1738:                            subs[i] = ((Fixnum) args[i + 1]).value;
1739:                        } catch (ClassCastException e) {
1740:                            return signal(new TypeError(args[i + i],
1741:                                    Symbol.FIXNUM));
1742:                        }
1743:                    }
1744:                    return array.get(subs);
1745:                }
1746:            };
1747:
1748:            // ### %aset
1749:            // %aset array subscripts new-element => new-element
1750:            private static final Primitive _ASET = new Primitive("%aset",
1751:                    PACKAGE_SYS, false, "array subscripts new-element") {
1752:                public LispObject execute() throws ConditionThrowable {
1753:                    return signal(new WrongNumberOfArgumentsException(this ));
1754:                }
1755:
1756:                public LispObject execute(LispObject arg)
1757:                        throws ConditionThrowable {
1758:                    return signal(new WrongNumberOfArgumentsException(this ));
1759:                }
1760:
1761:                public LispObject execute(LispObject first, LispObject second)
1762:                        throws ConditionThrowable {
1763:                    // Rank zero array.
1764:                    final ZeroRankArray array;
1765:                    try {
1766:                        array = (ZeroRankArray) first;
1767:                    } catch (ClassCastException e) {
1768:                        return signal(new TypeError(first
1769:                                + " is not an array of rank 0."));
1770:                    }
1771:                    array.setRowMajor(0, second);
1772:                    return second;
1773:                }
1774:
1775:                public LispObject execute(LispObject first, LispObject second,
1776:                        LispObject third) throws ConditionThrowable {
1777:                    final AbstractVector v;
1778:                    try {
1779:                        v = (AbstractVector) first;
1780:                    } catch (ClassCastException e) {
1781:                        return signal(new TypeError(first, Symbol.VECTOR));
1782:                    }
1783:                    final int index;
1784:                    try {
1785:                        index = ((Fixnum) second).value;
1786:                    } catch (ClassCastException e) {
1787:                        return signal(new TypeError(second, Symbol.FIXNUM));
1788:                    }
1789:                    v.setRowMajor(index, third);
1790:                    return third;
1791:                }
1792:
1793:                public LispObject execute(LispObject[] args)
1794:                        throws ConditionThrowable {
1795:                    final AbstractArray array;
1796:                    try {
1797:                        array = (AbstractArray) args[0];
1798:                    } catch (ClassCastException e) {
1799:                        return signal(new TypeError(args[0], Symbol.ARRAY));
1800:                    }
1801:                    final int nsubs = args.length - 2;
1802:                    final int[] subs = new int[nsubs];
1803:                    for (int i = nsubs; i-- > 0;) {
1804:                        try {
1805:                            subs[i] = ((Fixnum) args[i + 1]).value;
1806:                        } catch (ClassCastException e) {
1807:                            signal(new TypeError(args[i + 1], Symbol.FIXNUM));
1808:                        }
1809:                    }
1810:                    final LispObject newValue = args[args.length - 1];
1811:                    array.set(subs, newValue);
1812:                    return newValue;
1813:                }
1814:            };
1815:
1816:            // ### row-major-aref
1817:            // row-major-aref array index => element
1818:            private static final Primitive2 ROW_MAJOR_AREF = new Primitive2(
1819:                    "row-major-aref", "array index") {
1820:                public LispObject execute(LispObject first, LispObject second)
1821:                        throws ConditionThrowable {
1822:                    try {
1823:                        return ((AbstractArray) first)
1824:                                .getRowMajor(((Fixnum) second).value);
1825:                    } catch (ClassCastException e) {
1826:                        if (first instanceof  AbstractArray)
1827:                            return signal(new TypeError(second, Symbol.FIXNUM));
1828:                        else
1829:                            return signal(new TypeError(first, Symbol.ARRAY));
1830:                    }
1831:                }
1832:            };
1833:
1834:            // ### %set-row-major-aref
1835:            // %set-row-major-aref array index new-value => new-value
1836:            private static final Primitive3 _SET_ROW_MAJOR_AREF = new Primitive3(
1837:                    "%set-row-major-aref", PACKAGE_SYS, false) {
1838:                public LispObject execute(LispObject first, LispObject second,
1839:                        LispObject third) throws ConditionThrowable {
1840:                    try {
1841:                        ((AbstractArray) first).setRowMajor(
1842:                                ((Fixnum) second).value, third);
1843:                        return third;
1844:                    } catch (ClassCastException e) {
1845:                        if (first instanceof  AbstractArray)
1846:                            return signal(new TypeError(second, Symbol.FIXNUM));
1847:                        else
1848:                            return signal(new TypeError(first, Symbol.ARRAY));
1849:                    }
1850:                }
1851:            };
1852:
1853:            // ### vector
1854:            private static final Primitive VECTOR = new Primitive("vector",
1855:                    "&rest objects") {
1856:                public LispObject execute(LispObject[] args)
1857:                        throws ConditionThrowable {
1858:                    return new SimpleVector(args);
1859:                }
1860:            };
1861:
1862:            // ### %vset
1863:            // %vset vector index new-value => new-value
1864:            private static final Primitive3 _VSET = new Primitive3("%vset",
1865:                    PACKAGE_SYS, false) {
1866:                public LispObject execute(LispObject first, LispObject second,
1867:                        LispObject third) throws ConditionThrowable {
1868:                    try {
1869:                        ((AbstractVector) first).setRowMajor(
1870:                                ((Fixnum) second).value, third);
1871:                        return third;
1872:                    } catch (ClassCastException e) {
1873:                        if (first instanceof  AbstractVector)
1874:                            return signal(new TypeError(second, Symbol.FIXNUM));
1875:                        else
1876:                            return signal(new TypeError(first, Symbol.VECTOR));
1877:                    }
1878:                }
1879:            };
1880:
1881:            // ### fill-pointer
1882:            private static final Primitive1 FILL_POINTER = new Primitive1(
1883:                    "fill-pointer", "vector") {
1884:                public LispObject execute(LispObject arg)
1885:                        throws ConditionThrowable {
1886:                    try {
1887:                        return new Fixnum(((AbstractArray) arg)
1888:                                .getFillPointer());
1889:                    } catch (ClassCastException e) {
1890:                        return signal(new TypeError(arg, Symbol.ARRAY));
1891:                    }
1892:                }
1893:            };
1894:
1895:            // ### %set-fill-pointer vector new-fill-pointer
1896:            private static final Primitive2 _SET_FILL_POINTER = new Primitive2(
1897:                    "%set-fill-pointer", PACKAGE_SYS, false) {
1898:                public LispObject execute(LispObject first, LispObject second)
1899:                        throws ConditionThrowable {
1900:                    try {
1901:                        AbstractVector v = (AbstractVector) first;
1902:                        if (v.hasFillPointer())
1903:                            v.setFillPointer(second);
1904:                        else
1905:                            v.noFillPointer();
1906:                        return second;
1907:                    } catch (ClassCastException e) {
1908:                        return signal(new TypeError(first, Symbol.VECTOR));
1909:                    }
1910:                }
1911:            };
1912:
1913:            // ### vector-push new-element vector => index-of-new-element
1914:            private static final Primitive2 VECTOR_PUSH = new Primitive2(
1915:                    "vector-push", "new-element vector") {
1916:                public LispObject execute(LispObject first, LispObject second)
1917:                        throws ConditionThrowable {
1918:                    AbstractVector v = checkVector(second);
1919:                    int fillPointer = v.getFillPointer();
1920:                    if (fillPointer < 0)
1921:                        v.noFillPointer();
1922:                    if (fillPointer >= v.capacity())
1923:                        return NIL;
1924:                    v.setRowMajor(fillPointer, first);
1925:                    v.setFillPointer(fillPointer + 1);
1926:                    return new Fixnum(fillPointer);
1927:                }
1928:            };
1929:
1930:            // ### vector-push-extend new-element vector &optional extension
1931:            // => index-of-new-element
1932:            private static final Primitive VECTOR_PUSH_EXTEND = new Primitive(
1933:                    "vector-push-extend",
1934:                    "new-element vector &optional extension") {
1935:                public LispObject execute(LispObject first, LispObject second)
1936:                        throws ConditionThrowable {
1937:                    try {
1938:                        return ((AbstractVector) second)
1939:                                .vectorPushExtend(first);
1940:                    } catch (ClassCastException e) {
1941:                        return signal(new TypeError(second, Symbol.VECTOR));
1942:                    }
1943:                }
1944:
1945:                public LispObject execute(LispObject first, LispObject second,
1946:                        LispObject third) throws ConditionThrowable {
1947:                    try {
1948:                        return ((AbstractVector) second).vectorPushExtend(
1949:                                first, third);
1950:                    } catch (ClassCastException e) {
1951:                        return signal(new TypeError(second, Symbol.VECTOR));
1952:                    }
1953:                }
1954:            };
1955:
1956:            // ### vector-pop vector => element
1957:            private static final Primitive1 VECTOR_POP = new Primitive1(
1958:                    "vector-pop", "vector") {
1959:                public LispObject execute(LispObject arg)
1960:                        throws ConditionThrowable {
1961:                    AbstractVector v = checkVector(arg);
1962:                    int fillPointer = v.getFillPointer();
1963:                    if (fillPointer < 0)
1964:                        v.noFillPointer();
1965:                    if (fillPointer == 0)
1966:                        signal(new LispError("nothing left to pop"));
1967:                    int newFillPointer = v.checkIndex(fillPointer - 1);
1968:                    LispObject element = v.getRowMajor(newFillPointer);
1969:                    v.setFillPointer(newFillPointer);
1970:                    return element;
1971:                }
1972:            };
1973:
1974:            // ### type-of
1975:            private static final Primitive1 TYPE_OF = new Primitive1("type-of",
1976:                    "object") {
1977:                public LispObject execute(LispObject arg)
1978:                        throws ConditionThrowable {
1979:                    return arg.typeOf();
1980:                }
1981:            };
1982:
1983:            // ### class-of
1984:            private static final Primitive1 CLASS_OF = new Primitive1(
1985:                    "class-of", "object") {
1986:                public LispObject execute(LispObject arg)
1987:                        throws ConditionThrowable {
1988:                    return arg.classOf();
1989:                }
1990:            };
1991:
1992:            // ### simple-typep
1993:            private static final Primitive2 SIMPLE_TYPEP = new Primitive2(
1994:                    "simple-typep", PACKAGE_SYS, false) {
1995:                public LispObject execute(LispObject first, LispObject second)
1996:                        throws ConditionThrowable {
1997:                    return first.typep(second);
1998:                }
1999:            };
2000:
2001:            // ### function-lambda-expression
2002:            // function-lambda-expression function => lambda-expression, closure-p, name
2003:            private static final Primitive1 FUNCTION_LAMBDA_EXPRESSION = new Primitive1(
2004:                    "function-lambda-expression", "function") {
2005:                public LispObject execute(LispObject arg)
2006:                        throws ConditionThrowable {
2007:                    final LispObject value1, value2;
2008:                    Function function = checkFunction(arg);
2009:                    String name = function.getName();
2010:                    final LispObject value3 = name != null ? new SimpleString(
2011:                            name) : NIL;
2012:                    if (function instanceof  CompiledClosure) {
2013:                        value1 = NIL;
2014:                        value2 = T;
2015:                    } else if (function instanceof  Closure
2016:                            && !(function instanceof  CompiledFunction)) {
2017:                        Closure closure = (Closure) function;
2018:                        LispObject expr = closure.getBody();
2019:                        expr = new Cons(closure.getParameterList(), expr);
2020:                        expr = new Cons(Symbol.LAMBDA, expr);
2021:                        value1 = expr;
2022:                        Environment env = closure.getEnvironment();
2023:                        if (env == null || env.isEmpty())
2024:                            value2 = NIL;
2025:                        else
2026:                            value2 = env; // Return environment as closure-p.
2027:                    } else
2028:                        value1 = value2 = NIL;
2029:                    return LispThread.currentThread().setValues(value1, value2,
2030:                            value3);
2031:                }
2032:            };
2033:
2034:            // ### funcall
2035:            // This needs to be public for LispAPI.java.
2036:            public static final Primitive FUNCALL = new Primitive("funcall",
2037:                    "function &rest args") {
2038:                public LispObject execute(LispObject arg)
2039:                        throws ConditionThrowable {
2040:                    return funcall0(requireFunction(arg), LispThread
2041:                            .currentThread());
2042:                }
2043:
2044:                public LispObject execute(LispObject first, LispObject second)
2045:                        throws ConditionThrowable {
2046:                    return funcall1(requireFunction(first), second, LispThread
2047:                            .currentThread());
2048:                }
2049:
2050:                public LispObject execute(LispObject first, LispObject second,
2051:                        LispObject third) throws ConditionThrowable {
2052:                    return funcall2(requireFunction(first), second, third,
2053:                            LispThread.currentThread());
2054:                }
2055:
2056:                public LispObject execute(LispObject[] args)
2057:                        throws ConditionThrowable {
2058:                    if (args.length < 1) {
2059:                        signal(new WrongNumberOfArgumentsException(this ));
2060:                        return NIL;
2061:                    }
2062:                    LispObject fun = requireFunction(args[0]);
2063:                    final int length = args.length - 1; // Number of arguments.
2064:                    if (length == 3) {
2065:                        return funcall3(fun, args[1], args[2], args[3],
2066:                                LispThread.currentThread());
2067:                    } else {
2068:                        LispObject[] funArgs = new LispObject[length];
2069:                        System.arraycopy(args, 1, funArgs, 0, length);
2070:                        return funcall(fun, funArgs, LispThread.currentThread());
2071:                    }
2072:                }
2073:
2074:                private LispObject requireFunction(LispObject arg)
2075:                        throws ConditionThrowable {
2076:                    if (arg instanceof  Function
2077:                            || arg instanceof  GenericFunction)
2078:                        return arg;
2079:                    if (arg instanceof  Symbol) {
2080:                        LispObject function = arg.getSymbolFunction();
2081:                        if (function instanceof  Function
2082:                                || function instanceof  GenericFunction)
2083:                            return function;
2084:                        return signal(new UndefinedFunction(arg));
2085:                    }
2086:                    return signal(new TypeError(arg, list3(Symbol.OR,
2087:                            Symbol.FUNCTION, Symbol.SYMBOL)));
2088:                }
2089:            };
2090:
2091:            // ### apply
2092:            public static final Primitive APPLY = new Primitive("apply",
2093:                    "function &rest args") {
2094:                public LispObject execute(LispObject first, LispObject second)
2095:                        throws ConditionThrowable {
2096:                    LispObject spread = checkList(second);
2097:                    LispObject fun = first;
2098:                    if (fun instanceof  Symbol)
2099:                        fun = fun.getSymbolFunction();
2100:                    if (fun instanceof  Function
2101:                            || fun instanceof  GenericFunction) {
2102:                        final int numFunArgs = spread.length();
2103:                        final LispThread thread = LispThread.currentThread();
2104:                        switch (numFunArgs) {
2105:                        case 1:
2106:                            return funcall1(fun, spread.car(), thread);
2107:                        case 2:
2108:                            return funcall2(fun, spread.car(), spread.cadr(),
2109:                                    thread);
2110:                        case 3:
2111:                            return funcall3(fun, spread.car(), spread.cadr(),
2112:                                    spread.cdr().cdr().car(), thread);
2113:                        default: {
2114:                            final LispObject[] funArgs = new LispObject[numFunArgs];
2115:                            int j = 0;
2116:                            while (spread != NIL) {
2117:                                funArgs[j++] = spread.car();
2118:                                spread = spread.cdr();
2119:                            }
2120:                            return funcall(fun, funArgs, thread);
2121:                        }
2122:                        }
2123:                    }
2124:                    signal(new TypeError(fun, "function"));
2125:                    return NIL;
2126:                }
2127:
2128:                public LispObject execute(final LispObject[] args)
2129:                        throws ConditionThrowable {
2130:                    final int numArgs = args.length;
2131:                    if (numArgs < 2)
2132:                        signal(new WrongNumberOfArgumentsException(this ));
2133:                    LispObject spread = checkList(args[numArgs - 1]);
2134:                    LispObject fun = args[0];
2135:                    if (fun instanceof  Symbol)
2136:                        fun = fun.getSymbolFunction();
2137:                    if (fun instanceof  Function
2138:                            || fun instanceof  GenericFunction) {
2139:                        final int numFunArgs = numArgs - 2 + spread.length();
2140:                        final LispObject[] funArgs = new LispObject[numFunArgs];
2141:                        int j = 0;
2142:                        for (int i = 1; i < numArgs - 1; i++)
2143:                            funArgs[j++] = args[i];
2144:                        while (spread != NIL) {
2145:                            funArgs[j++] = spread.car();
2146:                            spread = spread.cdr();
2147:                        }
2148:                        return funcall(fun, funArgs, LispThread.currentThread());
2149:                    }
2150:                    signal(new TypeError(fun, "function"));
2151:                    return NIL;
2152:                }
2153:            };
2154:
2155:            // ### mapcar
2156:            private static final Primitive MAPCAR = new Primitive("mapcar",
2157:                    "function &rest lists") {
2158:                public LispObject execute(LispObject op, LispObject list)
2159:                        throws ConditionThrowable {
2160:                    LispObject fun;
2161:                    if (op instanceof  Symbol)
2162:                        fun = op.getSymbolFunction();
2163:                    else
2164:                        fun = op;
2165:                    if (fun instanceof  Function
2166:                            || fun instanceof  GenericFunction) {
2167:                        final LispThread thread = LispThread.currentThread();
2168:                        LispObject result = NIL;
2169:                        LispObject splice = null;
2170:                        while (list != NIL) {
2171:                            LispObject obj = funcall1(fun, list.car(), thread);
2172:                            if (splice == null) {
2173:                                result = new Cons(obj, result);
2174:                                splice = result;
2175:                            } else {
2176:                                Cons cons = new Cons(obj);
2177:                                splice.setCdr(cons);
2178:                                splice = cons;
2179:                            }
2180:                            list = list.cdr();
2181:                        }
2182:                        thread.clearValues();
2183:                        return result;
2184:                    }
2185:                    signal(new UndefinedFunction(op));
2186:                    return NIL;
2187:                }
2188:
2189:                public LispObject execute(LispObject first, LispObject second,
2190:                        LispObject third) throws ConditionThrowable {
2191:                    // First argument must be a function.
2192:                    LispObject fun = first;
2193:                    if (fun instanceof  Symbol)
2194:                        fun = fun.getSymbolFunction();
2195:                    if (!(fun instanceof  Function || fun instanceof  GenericFunction))
2196:                        signal(new UndefinedFunction(first));
2197:                    // Remaining arguments must be lists.
2198:                    LispObject list1 = checkList(second);
2199:                    LispObject list2 = checkList(third);
2200:                    final LispThread thread = LispThread.currentThread();
2201:                    LispObject result = NIL;
2202:                    LispObject splice = null;
2203:                    while (list1 != NIL && list2 != NIL) {
2204:                        LispObject obj = funcall2(fun, list1.car(),
2205:                                list2.car(), thread);
2206:                        if (splice == null) {
2207:                            result = new Cons(obj, result);
2208:                            splice = result;
2209:                        } else {
2210:                            Cons cons = new Cons(obj);
2211:                            splice.setCdr(cons);
2212:                            splice = cons;
2213:                        }
2214:                        list1 = list1.cdr();
2215:                        list2 = list2.cdr();
2216:                    }
2217:                    thread.clearValues();
2218:                    return result;
2219:                }
2220:
2221:                public LispObject execute(final LispObject[] args)
2222:                        throws ConditionThrowable {
2223:                    final int numArgs = args.length;
2224:                    if (numArgs < 2)
2225:                        signal(new WrongNumberOfArgumentsException(this ));
2226:                    // First argument must be a function.
2227:                    LispObject fun = args[0];
2228:                    if (fun instanceof  Symbol)
2229:                        fun = fun.getSymbolFunction();
2230:                    if (!(fun instanceof  Function || fun instanceof  GenericFunction))
2231:                        signal(new UndefinedFunction(args[0]));
2232:                    // Remaining arguments must be lists.
2233:                    int commonLength = -1;
2234:                    for (int i = 1; i < numArgs; i++) {
2235:                        if (!args[i].listp())
2236:                            signal(new TypeError(args[i], "list"));
2237:                        int len = args[i].length();
2238:                        if (commonLength < 0)
2239:                            commonLength = len;
2240:                        else if (commonLength > len)
2241:                            commonLength = len;
2242:                    }
2243:                    final LispThread thread = LispThread.currentThread();
2244:                    LispObject[] results = new LispObject[commonLength];
2245:                    final int numFunArgs = numArgs - 1;
2246:                    final LispObject[] funArgs = new LispObject[numFunArgs];
2247:                    for (int i = 0; i < commonLength; i++) {
2248:                        for (int j = 0; j < numFunArgs; j++)
2249:                            funArgs[j] = args[j + 1].car();
2250:                        results[i] = funcall(fun, funArgs, thread);
2251:                        for (int j = 1; j < numArgs; j++)
2252:                            args[j] = args[j].cdr();
2253:                    }
2254:                    thread.clearValues();
2255:                    LispObject result = NIL;
2256:                    for (int i = commonLength; i-- > 0;)
2257:                        result = new Cons(results[i], result);
2258:                    return result;
2259:                }
2260:            };
2261:
2262:            // ### macroexpand
2263:            private static final Primitive MACROEXPAND = new Primitive(
2264:                    "macroexpand", "form &optional env") {
2265:                public LispObject execute(LispObject[] args)
2266:                        throws ConditionThrowable {
2267:                    final int length = args.length;
2268:                    if (length < 1 || length > 2)
2269:                        signal(new WrongNumberOfArgumentsException(this ));
2270:                    LispObject form = args[0];
2271:                    final Environment env;
2272:                    if (length == 2 && args[1] != NIL)
2273:                        env = checkEnvironment(args[1]);
2274:                    else
2275:                        env = new Environment();
2276:                    return macroexpand(form, env, LispThread.currentThread());
2277:                }
2278:            };
2279:
2280:            // ### macroexpand-1
2281:            private static final Primitive MACROEXPAND_1 = new Primitive(
2282:                    "macroexpand-1", "form &optional env") {
2283:                public LispObject execute(LispObject form)
2284:                        throws ConditionThrowable {
2285:                    return macroexpand_1(form, new Environment(), LispThread
2286:                            .currentThread());
2287:                }
2288:
2289:                public LispObject execute(LispObject form, LispObject env)
2290:                        throws ConditionThrowable {
2291:                    return macroexpand_1(form,
2292:                            env != NIL ? checkEnvironment(env)
2293:                                    : new Environment(), LispThread
2294:                                    .currentThread());
2295:                }
2296:            };
2297:
2298:            // ### *gensym-counter*
2299:            private static final Symbol _GENSYM_COUNTER_ = PACKAGE_CL
2300:                    .addExternalSymbol("*GENSYM-COUNTER*");
2301:            static {
2302:                _GENSYM_COUNTER_.setSymbolValue(Fixnum.ZERO);
2303:                _GENSYM_COUNTER_.setSpecial(true);
2304:            }
2305:
2306:            // ### gensym
2307:            private static final Primitive GENSYM = new Primitive("gensym",
2308:                    "&optional x") {
2309:                public LispObject execute() throws ConditionThrowable {
2310:                    return gensym("G");
2311:                }
2312:
2313:                public LispObject execute(LispObject arg)
2314:                        throws ConditionThrowable {
2315:                    String prefix = "G";
2316:                    if (arg instanceof  Fixnum) {
2317:                        int n = ((Fixnum) arg).getValue();
2318:                        if (n < 0)
2319:                            signal(new TypeError(arg, "non-negative integer"));
2320:                        StringBuffer sb = new StringBuffer(prefix);
2321:                        sb.append(n);
2322:                        return new Symbol(sb.toString());
2323:                    }
2324:                    if (arg instanceof  Bignum) {
2325:                        BigInteger n = ((Bignum) arg).getValue();
2326:                        if (n.signum() < 0)
2327:                            signal(new TypeError(arg, "non-negative integer"));
2328:                        StringBuffer sb = new StringBuffer(prefix);
2329:                        sb.append(n.toString());
2330:                        return new Symbol(sb.toString());
2331:                    }
2332:                    if (arg instanceof  AbstractString)
2333:                        prefix = arg.getStringValue();
2334:                    else
2335:                        signal(new TypeError(arg,
2336:                                "string or non-negative integer"));
2337:                    return gensym(prefix);
2338:                }
2339:            };
2340:
2341:            private static final Symbol gensym(String prefix)
2342:                    throws ConditionThrowable {
2343:                LispThread thread = LispThread.currentThread();
2344:                Environment dynEnv = thread.getDynamicEnvironment();
2345:                Binding binding = (dynEnv == null) ? null : dynEnv
2346:                        .getBinding(_GENSYM_COUNTER_);
2347:                LispObject oldValue;
2348:                if (binding != null) {
2349:                    oldValue = binding.value;
2350:                    binding.value = oldValue.incr();
2351:                } else {
2352:                    oldValue = _GENSYM_COUNTER_.getSymbolValue();
2353:                    _GENSYM_COUNTER_.setSymbolValue(oldValue.incr());
2354:                }
2355:                StringBuffer sb = new StringBuffer(prefix);
2356:                sb.append(oldValue.writeToString());
2357:                return new Symbol(sb.toString());
2358:            }
2359:
2360:            // ### string
2361:            private static final Primitive1 STRING = new Primitive1("string",
2362:                    "x") {
2363:                public LispObject execute(LispObject arg)
2364:                        throws ConditionThrowable {
2365:                    return arg.STRING();
2366:                }
2367:            };
2368:
2369:            // ### intern
2370:            // intern string &optional package => symbol, status
2371:            // status is one of :INHERITED, :EXTERNAL, :INTERNAL or NIL.
2372:            private static final Primitive INTERN = new Primitive("intern",
2373:                    "string &optional package") {
2374:                public LispObject execute(LispObject arg)
2375:                        throws ConditionThrowable {
2376:                    String s = arg.getStringValue();
2377:                    final LispThread thread = LispThread.currentThread();
2378:                    Package pkg = (Package) _PACKAGE_
2379:                            .symbolValueNoThrow(thread);
2380:                    return pkg.intern(s, thread);
2381:                }
2382:
2383:                public LispObject execute(LispObject first, LispObject second)
2384:                        throws ConditionThrowable {
2385:                    String s = first.getStringValue();
2386:                    Package pkg = coerceToPackage(second);
2387:                    return pkg.intern(s, LispThread.currentThread());
2388:                }
2389:            };
2390:
2391:            // ### unintern
2392:            // unintern symbol &optional package => generalized-boolean
2393:            private static final Primitive UNINTERN = new Primitive("unintern",
2394:                    "symbol &optional package") {
2395:                public LispObject execute(LispObject[] args)
2396:                        throws ConditionThrowable {
2397:                    if (args.length == 0 || args.length > 2)
2398:                        signal(new WrongNumberOfArgumentsException(this ));
2399:                    Symbol symbol = checkSymbol(args[0]);
2400:                    Package pkg;
2401:                    if (args.length == 2)
2402:                        pkg = coerceToPackage(args[1]);
2403:                    else
2404:                        pkg = getCurrentPackage();
2405:                    return pkg.unintern(symbol);
2406:                }
2407:            };
2408:
2409:            // ### find-package
2410:            private static final Primitive1 FIND_PACKAGE = new Primitive1(
2411:                    "find-package", "name") {
2412:                public LispObject execute(LispObject arg)
2413:                        throws ConditionThrowable {
2414:                    if (arg instanceof  Package)
2415:                        return arg;
2416:                    if (arg instanceof  AbstractString) {
2417:                        Package pkg = Packages
2418:                                .findPackage(arg.getStringValue());
2419:                        return pkg != null ? pkg : NIL;
2420:                    }
2421:                    if (arg instanceof  Symbol) {
2422:                        Package pkg = Packages.findPackage(arg.getName());
2423:                        return pkg != null ? pkg : NIL;
2424:                    }
2425:                    if (arg instanceof  LispCharacter) {
2426:                        String packageName = String
2427:                                .valueOf(new char[] { ((LispCharacter) arg)
2428:                                        .getValue() });
2429:                        Package pkg = Packages.findPackage(packageName);
2430:                        return pkg != null ? pkg : NIL;
2431:                    }
2432:                    return NIL;
2433:                }
2434:            };
2435:
2436:            // ### %make-package
2437:            // %make-package package-name nicknames use => package
2438:            private static final Primitive3 _MAKE_PACKAGE = new Primitive3(
2439:                    "%make-package", PACKAGE_SYS, false) {
2440:                public LispObject execute(LispObject first, LispObject second,
2441:                        LispObject third) throws ConditionThrowable {
2442:                    String packageName = javaString(first);
2443:                    Package pkg = Packages.findPackage(packageName);
2444:                    if (pkg != null)
2445:                        signal(new LispError("Package " + packageName
2446:                                + " already exists."));
2447:                    LispObject nicknames = checkList(second);
2448:                    if (nicknames != NIL) {
2449:                        LispObject list = nicknames;
2450:                        while (list != NIL) {
2451:                            String nick = javaString(list.car());
2452:                            if (Packages.findPackage(nick) != null) {
2453:                                signal(new PackageError("A package named "
2454:                                        + nick + " already exists."));
2455:                            }
2456:                            list = list.cdr();
2457:                        }
2458:                    }
2459:                    LispObject use = checkList(third);
2460:                    if (use != NIL) {
2461:                        LispObject list = use;
2462:                        while (list != NIL) {
2463:                            LispObject obj = list.car();
2464:                            if (obj instanceof  Package)
2465:                                ; // OK.
2466:                            else {
2467:                                String s = javaString(obj);
2468:                                Package p = Packages.findPackage(s);
2469:                                if (p == null) {
2470:                                    signal(new LispError(obj.writeToString()
2471:                                            + " is not the name of a package."));
2472:                                    return NIL;
2473:                                }
2474:                            }
2475:                            list = list.cdr();
2476:                        }
2477:                    }
2478:                    // Now create the package.
2479:                    pkg = Packages.createPackage(packageName);
2480:                    // Add the nicknames.
2481:                    while (nicknames != NIL) {
2482:                        String nick = javaString(nicknames.car());
2483:                        pkg.addNickname(nick);
2484:                        nicknames = nicknames.cdr();
2485:                    }
2486:                    // Create the use list.
2487:                    while (use != NIL) {
2488:                        LispObject obj = use.car();
2489:                        if (obj instanceof  Package)
2490:                            pkg.usePackage((Package) obj);
2491:                        else {
2492:                            String s = javaString(obj);
2493:                            Package p = Packages.findPackage(s);
2494:                            if (p == null) {
2495:                                signal(new LispError(obj.writeToString()
2496:                                        + " is not the name of a package."));
2497:                                return NIL;
2498:                            }
2499:                            pkg.usePackage(p);
2500:                        }
2501:                        use = use.cdr();
2502:                    }
2503:                    return pkg;
2504:                }
2505:            };
2506:
2507:            // ### %in-package
2508:            private static final Primitive1 _IN_PACKAGE = new Primitive1(
2509:                    "%in-package", PACKAGE_SYS, false) {
2510:                public LispObject execute(LispObject arg)
2511:                        throws ConditionThrowable {
2512:                    String packageName = javaString(arg);
2513:                    Package pkg = Packages.findPackage(packageName);
2514:                    if (pkg == null)
2515:                        signal(new PackageError("The name " + packageName
2516:                                + " does not designate any package."));
2517:                    LispThread thread = LispThread.currentThread();
2518:                    Environment dynEnv = thread.getDynamicEnvironment();
2519:                    if (dynEnv != null) {
2520:                        Binding binding = dynEnv.getBinding(_PACKAGE_);
2521:                        if (binding != null) {
2522:                            binding.value = pkg;
2523:                            return pkg;
2524:                        }
2525:                    }
2526:                    // No dynamic binding.
2527:                    _PACKAGE_.setSymbolValue(pkg);
2528:                    return pkg;
2529:                }
2530:            };
2531:
2532:            // ### use-package
2533:            // use-package packages-to-use &optional package => t
2534:            private static final Primitive USE_PACKAGE = new Primitive(
2535:                    "use-package", "packages-to-use &optional package") {
2536:                public LispObject execute(LispObject[] args)
2537:                        throws ConditionThrowable {
2538:                    if (args.length < 1 || args.length > 2)
2539:                        signal(new WrongNumberOfArgumentsException(this ));
2540:                    Package pkg;
2541:                    if (args.length == 2)
2542:                        pkg = coerceToPackage(args[1]);
2543:                    else
2544:                        pkg = getCurrentPackage();
2545:                    if (args[0] instanceof  Cons) {
2546:                        LispObject list = args[0];
2547:                        while (list != NIL) {
2548:                            pkg.usePackage(coerceToPackage(list.car()));
2549:                            list = list.cdr();
2550:                        }
2551:                    } else
2552:                        pkg.usePackage(coerceToPackage(args[0]));
2553:                    return T;
2554:                }
2555:            };
2556:
2557:            // ### package-symbols
2558:            private static final Primitive1 PACKAGE_SYMBOLS = new Primitive1(
2559:                    "package-symbols", PACKAGE_SYS, false) {
2560:                public LispObject execute(LispObject arg)
2561:                        throws ConditionThrowable {
2562:                    return coerceToPackage(arg).getSymbols();
2563:                }
2564:            };
2565:
2566:            // ### package-internal-symbols
2567:            private static final Primitive1 PACKAGE_INTERNAL_SYMBOLS = new Primitive1(
2568:                    "package-internal-symbols", PACKAGE_SYS, false) {
2569:                public LispObject execute(LispObject arg)
2570:                        throws ConditionThrowable {
2571:                    return coerceToPackage(arg).PACKAGE_INTERNAL_SYMBOLS();
2572:                }
2573:            };
2574:
2575:            // ### package-external-symbols
2576:            private static final Primitive1 PACKAGE_EXTERNAL_SYMBOLS = new Primitive1(
2577:                    "package-external-symbols", PACKAGE_SYS, false) {
2578:                public LispObject execute(LispObject arg)
2579:                        throws ConditionThrowable {
2580:                    return coerceToPackage(arg).PACKAGE_EXTERNAL_SYMBOLS();
2581:                }
2582:            };
2583:
2584:            // ### package-inherited-symbols
2585:            private static final Primitive1 PACKAGE_INHERITED_SYMBOLS = new Primitive1(
2586:                    "package-inherited-symbols", PACKAGE_SYS, false) {
2587:                public LispObject execute(LispObject arg)
2588:                        throws ConditionThrowable {
2589:                    return coerceToPackage(arg).PACKAGE_INHERITED_SYMBOLS();
2590:                }
2591:            };
2592:
2593:            // ### export symbols &optional package
2594:            private static final Primitive EXPORT = new Primitive("export",
2595:                    "symbols &optional package") {
2596:                public LispObject execute(LispObject arg)
2597:                        throws ConditionThrowable {
2598:                    if (arg instanceof  Cons) {
2599:                        Package pkg = getCurrentPackage();
2600:                        for (LispObject list = arg; list != NIL; list = list
2601:                                .cdr())
2602:                            pkg.export(checkSymbol(list.car()));
2603:                    } else
2604:                        getCurrentPackage().export(checkSymbol(arg));
2605:                    return T;
2606:                }
2607:
2608:                public LispObject execute(LispObject first, LispObject second)
2609:                        throws ConditionThrowable {
2610:                    if (first instanceof  Cons) {
2611:                        Package pkg = coerceToPackage(second);
2612:                        for (LispObject list = first; list != NIL; list = list
2613:                                .cdr())
2614:                            pkg.export(checkSymbol(list.car()));
2615:                    } else
2616:                        coerceToPackage(second).export(checkSymbol(first));
2617:                    return T;
2618:                }
2619:            };
2620:
2621:            // ### find-symbol string &optional package => symbol, status
2622:            private static final Primitive FIND_SYMBOL = new Primitive(
2623:                    "find-symbol", "string &optional package") {
2624:                public LispObject execute(LispObject arg)
2625:                        throws ConditionThrowable {
2626:                    return getCurrentPackage().findSymbol(arg.getStringValue());
2627:                }
2628:
2629:                public LispObject execute(LispObject first, LispObject second)
2630:                        throws ConditionThrowable {
2631:                    return coerceToPackage(second).findSymbol(
2632:                            first.getStringValue());
2633:                }
2634:            };
2635:
2636:            // ### fset name function &optional source-position arglist => function
2637:            private static final Primitive FSET = new Primitive("fset",
2638:                    PACKAGE_SYS, false) {
2639:                public LispObject execute(LispObject first, LispObject second)
2640:                        throws ConditionThrowable {
2641:                    return execute(first, second, NIL, NIL);
2642:                }
2643:
2644:                public LispObject execute(LispObject first, LispObject second,
2645:                        LispObject third) throws ConditionThrowable {
2646:                    return execute(first, second, third, NIL);
2647:                }
2648:
2649:                public LispObject execute(LispObject first, LispObject second,
2650:                        LispObject third, LispObject fourth)
2651:                        throws ConditionThrowable {
2652:                    if (first instanceof  Symbol) {
2653:                        Symbol symbol = (Symbol) first;
2654:                        symbol.setSymbolFunction(second);
2655:                        LispObject source = Load._FASL_SOURCE_.symbolValue();
2656:                        if (source != NIL) {
2657:                            if (third != NIL)
2658:                                put(symbol, Symbol._SOURCE, new Cons(source,
2659:                                        third));
2660:                            else
2661:                                put(symbol, Symbol._SOURCE, source);
2662:                        }
2663:                    } else if (first instanceof  Cons
2664:                            && first.car() == Symbol.SETF) {
2665:                        // SETF function
2666:                        Symbol symbol = checkSymbol(first.cadr());
2667:                        put(symbol, Symbol._SETF_FUNCTION, second);
2668:                    } else
2669:                        return signal(new TypeError(first.writeToString()
2670:                                + " is not a valid function name."));
2671:                    if (second instanceof  Functional) {
2672:                        ((Functional) second).setLambdaName(first);
2673:                        if (fourth != NIL)
2674:                            ((Functional) second).setArglist(fourth);
2675:                    }
2676:                    return second;
2677:                }
2678:            };
2679:
2680:            // ### %set-symbol-plist
2681:            private static final Primitive2 _SET_SYMBOL_PLIST = new Primitive2(
2682:                    "%set-symbol-plist", PACKAGE_SYS, false) {
2683:                public LispObject execute(LispObject first, LispObject second)
2684:                        throws ConditionThrowable {
2685:                    checkSymbol(first).setPropertyList(checkList(second));
2686:                    return second;
2687:                }
2688:            };
2689:
2690:            // ### getf
2691:            // getf plist indicator &optional default => value
2692:            private static final Primitive GETF = new Primitive("getf",
2693:                    "plist indicator &optional default") {
2694:                public LispObject execute(LispObject plist, LispObject indicator)
2695:                        throws ConditionThrowable {
2696:                    return getf(plist, indicator, NIL);
2697:                }
2698:
2699:                public LispObject execute(LispObject plist,
2700:                        LispObject indicator, LispObject defaultValue)
2701:                        throws ConditionThrowable {
2702:                    return getf(plist, indicator, defaultValue);
2703:                }
2704:            };
2705:
2706:            // ### get
2707:            // get symbol indicator &optional default => value
2708:            private static final Primitive GET = new Primitive("get",
2709:                    "symbol indicator &optional default") {
2710:                public LispObject execute(LispObject symbol,
2711:                        LispObject indicator) throws ConditionThrowable {
2712:                    try {
2713:                        return get((Symbol) symbol, indicator, NIL);
2714:                    } catch (ClassCastException e) {
2715:                        return signal(new TypeError(symbol, Symbol.SYMBOL));
2716:                    }
2717:                }
2718:
2719:                public LispObject execute(LispObject symbol,
2720:                        LispObject indicator, LispObject defaultValue)
2721:                        throws ConditionThrowable {
2722:                    try {
2723:                        return get((Symbol) symbol, indicator, defaultValue);
2724:                    } catch (ClassCastException e) {
2725:                        return signal(new TypeError(symbol, Symbol.SYMBOL));
2726:                    }
2727:                }
2728:            };
2729:
2730:            // ### %put
2731:            // %put symbol indicator value => value
2732:            private static final Primitive _PUT = new Primitive("%put",
2733:                    PACKAGE_SYS, false) {
2734:                public LispObject execute(LispObject symbol,
2735:                        LispObject indicator, LispObject value)
2736:                        throws ConditionThrowable {
2737:                    return put(checkSymbol(symbol), indicator, value);
2738:                }
2739:
2740:                public LispObject execute(LispObject symbol,
2741:                        LispObject indicator, LispObject defaultValue,
2742:                        LispObject value) throws ConditionThrowable {
2743:                    return put(checkSymbol(symbol), indicator, value);
2744:                }
2745:            };
2746:
2747:            // ### macrolet
2748:            private static final SpecialOperator MACROLET = new SpecialOperator(
2749:                    "macrolet", "definitions &rest body") {
2750:                public LispObject execute(LispObject args, Environment env)
2751:                        throws ConditionThrowable {
2752:                    LispObject defs = checkList(args.car());
2753:                    final LispThread thread = LispThread.currentThread();
2754:                    LispObject result;
2755:                    if (defs != NIL) {
2756:                        Environment ext = new Environment(env);
2757:                        while (defs != NIL) {
2758:                            LispObject def = checkList(defs.car());
2759:                            Symbol symbol = checkSymbol(def.car());
2760:                            LispObject lambdaList = def.cadr();
2761:                            LispObject body = def.cddr();
2762:                            LispObject block = new Cons(Symbol.BLOCK, new Cons(
2763:                                    symbol, body));
2764:                            LispObject toBeApplied = list3(Symbol.LAMBDA,
2765:                                    lambdaList, block);
2766:                            LispObject formArg = gensym("FORM-");
2767:                            LispObject envArg = gensym("ENV-"); // Ignored.
2768:                            LispObject expander = list3(Symbol.LAMBDA, list2(
2769:                                    formArg, envArg), list3(Symbol.APPLY,
2770:                                    toBeApplied, list2(Symbol.CDR, formArg)));
2771:                            Closure expansionFunction = new Closure(expander
2772:                                    .cadr(), expander.cddr(), env);
2773:                            MacroObject macroObject = new MacroObject(
2774:                                    expansionFunction);
2775:                            ext.bindFunctional(symbol, macroObject);
2776:                            defs = defs.cdr();
2777:                        }
2778:                        result = progn(args.cdr(), ext, thread);
2779:                    } else
2780:                        result = progn(args.cdr(), env, thread);
2781:                    return result;
2782:                }
2783:            };
2784:
2785:            // ### tagbody
2786:            private static final SpecialOperator TAGBODY = new SpecialOperator(
2787:                    "tagbody", "&rest statements") {
2788:                public LispObject execute(LispObject args, Environment env)
2789:                        throws ConditionThrowable {
2790:                    Environment ext = new Environment(env);
2791:                    LispObject localTags = NIL; // Tags that are local to this TAGBODY.
2792:                    LispObject body = args;
2793:                    while (body != NIL) {
2794:                        LispObject current = body.car();
2795:                        body = body.cdr();
2796:                        if (current instanceof  Cons)
2797:                            continue;
2798:                        // It's a tag.
2799:                        ext.addTagBinding(current, body);
2800:                        localTags = new Cons(current, localTags);
2801:                    }
2802:                    final LispThread thread = LispThread.currentThread();
2803:                    final LispObject stack = thread.getStack();
2804:                    LispObject remaining = args;
2805:                    while (remaining != NIL) {
2806:                        LispObject current = remaining.car();
2807:                        if (current instanceof  Cons) {
2808:                            try {
2809:                                // Handle GO inline if possible.
2810:                                if (current.car() == Symbol.GO) {
2811:                                    if (interrupted)
2812:                                        handleInterrupt();
2813:                                    LispObject tag = current.cadr();
2814:                                    if (memql(tag, localTags)) {
2815:                                        Binding binding = ext
2816:                                                .getTagBinding(tag);
2817:                                        if (binding != null
2818:                                                && binding.value != null) {
2819:                                            remaining = binding.value;
2820:                                            continue;
2821:                                        }
2822:                                    }
2823:                                    throw new Go(tag);
2824:                                }
2825:                                eval(current, ext, thread);
2826:                            } catch (Go go) {
2827:                                LispObject tag = go.getTag();
2828:                                if (memql(tag, localTags)) {
2829:                                    Binding binding = ext.getTagBinding(tag);
2830:                                    if (binding != null
2831:                                            && binding.value != null) {
2832:                                        remaining = binding.value;
2833:                                        thread.setStack(stack);
2834:                                        continue;
2835:                                    }
2836:                                }
2837:                                throw go;
2838:                            }
2839:                        }
2840:                        remaining = remaining.cdr();
2841:                    }
2842:                    thread.clearValues();
2843:                    return NIL;
2844:                }
2845:            };
2846:
2847:            // ### go
2848:            private static final SpecialOperator GO = new SpecialOperator("go",
2849:                    "tag") {
2850:                public LispObject execute(LispObject args, Environment env)
2851:                        throws ConditionThrowable {
2852:                    if (args.length() != 1)
2853:                        signal(new WrongNumberOfArgumentsException(this ));
2854:                    Binding binding = env.getTagBinding(args.car());
2855:                    if (binding == null)
2856:                        return signal(new ControlError("No tag named "
2857:                                + args.car().writeToString()
2858:                                + " is currently visible."));
2859:                    throw new Go(args.car());
2860:                }
2861:            };
2862:
2863:            // ### block
2864:            private static final SpecialOperator BLOCK = new SpecialOperator(
2865:                    "block", "name &rest forms") {
2866:                public LispObject execute(LispObject args, Environment env)
2867:                        throws ConditionThrowable {
2868:                    if (args == NIL)
2869:                        signal(new WrongNumberOfArgumentsException(this ));
2870:                    LispObject tag;
2871:                    try {
2872:                        tag = (Symbol) args.car();
2873:                    } catch (ClassCastException e) {
2874:                        return signal(new TypeError(args.car(), Symbol.SYMBOL));
2875:                    }
2876:                    LispObject body = args.cdr();
2877:                    Environment ext = new Environment(env);
2878:                    final LispObject block = new LispObject();
2879:                    ext.addBlock(tag, block);
2880:                    LispObject result = NIL;
2881:                    final LispThread thread = LispThread.currentThread();
2882:                    final LispObject stack = thread.getStack();
2883:                    try {
2884:                        while (body != NIL) {
2885:                            result = eval(body.car(), ext, thread);
2886:                            body = body.cdr();
2887:                        }
2888:                        return result;
2889:                    } catch (Return ret) {
2890:                        if (ret.getBlock() == block) {
2891:                            thread.setStack(stack);
2892:                            return ret.getResult();
2893:                        }
2894:                        throw ret;
2895:                    }
2896:                }
2897:            };
2898:
2899:            // ### return-from
2900:            private static final SpecialOperator RETURN_FROM = new SpecialOperator(
2901:                    "return-from", "name &optional value") {
2902:                public LispObject execute(LispObject args, Environment env)
2903:                        throws ConditionThrowable {
2904:                    final int length = args.length();
2905:                    if (length < 1 || length > 2)
2906:                        signal(new WrongNumberOfArgumentsException(this ));
2907:                    LispObject symbol;
2908:                    try {
2909:                        symbol = (Symbol) args.car();
2910:                    } catch (ClassCastException e) {
2911:                        return signal(new TypeError(args.car(), Symbol.SYMBOL));
2912:                    }
2913:                    LispObject block = env.lookupBlock(symbol);
2914:                    if (block == null) {
2915:                        StringBuffer sb = new StringBuffer("No block named ");
2916:                        sb.append(symbol.getName());
2917:                        sb.append(" is currently visible.");
2918:                        signal(new LispError(sb.toString()));
2919:                    }
2920:                    LispObject result;
2921:                    if (length == 2)
2922:                        result = eval(args.cadr(), env, LispThread
2923:                                .currentThread());
2924:                    else
2925:                        result = NIL;
2926:                    throw new Return(symbol, block, result);
2927:                }
2928:            };
2929:
2930:            // ### catch
2931:            private static final SpecialOperator CATCH = new SpecialOperator(
2932:                    "catch", "tag &body body") {
2933:                public LispObject execute(LispObject args, Environment env)
2934:                        throws ConditionThrowable {
2935:                    if (args.length() < 1)
2936:                        signal(new WrongNumberOfArgumentsException(this ));
2937:                    final LispThread thread = LispThread.currentThread();
2938:                    LispObject tag = eval(args.car(), env, thread);
2939:                    thread.pushCatchTag(tag);
2940:                    LispObject body = args.cdr();
2941:                    LispObject result = NIL;
2942:                    final LispObject stack = thread.getStack();
2943:                    try {
2944:                        while (body != NIL) {
2945:                            result = eval(body.car(), env, thread);
2946:                            body = body.cdr();
2947:                        }
2948:                        return result;
2949:                    } catch (Throw t) {
2950:                        if (t.tag == tag) {
2951:                            thread.setStack(stack);
2952:                            return t.getResult(thread);
2953:                        }
2954:                        throw t;
2955:                    } catch (Return ret) {
2956:                        throw ret;
2957:                    } finally {
2958:                        thread.popCatchTag();
2959:                    }
2960:                }
2961:            };
2962:
2963:            // ### throw
2964:            private static final SpecialOperator THROW = new SpecialOperator(
2965:                    "throw", "tag result") {
2966:                public LispObject execute(LispObject args, Environment env)
2967:                        throws ConditionThrowable {
2968:                    if (args.length() != 2)
2969:                        signal(new WrongNumberOfArgumentsException(this ));
2970:                    final LispThread thread = LispThread.currentThread();
2971:                    thread.throwToTag(eval(args.car(), env, thread), eval(args
2972:                            .cadr(), env, thread));
2973:                    // Not reached.
2974:                    return NIL;
2975:                }
2976:            };
2977:
2978:            // ### unwind-protect
2979:            private static final SpecialOperator UNWIND_PROTECT = new SpecialOperator(
2980:                    "unwind-protect", "protected &body cleanup") {
2981:                public LispObject execute(LispObject args, Environment env)
2982:                        throws ConditionThrowable {
2983:                    final LispThread thread = LispThread.currentThread();
2984:                    LispObject result;
2985:                    LispObject[] values;
2986:                    try {
2987:                        result = eval(args.car(), env, thread);
2988:                        values = thread.getValues();
2989:                    } finally {
2990:                        LispObject body = args.cdr();
2991:                        while (body != NIL) {
2992:                            eval(body.car(), env, thread);
2993:                            body = body.cdr();
2994:                        }
2995:                    }
2996:                    if (values != null)
2997:                        thread.setValues(values);
2998:                    else
2999:                        thread.clearValues();
3000:                    return result;
3001:                }
3002:            };
3003:
3004:            // ### eval-when
3005:            private static final SpecialOperator EVAL_WHEN = new SpecialOperator(
3006:                    "eval-when", "situations &rest forms") {
3007:                public LispObject execute(LispObject args, Environment env)
3008:                        throws ConditionThrowable {
3009:                    LispObject situations = args.car();
3010:                    if (situations != NIL) {
3011:                        final LispThread thread = LispThread.currentThread();
3012:                        if (memq(Keyword.EXECUTE, situations)
3013:                                || memq(Symbol.EVAL, situations)) {
3014:                            return progn(args.cdr(), env, thread);
3015:                        }
3016:                    }
3017:                    return NIL;
3018:                }
3019:            };
3020:
3021:            // ### multiple-value-bind
3022:            // multiple-value-bind (var*) values-form declaration* form*
3023:            // Should be a macro.
3024:            private static final SpecialOperator MULTIPLE_VALUE_BIND = new SpecialOperator(
3025:                    "multiple-value-bind", "vars value-form &body body") {
3026:                public LispObject execute(LispObject args, Environment env)
3027:                        throws ConditionThrowable {
3028:                    LispObject vars = args.car();
3029:                    args = args.cdr();
3030:                    LispObject valuesForm = args.car();
3031:                    LispObject body = args.cdr();
3032:                    final LispThread thread = LispThread.currentThread();
3033:                    LispObject value = eval(valuesForm, env, thread);
3034:                    LispObject[] values = thread.getValues();
3035:                    if (values == null) {
3036:                        // eval() did not return multiple values.
3037:                        values = new LispObject[1];
3038:                        values[0] = value;
3039:                    }
3040:                    // Process declarations.
3041:                    LispObject specials = NIL;
3042:                    while (body != NIL) {
3043:                        LispObject obj = body.car();
3044:                        if (obj instanceof  Cons && obj.car() == Symbol.DECLARE) {
3045:                            LispObject decls = obj.cdr();
3046:                            while (decls != NIL) {
3047:                                LispObject decl = decls.car();
3048:                                if (decl instanceof  Cons
3049:                                        && decl.car() == Symbol.SPECIAL) {
3050:                                    LispObject declvars = decl.cdr();
3051:                                    while (declvars != NIL) {
3052:                                        specials = new Cons(declvars.car(),
3053:                                                specials);
3054:                                        declvars = declvars.cdr();
3055:                                    }
3056:                                }
3057:                                decls = decls.cdr();
3058:                            }
3059:                            body = body.cdr();
3060:                        } else
3061:                            break;
3062:                    }
3063:                    final Environment oldDynEnv = thread
3064:                            .getDynamicEnvironment();
3065:                    final Environment ext = new Environment(env);
3066:                    int i = 0;
3067:                    LispObject var = vars.car();
3068:                    while (var != NIL) {
3069:                        Symbol sym = checkSymbol(var);
3070:                        LispObject val = i < values.length ? values[i] : NIL;
3071:                        if (specials != NIL && memq(sym, specials)) {
3072:                            thread.bindSpecial(sym, val);
3073:                            ext.declareSpecial(sym);
3074:                        } else if (sym.isSpecialVariable()) {
3075:                            thread.bindSpecial(sym, val);
3076:                        } else
3077:                            ext.bind(sym, val);
3078:                        vars = vars.cdr();
3079:                        var = vars.car();
3080:                        ++i;
3081:                    }
3082:                    thread._values = null;
3083:                    LispObject result = NIL;
3084:                    try {
3085:                        while (body != NIL) {
3086:                            result = eval(body.car(), ext, thread);
3087:                            body = body.cdr();
3088:                        }
3089:                    } finally {
3090:                        thread.setDynamicEnvironment(oldDynEnv);
3091:                    }
3092:                    return result;
3093:                }
3094:            };
3095:
3096:            // ### multiple-value-prog1
3097:            private static final SpecialOperator MULTIPLE_VALUE_PROG1 = new SpecialOperator(
3098:                    "multiple-value-prog1", "values-form &rest forms") {
3099:                public LispObject execute(LispObject args, Environment env)
3100:                        throws ConditionThrowable {
3101:                    if (args.length() == 0)
3102:                        signal(new WrongNumberOfArgumentsException(this ));
3103:                    final LispThread thread = LispThread.currentThread();
3104:                    LispObject result = eval(args.car(), env, thread);
3105:                    LispObject[] values = thread.getValues();
3106:                    while ((args = args.cdr()) != NIL)
3107:                        eval(args.car(), env, thread);
3108:                    if (values != null)
3109:                        thread.setValues(values);
3110:                    else
3111:                        thread.clearValues();
3112:                    return result;
3113:                }
3114:            };
3115:
3116:            // ### multiple-value-call
3117:            private static final SpecialOperator MULTIPLE_VALUE_CALL = new SpecialOperator(
3118:                    "multiple-value-call", "fun &rest args") {
3119:                public LispObject execute(LispObject args, Environment env)
3120:                        throws ConditionThrowable {
3121:                    if (args.length() == 0)
3122:                        signal(new WrongNumberOfArgumentsException(this ));
3123:                    final LispThread thread = LispThread.currentThread();
3124:                    LispObject function;
3125:                    LispObject obj = eval(args.car(), env, thread);
3126:                    args = args.cdr();
3127:                    if (obj instanceof  Symbol) {
3128:                        function = obj.getSymbolFunction();
3129:                        if (function == null)
3130:                            signal(new UndefinedFunction(obj));
3131:                    } else if (obj instanceof  Function) {
3132:                        function = obj;
3133:                    } else {
3134:                        signal(new LispError(obj.writeToString()
3135:                                + " is not a function name."));
3136:                        return NIL;
3137:                    }
3138:                    ArrayList arrayList = new ArrayList();
3139:                    while (args != NIL) {
3140:                        LispObject form = args.car();
3141:                        LispObject result = eval(form, env, thread);
3142:                        LispObject[] values = thread.getValues();
3143:                        if (values != null) {
3144:                            for (int i = 0; i < values.length; i++)
3145:                                arrayList.add(values[i]);
3146:                        } else
3147:                            arrayList.add(result);
3148:                        args = args.cdr();
3149:                    }
3150:                    LispObject[] argv = new LispObject[arrayList.size()];
3151:                    arrayList.toArray(argv);
3152:                    return funcall(function, argv, thread);
3153:                }
3154:            };
3155:
3156:            // ### and
3157:            // Should be a macro.
3158:            private static final SpecialOperator AND = new SpecialOperator(
3159:                    "and", "&rest forms") {
3160:                public LispObject execute(LispObject args, Environment env)
3161:                        throws ConditionThrowable {
3162:                    final LispThread thread = LispThread.currentThread();
3163:                    LispObject result = T;
3164:                    while (args != NIL) {
3165:                        result = eval(args.car(), env, thread);
3166:                        if (result == NIL) {
3167:                            if (args.cdr() != NIL) {
3168:                                // Not the last form.
3169:                                thread.clearValues();
3170:                            }
3171:                            break;
3172:                        }
3173:                        args = args.cdr();
3174:                    }
3175:                    return result;
3176:                }
3177:            };
3178:
3179:            // ### or
3180:            // Should be a macro.
3181:            private static final SpecialOperator OR = new SpecialOperator("or",
3182:                    "&rest forms") {
3183:                public LispObject execute(LispObject args, Environment env)
3184:                        throws ConditionThrowable {
3185:                    final LispThread thread = LispThread.currentThread();
3186:                    LispObject result = NIL;
3187:                    while (args != NIL) {
3188:                        result = eval(args.car(), env, thread);
3189:                        if (result != NIL) {
3190:                            if (args.cdr() != NIL) {
3191:                                // Not the last form.
3192:                                thread.clearValues();
3193:                            }
3194:                            break;
3195:                        }
3196:                        args = args.cdr();
3197:                    }
3198:                    return result;
3199:                }
3200:            };
3201:
3202:            // ### %write-char
3203:            // %write-char character output-stream => character
3204:            private static final Primitive2 _WRITE_CHAR = new Primitive2(
3205:                    "%write-char", PACKAGE_SYS, false,
3206:                    "character output-stream") {
3207:                public LispObject execute(LispObject first, LispObject second)
3208:                        throws ConditionThrowable {
3209:                    outSynonymOf(second)._writeChar(
3210:                            LispCharacter.getValue(first));
3211:                    return first;
3212:                }
3213:            };
3214:
3215:            // ### %write-string
3216:            // write-string string output-stream start end => string
3217:            private static final Primitive4 _WRITE_STRING = new Primitive4(
3218:                    "%write-string", PACKAGE_SYS, false,
3219:                    "string output-stream start end") {
3220:                public LispObject execute(LispObject first, LispObject second,
3221:                        LispObject third, LispObject fourth)
3222:                        throws ConditionThrowable {
3223:                    AbstractString s;
3224:                    try {
3225:                        s = (AbstractString) first;
3226:                    } catch (ClassCastException e) {
3227:                        return signal(new TypeError(first, Symbol.STRING));
3228:                    }
3229:                    char[] chars = s.chars();
3230:                    Stream out = outSynonymOf(second);
3231:                    int start = Fixnum.getValue(third);
3232:                    int end;
3233:                    if (fourth == NIL)
3234:                        end = chars.length;
3235:                    else
3236:                        end = Fixnum.getValue(fourth);
3237:                    checkBounds(start, end, chars.length);
3238:                    out._writeChars(chars, start, end);
3239:                    return first;
3240:                }
3241:            };
3242:
3243:            // ### %finish-output output-stream => nil
3244:            private static final Primitive1 _FINISH_OUTPUT = new Primitive1(
3245:                    "%finish-output", PACKAGE_SYS, false, "output-stream") {
3246:                public LispObject execute(LispObject arg)
3247:                        throws ConditionThrowable {
3248:                    return finishOutput(arg);
3249:                }
3250:            };
3251:
3252:            // ### %force-output output-stream => nil
3253:            private static final Primitive1 _FORCE_OUTPUT = new Primitive1(
3254:                    "%force-output", PACKAGE_SYS, false, "output-stream") {
3255:                public LispObject execute(LispObject arg)
3256:                        throws ConditionThrowable {
3257:                    return finishOutput(arg);
3258:                }
3259:            };
3260:
3261:            private static final LispObject finishOutput(LispObject arg)
3262:                    throws ConditionThrowable {
3263:                Stream out = null;
3264:                if (arg == T)
3265:                    out = checkCharacterOutputStream(_TERMINAL_IO_
3266:                            .symbolValue());
3267:                else if (arg == NIL)
3268:                    out = checkCharacterOutputStream(_STANDARD_OUTPUT_
3269:                            .symbolValue());
3270:                else if (arg instanceof  Stream) {
3271:                    Stream stream = (Stream) arg;
3272:                    if (stream instanceof  TwoWayStream)
3273:                        out = ((TwoWayStream) arg).getOutputStream();
3274:                    else if (stream.isOutputStream())
3275:                        out = stream;
3276:                }
3277:                if (out == null)
3278:                    signal(new TypeError(arg, "output stream"));
3279:                return out.finishOutput();
3280:            }
3281:
3282:            // ### clear-input
3283:            // clear-input &optional input-stream => nil
3284:            private static final Primitive CLEAR_INPUT = new Primitive(
3285:                    "clear-input", "&optional input-stream") {
3286:                public LispObject execute(LispObject[] args)
3287:                        throws ConditionThrowable {
3288:                    if (args.length > 1)
3289:                        signal(new WrongNumberOfArgumentsException(this ));
3290:                    final Stream in;
3291:                    if (args.length == 0)
3292:                        in = checkCharacterInputStream(_STANDARD_INPUT_
3293:                                .symbolValue());
3294:                    else
3295:                        in = inSynonymOf(args[0]);
3296:                    in.clearInput();
3297:                    return NIL;
3298:                }
3299:            };
3300:
3301:            // ### %clear-output output-stream => nil
3302:            // "If any of these operations does not make sense for output-stream, then
3303:            // it does nothing."
3304:            private static final Primitive1 _CLEAR_OUTPUT = new Primitive1(
3305:                    "%clear-output", PACKAGE_SYS, false, "output-stream") {
3306:                public LispObject execute(LispObject arg)
3307:                        throws ConditionThrowable {
3308:                    if (arg == T)
3309:                        return NIL; // *TERMINAL-IO*
3310:                    if (arg == NIL)
3311:                        return NIL; // *STANDARD-OUTPUT*
3312:                    if (arg instanceof  Stream) {
3313:                        Stream stream = (Stream) arg;
3314:                        if (stream instanceof  TwoWayStream) {
3315:                            Stream out = ((TwoWayStream) stream)
3316:                                    .getOutputStream();
3317:                            if (out.isOutputStream())
3318:                                return NIL;
3319:                        }
3320:                        if (stream.isOutputStream())
3321:                            return NIL;
3322:                    }
3323:                    return signal(new TypeError(arg, "output stream"));
3324:                }
3325:            };
3326:
3327:            // ### close
3328:            // close stream &key abort => result
3329:            private static final Primitive CLOSE = new Primitive("close",
3330:                    "stream &key abort") {
3331:                public LispObject execute(LispObject[] args)
3332:                        throws ConditionThrowable {
3333:                    final int length = args.length;
3334:                    if (length == 0)
3335:                        signal(new WrongNumberOfArgumentsException(this ));
3336:                    LispObject abort = NIL; // Default.
3337:                    Stream stream = checkStream(args[0]);
3338:                    if (length > 1) {
3339:                        if ((length - 1) % 2 != 0)
3340:                            signal(new ProgramError(
3341:                                    "Odd number of keyword arguments."));
3342:                        if (length > 3)
3343:                            signal(new WrongNumberOfArgumentsException(this ));
3344:                        if (args[1] == Keyword.ABORT)
3345:                            abort = args[2];
3346:                        else
3347:                            signal(new ProgramError(
3348:                                    "Unrecognized keyword argument "
3349:                                            + args[1].writeToString() + "."));
3350:                    }
3351:                    return stream.close(abort);
3352:                }
3353:            };
3354:
3355:            // ### multiple-value-list
3356:            // multiple-value-list form => list
3357:            // Evaluates form and creates a list of the multiple values it returns.
3358:            // Should be a macro.
3359:            private static final SpecialOperator MULTIPLE_VALUE_LIST = new SpecialOperator(
3360:                    "multiple-value-list", "value-form") {
3361:                public LispObject execute(LispObject args, Environment env)
3362:                        throws ConditionThrowable {
3363:                    if (args.length() != 1)
3364:                        signal(new WrongNumberOfArgumentsException(this ));
3365:                    final LispThread thread = LispThread.currentThread();
3366:                    LispObject result = eval(args.car(), env, thread);
3367:                    LispObject[] values = thread.getValues();
3368:                    if (values == null)
3369:                        return new Cons(result);
3370:                    thread.clearValues();
3371:                    LispObject list = NIL;
3372:                    for (int i = values.length; i-- > 0;)
3373:                        list = new Cons(values[i], list);
3374:                    return list;
3375:                }
3376:            };
3377:
3378:            // ### nth-value
3379:            // nth-value n form => object
3380:            // Evaluates n and then form and returns the nth value returned by form, or
3381:            // NIL if n >= number of values returned.
3382:            // Should be a macro.
3383:            private static final SpecialOperator NTH_VALUE = new SpecialOperator(
3384:                    "nth-value", "n form") {
3385:                public LispObject execute(LispObject args, Environment env)
3386:                        throws ConditionThrowable {
3387:                    if (args.length() != 2)
3388:                        signal(new WrongNumberOfArgumentsException(this ));
3389:                    final LispThread thread = LispThread.currentThread();
3390:                    int n = Fixnum.getInt(eval(args.car(), env, thread));
3391:                    if (n < 0)
3392:                        n = 0;
3393:                    LispObject result = eval(args.cadr(), env, thread);
3394:                    LispObject[] values = thread.getValues();
3395:                    thread.clearValues();
3396:                    if (values == null) {
3397:                        // A single value was returned.
3398:                        return n == 0 ? result : NIL;
3399:                    }
3400:                    if (n < values.length)
3401:                        return values[n];
3402:                    return NIL;
3403:                }
3404:            };
3405:
3406:            // ### write-8-bits
3407:            // write-8-bits byte stream => byte
3408:            private static final Primitive2 WRITE_8_BITS = new Primitive2(
3409:                    "write-8-bits", PACKAGE_SYS, false, "byte stream") {
3410:                public LispObject execute(LispObject first, LispObject second)
3411:                        throws ConditionThrowable {
3412:                    int n;
3413:                    try {
3414:                        n = ((Fixnum) first).value;
3415:                    } catch (ClassCastException e) {
3416:                        return signal(new TypeError(first, Symbol.FIXNUM));
3417:                    }
3418:                    if (n < 0 || n > 255)
3419:                        signal(new TypeError(first, list2(Symbol.UNSIGNED_BYTE,
3420:                                new Fixnum(8))));
3421:                    checkBinaryOutputStream(second)._writeByte(n);
3422:                    return first;
3423:                }
3424:            };
3425:
3426:            // ### read-8-bits
3427:            // read-8-bits stream &optional eof-error-p eof-value => byte
3428:            private static final Primitive READ_8_BITS = new Primitive(
3429:                    "read-8-bits", PACKAGE_SYS, false,
3430:                    "stream &optional eof-error-p eof-value") {
3431:                public LispObject execute(LispObject[] args)
3432:                        throws ConditionThrowable {
3433:                    int length = args.length;
3434:                    if (length < 1 || length > 3)
3435:                        signal(new WrongNumberOfArgumentsException(this ));
3436:                    final Stream in = checkBinaryInputStream(args[0]);
3437:                    boolean eofError = length > 1 ? (args[1] != NIL) : true;
3438:                    LispObject eofValue = length > 2 ? args[2] : NIL;
3439:                    return in.readByte(eofError, eofValue);
3440:                }
3441:            };
3442:
3443:            // ### read-line
3444:            // read-line &optional input-stream eof-error-p eof-value recursive-p
3445:            // => line, missing-newline-p
3446:            private static final Primitive READ_LINE = new Primitive(
3447:                    "read-line",
3448:                    "&optional input-stream eof-error-p eof-value recursive-p") {
3449:                public LispObject execute(LispObject[] args)
3450:                        throws ConditionThrowable {
3451:                    int length = args.length;
3452:                    if (length > 4)
3453:                        signal(new WrongNumberOfArgumentsException(this ));
3454:                    Stream stream = length > 0 ? inSynonymOf(args[0])
3455:                            : getStandardInput();
3456:                    boolean eofError = length > 1 ? (args[1] != NIL) : true;
3457:                    LispObject eofValue = length > 2 ? args[2] : NIL;
3458:                    boolean recursive = length > 3 ? (args[3] != NIL) : false;
3459:                    return stream.readLine(eofError, eofValue);
3460:                }
3461:            };
3462:
3463:            // ### %read-from-string
3464:            // read-from-string string &optional eof-error-p eof-value &key start end
3465:            // preserve-whitespace => object, position
3466:            private static final Primitive _READ_FROM_STRING = new Primitive(
3467:                    "%read-from-string", PACKAGE_SYS, false) {
3468:                public LispObject execute(LispObject[] args)
3469:                        throws ConditionThrowable {
3470:                    if (args.length < 6)
3471:                        signal(new WrongNumberOfArgumentsException(this ));
3472:                    String s = args[0].getStringValue();
3473:                    boolean eofError = args[1] != NIL;
3474:                    LispObject eofValue = args[2];
3475:                    LispObject start = args[3];
3476:                    LispObject end = args[4];
3477:                    boolean preserveWhitespace = args[5] != NIL;
3478:                    int startIndex, endIndex;
3479:                    if (start != NIL)
3480:                        startIndex = (int) Fixnum.getValue(start);
3481:                    else
3482:                        startIndex = 0;
3483:                    if (end != NIL)
3484:                        endIndex = (int) Fixnum.getValue(end);
3485:                    else
3486:                        endIndex = s.length();
3487:                    StringInputStream in = new StringInputStream(s, startIndex,
3488:                            endIndex);
3489:                    LispObject result;
3490:                    if (preserveWhitespace)
3491:                        result = in.readPreservingWhitespace(eofError,
3492:                                eofValue, false);
3493:                    else
3494:                        result = in.read(eofError, eofValue, false);
3495:                    return LispThread.currentThread().setValues(result,
3496:                            new Fixnum(in.getOffset()));
3497:                }
3498:            };
3499:
3500:            private static final Primitive1 _CALL_COUNT = new Primitive1(
3501:                    "%call-count", PACKAGE_SYS, false) {
3502:                public LispObject execute(LispObject arg)
3503:                        throws ConditionThrowable {
3504:                    return new Fixnum(arg.getCallCount());
3505:                }
3506:            };
3507:
3508:            private static final Primitive2 _SET_CALL_COUNT = new Primitive2(
3509:                    "%set-call-count", PACKAGE_SYS, false) {
3510:                public LispObject execute(LispObject first, LispObject second)
3511:                        throws ConditionThrowable {
3512:                    first.setCallCount(Fixnum.getValue(second));
3513:                    return second;
3514:                }
3515:            };
3516:
3517:            // ### read
3518:            // read &optional input-stream eof-error-p eof-value recursive-p => object
3519:            private static final Primitive READ = new Primitive("read",
3520:                    "&optional input-stream eof-error-p eof-value recursive-p") {
3521:                public LispObject execute(LispObject[] args)
3522:                        throws ConditionThrowable {
3523:                    int length = args.length;
3524:                    if (length > 4)
3525:                        signal(new WrongNumberOfArgumentsException(this ));
3526:                    Stream stream = length > 0 ? checkCharacterInputStream(args[0])
3527:                            : getStandardInput();
3528:                    boolean eofError = length > 1 ? (args[1] != NIL) : true;
3529:                    LispObject eofValue = length > 2 ? args[2] : NIL;
3530:                    boolean recursive = length > 3 ? (args[3] != NIL) : false;
3531:                    return stream.read(eofError, eofValue, recursive);
3532:                }
3533:            };
3534:
3535:            // ### read-preserving-whitespace
3536:            // read &optional input-stream eof-error-p eof-value recursive-p => object
3537:            private static final Primitive READ_PRESERVING_WHITESPACE = new Primitive(
3538:                    "read-preserving-whitespace",
3539:                    "&optional input-stream eof-error-p eof-value recursive-p") {
3540:                public LispObject execute(LispObject[] args)
3541:                        throws ConditionThrowable {
3542:                    int length = args.length;
3543:                    if (length > 4)
3544:                        signal(new WrongNumberOfArgumentsException(this ));
3545:                    Stream stream = length > 0 ? checkCharacterInputStream(args[0])
3546:                            : getStandardInput();
3547:                    boolean eofError = length > 1 ? (args[1] != NIL) : true;
3548:                    LispObject eofValue = length > 2 ? args[2] : NIL;
3549:                    boolean recursive = length > 3 ? (args[3] != NIL) : false;
3550:                    return stream.readPreservingWhitespace(eofError, eofValue,
3551:                            recursive);
3552:                }
3553:            };
3554:
3555:            // ### read-char
3556:            // read-char &optional input-stream eof-error-p eof-value recursive-p => char
3557:            private static final Primitive READ_CHAR = new Primitive(
3558:                    "read-char",
3559:                    "&optional input-stream eof-error-p eof-value recursive-p") {
3560:                public LispObject execute(LispObject[] args)
3561:                        throws ConditionThrowable {
3562:                    int length = args.length;
3563:                    if (length > 4)
3564:                        signal(new WrongNumberOfArgumentsException(this ));
3565:                    Stream stream = length > 0 ? inSynonymOf(args[0])
3566:                            : getStandardInput();
3567:                    boolean eofError = length > 1 ? (args[1] != NIL) : true;
3568:                    LispObject eofValue = length > 2 ? args[2] : NIL;
3569:                    boolean recursive = length > 3 ? (args[3] != NIL) : false;
3570:                    return stream.readChar(eofError, eofValue);
3571:                }
3572:            };
3573:
3574:            // ### unread-char
3575:            // unread-char character &optional input-stream => nil
3576:            private static final Primitive UNREAD_CHAR = new Primitive(
3577:                    "unread-char", "character &optional input-stream") {
3578:                public LispObject execute(LispObject arg)
3579:                        throws ConditionThrowable {
3580:                    return getStandardInput().unreadChar(checkCharacter(arg));
3581:                }
3582:
3583:                public LispObject execute(LispObject first, LispObject second)
3584:                        throws ConditionThrowable {
3585:                    Stream stream = inSynonymOf(second);
3586:                    return stream.unreadChar(checkCharacter(first));
3587:                }
3588:            };
3589:
3590:            // ### %set-lambda-name
3591:            private static final Primitive2 _SET_LAMBDA_NAME = new Primitive2(
3592:                    "%set-lambda-name", PACKAGE_SYS, false) {
3593:                public LispObject execute(LispObject first, LispObject second)
3594:                        throws ConditionThrowable {
3595:                    if (first instanceof  Function) {
3596:                        Function f = (Function) first;
3597:                        f.setLambdaName(second);
3598:                        return second;
3599:                    }
3600:                    return signal(new TypeError(first, "function"));
3601:                }
3602:            };
3603:
3604:            // ### shrink-vector
3605:            // Destructively alters the vector, changing its length to NEW-SIZE, which
3606:            // must be less than or equal to its current length.
3607:            // shrink-vector vector new-size => vector
3608:            private static final Primitive2 SHRINK_VECTOR = new Primitive2(
3609:                    "shrink-vector", PACKAGE_SYS, false) {
3610:                public LispObject execute(LispObject first, LispObject second)
3611:                        throws ConditionThrowable {
3612:                    checkVector(first).shrink(Fixnum.getInt(second));
3613:                    return first;
3614:                }
3615:            };
3616:
3617:            // ### subseq
3618:            // subseq sequence start &optional end
3619:            private static final Primitive SUBSEQ = new Primitive("subseq",
3620:                    "sequence start &optional end") {
3621:                public LispObject execute(LispObject first, LispObject second)
3622:                        throws ConditionThrowable {
3623:                    final int start = Fixnum.getValue(second);
3624:                    if (start < 0) {
3625:                        StringBuffer sb = new StringBuffer("Bad start index (");
3626:                        sb.append(start);
3627:                        sb.append(") for SUBSEQ.");
3628:                        signal(new TypeError(sb.toString()));
3629:                    }
3630:                    if (first.listp())
3631:                        return list_subseq(first, start, -1);
3632:                    if (first.vectorp()) {
3633:                        AbstractVector v = (AbstractVector) first;
3634:                        return v.subseq(start, v.length());
3635:                    }
3636:                    return signal(new TypeError(first, Symbol.SEQUENCE));
3637:                }
3638:
3639:                public LispObject execute(LispObject first, LispObject second,
3640:                        LispObject third) throws ConditionThrowable {
3641:                    final int start = Fixnum.getValue(second);
3642:                    if (start < 0) {
3643:                        StringBuffer sb = new StringBuffer("Bad start index (");
3644:                        sb.append(start);
3645:                        sb.append(").");
3646:                        signal(new TypeError(sb.toString()));
3647:                    }
3648:                    int end;
3649:                    if (third != NIL) {
3650:                        end = Fixnum.getValue(third);
3651:                        if (start > end) {
3652:                            StringBuffer sb = new StringBuffer("Start index (");
3653:                            sb.append(start);
3654:                            sb.append(") is greater than end index (");
3655:                            sb.append(end);
3656:                            sb.append(") for SUBSEQ.");
3657:                            signal(new TypeError(sb.toString()));
3658:                        }
3659:                    } else
3660:                        end = -1;
3661:                    if (first.listp())
3662:                        return list_subseq(first, start, end);
3663:                    if (first.vectorp()) {
3664:                        AbstractVector v = (AbstractVector) first;
3665:                        if (end < 0)
3666:                            end = v.length();
3667:                        return v.subseq(start, end);
3668:                    }
3669:                    return signal(new TypeError(first, Symbol.SEQUENCE));
3670:                }
3671:            };
3672:
3673:            private static final LispObject list_subseq(LispObject list,
3674:                    int start, int end) throws ConditionThrowable {
3675:                int index = 0;
3676:                LispObject result = NIL;
3677:                while (list != NIL) {
3678:                    if (end >= 0 && index == end)
3679:                        return result.nreverse();
3680:                    if (index++ >= start)
3681:                        result = new Cons(list.car(), result);
3682:                    list = list.cdr();
3683:                }
3684:                return result.nreverse();
3685:            }
3686:
3687:            // ### expt
3688:            // expt base-number power-number => result
3689:            public static final Primitive2 EXPT = new Primitive2("expt",
3690:                    "base-number power-number") {
3691:                public LispObject execute(LispObject base, LispObject power)
3692:                        throws ConditionThrowable {
3693:                    if (power.zerop()) {
3694:                        if (power instanceof  Fixnum) {
3695:                            if (base instanceof  LispFloat)
3696:                                return LispFloat.ONE;
3697:                            if (base instanceof  Complex) {
3698:                                if (((Complex) base).getRealPart() instanceof  LispFloat)
3699:                                    return Complex.getInstance(LispFloat.ONE,
3700:                                            LispFloat.ZERO);
3701:                            }
3702:                            return Fixnum.ONE;
3703:                        }
3704:                        if (power instanceof  LispFloat) {
3705:                            return LispFloat.ONE;
3706:                        }
3707:                    }
3708:                    if (power instanceof  Fixnum) {
3709:                        if (base.rationalp())
3710:                            return intexp(base, power);
3711:                        LispObject result;
3712:                        if (base instanceof  LispFloat)
3713:                            result = LispFloat.ONE;
3714:                        else
3715:                            result = Fixnum.ONE;
3716:                        int pow = ((Fixnum) power).value;
3717:                        if (pow > 0) {
3718:                            for (int i = pow; i-- > 0;)
3719:                                result = result.multiplyBy(base);
3720:                        } else if (pow < 0) {
3721:                            for (int i = -pow; i-- > 0;)
3722:                                result = result.divideBy(base);
3723:                        }
3724:                        return result;
3725:                    }
3726:                    if (power instanceof  LispFloat) {
3727:                        if (base instanceof  Fixnum) {
3728:                            double d = Math.pow(((Fixnum) base).value,
3729:                                    ((LispFloat) power).value);
3730:                            return new LispFloat(d);
3731:                        }
3732:                        if (base instanceof  LispFloat) {
3733:                            double d = Math.pow(((LispFloat) base).value,
3734:                                    ((LispFloat) power).value);
3735:                            return new LispFloat(d);
3736:                        }
3737:                    }
3738:                    if (power instanceof  Ratio) {
3739:                        if (base instanceof  Fixnum) {
3740:                            double d = Math.pow(((Fixnum) base).getValue(),
3741:                                    ((Ratio) power).floatValue());
3742:                            return new LispFloat(d);
3743:                        }
3744:                        if (base instanceof  LispFloat) {
3745:                            double d = Math.pow(((LispFloat) base).value,
3746:                                    ((Ratio) power).floatValue());
3747:                            return new LispFloat(d);
3748:                        }
3749:                    }
3750:                    signal(new LispError("EXPT: unsupported case"));
3751:                    return NIL;
3752:                }
3753:            };
3754:
3755:            // Adapted from SBCL.
3756:            private static final LispObject intexp(LispObject base,
3757:                    LispObject power) throws ConditionThrowable {
3758:                if (power.minusp()) {
3759:                    power = Fixnum.ZERO.subtract(power);
3760:                    return Fixnum.ONE.divideBy(intexp(base, power));
3761:                }
3762:                if (base.eql(Fixnum.TWO))
3763:                    return Fixnum.ONE.ash(power);
3764:                LispObject nextn = power.ash(Fixnum.MINUS_ONE);
3765:                LispObject total;
3766:                if (power.oddp())
3767:                    total = base;
3768:                else
3769:                    total = Fixnum.ONE;
3770:                while (true) {
3771:                    if (nextn.zerop())
3772:                        return total;
3773:                    base = base.multiplyBy(base);
3774:                    power = nextn;
3775:                    nextn = power.ash(Fixnum.MINUS_ONE);
3776:                    if (power.oddp())
3777:                        total = base.multiplyBy(total);
3778:                }
3779:            }
3780:
3781:            // ### list
3782:            private static final Primitive LIST = new Primitive("list",
3783:                    "&rest objects") {
3784:                public LispObject execute(LispObject arg)
3785:                        throws ConditionThrowable {
3786:                    return new Cons(arg);
3787:                }
3788:
3789:                public LispObject execute(LispObject first, LispObject second)
3790:                        throws ConditionThrowable {
3791:                    return new Cons(first, new Cons(second));
3792:                }
3793:
3794:                public LispObject execute(LispObject first, LispObject second,
3795:                        LispObject third) throws ConditionThrowable {
3796:                    return new Cons(first, new Cons(second, new Cons(third)));
3797:                }
3798:
3799:                public LispObject execute(LispObject[] args)
3800:                        throws ConditionThrowable {
3801:                    LispObject result = NIL;
3802:                    for (int i = args.length; i-- > 0;)
3803:                        result = new Cons(args[i], result);
3804:                    return result;
3805:                }
3806:            };
3807:
3808:            // ### list*
3809:            private static final Primitive LIST_ = new Primitive("list*",
3810:                    "&rest objects") {
3811:                public LispObject execute() throws ConditionThrowable {
3812:                    signal(new WrongNumberOfArgumentsException("LIST*"));
3813:                    return NIL;
3814:                }
3815:
3816:                public LispObject execute(LispObject arg)
3817:                        throws ConditionThrowable {
3818:                    return arg;
3819:                }
3820:
3821:                public LispObject execute(LispObject first, LispObject second)
3822:                        throws ConditionThrowable {
3823:                    return new Cons(first, second);
3824:                }
3825:
3826:                public LispObject execute(LispObject first, LispObject second,
3827:                        LispObject third) throws ConditionThrowable {
3828:                    return new Cons(first, new Cons(second, third));
3829:                }
3830:
3831:                public LispObject execute(LispObject[] args)
3832:                        throws ConditionThrowable {
3833:                    int i = args.length - 1;
3834:                    LispObject result = args[i];
3835:                    while (i-- > 0)
3836:                        result = new Cons(args[i], result);
3837:                    return result;
3838:                }
3839:            };
3840:
3841:            // ### nreverse
3842:            public static final Primitive1 NREVERSE = new Primitive1(
3843:                    "nreverse", "sequence") {
3844:                public LispObject execute(LispObject arg)
3845:                        throws ConditionThrowable {
3846:                    return arg.nreverse();
3847:                }
3848:            };
3849:
3850:            // ### nreconc
3851:            // Adapted from CLISP.
3852:            private static final Primitive2 NRECONC = new Primitive2("nreconc",
3853:                    "list tail") {
3854:                public LispObject execute(LispObject list, LispObject obj)
3855:                        throws ConditionThrowable {
3856:                    if (list instanceof  Cons) {
3857:                        LispObject list3 = list.cdr();
3858:                        if (list3 instanceof  Cons) {
3859:                            if (list3.cdr() instanceof  Cons) {
3860:                                LispObject list1 = list3;
3861:                                LispObject list2 = NIL;
3862:                                do {
3863:                                    LispObject h = list3.cdr();
3864:                                    list3.setCdr(list2);
3865:                                    list2 = list3;
3866:                                    list3 = h;
3867:                                } while (list3.cdr() instanceof  Cons);
3868:                                list.setCdr(list2);
3869:                                list1.setCdr(list3);
3870:                            }
3871:                            LispObject h = list.car();
3872:                            list.setCar(list3.car());
3873:                            list3.setCar(h);
3874:                            list3.setCdr(obj);
3875:                        } else if (list3 == NIL) {
3876:                            list.setCdr(obj);
3877:                        } else
3878:                            signal(new TypeError(list3, Symbol.LIST));
3879:                        return list;
3880:                    } else
3881:                        return obj;
3882:                }
3883:            };
3884:
3885:            // ### reverse
3886:            private static final Primitive1 REVERSE = new Primitive1("reverse",
3887:                    "sequence") {
3888:                public LispObject execute(LispObject arg)
3889:                        throws ConditionThrowable {
3890:                    if (arg instanceof  AbstractVector)
3891:                        return ((AbstractVector) arg).reverse();
3892:                    if (arg instanceof  Cons) {
3893:                        LispObject result = NIL;
3894:                        while (arg != NIL) {
3895:                            result = new Cons(arg.car(), result);
3896:                            arg = arg.cdr();
3897:                        }
3898:                        return result;
3899:                    }
3900:                    if (arg == NIL)
3901:                        return NIL;
3902:                    signal(new TypeError(arg, "proper sequence"));
3903:                    return NIL;
3904:                }
3905:            };
3906:
3907:            // ### %set-elt
3908:            // %setelt sequence index newval => newval
3909:            private static final Primitive3 _SET_ELT = new Primitive3(
3910:                    "%set-elt", PACKAGE_SYS, false) {
3911:                public LispObject execute(LispObject first, LispObject second,
3912:                        LispObject third) throws ConditionThrowable {
3913:                    if (first instanceof  AbstractVector) {
3914:                        ((AbstractVector) first).setRowMajor(Fixnum
3915:                                .getValue(second), third);
3916:                        return third;
3917:                    }
3918:                    if (first instanceof  Cons) {
3919:                        int index = Fixnum.getValue(second);
3920:                        if (index < 0)
3921:                            signal(new TypeError());
3922:                        LispObject list = first;
3923:                        int i = 0;
3924:                        while (true) {
3925:                            if (i == index) {
3926:                                list.setCar(third);
3927:                                return third;
3928:                            }
3929:                            list = list.cdr();
3930:                            if (list == NIL)
3931:                                signal(new TypeError());
3932:                            ++i;
3933:                        }
3934:                    }
3935:                    signal(new TypeError(first, Symbol.SEQUENCE));
3936:                    return NIL;
3937:                }
3938:            };
3939:
3940:            //     (defun maptree (fun x)
3941:            //       (if (atom x)
3942:            //           (funcall fun x)
3943:            //           (let ((a (funcall fun (car x)))
3944:            //                 (d (maptree fun (cdr x))))
3945:            //             (if (and (eql a (car x)) (eql d (cdr x)))
3946:            //                 x
3947:            //                 (cons a d)))))
3948:
3949:            // ### maptree
3950:            private static final Primitive2 MAPTREE = new Primitive2("maptree",
3951:                    PACKAGE_SYS, false) {
3952:                public LispObject execute(LispObject fun, LispObject x)
3953:                        throws ConditionThrowable {
3954:                    if (x instanceof  Cons) {
3955:                        LispObject a = fun.execute(x.car());
3956:                        // Recurse!
3957:                        LispObject d = execute(fun, x.cdr());
3958:                        if (a.eql(x.car()) && d.eql(x.cdr()))
3959:                            return x;
3960:                        else
3961:                            return new Cons(a, d);
3962:                    } else
3963:                        return fun.execute(x);
3964:                }
3965:            };
3966:
3967:            // ### %make-list
3968:            private static final Primitive2 _MAKE_LIST = new Primitive2(
3969:                    "%make-list", PACKAGE_SYS, false) {
3970:                public LispObject execute(LispObject first, LispObject second)
3971:                        throws ConditionThrowable {
3972:                    int size = Fixnum.getValue(first);
3973:                    if (size < 0)
3974:                        signal(new TypeError(String.valueOf(size)
3975:                                + " is not a valid list length."));
3976:                    LispObject result = NIL;
3977:                    for (int i = size; i-- > 0;)
3978:                        result = new Cons(second, result);
3979:                    return result;
3980:                }
3981:            };
3982:
3983:            // ### %member
3984:            // %member item list key test test-not => tail
3985:            private static final Primitive _MEMBER = new Primitive("%member",
3986:                    PACKAGE_SYS, false) {
3987:                public LispObject execute(LispObject[] args)
3988:                        throws ConditionThrowable {
3989:                    if (args.length != 5)
3990:                        signal(new WrongNumberOfArgumentsException(this ));
3991:                    LispObject item = args[0];
3992:                    LispObject tail = checkList(args[1]);
3993:                    LispObject key = args[2];
3994:                    if (key != NIL) {
3995:                        if (key instanceof  Symbol)
3996:                            key = key.getSymbolFunction();
3997:                        if (!(key instanceof  Function || key instanceof  GenericFunction))
3998:                            signal(new UndefinedFunction(args[2]));
3999:                    }
4000:                    LispObject test = args[3];
4001:                    LispObject testNot = args[4];
4002:                    if (test != NIL && testNot != NIL)
4003:                        signal(new LispError(
4004:                                "MEMBER: test and test-not both supplied"));
4005:                    if (test == NIL && testNot == NIL) {
4006:                        test = EQL;
4007:                    } else if (test != NIL) {
4008:                        if (test instanceof  Symbol)
4009:                            test = test.getSymbolFunction();
4010:                        if (!(test instanceof  Function || test instanceof  GenericFunction))
4011:                            signal(new UndefinedFunction(args[3]));
4012:                    } else if (testNot != NIL) {
4013:                        if (testNot instanceof  Symbol)
4014:                            testNot = testNot.getSymbolFunction();
4015:                        if (!(testNot instanceof  Function || testNot instanceof  GenericFunction))
4016:                            signal(new UndefinedFunction(args[3]));
4017:                    }
4018:                    if (key == NIL && test == EQL) {
4019:                        while (tail != NIL) {
4020:                            if (item.eql(tail.car()))
4021:                                return tail;
4022:                            tail = tail.cdr();
4023:                        }
4024:                        return NIL;
4025:                    }
4026:                    while (tail != NIL) {
4027:                        LispObject candidate = tail.car();
4028:                        if (key != NIL)
4029:                            candidate = key.execute(candidate);
4030:                        if (test != NIL) {
4031:                            if (test.execute(item, candidate) == T)
4032:                                return tail;
4033:                        } else if (testNot != NIL) {
4034:                            if (testNot.execute(item, candidate) == NIL)
4035:                                return tail;
4036:                        }
4037:                        tail = tail.cdr();
4038:                    }
4039:                    return NIL;
4040:                }
4041:            };
4042:
4043:            // ### funcall-key
4044:            // funcall-key function-or-nil element
4045:            private static final Primitive2 FUNCALL_KEY = new Primitive2(
4046:                    "funcall-key", PACKAGE_SYS, false) {
4047:                public LispObject execute(LispObject first, LispObject second)
4048:                        throws ConditionThrowable {
4049:                    if (first != NIL)
4050:                        return funcall1(first, second, LispThread
4051:                                .currentThread());
4052:                    return second;
4053:                }
4054:            };
4055:
4056:            // ### coerce-to-function
4057:            private static final Primitive1 COERCE_TO_FUNCTION = new Primitive1(
4058:                    "coerce-to-function", PACKAGE_SYS, false) {
4059:                public LispObject execute(LispObject arg)
4060:                        throws ConditionThrowable {
4061:                    return coerceToFunction(arg);
4062:                }
4063:            };
4064:
4065:            // ### make-closure lambda-form environment => closure
4066:            private static final Primitive2 MAKE_CLOSURE = new Primitive2(
4067:                    "make-closure", PACKAGE_SYS, false) {
4068:                public LispObject execute(LispObject first, LispObject second)
4069:                        throws ConditionThrowable {
4070:                    if (first instanceof  Cons && first.car() == Symbol.LAMBDA) {
4071:                        final Environment env;
4072:                        if (second == NIL)
4073:                            env = new Environment();
4074:                        else
4075:                            env = checkEnvironment(second);
4076:                        return new Closure(first.cadr(), first.cddr(), env);
4077:                    }
4078:                    return signal(new TypeError(
4079:                            "Argument to MAKE-CLOSURE is not a lambda form."));
4080:                }
4081:            };
4082:
4083:            // ### streamp
4084:            private static final Primitive1 STREAMP = new Primitive1("streamp",
4085:                    "object") {
4086:                public LispObject execute(LispObject arg) {
4087:                    return arg instanceof  Stream ? T : NIL;
4088:                }
4089:            };
4090:
4091:            // ### integerp
4092:            private static final Primitive1 INTEGERP = new Primitive1(
4093:                    "integerp", "object") {
4094:                public LispObject execute(LispObject arg) {
4095:                    return arg.INTEGERP();
4096:                }
4097:            };
4098:
4099:            // ### evenp
4100:            private static final Primitive1 EVENP = new Primitive1("evenp",
4101:                    "integer") {
4102:                public LispObject execute(LispObject arg)
4103:                        throws ConditionThrowable {
4104:                    return arg.EVENP();
4105:                }
4106:            };
4107:
4108:            // ### oddp
4109:            private static final Primitive1 ODDP = new Primitive1("oddp",
4110:                    "integer") {
4111:                public LispObject execute(LispObject arg)
4112:                        throws ConditionThrowable {
4113:                    return arg.ODDP();
4114:                }
4115:            };
4116:
4117:            // ### numberp
4118:            private static final Primitive1 NUMBERP = new Primitive1("numberp",
4119:                    "object") {
4120:                public LispObject execute(LispObject arg) {
4121:                    return arg.NUMBERP();
4122:                }
4123:            };
4124:
4125:            // ### realp
4126:            private static final Primitive1 REALP = new Primitive1("realp",
4127:                    "object") {
4128:                public LispObject execute(LispObject arg) {
4129:                    return arg.REALP();
4130:                }
4131:            };
4132:
4133:            // ### rationalp
4134:            private static final Primitive1 RATIONALP = new Primitive1(
4135:                    "rationalp", "object") {
4136:                public LispObject execute(LispObject arg) {
4137:                    return arg.RATIONALP();
4138:                }
4139:            };
4140:
4141:            // ### complex
4142:            private static final Primitive2 COMPLEX = new Primitive2("complex",
4143:                    "realpart &optional imagpart") {
4144:                public LispObject execute(LispObject arg)
4145:                        throws ConditionThrowable {
4146:                    if (arg instanceof  LispFloat)
4147:                        return Complex.getInstance(arg, LispFloat.ZERO);
4148:                    if (arg.realp())
4149:                        return arg;
4150:                    signal(new TypeError(arg, "real number"));
4151:                    return NIL;
4152:                }
4153:
4154:                public LispObject execute(LispObject first, LispObject second)
4155:                        throws ConditionThrowable {
4156:                    return Complex.getInstance(first, second);
4157:                }
4158:            };
4159:
4160:            // ### complexp
4161:            private static final Primitive1 COMPLEXP = new Primitive1(
4162:                    "complexp", "object") {
4163:                public LispObject execute(LispObject arg) {
4164:                    return arg.COMPLEXP();
4165:                }
4166:            };
4167:
4168:            // ### numerator
4169:            private static final Primitive1 NUMERATOR = new Primitive1(
4170:                    "numerator", "rational") {
4171:                public LispObject execute(LispObject arg)
4172:                        throws ConditionThrowable {
4173:                    return arg.NUMERATOR();
4174:                }
4175:            };
4176:
4177:            // ### denominator
4178:            private static final Primitive1 DENOMINATOR = new Primitive1(
4179:                    "denominator", "rational") {
4180:                public LispObject execute(LispObject arg)
4181:                        throws ConditionThrowable {
4182:                    return arg.DENOMINATOR();
4183:                }
4184:            };
4185:
4186:            // ### realpart
4187:            private static final Primitive1 REALPART = new Primitive1(
4188:                    "realpart", "number") {
4189:                public LispObject execute(LispObject arg)
4190:                        throws ConditionThrowable {
4191:                    if (arg instanceof  Complex)
4192:                        return ((Complex) arg).getRealPart();
4193:                    if (arg.numberp())
4194:                        return arg;
4195:                    signal(new TypeError(arg, "number"));
4196:                    return NIL;
4197:                }
4198:            };
4199:
4200:            // ### imagpart
4201:            private static final Primitive1 IMAGPART = new Primitive1(
4202:                    "imagpart", "number") {
4203:                public LispObject execute(LispObject arg)
4204:                        throws ConditionThrowable {
4205:                    if (arg instanceof  Complex)
4206:                        return ((Complex) arg).getImaginaryPart();
4207:                    return arg.multiplyBy(Fixnum.ZERO);
4208:                }
4209:            };
4210:
4211:            // ### integer-length
4212:            private static final Primitive1 INTEGER_LENGTH = new Primitive1(
4213:                    "integer-length", "integer") {
4214:                public LispObject execute(LispObject arg)
4215:                        throws ConditionThrowable {
4216:                    if (arg instanceof  Fixnum) {
4217:                        int n = ((Fixnum) arg).value;
4218:                        if (n < 0)
4219:                            n = ~n;
4220:                        int count = 0;
4221:                        while (n > 0) {
4222:                            n = n >>> 1;
4223:                            ++count;
4224:                        }
4225:                        return new Fixnum(count);
4226:                    }
4227:                    if (arg instanceof  Bignum)
4228:                        return new Fixnum(((Bignum) arg).value.bitLength());
4229:                    return signal(new TypeError(arg, "integer"));
4230:                }
4231:            };
4232:
4233:            // ### gcd-2
4234:            private static final Primitive2 GCD_2 = new Primitive2("gcd-2",
4235:                    PACKAGE_SYS, false) {
4236:                public LispObject execute(LispObject first, LispObject second)
4237:                        throws ConditionThrowable {
4238:                    BigInteger n1, n2;
4239:                    if (first instanceof  Fixnum)
4240:                        n1 = BigInteger.valueOf(((Fixnum) first).getValue());
4241:                    else if (first instanceof  Bignum)
4242:                        n1 = ((Bignum) first).getValue();
4243:                    else {
4244:                        signal(new TypeError(first, "integer"));
4245:                        return NIL;
4246:                    }
4247:                    if (second instanceof  Fixnum)
4248:                        n2 = BigInteger.valueOf(((Fixnum) second).getValue());
4249:                    else if (second instanceof  Bignum)
4250:                        n2 = ((Bignum) second).getValue();
4251:                    else {
4252:                        signal(new TypeError(second, "integer"));
4253:                        return NIL;
4254:                    }
4255:                    return number(n1.gcd(n2));
4256:                }
4257:            };
4258:
4259:            // ### identity-hash-code
4260:            private static final Primitive1 IDENTITY_HASH_CODE = new Primitive1(
4261:                    "identity-hash-code", PACKAGE_SYS, false) {
4262:                public LispObject execute(LispObject arg)
4263:                        throws ConditionThrowable {
4264:                    return new Fixnum(System.identityHashCode(arg));
4265:                }
4266:            };
4267:
4268:            // ### simple-vector-search pattern vector => position
4269:            // Searches vector for pattern.
4270:            private static final Primitive2 SIMPLE_VECTOR_SEARCH = new Primitive2(
4271:                    "simple-vector-search", PACKAGE_SYS, false) {
4272:                public LispObject execute(LispObject first, LispObject second)
4273:                        throws ConditionThrowable {
4274:                    AbstractVector v = checkVector(second);
4275:                    if (first.length() == 0)
4276:                        return Fixnum.ZERO;
4277:                    final int patternLength = first.length();
4278:                    final int limit = v.length() - patternLength;
4279:                    if (first instanceof  AbstractVector) {
4280:                        AbstractVector pattern = (AbstractVector) first;
4281:                        LispObject element = pattern.getRowMajor(0);
4282:                        for (int i = 0; i <= limit; i++) {
4283:                            if (v.getRowMajor(i).eql(element)) {
4284:                                // Found match for first element of pattern.
4285:                                boolean match = true;
4286:                                // We've already checked the first element.
4287:                                int j = i + 1;
4288:                                for (int k = 1; k < patternLength; k++) {
4289:                                    if (v.getRowMajor(j).eql(
4290:                                            pattern.getRowMajor(k))) {
4291:                                        ++j;
4292:                                    } else {
4293:                                        match = false;
4294:                                        break;
4295:                                    }
4296:                                }
4297:                                if (match)
4298:                                    return new Fixnum(i);
4299:                            }
4300:                        }
4301:                    } else {
4302:                        // Pattern is a list.
4303:                        LispObject element = first.car();
4304:                        for (int i = 0; i <= limit; i++) {
4305:                            if (v.getRowMajor(i).eql(element)) {
4306:                                // Found match for first element of pattern.
4307:                                boolean match = true;
4308:                                // We've already checked the first element.
4309:                                int j = i + 1;
4310:                                for (LispObject rest = first.cdr(); rest != NIL; rest = rest
4311:                                        .cdr()) {
4312:                                    if (v.getRowMajor(j).eql(rest.car())) {
4313:                                        ++j;
4314:                                    } else {
4315:                                        match = false;
4316:                                        break;
4317:                                    }
4318:                                }
4319:                                if (match)
4320:                                    return new Fixnum(i);
4321:                            }
4322:                        }
4323:                    }
4324:                    return NIL;
4325:                }
4326:            };
4327:
4328:            // ### uptime
4329:            private static final Primitive0 UPTIME = new Primitive0("uptime",
4330:                    PACKAGE_EXT, true) {
4331:                public LispObject execute() throws ConditionThrowable {
4332:                    return number(System.currentTimeMillis()
4333:                            - Main.startTimeMillis);
4334:                }
4335:            };
4336:
4337:            // ### built-in-function-p
4338:            private static final Primitive1 BUILT_IN_FUNCTION_P = new Primitive1(
4339:                    "built-in-function-p", PACKAGE_SYS, false) {
4340:                public LispObject execute(LispObject arg)
4341:                        throws ConditionThrowable {
4342:                    try {
4343:                        return ((Symbol) arg).isBuiltInFunction() ? T : NIL;
4344:                    } catch (ClassCastException e) {
4345:                        return signal(new TypeError(arg, Symbol.SYMBOL));
4346:                    }
4347:                }
4348:            };
4349:
4350:            // ### inspected-parts
4351:            private static final Primitive1 INSPECTED_PARTS = new Primitive1(
4352:                    "inspected-parts", PACKAGE_SYS, false) {
4353:                public LispObject execute(LispObject arg)
4354:                        throws ConditionThrowable {
4355:                    return arg.getParts();
4356:                }
4357:            };
4358:
4359:            // ### inspected-description
4360:            private static final Primitive1 INSPECTED_DESCRIPTION = new Primitive1(
4361:                    "inspected-description", PACKAGE_SYS, false) {
4362:                public LispObject execute(LispObject arg)
4363:                        throws ConditionThrowable {
4364:                    return arg.getDescription();
4365:                }
4366:            };
4367:
4368:            static {
4369:                new Primitives();
4370:            }
4371:        }
www.java2java.com | Contact Us
Copyright 2010 - 2030 Java Source and Support. All rights reserved.
All other trademarks are property of their respective owners.