|
1
4 package gnu.commonlisp.lang;
5 import gnu.mapping.*;
6 import gnu.lists.*;
7 import gnu.expr.*;
8 import gnu.text.Char;
9 import kawa.standard.Scheme;
10 import gnu.bytecode.Type;
11 import gnu.kawa.lispexpr.LangPrimType;
12 import gnu.kawa.functions.DisplayFormat;
13 import gnu.kawa.functions.NumberCompare;
14 import gnu.kawa.lispexpr.ReadTable;
15
16 public class CommonLisp extends Lisp2
17 {
18 static boolean charIsInt = false;
19
20
21 public static Object  getCharacter(int c)
22 {
23 if (charIsInt)
24 return gnu.math.IntNum.make(c);
25 else
26 return Char.make((char)c);
27 }
28
29 public static gnu.math.Numeric asNumber(Object arg)
30 {
31 if (arg instanceof Char)
32 return gnu.math.IntNum.make(((Char) arg).intValue());
33 return (gnu.math.Numeric) arg;
34 }
35
36 public static char asChar(Object x)
37 {
38 if (x instanceof Char)
39 return ((Char) x).charValue();
40 int i;
41 if (x instanceof gnu.math.Numeric)
42 i = ((gnu.math.Numeric) x).intValue();
43 else
44 i = -1;
45 if (i < 0 || i > 0xffff)
46 throw new ClassCastException ("not a character value");
47 return (char) i;
48 }
49
50 public String getName()
51 {
52 return "CommonLisp";
53 }
54
55 public static final CommonLisp instance;
58
59 public static final Environment clispEnvironment
60 = Environment.make("clisp-environment");
61
62 public static final NumberCompare numEqu;
63 public static final NumberCompare numGrt;
64 public static final NumberCompare numGEq;
65 public static final NumberCompare numLss;
66 public static final NumberCompare numLEq;
67
68 static
69 {
70 instance = new CommonLisp();
71
72 instance.define("t", TRUE);
73 instance.define("nil", FALSE);
74 numEqu = NumberCompare.make(instance, "=",
75 NumberCompare.TRUE_IF_EQU);
76 numGrt = NumberCompare.make(instance, ">",
77 NumberCompare.TRUE_IF_GRT);
78 numGEq = NumberCompare.make(instance, ">=",
79 NumberCompare.TRUE_IF_GRT|NumberCompare.TRUE_IF_EQU);
80 numLss = NumberCompare.make(instance, "<",
81 NumberCompare.TRUE_IF_LSS);
82 numLEq = NumberCompare.make(instance, "<=",
83 NumberCompare.TRUE_IF_LSS|NumberCompare.TRUE_IF_EQU);
84 CallContext ctx = CallContext.getInstance();
85 Environment saveEnv = ctx.getEnvironmentRaw();
86 try
87 {
88 ctx.setEnvironmentRaw(clispEnvironment);
89 instance.initLisp();
90 }
91 finally
92 {
93 ctx.setEnvironmentRaw(saveEnv);
94 }
95 }
96
97 public CommonLisp()
98 {
99 environ = clispEnvironment;
100 }
101
102 void initLisp()
103 {
104 LocationEnumeration e = Scheme.builtin().enumerateAllLocations();
105 while (e.hasMoreElements())
106 {
107 importLocation(e.nextLocation());
108 }
109
110 try
111 {
112 loadClass("kawa.lib.prim_syntax");
114 loadClass("kawa.lib.std_syntax");
115 loadClass("kawa.lib.lists");
116 loadClass("kawa.lib.strings");
117 loadClass("gnu.commonlisp.lisp.PrimOps");
118 }
119 catch (java.lang.ClassNotFoundException ex)
120 {
121 }
123
124 kawa.lang.Lambda lambda = new kawa.lang.Lambda();
125 lambda.setKeywords(asSymbol("&optional"),
126 asSymbol("&rest"),
127 asSymbol("&key"));
128 lambda.defaultDefault = nilExpr;
129 defun("lambda", lambda);
130 defun("defun", new defun(lambda));
131
132 defun("defvar", new defvar(false));
133 defun("defconst", new defvar(true));
134 defun("defsubst", new defun(lambda));
135 defun("function", new function(lambda));
136 defun("setq", new setq());
137 defun("prog1", new prog1("prog1", 1));
138 defun("prog2", prog1.prog2);
139 defun("progn", new kawa.standard.begin());
140 defun("unwind-protect", new gnu.commonlisp.lang.UnwindProtect());
141 Procedure not = new kawa.standard.not(this);
142 defun("not", not);
143 defun("null", not);
144 defun("eq", new gnu.kawa.functions.IsEq(this, "eq"));
145 defun("equal", new gnu.kawa.functions.IsEqual(this, "equal"));
146 defun("typep", new gnu.kawa.reflect.InstanceOf(this));
147 defun("princ", displayFormat);
148 defun("prin1", writeFormat);
149
150 defProcStFld("=", "gnu.commonlisp.lang.CommonLisp", "numEqu");
151 defProcStFld("<", "gnu.commonlisp.lang.CommonLisp", "numLss");
152 defProcStFld(">", "gnu.commonlisp.lang.CommonLisp", "numGrt");
153 defProcStFld("<=", "gnu.commonlisp.lang.CommonLisp", "numLEq");
154 defProcStFld(">=", "gnu.commonlisp.lang.CommonLisp", "numGEq");
155
156 defProcStFld("functionp", "gnu.commonlisp.lisp.PrimOps");
157 }
158
159 public static CommonLisp getInstance()
160 {
161 return instance;
162 }
163
164
165 public static void registerEnvironment()
166 {
167 Language.setDefaults(instance);
168 }
169
170 static final AbstractFormat writeFormat = new DisplayFormat(true, 'C');
171 static final AbstractFormat displayFormat = new DisplayFormat(false, 'C');
172
173 public AbstractFormat getFormat(boolean readable)
174 {
175 return readable ? writeFormat : displayFormat;
176 }
177
178 LangPrimType booleanType;
179
180 public Type getTypeFor(String name)
181 {
182 if (name == "t")
183 name = "java.lang.Object";
184 return Scheme.string2Type(name);
185 }
186
187 public Type getTypeFor (Class clas)
188 {
189 if (clas.isPrimitive())
190 {
191 String name = clas.getName();
192 if (name.equals("boolean"))
193 {
194 if (booleanType == null)
195 booleanType = new LangPrimType(Type.boolean_type, this);
196 return booleanType;
197 }
198 return Scheme.getNamedType(name);
199 }
200 return Type.make(clas);
201 }
202 }
203 |
Popular Tags |
Java API By Example, From Geeks To Geeks.