001: /*
002: * coerce.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: coerce.java,v 1.6 2003/11/15 11:03:30 beedlem Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class coerce extends Lisp {
025: // ### coerce
026: // coerce object result-type => result
027: private static final Primitive2 COERCE = new Primitive2("coerce") {
028: public LispObject execute(LispObject first, LispObject second)
029: throws ConditionThrowable {
030: if (second == T)
031: return first;
032: if (first.typep(second) == T)
033: return first;
034: if (second == Symbol.CHARACTER) {
035: if (first instanceof LispString) {
036: if (first.length() == 1)
037: return ((LispString) first).get(0);
038: } else if (first instanceof Symbol) {
039: String name = first.getName();
040: if (name.length() == 1)
041: return LispCharacter
042: .getInstance(name.charAt(0));
043: }
044: throw new ConditionThrowable(new TypeError());
045: }
046: if (second == Symbol.FLOAT || second == Symbol.SINGLE_FLOAT
047: || second == Symbol.DOUBLE_FLOAT
048: || second == Symbol.SHORT_FLOAT
049: || second == Symbol.LONG_FLOAT) {
050: return LispFloat.coerceToFloat(first);
051: }
052: if (second == Symbol.COMPLEX) {
053: if (first.numberp()) {
054: if (first instanceof LispFloat)
055: return Complex.getInstance(first,
056: LispFloat.ZERO);
057: return first;
058: }
059: throw new ConditionThrowable(new TypeError(first,
060: "number"));
061: }
062: if (first instanceof AbstractVector) {
063: if (second == Symbol.BIT_VECTOR
064: || second == Symbol.SIMPLE_BIT_VECTOR) {
065: AbstractVector v1 = (AbstractVector) first;
066: BitVector v2 = new BitVector(v1.length());
067: for (int i = v1.length(); i-- > 0;)
068: v2.set(i, v1.get(i));
069: return v2;
070: }
071: if (second == Symbol.SIMPLE_VECTOR) {
072: AbstractVector v1 = (AbstractVector) first;
073: Vector v2 = new Vector(v1.length());
074: for (int i = v1.length(); i-- > 0;)
075: v2.set(i, v1.get(i));
076: return v2;
077: }
078: if (second == Symbol.LIST) {
079: AbstractVector v = (AbstractVector) first;
080: LispObject result = NIL;
081: for (int i = first.length(); i-- > 0;)
082: result = new Cons(v.get(i), result);
083: return result;
084: }
085: } else if (first.listp()) {
086: if (second == Symbol.BIT_VECTOR
087: || second == Symbol.SIMPLE_BIT_VECTOR) {
088: BitVector v = new BitVector(first.length());
089: int i = 0;
090: while (first != NIL) {
091: v.set(i++, first.car());
092: first = first.cdr();
093: }
094: return v;
095: }
096: if (second == Symbol.VECTOR
097: || second == Symbol.SIMPLE_VECTOR
098: || (second instanceof LispClass && second
099: .getName().equals("VECTOR"))) {
100: Vector v = new Vector(first.length());
101: int i = 0;
102: while (first != NIL) {
103: v.set(i++, first.car());
104: first = first.cdr();
105: }
106: return v;
107: }
108: if (second == Symbol.STRING
109: || second == Symbol.SIMPLE_STRING
110: || second == Symbol.BASE_STRING
111: || second == Symbol.SIMPLE_BASE_STRING) {
112: LispString string = new LispString(first.length());
113: int i = 0;
114: while (first != NIL) {
115: string.set(i++, first.car());
116: first = first.cdr();
117: }
118: return string;
119: }
120: if (second == Symbol.FUNCTION) {
121: if (first.car() == Symbol.LAMBDA)
122: return new Closure(first.cadr(), first.cddr(),
123: new Environment());
124: }
125: } else if (first instanceof Symbol) {
126: if (second == Symbol.FUNCTION) {
127: LispObject obj = first.getSymbolFunction();
128: if (obj instanceof Function) {
129: if (obj instanceof SpecialOperator)
130: throw new ConditionThrowable(
131: new TypeError());
132: return obj;
133: }
134: }
135: }
136: throw new ConditionThrowable(new TypeError());
137: }
138: };
139: }
|