1 /* 2 * SimpleTypeError.java 3 * 4 * Copyright (C) 2002-2005 Peter Graves 5 * $Id$ 6 * 7 * This program is free software; you can redistribute it and/or 8 * modify it under the terms of the GNU General Public License 9 * as published by the Free Software Foundation; either version 2 10 * of the License, or (at your option) any later version. 11 * 12 * This program is distributed in the hope that it will be useful, 13 * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 * GNU General Public License for more details. 16 * 17 * You should have received a copy of the GNU General Public License 18 * along with this program; if not, write to the Free Software 19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 * 21 * As a special exception, the copyright holders of this library give you 22 * permission to link this library with independent modules to produce an 23 * executable, regardless of the license terms of these independent 24 * modules, and to copy and distribute the resulting executable under 25 * terms of your choice, provided that you also meet, for each linked 26 * independent module, the terms and conditions of the license of that 27 * module. An independent module is a module which is not derived from 28 * or based on this library. If you modify this library, you may extend 29 * this exception to your version of the library, but you are not 30 * obligated to do so. If you do not wish to do so, delete this 31 * exception statement from your version. 32 */ 33 34 package org.armedbear.lisp; 35 36 import static org.armedbear.lisp.Lisp.*; 37 38 public final class SimpleTypeError extends TypeError 39 { SimpleTypeError(LispObject initArgs)40 public SimpleTypeError(LispObject initArgs) 41 { 42 super(StandardClass.SIMPLE_TYPE_ERROR); 43 initialize(initArgs); 44 } 45 46 @Override typeOf()47 public LispObject typeOf() 48 { 49 return Symbol.SIMPLE_TYPE_ERROR; 50 } 51 52 @Override classOf()53 public LispObject classOf() 54 { 55 return StandardClass.SIMPLE_TYPE_ERROR; 56 } 57 58 @Override typep(LispObject type)59 public LispObject typep(LispObject type) 60 { 61 if (type == Symbol.SIMPLE_TYPE_ERROR) 62 return T; 63 if (type == StandardClass.SIMPLE_TYPE_ERROR) 64 return T; 65 if (type == Symbol.SIMPLE_CONDITION) 66 return T; 67 if (type == StandardClass.SIMPLE_CONDITION) 68 return T; 69 return super.typep(type); 70 } 71 72 @Override getMessage()73 public String getMessage() 74 { 75 LispObject formatControl = getFormatControl(); 76 if (formatControl != NIL) { 77 LispObject formatArguments = getFormatArguments(); 78 // (apply 'format (append '(nil format-control) format-arguments)) 79 LispObject result = 80 Primitives.APPLY.execute(Symbol.FORMAT, 81 Primitives.APPEND.execute(list(NIL, 82 formatControl), 83 formatArguments)); 84 return result.getStringValue(); 85 } 86 return super.getMessage(); 87 } 88 } 89