001: // Copyright (c) 2001, 2004, 2005 Per M.A. Bothner.
002: // This is free software; for terms and warranty disclaimer see ./COPYING.
003:
004: package gnu.commonlisp.lang;
005:
006: import gnu.mapping.*;
007: import gnu.lists.*;
008: import gnu.expr.*;
009: import gnu.text.Char;
010: import kawa.standard.Scheme;
011: import gnu.bytecode.Type;
012: import gnu.kawa.lispexpr.LangPrimType;
013: import gnu.kawa.functions.DisplayFormat;
014: import gnu.kawa.functions.NumberCompare;
015: import gnu.kawa.lispexpr.ReadTable;
016:
017: public class CommonLisp extends Lisp2 {
018: static boolean charIsInt = false;
019:
020: /** Get a CommonLisp character object. */
021: public static Object getCharacter(int c) {
022: if (charIsInt)
023: return gnu.math.IntNum.make(c);
024: else
025: return Char.make((char) c);
026: }
027:
028: public static gnu.math.Numeric asNumber(Object arg) {
029: if (arg instanceof Char)
030: return gnu.math.IntNum.make(((Char) arg).intValue());
031: return (gnu.math.Numeric) arg;
032: }
033:
034: public static char asChar(Object x) {
035: if (x instanceof Char)
036: return ((Char) x).charValue();
037: int i;
038: if (x instanceof gnu.math.Numeric)
039: i = ((gnu.math.Numeric) x).intValue();
040: else
041: i = -1;
042: if (i < 0 || i > 0xffff)
043: throw new ClassCastException("not a character value");
044: return (char) i;
045: }
046:
047: public String getName() {
048: return "CommonLisp";
049: }
050:
051: // This field need to be public so that the findLiteral method in
052: // gnu.expr.LitTable can find it.
053: public static final CommonLisp instance;
054:
055: public static final Environment clispEnvironment = Environment
056: .make("clisp-environment");
057:
058: public static final NumberCompare numEqu;
059: public static final NumberCompare numGrt;
060: public static final NumberCompare numGEq;
061: public static final NumberCompare numLss;
062: public static final NumberCompare numLEq;
063:
064: static {
065: instance = new CommonLisp();
066:
067: instance.define("t", TRUE);
068: instance.define("nil", FALSE);
069: numEqu = NumberCompare.make(instance, "=",
070: NumberCompare.TRUE_IF_EQU);
071: numGrt = NumberCompare.make(instance, ">",
072: NumberCompare.TRUE_IF_GRT);
073: numGEq = NumberCompare.make(instance, ">=",
074: NumberCompare.TRUE_IF_GRT | NumberCompare.TRUE_IF_EQU);
075: numLss = NumberCompare.make(instance, "<",
076: NumberCompare.TRUE_IF_LSS);
077: numLEq = NumberCompare.make(instance, "<=",
078: NumberCompare.TRUE_IF_LSS | NumberCompare.TRUE_IF_EQU);
079: CallContext ctx = CallContext.getInstance();
080: Environment saveEnv = ctx.getEnvironmentRaw();
081: try {
082: ctx.setEnvironmentRaw(clispEnvironment);
083: instance.initLisp();
084: } finally {
085: ctx.setEnvironmentRaw(saveEnv);
086: }
087: }
088:
089: public CommonLisp() {
090: environ = clispEnvironment;
091: }
092:
093: void initLisp() {
094: LocationEnumeration e = Scheme.builtin()
095: .enumerateAllLocations();
096: while (e.hasMoreElements()) {
097: importLocation(e.nextLocation());
098: }
099:
100: try {
101: // Force it to be loaded now, so we can over-ride let* length etc.
102: loadClass("kawa.lib.prim_syntax");
103: loadClass("kawa.lib.std_syntax");
104: loadClass("kawa.lib.lists");
105: loadClass("kawa.lib.strings");
106: loadClass("gnu.commonlisp.lisp.PrimOps");
107: } catch (java.lang.ClassNotFoundException ex) {
108: // Ignore - happens while building this directory.
109: }
110:
111: kawa.lang.Lambda lambda = new kawa.lang.Lambda();
112: lambda.setKeywords(asSymbol("&optional"), asSymbol("&rest"),
113: asSymbol("&key"));
114: lambda.defaultDefault = nilExpr;
115: defun("lambda", lambda);
116: defun("defun", new defun(lambda));
117:
118: defun("defvar", new defvar(false));
119: defun("defconst", new defvar(true));
120: defun("defsubst", new defun(lambda));
121: defun("function", new function(lambda));
122: defun("setq", new setq());
123: defun("prog1", new prog1("prog1", 1));
124: defun("prog2", prog1.prog2);
125: defun("progn", new kawa.standard.begin());
126: defun("unwind-protect", new gnu.commonlisp.lang.UnwindProtect());
127: Procedure not = new kawa.standard.not(this );
128: defun("not", not);
129: defun("null", not);
130: defun("eq", new gnu.kawa.functions.IsEq(this , "eq"));
131: defun("equal", new gnu.kawa.functions.IsEqual(this , "equal"));
132: defun("typep", new gnu.kawa.reflect.InstanceOf(this ));
133: defun("princ", displayFormat);
134: defun("prin1", writeFormat);
135:
136: defProcStFld("=", "gnu.commonlisp.lang.CommonLisp", "numEqu");
137: defProcStFld("<", "gnu.commonlisp.lang.CommonLisp", "numLss");
138: defProcStFld(">", "gnu.commonlisp.lang.CommonLisp", "numGrt");
139: defProcStFld("<=", "gnu.commonlisp.lang.CommonLisp", "numLEq");
140: defProcStFld(">=", "gnu.commonlisp.lang.CommonLisp", "numGEq");
141:
142: defProcStFld("functionp", "gnu.commonlisp.lisp.PrimOps");
143: }
144:
145: public static CommonLisp getInstance() {
146: return instance;
147: }
148:
149: /** The compiler insert calls to this method for applications and applets. */
150: public static void registerEnvironment() {
151: Language.setDefaults(instance);
152: }
153:
154: static final AbstractFormat writeFormat = new DisplayFormat(true,
155: 'C');
156: static final AbstractFormat displayFormat = new DisplayFormat(
157: false, 'C');
158:
159: public AbstractFormat getFormat(boolean readable) {
160: return readable ? writeFormat : displayFormat;
161: }
162:
163: LangPrimType booleanType;
164:
165: public Type getTypeFor(String name) {
166: if (name == "t")
167: name = "java.lang.Object";
168: return Scheme.string2Type(name);
169: }
170:
171: public Type getTypeFor(Class clas) {
172: if (clas.isPrimitive()) {
173: String name = clas.getName();
174: if (name.equals("boolean")) {
175: if (booleanType == null)
176: booleanType = new LangPrimType(Type.boolean_type,
177: this);
178: return booleanType;
179: }
180: return Scheme.getNamedType(name);
181: }
182: return Type.make(clas);
183: }
184: }
|