|
1
4 package gnu.commonlisp.lang;
5 import gnu.expr.*;
6 import gnu.lists.*;
7 import gnu.mapping.*;
8 import gnu.bytecode.CodeAttr;
9 import gnu.bytecode.ClassType;
10 import gnu.kawa.lispexpr.LispLanguage;
11 import gnu.kawa.lispexpr.ReadTable;
12 import gnu.kawa.reflect.FieldLocation;
13
14
15
16 public abstract class Lisp2 extends LispLanguage
17 {
18 public static final LList FALSE = LList.Empty;
19 public static final Symbol TRUE = Namespace.getDefault().getSymbol("t");
21 public static final Expression nilExpr = new QuoteExp(FALSE);
22
23 public boolean isTrue(Object  value)
24 {
25 return value != FALSE;
26 }
27
28 public Object booleanObject(boolean b)
29 {
30 if (b) return TRUE; else return FALSE;
31 }
32
33 public void emitPushBoolean(boolean value, CodeAttr code)
34 {
35 if (value)
36 code.emitGetStatic(ClassType.make("gnu.commonlisp.lang.Lisp2").getDeclaredField("TRUE"));
37 else
38 code.emitGetStatic(Compilation.scmListType.getDeclaredField("Empty"));
39 }
40
41 public Object noValue()
42 {
43 return FALSE;
44 }
45
46 public boolean hasSeparateFunctionNamespace()
47 {
48 return true;
49 }
50
51 public boolean selfEvaluatingSymbol (Object obj)
52 {
53 return obj instanceof Keyword || obj == TRUE || obj == FALSE;
54 }
55
56 public Object getEnvPropertyFor (java.lang.reflect.Field fld, Object value)
57 {
58 if (Compilation.typeProcedure.getReflectClass()
59 .isAssignableFrom(fld.getType())
60 || value instanceof kawa.lang.Syntax)
61 return EnvironmentKey.FUNCTION;
62 return null;
63 }
64
65 public int getNamespaceOf(Declaration decl)
66 {
67 if (decl.isAlias())
71 return FUNCTION_NAMESPACE+VALUE_NAMESPACE;
72 return decl.isProcedureDecl() ? FUNCTION_NAMESPACE : VALUE_NAMESPACE;
73 }
74
75
76 public static Object asSymbol (String name)
77 {
78 if (name == "nil")
79 return FALSE;
80 return Environment.getCurrent().getSymbol(name);
81 }
83
84 protected Symbol fromLangSymbol (Object obj)
85 {
86 if (obj == LList.Empty)
87 return environ.getSymbol("nil");
88 return super.fromLangSymbol(obj);
89 }
90
91
92 public static Object getString (String name)
93 {
94 return new FString(name);
95 }
96
97
98 public static Object getString (Symbol symbol)
99 {
100 return getString(symbol.getName());
101 }
102
103 protected void defun(String name, Object value)
104 {
105 environ.define(getSymbol(name), EnvironmentKey.FUNCTION, value);
106 if (value instanceof Named)
107 {
108 Named n = (Named) value;
109 if (n.getName() == null)
110 n.setName(name);
111 }
112 }
113
114 protected void defun(Symbol sym, Object value)
115 {
116 environ.define(sym, EnvironmentKey.FUNCTION, value);
117 if (value instanceof Procedure)
118 {
119 Procedure n = (Procedure) value;
120 if (n.getSymbol() == null)
121 n.setSymbol(sym);
122 }
123 }
124
125 private void defun(Procedure proc)
126 {
127 defun(proc.getName(), proc);
128 }
129
130 protected void importLocation (Location loc)
131 {
132 Symbol name = ((NamedLocation) loc).getKeySymbol();
133 if (environ.isBound(name, EnvironmentKey.FUNCTION))
134 return;
135 Object val;
136 loc = loc.getBase();
137 if (loc instanceof FieldLocation
143 && ((FieldLocation) loc).isProcedureOrSyntax())
144 {
145 environ.addLocation(name, EnvironmentKey.FUNCTION, loc);
146 }
147 else if ((val = loc.get(null)) != null)
148 {
149 if (val instanceof Procedure || val instanceof kawa.lang.Syntax)
150 defun(name, val);
151 else
152 define(name.getName(), val);
153 }
154 }
155
156 public ReadTable createReadTable ()
157 {
158 ReadTable tab = new Lisp2ReadTable();
159 tab.initialize();
160 return tab;
161 }
162 }
163
164 class Lisp2ReadTable extends ReadTable
165 {
166 protected Object makeSymbol (String name)
167 {
168 return Lisp2.asSymbol(name.intern());
169 }
170 }
171 |
Popular Tags |
Java API By Example, From Geeks To Geeks.