001: // Copyright (c) 2001, 2004 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.expr.*;
007: import gnu.lists.*;
008: import gnu.mapping.*;
009: import gnu.bytecode.CodeAttr;
010: import gnu.bytecode.ClassType;
011: import gnu.kawa.lispexpr.LispLanguage;
012: import gnu.kawa.lispexpr.ReadTable;
013: import gnu.kawa.reflect.FieldLocation;
014:
015: /** Abstract class for Lisp-like languages with separate namespaces. */
016:
017: public abstract class Lisp2 extends LispLanguage {
018: public static final LList FALSE = LList.Empty;
019: // FIXME - which namespace?
020: public static final Symbol TRUE = Namespace.getDefault().getSymbol(
021: "t");
022: public static final Expression nilExpr = new QuoteExp(FALSE);
023:
024: public boolean isTrue(Object value) {
025: return value != FALSE;
026: }
027:
028: public Object booleanObject(boolean b) {
029: if (b)
030: return TRUE;
031: else
032: return FALSE;
033: }
034:
035: public void emitPushBoolean(boolean value, CodeAttr code) {
036: if (value)
037: code.emitGetStatic(ClassType.make(
038: "gnu.commonlisp.lang.Lisp2").getDeclaredField(
039: "TRUE"));
040: else
041: code.emitGetStatic(Compilation.scmListType
042: .getDeclaredField("Empty"));
043: }
044:
045: public Object noValue() {
046: return FALSE;
047: }
048:
049: public boolean hasSeparateFunctionNamespace() {
050: return true;
051: }
052:
053: public boolean selfEvaluatingSymbol(Object obj) {
054: return obj instanceof Keyword || obj == TRUE || obj == FALSE;
055: }
056:
057: public Object getEnvPropertyFor(java.lang.reflect.Field fld,
058: Object value) {
059: if (Compilation.typeProcedure.getReflectClass()
060: .isAssignableFrom(fld.getType())
061: || value instanceof kawa.lang.Syntax)
062: return EnvironmentKey.FUNCTION;
063: return null;
064: }
065:
066: public int getNamespaceOf(Declaration decl) {
067: // This is a kludge because the hygiene renameing in SyntaxRules
068: // (which is used for some macros that Lisp uses) doesn't distinguish
069: // function and variable position.
070: if (decl.isAlias())
071: return FUNCTION_NAMESPACE + VALUE_NAMESPACE;
072: return decl.isProcedureDecl() ? FUNCTION_NAMESPACE
073: : VALUE_NAMESPACE;
074: }
075:
076: /** Get a symbol for a given (interned) Java string. */
077: public static Object asSymbol(String name) {
078: if (name == "nil")
079: return FALSE;
080: return Environment.getCurrent().getSymbol(name);
081: //return name;
082: }
083:
084: protected Symbol fromLangSymbol(Object obj) {
085: if (obj == LList.Empty)
086: return environ.getSymbol("nil");
087: return super .fromLangSymbol(obj);
088: }
089:
090: /** Get a string for a given Java string. */
091: public static Object getString(String name) {
092: return new FString(name);
093: }
094:
095: /** Get a string for a given symbol. */
096: public static Object getString(Symbol symbol) {
097: return getString(symbol.getName());
098: }
099:
100: protected void defun(String name, Object value) {
101: environ.define(getSymbol(name), EnvironmentKey.FUNCTION, value);
102: if (value instanceof Named) {
103: Named n = (Named) value;
104: if (n.getName() == null)
105: n.setName(name);
106: }
107: }
108:
109: protected void defun(Symbol sym, Object value) {
110: environ.define(sym, EnvironmentKey.FUNCTION, value);
111: if (value instanceof Procedure) {
112: Procedure n = (Procedure) value;
113: if (n.getSymbol() == null)
114: n.setSymbol(sym);
115: }
116: }
117:
118: private void defun(Procedure proc) {
119: defun(proc.getName(), proc);
120: }
121:
122: protected void importLocation(Location loc) {
123: Symbol name = ((NamedLocation) loc).getKeySymbol();
124: if (environ.isBound(name, EnvironmentKey.FUNCTION))
125: return;
126: Object val;
127: loc = loc.getBase();
128: // Disable the following, for now, if using GCJ. It hangs when using GCJ.
129: // The problem appears to be with a _Jv_Field for a static field
130: // that is in a BSS segment; the address in the _Jv_Field doesn't
131: // get initialized. FIXME.
132: // (We do need to use this for JEmacs. Sigh.)
133: if (loc instanceof FieldLocation
134: && ((FieldLocation) loc).isProcedureOrSyntax()) {
135: environ.addLocation(name, EnvironmentKey.FUNCTION, loc);
136: } else if ((val = loc.get(null)) != null) {
137: if (val instanceof Procedure
138: || val instanceof kawa.lang.Syntax)
139: defun(name, val);
140: else
141: define(name.getName(), val);
142: }
143: }
144:
145: public ReadTable createReadTable() {
146: ReadTable tab = new Lisp2ReadTable();
147: tab.initialize();
148: return tab;
149: }
150: }
151:
152: class Lisp2ReadTable extends ReadTable {
153: protected Object makeSymbol(String name) {
154: return Lisp2.asSymbol(name.intern());
155: }
156: }
|