This is the mail archive of the
kawa@sourceware.org
mailing list for the Kawa project.
Re: GSOC | Extending Common Lisp support
On 31/05/12 19:39, Helmut Eller wrote:
I think scm-classes.stamp needs to be replaced with
clisp-classes.stamp in Makefile.am Is your code available in some
repository/branch to look at? The new code uses DECLARE and that
doesn't work with the normal repository that I have. Helmut
Thanks Helmut, the clisp-classes.stamp needed to be put in there. It
works now, though my svn diff got polluted with a bunch of Makefile.in
changes after an automake, so I reverted the change as my diff file is
already cumbersome.
I don't have anywhere to upload my changes, and I can't remember exactly
which files I changed for the DECLARE feature, I believe it was only
Lisp2Compilation and Translator (Lisp2Compilation is where the actual
implementation of the DECALRE processing is), but I've attached all my
local changes to make sure. Sorry about the lack of organisation, and
for the trailing whitespace in the patch, I'll have to run a script over
it at some point as it's all over my Java code.
Thanks again!
Charlie.
Index: kawa/standard/SchemeCompilation.java
===================================================================
--- kawa/standard/SchemeCompilation.java (revision 7243)
+++ kawa/standard/SchemeCompilation.java (working copy)
@@ -66,18 +66,12 @@
* {@code <java.lang.Integer>} and {@code java.lang.Integer}.
* Also handles arrays, such as {@code java.lang.String[]}.
*/
+ @Override
public Expression checkDefaultBinding (Symbol symbol, Translator tr)
{
Namespace namespace = symbol.getNamespace();
String local = symbol.getLocalPart();
- if (namespace instanceof XmlNamespace)
- return makeQuoteExp(((XmlNamespace) namespace).get(local));
- if (namespace.getName() == Scheme.unitNamespace.getName())
- {
- Object val = Unit.lookup(local);
- if (val != null)
- return makeQuoteExp(val);
- }
+
String name = symbol.toString();
int len = name.length();
if (len == 0)
@@ -111,241 +105,8 @@
}
}
}
- char ch0 = name.charAt(0);
-
- if (ch0 == '@')
- {
- String rest = name.substring(1);
- Expression classRef = tr.rewrite(Symbol.valueOf(rest));
- return MakeAnnotation.makeAnnotationMaker(classRef);
- }
-
- // Look for quantities.
- if (ch0 == '-' || ch0 == '+' || Character.digit(ch0, 10) >= 0)
- {
- // 1: initial + or -1 seen.
- // 2: digits seen
- // 3: '.' seen
- // 4: fraction seen
- // 5: [eE][=+]?[0-9]+ seen
- int state = 0;
- int i = 0;
- for (; i < len; i++)
- {
- char ch = name.charAt(i);
- if (Character.digit(ch, 10) >= 0)
- state = state < 3 ? 2 : state < 5 ? 4 : 5;
- else if ((ch == '+' || ch == '-') && state == 0)
- state = 1;
- else if (ch == '.' && state < 3)
- state = 3;
- else if ((ch == 'e' || ch == 'E') && (state == 2 || state == 4)
- && i + 1 < len)
- {
- int j = i+1;
- char next = name.charAt(j);
- if ((next == '-' || next == '+') && ++j < len)
- next = name.charAt(j);
- if (Character.digit(next, 10) < 0)
- break;
- state = 5;
- i = j+1;
- }
- else
- break;
- }
- tryQuantity:
- if (i < len && state > 1)
- {
- DFloNum num = new DFloNum(name.substring(0,i));
- boolean div = false;
- Vector vec = new Vector();
- for (; i < len ;)
- {
- char ch = name.charAt(i++);
- if (ch == '*')
- {
- if (i == len) break tryQuantity;
- ch = name.charAt(i++);
- }
- else if (ch == '/')
- {
- if (i == len || div) break tryQuantity;
- div = true;
- ch = name.charAt(i++);
- }
- int unitStart = i-1;
- int unitEnd;
- for (;;)
- {
- if (! Character.isLetter(ch))
- {
- unitEnd = i - 1;
- if (unitEnd == unitStart)
- break tryQuantity;
- break;
- }
- if (i == len)
- {
- unitEnd = i;
- ch = '1';
- break;
- }
- ch = name.charAt(i++);
- }
- vec.addElement(name.substring(unitStart, unitEnd));
- boolean expRequired = false;
- if (ch == '^')
- {
- expRequired = true;
- if (i == len) break tryQuantity;
- ch = name.charAt(i++);
- }
- boolean neg = div;
- if (ch == '+')
- {
- expRequired = true;
- if (i == len) break tryQuantity;
- ch = name.charAt(i++);
- }
- else if (ch == '-')
- {
- expRequired = true;
- if (i == len) break tryQuantity;
- ch = name.charAt(i++);
- neg = ! neg;
- }
- int nexp = 0;
- int exp = 0;
- for (;;)
- {
- int dig = Character.digit(ch, 10);
- if (dig <= 0)
- {
- i--;
- break;
- }
- exp = 10 * exp + dig;
- nexp++;
- if (i == len)
- break;
- ch = name.charAt(i++);
- }
- if (nexp == 0)
- {
- exp = 1;
- if (expRequired)
- break tryQuantity;
- }
- if (neg)
- exp = - exp;
- vec.addElement(IntNum.make(exp));
- }
- if (i == len)
- {
- int nunits = vec.size() >> 1;
- Expression[] units = new Expression[nunits];
- for (i = 0; i < nunits; i++)
- {
- String uname = (String) vec.elementAt(2*i);
- Symbol usym = Scheme.unitNamespace.getSymbol(uname.intern());
- Expression uref = tr.rewrite(usym);
- IntNum uexp = (IntNum) vec.elementAt(2*i+1);
- if (uexp.longValue() != 1)
- uref = new ApplyExp(expt.expt,
- new Expression[] { uref , makeQuoteExp(uexp) });
- units[i] = uref;
- }
- Expression unit;
- if (nunits == 1)
- unit = units[0];
- else
- unit = new ApplyExp(MultiplyOp.$St, units);
- return new ApplyExp(MultiplyOp.$St,
- new Expression[] { makeQuoteExp(num),
- unit });
- }
- }
- }
-
- boolean sawAngle;
- if (len > 2 && ch0 == '<' && name.charAt(len-1) == '>')
- {
- name = name.substring(1, len-1);
- len -= 2;
- sawAngle = true;
- }
- else
- sawAngle = false;
- int rank = 0;
- while (len > 2 && name.charAt(len-2) == '[' && name.charAt(len-1) == ']')
- {
- len -= 2;
- rank++;
- }
-
- String cname = name;
- if (rank != 0)
- cname = name.substring(0, len);
- try
- {
- Class clas;
- Type type = Scheme.getNamedType(cname);
- if (rank > 0 && (! sawAngle || type == null))
- {
- Symbol tsymbol = namespace.getSymbol(cname.intern());
- Expression texp = tr.rewrite(tsymbol, false);
- texp = InlineCalls.inlineCalls(texp, tr);
- if (! (texp instanceof ErrorExp))
- type = tr.getLanguage().getTypeFor(texp);
- }
- if (type != null)
- {
- // Somewhat inconsistent: Types named by getNamedType are Type,
- // while standard type/classes are Class. FIXME.
- while (--rank >= 0)
- type = gnu.bytecode.ArrayType.make(type);
- return makeQuoteExp(type);
- }
- else
- {
- type = Type.lookupType(cname);
- if (type instanceof gnu.bytecode.PrimType)
- clas = type.getReflectClass();
- else
- {
- if (cname.indexOf('.') < 0)
- cname = (tr.classPrefix
- + Compilation.mangleNameIfNeeded(cname));
- clas = ClassType.getContextClass(cname);
- }
- }
- if (clas != null)
- {
- if (rank > 0)
- {
- type = Type.make(clas);
- while (--rank >= 0)
- type = gnu.bytecode.ArrayType.make(type);
- clas = type.getReflectClass();
- }
- return makeQuoteExp(clas);
- }
- }
- catch (ClassNotFoundException ex)
- {
- Package pack = gnu.bytecode.ArrayClassLoader.getContextPackage(name);
- if (pack != null)
- return makeQuoteExp(pack);
- }
- catch (NoClassDefFoundError ex)
- {
- tr.error('w', "error loading class "+cname+" - "+ex.getMessage()+" not found");
- }
- catch (Throwable ex)
- {
- }
- return null;
+
+ return super.checkDefaultBinding(symbol, tr);
}
Index: kawa/standard/Scheme.java
===================================================================
--- kawa/standard/Scheme.java (revision 7243)
+++ kawa/standard/Scheme.java (working copy)
@@ -26,7 +26,7 @@
public static final Environment r6Environment;
protected static final SimpleEnvironment kawaEnvironment;
- public static LangPrimType booleanType;
+ private LangPrimType booleanType;
public static final int FOLLOW_R5RS = 5;
public static final int FOLLOW_R6RS = 6;
@@ -819,7 +819,7 @@
defAliasStFld("*print-xml-indent*",
"gnu.xml.XMLPrinter", "indentLoc");
defAliasStFld("html", "gnu.kawa.xml.XmlNamespace", "HTML");
- defAliasStFld("unit", "kawa.standard.Scheme", "unitNamespace");
+ defAliasStFld("unit", "gnu.kawa.lispexpr.LispLanguage", "unitNamespace");
defAliasStFld("path", "gnu.kawa.lispexpr.LangObjType", "pathType");
defAliasStFld("filepath", "gnu.kawa.lispexpr.LangObjType", "filepathType");
@@ -990,135 +990,50 @@
return getInstance().getTypeFor(exp);
}
- static HashMap<String,Type> types;
- static HashMap<Type,String> typeToStringMap;
+ private HashMap<String,Type> types;
+ private HashMap<Type,String> typeToStringMap;
- static synchronized HashMap<String,Type> getTypeMap ()
+ public synchronized HashMap<String, Type> getTypeMap ()
{
if (types == null)
+ {
+ types = new HashMap<String, Type>();
+ booleanType = new LangPrimType(Type.booleanType, Scheme.getInstance());
+ types.put("boolean", booleanType);
+ for (int i = uniformVectorTags.length; --i >= 0;)
{
- booleanType
- = new LangPrimType(Type.booleanType, Scheme.getInstance());
- types = new HashMap<String,Type> ();
- types.put ("void", LangPrimType.voidType);
- types.put ("int", LangPrimType.intType);
- types.put ("char", LangPrimType.charType);
- types.put ("boolean", booleanType);
- types.put ("byte", LangPrimType.byteType);
- types.put ("short", LangPrimType.shortType);
- types.put ("long", LangPrimType.longType);
- types.put ("float", LangPrimType.floatType);
- types.put ("double", LangPrimType.doubleType);
- types.put ("never-returns", Type.neverReturnsType);
-
- types.put ("Object", Type.objectType);
- types.put ("String", Type.toStringType);
-
- types.put ("object", Type.objectType);
- types.put ("number", LangObjType.numericType);
- types.put ("quantity", ClassType.make("gnu.math.Quantity"));
- types.put ("complex", ClassType.make("gnu.math.Complex"));
- types.put ("real", LangObjType.realType);
- types.put ("rational", LangObjType.rationalType);
- types.put ("integer", LangObjType.integerType);
- types.put ("symbol", ClassType.make("gnu.mapping.Symbol"));
- types.put ("namespace", ClassType.make("gnu.mapping.Namespace"));
- types.put ("keyword", ClassType.make("gnu.expr.Keyword"));
- types.put ("pair", ClassType.make("gnu.lists.Pair"));
- types.put ("pair-with-position",
- ClassType.make("gnu.lists.PairWithPosition"));
- types.put ("constant-string", ClassType.make("java.lang.String"));
- types.put ("abstract-string", ClassType.make("gnu.lists.CharSeq"));
- types.put ("character", ClassType.make("gnu.text.Char"));
- types.put ("vector", LangObjType.vectorType);
- types.put ("string", LangObjType.stringType);
- types.put ("empty-list", ClassType.make("gnu.lists.EmptyList"));
- types.put ("list", LangObjType.listType);
- types.put ("function", ClassType.make("gnu.mapping.Procedure"));
- types.put ("procedure", LangObjType.procedureType);
- types.put ("input-port", ClassType.make("gnu.mapping.InPort"));
- types.put ("output-port", ClassType.make("gnu.mapping.OutPort"));
- types.put ("string-output-port",
- ClassType.make("gnu.mapping.CharArrayOutPort"));
- types.put ("string-input-port",
- ClassType.make("gnu.mapping.CharArrayInPort"));
- types.put ("record", ClassType.make("kawa.lang.Record"));
- types.put ("type", LangObjType.typeType);
- types.put ("class-type", LangObjType.typeClassType);
- types.put ("class", LangObjType.typeClass);
- types.put ("promise", LangObjType.promiseType);
-
- for (int i = uniformVectorTags.length; --i >= 0; )
- {
- String tag = uniformVectorTags[i];
- String cname = "gnu.lists."+tag.toUpperCase()+"Vector";
- types.put(tag+"vector", ClassType.make(cname));
- }
-
- types.put ("document", ClassType.make("gnu.kawa.xml.KDocument"));
- types.put ("readtable", ClassType.make("gnu.kawa.lispexpr.ReadTable"));
+ String tag = uniformVectorTags[i];
+ String cname = "gnu.lists." + tag.toUpperCase() + "Vector";
+ types.put(tag + "vector", ClassType.make(cname));
}
+
+ }
return types;
}
- public static Type getNamedType (String name)
+ public Type getNamedType (String name)
{
- getTypeMap();
- Type type = (Type) types.get(name);
- if (type == null
- && (name.startsWith("elisp:") || name.startsWith("clisp:")))
- {
- int colon = name.indexOf(':');
- Class clas = getNamedType(name.substring(colon+1)).getReflectClass();
- String lang = name.substring(0,colon);
- Language interp = Language.getInstance(lang);
- if (interp == null)
- throw new RuntimeException("unknown type '" + name
- + "' - unknown language '"
- + lang + '\'');
- type = interp.getTypeFor(clas);
- if (type != null)
- types.put(name, type);
- }
+ Type type;
+
+ type = getTypeMap().get(name);
+
+ if (type == null) {
+ return LispLanguage.getNamedLispType(name);
+ }
+
return type;
}
- public Type getTypeFor (Class clas)
- {
- String name = clas.getName();
- if (clas.isPrimitive())
- return getNamedType(name);
- if ("java.lang.String".equals(name))
- return Type.toStringType;
- if ("gnu.math.IntNum".equals(name))
- return LangObjType.integerType;
- if ("gnu.math.DFloNum".equals(name))
- return LangObjType.dflonumType;
- if ("gnu.math.RatNum".equals(name))
- return LangObjType.rationalType;
- if ("gnu.math.RealNum".equals(name))
- return LangObjType.realType;
- if ("gnu.math.Numeric".equals(name))
- return LangObjType.numericType;
- if ("gnu.lists.FVector".equals(name))
- return LangObjType.vectorType;
- if ("gnu.lists.LList".equals(name))
- return LangObjType.listType;
- if ("gnu.text.Path".equals(name))
- return LangObjType.pathType;
- if ("gnu.text.URIPath".equals(name))
- return LangObjType.URIType;
- if ("gnu.text.FilePath".equals(name))
- return LangObjType.filepathType;
- if ("java.lang.Class".equals(name))
- return LangObjType.typeClass;
- if ("gnu.bytecode.Type".equals(name))
- return LangObjType.typeType;
- if ("gnu.bytecode.ClassType".equals(name))
- return LangObjType.typeClassType;
- return Type.make(clas);
+ @Override
+ public Type getTypeFor (Class clas) {
+ Type type = super.getTypeFor(clas);
+ if (type == null) {
+ type = getTypeMap().get(clas.getName());
+ }
+ return type;
}
+ @Override
public String formatType (Type type)
{
// FIXME synchronize
@@ -1157,12 +1072,12 @@
t = ArrayType.make(t);
}
else
- t = getNamedType (name);
+ t = getInstance().getNamedType (name);
if (t != null)
return t;
t = Language.string2Type(name);
if (t != null)
- types.put (name, t);
+ getInstance().getTypeMap().put (name, t);
return t;
}
@@ -1179,9 +1094,6 @@
return getInstance().getTypeFor(exp);
}
- public static final Namespace unitNamespace =
- Namespace.valueOf("http://kawa.gnu.org/unit";, "unit");
-
public Symbol asSymbol (String ident)
{
return Namespace.EmptyNamespace.getSymbol(ident);
Index: kawa/standard/let.java
===================================================================
--- kawa/standard/let.java (revision 7243)
+++ kawa/standard/let.java (working copy)
@@ -17,6 +17,7 @@
public static final let let = new let();
static { let.setName("let"); }
+ @Override
public Expression rewrite (Object obj, Translator tr)
{
if (! (obj instanceof Pair))
Index: kawa/standard/define_unit.java
===================================================================
--- kawa/standard/define_unit.java (revision 7243)
+++ kawa/standard/define_unit.java (working copy)
@@ -7,6 +7,7 @@
import gnu.expr.*;
import gnu.math.*;
import gnu.bytecode.*;
+import gnu.kawa.lispexpr.LispLanguage;
import gnu.mapping.*;
public class define_unit extends Syntax
@@ -34,7 +35,7 @@
if (q instanceof SimpleSymbol)
{
String name = q.toString();
- Symbol sym = Scheme.unitNamespace.getSymbol(name);
+ Symbol sym = LispLanguage.unitNamespace.getSymbol(name);
Declaration decl = defs.getDefine(sym, 'w', tr);
tr.push(decl);
Translator.setLine(decl, p);
Index: kawa/lang/Translator.java
===================================================================
--- kawa/lang/Translator.java (revision 7243)
+++ kawa/lang/Translator.java (working copy)
@@ -13,9 +13,16 @@
import java.util.*;
import gnu.kawa.functions.GetNamedPart;
import gnu.kawa.functions.CompileNamedPart;
+import gnu.kawa.functions.MultiplyOp;
+import gnu.kawa.xml.XmlNamespace;
+import gnu.math.DFloNum;
+import gnu.math.IntNum;
+import gnu.math.Unit;
import gnu.text.SourceLocator;
/* #ifdef enable:XML */
import gnu.xml.NamespaceBinding;
+import kawa.standard.Scheme;
+import kawa.standard.expt;
/* #endif */
/** Used to translate from source to Expression.
@@ -833,11 +840,262 @@
}
/** If a symbol is lexically unbound, look for a default binding.
- * The default implementation does nothing.
* @return null if no binidng, or an Expression.
*/
- public Expression checkDefaultBinding (Symbol name, Translator tr)
+ // FIXME: This method needs refactoring. The quantities method should be moved
+ // to its own method, at least!
+ public Expression checkDefaultBinding (Symbol symbol, Translator tr)
{
+ Namespace namespace = symbol.getNamespace();
+ String local = symbol.getLocalPart();
+
+ if (namespace instanceof XmlNamespace)
+ return makeQuoteExp(((XmlNamespace) namespace).get(local));
+
+ if (namespace.getName() == LispLanguage.unitNamespace.getName())
+ {
+ Object val = Unit.lookup(local);
+ if (val != null)
+ return makeQuoteExp(val);
+ }
+
+ String name = symbol.toString();
+ int len = name.length();
+
+ char ch0 = name.charAt(0);
+
+ if (ch0 == '@')
+ {
+ String rest = name.substring(1);
+ Expression classRef = tr.rewrite(Symbol.valueOf(rest));
+ return MakeAnnotation.makeAnnotationMaker(classRef);
+ }
+
+ // Look for quantities.
+ if (ch0 == '-' || ch0 == '+' || Character.digit(ch0, 10) >= 0)
+ {
+ // 1: initial + or -1 seen.
+ // 2: digits seen
+ // 3: '.' seen
+ // 4: fraction seen
+ // 5: [eE][=+]?[0-9]+ seen
+ int state = 0;
+ int i = 0;
+ for (; i < len; i++)
+ {
+ char ch = name.charAt(i);
+ if (Character.digit(ch, 10) >= 0)
+ state = state < 3 ? 2 : state < 5 ? 4 : 5;
+ else if ((ch == '+' || ch == '-') && state == 0)
+ state = 1;
+ else if (ch == '.' && state < 3)
+ state = 3;
+ else if ((ch == 'e' || ch == 'E') && (state == 2 || state == 4)
+ && i + 1 < len)
+ {
+ int j = i+1;
+ char next = name.charAt(j);
+ if ((next == '-' || next == '+') && ++j < len)
+ next = name.charAt(j);
+ if (Character.digit(next, 10) < 0)
+ break;
+ state = 5;
+ i = j+1;
+}
+ else
+ break;
+ }
+ tryQuantity:
+ if (i < len && state > 1)
+ {
+ DFloNum num = new DFloNum(name.substring(0,i));
+ boolean div = false;
+ Vector vec = new Vector();
+ for (; i < len ;)
+ {
+ char ch = name.charAt(i++);
+ if (ch == '*')
+ {
+ if (i == len) break tryQuantity;
+ ch = name.charAt(i++);
+ }
+ else if (ch == '/')
+ {
+ if (i == len || div) break tryQuantity;
+ div = true;
+ ch = name.charAt(i++);
+ }
+ int unitStart = i-1;
+ int unitEnd;
+ for (;;)
+ {
+ if (! Character.isLetter(ch))
+ {
+ unitEnd = i - 1;
+ if (unitEnd == unitStart)
+ break tryQuantity;
+ break;
+ }
+ if (i == len)
+ {
+ unitEnd = i;
+ ch = '1';
+ break;
+ }
+ ch = name.charAt(i++);
+ }
+ vec.addElement(name.substring(unitStart, unitEnd));
+ boolean expRequired = false;
+ if (ch == '^')
+ {
+ expRequired = true;
+ if (i == len) break tryQuantity;
+ ch = name.charAt(i++);
+ }
+ boolean neg = div;
+ if (ch == '+')
+ {
+ expRequired = true;
+ if (i == len) break tryQuantity;
+ ch = name.charAt(i++);
+ }
+ else if (ch == '-')
+ {
+ expRequired = true;
+ if (i == len) break tryQuantity;
+ ch = name.charAt(i++);
+ neg = ! neg;
+ }
+ int nexp = 0;
+ int exp = 0;
+ for (;;)
+ {
+ int dig = Character.digit(ch, 10);
+ if (dig <= 0)
+ {
+ i--;
+ break;
+ }
+ exp = 10 * exp + dig;
+ nexp++;
+ if (i == len)
+ break;
+ ch = name.charAt(i++);
+ }
+ if (nexp == 0)
+ {
+ exp = 1;
+ if (expRequired)
+ break tryQuantity;
+ }
+ if (neg)
+ exp = - exp;
+ vec.addElement(IntNum.make(exp));
+ }
+ if (i == len)
+ {
+ int nunits = vec.size() >> 1;
+ Expression[] units = new Expression[nunits];
+ for (i = 0; i < nunits; i++)
+ {
+ String uname = (String) vec.elementAt(2*i);
+ Symbol usym = LispLanguage.unitNamespace.getSymbol(uname.intern());
+ Expression uref = tr.rewrite(usym);
+ IntNum uexp = (IntNum) vec.elementAt(2*i+1);
+ if (uexp.longValue() != 1)
+ uref = new ApplyExp(expt.expt,
+ new Expression[] { uref , makeQuoteExp(uexp) });
+ units[i] = uref;
+ }
+ Expression unit;
+ if (nunits == 1)
+ unit = units[0];
+ else
+ unit = new ApplyExp(MultiplyOp.$St, units);
+ return new ApplyExp(MultiplyOp.$St,
+ new Expression[] { makeQuoteExp(num),
+ unit });
+ }
+ }
+ }
+
+ boolean sawAngle;
+ if (len > 2 && ch0 == '<' && name.charAt(len-1) == '>')
+ {
+ name = name.substring(1, len-1);
+ len -= 2;
+ sawAngle = true;
+ }
+ else
+ sawAngle = false;
+ int rank = 0;
+ while (len > 2 && name.charAt(len-2) == '[' && name.charAt(len-1) == ']')
+ {
+ len -= 2;
+ rank++;
+ }
+
+ String cname = name;
+ if (rank != 0)
+ cname = name.substring(0, len);
+ try
+ {
+ Class clas;
+ Type type = Language.getDefaultLanguage().getNamedType(cname);
+ if (rank > 0 && (! sawAngle || type == null))
+ {
+ Symbol tsymbol = namespace.getSymbol(cname.intern());
+ Expression texp = tr.rewrite(tsymbol, false);
+ texp = InlineCalls.inlineCalls(texp, tr);
+ if (! (texp instanceof ErrorExp))
+ type = tr.getLanguage().getTypeFor(texp);
+ }
+ if (type != null)
+ {
+ // Somewhat inconsistent: Types named by getNamedType are Type,
+ // while standard type/classes are Class. FIXME.
+ while (--rank >= 0)
+ type = gnu.bytecode.ArrayType.make(type);
+ return makeQuoteExp(type);
+ }
+ else
+ {
+ type = Type.lookupType(cname);
+ if (type instanceof gnu.bytecode.PrimType)
+ clas = type.getReflectClass();
+ else
+ {
+ if (cname.indexOf('.') < 0)
+ cname = (tr.classPrefix
+ + Compilation.mangleNameIfNeeded(cname));
+ clas = ClassType.getContextClass(cname);
+ }
+ }
+ if (clas != null)
+ {
+ if (rank > 0)
+ {
+ type = Type.make(clas);
+ while (--rank >= 0)
+ type = gnu.bytecode.ArrayType.make(type);
+ clas = type.getReflectClass();
+ }
+ return makeQuoteExp(clas);
+ }
+ }
+ catch (ClassNotFoundException ex)
+ {
+ Package pack = gnu.bytecode.ArrayClassLoader.getContextPackage(name);
+ if (pack != null)
+ return makeQuoteExp(pack);
+ }
+ catch (NoClassDefFoundError ex)
+ {
+ tr.error('w', "error loading class "+cname+" - "+ex.getMessage()+" not found");
+ }
+ catch (Throwable ex)
+ {
+ }
return null;
}
@@ -1259,7 +1517,7 @@
}
}
- private void rewriteBody (LList forms)
+ protected void rewriteBody (LList forms)
{
while (forms != LList.Empty)
{
@@ -1278,7 +1536,7 @@
}
/** Combine a list of zero or more expression forms into a "body". */
- private Expression makeBody(int first, ScopeExp scope)
+ protected Expression makeBody(int first, ScopeExp scope)
{
int nforms = formStack.size() - first;
if (nforms == 0)
Index: gnu/mapping/PropertyLocation.java
===================================================================
--- gnu/mapping/PropertyLocation.java (revision 7243)
+++ gnu/mapping/PropertyLocation.java (working copy)
@@ -19,6 +19,7 @@
return pair.getCar();
}
+ @Override
public boolean isBound ()
{
return true;
@@ -29,7 +30,7 @@
pair.setCar(newValue);
}
- /** Get the property list assocated with an object in a given Environment.
+ /** Get the property list associated with an object in a given Environment.
* @param symbol Usually but not necessarily a Symbol.
* (A String is <em>not </em> converted a Symbol by this method.)
*/
@@ -48,7 +49,7 @@
return Environment.getCurrent().get(Symbol.PLIST, symbol, LList.Empty);
}
- /** Set the property list assocated with an object in a given Environment.
+ /** Set the property list associated with an object in a given Environment.
* This function should be avoided, since a Symbol's property list may
* be used by unknown classes. It also can be slow.
* @param symbol Usually but not necessarily a Symbol.
@@ -60,7 +61,7 @@
synchronized (env)
{
Location lloc = env.lookup(Symbol.PLIST, symbol);
- if (symbol instanceof Symbol)
+ if (symbol instanceof Symbol && lloc != null)
{
Symbol sym = (Symbol) symbol;
Object old = lloc.get(LList.Empty);
@@ -106,7 +107,7 @@
}
}
- /** Set the property list assocated with an object in a given Environment.
+ /** Set the property list associated with an object in a given Environment.
* Corresponds to Common Lisp's <code>(setf symbol-plist)</code> function.
* @see #setPropertyList(Object, Object, Environment).
*/
@@ -246,7 +247,7 @@
return true;
}
- /** Remove a properaty assocatied with an object.
+ /** Remove a property associated with an object.
* Corresponds to Common Lisp's <code>remprop</code> function.
*/
public static boolean removeProperty (Object symbol, Object property)
Index: gnu/xquery/lang/XQuery.java
===================================================================
--- gnu/xquery/lang/XQuery.java (revision 7243)
+++ gnu/xquery/lang/XQuery.java (working copy)
@@ -16,10 +16,12 @@
import java.io.Reader;
import java.util.Vector;
import gnu.kawa.functions.ConstantFunction0;
+import gnu.kawa.lispexpr.LispLanguage;
import gnu.kawa.reflect.ClassMethods;
import gnu.math.IntNum;
import gnu.kawa.xml.*;
+
/** The XQuery language. */
public class XQuery extends Language
@@ -869,7 +871,7 @@
String name = clas.getName();
if (name.equals("boolean"))
return XDataType.booleanType;
- return Scheme.getNamedType(name);
+ return LispLanguage.getNamedLispType(name);
}
else if (! clas.isArray())
{
@@ -1028,6 +1030,12 @@
}
return value;
}
+
+ @Override
+ public Type getNamedType (String name)
+ {
+ return getTypeFor(name);
+ }
}
class Prompter extends Procedure1
Index: gnu/jemacs/lang/ELisp.java
===================================================================
--- gnu/jemacs/lang/ELisp.java (revision 7243)
+++ gnu/jemacs/lang/ELisp.java (working copy)
@@ -210,7 +210,7 @@
booleanType = new LangPrimType(Type.booleanType, this);
return booleanType;
}
- return Scheme.getNamedType(name);
+ return LispLanguage.getNamedLispType(name);
}
return Type.make(clas);
}
Index: gnu/expr/Compilation.java
===================================================================
--- gnu/expr/Compilation.java (revision 7243)
+++ gnu/expr/Compilation.java (working copy)
@@ -2644,6 +2644,10 @@
/** A help vector for building expressions. */
public Stack<Expression> exprStack;
+ /**
+ * Pushed when a LET form's bindings have been evaluated.
+ * @see {@code let#rewrite}
+ */
public void letStart ()
{
pushScope(new LetExp());
Index: gnu/expr/Declaration.java
===================================================================
--- gnu/expr/Declaration.java (revision 7243)
+++ gnu/expr/Declaration.java (working copy)
@@ -1323,7 +1323,9 @@
* This is used for the initializing value in a LetExp,
* a parameter's default value, or for pattern-matching.
*/
- public Expression getInitValue() { return initValue; }
+ public Expression getInitValue() {
+ return initValue;
+ }
public void setInitValue(Expression init) { this.initValue = init; }
private Expression initValue;
Index: gnu/expr/Language.java
===================================================================
--- gnu/expr/Language.java (revision 7243)
+++ gnu/expr/Language.java (working copy)
@@ -308,6 +308,19 @@
{
return Environment.make("environment-"+(++envCounter), environ);
}
+
+ /**
+ * Get the corresponding {@link Type} for a given name.
+ *
+ * If a subclass does not require any modification to the types found
+ * in {@code LispLanguage}, then they should just call
+ * {@link LispLanguage#getNamedLispType(java.lang.String)}
+ *
+ * @param name The name of a type to search for.
+ * @return The corresponding {@link Type}, if a suitable one can be found,
+ * otherwise {@code null}.
+ */
+ abstract public Type getNamedType (String name);
public Environment getLangEnvironment() { return environ; }
Index: gnu/commonlisp/lang/CommonLisp.java
===================================================================
--- gnu/commonlisp/lang/CommonLisp.java (revision 7243)
+++ gnu/commonlisp/lang/CommonLisp.java (working copy)
@@ -2,15 +2,20 @@
// This is free software; for terms and warranty disclaimer see ./COPYING.
package gnu.commonlisp.lang;
-import gnu.mapping.*;
-import gnu.lists.*;
-import gnu.expr.*;
-import gnu.text.Char;
-import kawa.standard.Scheme;
+import gnu.bytecode.ClassType;
import gnu.bytecode.Type;
-import gnu.kawa.lispexpr.LangPrimType;
+import gnu.expr.Language;
import gnu.kawa.functions.DisplayFormat;
import gnu.kawa.functions.NumberCompare;
+import gnu.kawa.lispexpr.LangPrimType;
+import gnu.kawa.lispexpr.LispLanguage;
+import gnu.lists.AbstractFormat;
+import gnu.mapping.Environment;
+import gnu.mapping.LocationEnumeration;
+import gnu.mapping.Procedure;
+import gnu.text.Char;
+import java.util.HashMap;
+import kawa.standard.Scheme;
public class CommonLisp extends Lisp2
{
@@ -111,7 +116,9 @@
loadClass("kawa.lib.std_syntax");
loadClass("kawa.lib.lists");
loadClass("kawa.lib.strings");
- loadClass("gnu.commonlisp.lisp.PrimOps");
+ //loadClass("gnu.commonlisp.lisp.PrimOps");
+ System.out.println("Loading primitives.lisp...");
+ loadClass("gnu.commonlisp.lisp.primitives");
}
catch (java.lang.ClassNotFoundException ex)
{
@@ -125,7 +132,6 @@
lambda.defaultDefault = nilExpr;
defun("lambda", lambda);
defun("defun", new defun(lambda));
-
defun("defvar", new defvar(false));
defun("defconst", new defvar(true));
defun("defsubst", new defun(lambda));
@@ -141,6 +147,7 @@
defun("eq", new gnu.kawa.functions.IsEq(this, "eq"));
defun("equal", new gnu.kawa.functions.IsEqual(this, "equal"));
defun("typep", new gnu.kawa.reflect.InstanceOf(this));
+ //defun("the", new the());
defun("princ", displayFormat);
defun("prin1", writeFormat);
@@ -149,8 +156,9 @@
defProcStFld(">", "gnu.commonlisp.lang.CommonLisp", "numGrt");
defProcStFld("<=", "gnu.commonlisp.lang.CommonLisp", "numLEq");
defProcStFld(">=", "gnu.commonlisp.lang.CommonLisp", "numGEq");
-
+
defProcStFld("functionp", "gnu.commonlisp.lisp.PrimOps");
+ defProcStFld("the", "gnu.kawa.functions.Convert", "as");
}
public static CommonLisp getInstance()
@@ -173,6 +181,22 @@
}
LangPrimType booleanType;
+ private HashMap<String,Type> types;
+ private HashMap<Type,String> typeToStringMap;
+
+ public synchronized HashMap<String, Type> getTypeMap ()
+ {
+ if (types == null)
+ {
+ types = new HashMap<String, Type>();
+ booleanType = new LangPrimType(Type.booleanType, CommonLisp.getInstance());
+ types.put("boolean", booleanType);
+ types.put("t", Type.objectType);
+ types.put("nil", Type.voidType);
+ }
+
+ return types;
+ }
public Type getTypeFor(String name)
{
@@ -180,20 +204,45 @@
name = "java.lang.Object";
return Scheme.string2Type(name);
}
-
- public Type getTypeFor (Class clas)
+
+ @Override
+ public Type getNamedType (String name)
{
- if (clas.isPrimitive())
- {
- String name = clas.getName();
- if (name.equals("boolean"))
- {
- if (booleanType == null)
- booleanType = new LangPrimType(Type.booleanType, this);
- return booleanType;
- }
- return Scheme.getNamedType(name);
- }
- return Type.make(clas);
+ Type type;
+
+ type = getTypeMap().get(name);
+
+ if (type == null) {
+ return LispLanguage.getNamedLispType(name);
+ }
+
+ return type;
}
+
+ @Override
+ public Type getTypeFor (Class clas) {
+ Type type = super.getTypeFor(clas);
+ if (type == null) {
+ type = getTypeMap().get(clas.getName());
+ }
+ return type;
+ }
+
+// public Type getTypeFor (Class clas)
+// {
+// if (clas.isPrimitive())
+// {
+// String name = clas.getName();
+// if (name.equals("boolean"))
+// {
+// if (booleanType == null)
+// booleanType = new LangPrimType(Type.booleanType, this);
+// return booleanType;
+// }
+// return LispLanguage.getNamedLispType(name);
+// }
+// return Type.make(clas);
+// }
+
+
}
Index: gnu/commonlisp/lang/Lisp2Compilation.java
===================================================================
--- gnu/commonlisp/lang/Lisp2Compilation.java (revision 7243)
+++ gnu/commonlisp/lang/Lisp2Compilation.java (working copy)
@@ -1,8 +1,13 @@
package gnu.commonlisp.lang;
-import kawa.lang.*;
-import gnu.bytecode.*;
+
+import gnu.bytecode.ClassType;
+import gnu.bytecode.CodeAttr;
import gnu.expr.*;
-import gnu.text.*;
+import gnu.lists.LList;
+import gnu.lists.Pair;
+import gnu.lists.SeqPosition;
+import gnu.text.SourceMessages;
+import kawa.lang.Translator;
public class Lisp2Compilation extends Translator
{
@@ -11,7 +16,8 @@
super(language, messages, lexical);
}
- public void emitPushBoolean(boolean value)
+ @Override
+ public void emitPushBoolean (boolean value)
{
CodeAttr code = getCode();
if (value)
@@ -20,4 +26,136 @@
code.emitGetStatic(Compilation.scmListType.getDeclaredField("Empty"));
}
+ /**
+ * Re-write a Scheme <body> in S-expression format into internal form.
+ */
+ @Override
+ public Expression rewrite_body (Object exp)
+ {
+ // NOTE we have both a rewrite_body and a rewriteBody.
+ // This is confusing, at the least. FIXME.
+ Object saved = pushPositionOf(exp);
+ LetExp defs = new LetExp();
+ int first = formStack.size();
+ defs.outer = current_scope;
+ current_scope = defs;
+ try
+ {
+ LList list = scanBody(exp, defs, true);
+ if (list.isEmpty())
+ formStack.add(syntaxError("body with no expressions"));
+ int ndecls = 0;
+ for (Declaration decl = defs.firstDecl(); decl != null; decl = decl.nextDecl())
+ {
+ if (!decl.getFlag(Declaration.IS_DYNAMIC))
+ {
+ ndecls++;
+ decl.setInitValue(QuoteExp.undefined_exp);
+ }
+ }
+
+ Expression body;
+ body = processDeclare(list);
+
+ if (body == null)
+ {
+ rewriteBody(list);
+ body = makeBody(first, null);
+ }
+
+ setLineOf(body);
+ if (ndecls == 0)
+ return body;
+ defs.setBody(body);
+ setLineOf(defs);
+ return defs;
+ } finally
+ {
+ pop(defs);
+ popPositionOf(saved);
+ }
+ }
+
+ /**
+ * Process the DECLARE (if any) in a Common Lisp form.
+ *
+ * @param list The body of this expression.
+ * @return the {@code LetExp} representing the new scope of these declared
+ * variables, or null if no declarations were found.
+ */
+ private Expression processDeclare (LList list)
+ {
+ LetExp letexp = null;
+ // Could be checked futher up the call chain.
+ if (list.isEmpty())
+ return null;
+ // Declarations are always at the start of a body.
+ Object head = ((Pair) list).getCar();
+ // The body to rewrite into the new LET body, this is just what follows
+ // the DECLARE form in list
+ Object body = ((Pair) list).getCdr();
+ // For cases like (declare (integer x1 x2 .. xn)), maintain a stack of the
+ // xi which are then popped back off for their types to be set. This is
+ // to avoid creating a new lexical scope for each xi since we want to
+ // call letVariable() on each of the xi before letEnter().
+ //Stack<Declaration> declarations = new Stack<Declaration>();
+
+ if (head instanceof Pair && matches(((Pair) head).getCar(), "declare"))
+ {
+ SeqPosition declIterator = ((LList) head).getIterator(1);
+ SeqPosition varIterator;
+ Pair declItem;
+ Object var;
+ Declaration varDecl, aliasedDecl;
+ ReferenceExp ref;
+ // Create a new lexical environment for this DECLARE
+ letStart();
+
+ // eg. declIterator == [(integer x y) (float z) (gnu.lists.Sequence k)]
+ while (declIterator.hasNext())
+ {
+ declItem = (Pair) declIterator.next();
+ if (matches(declItem.getCar(), "type"))
+ {
+ // Just skip past TYPE and process the type declarations
+ varIterator = ((LList) declItem.getCdr()).getIterator(1);
+ }
+ // .. other checks could be performed here
+ else
+ {
+ // By default we process type declarations
+ varIterator = ((LList) declItem.getCdr()).getIterator();
+ }
+
+ if (!varIterator.hasNext())
+ {
+ // FIXME: Add better diagnostics...
+ return syntaxError("bad declare syntax");
+ }
+
+ // e.g varIterator = (x y) or (z) or (k)
+ // For each aliased variable, place it in the new lexical environment
+ while (varIterator.hasNext())
+ {
+ var = varIterator.next();
+ varDecl = lexical.get(var);
+ if (varDecl != null)
+ {
+ aliasedDecl = new Declaration(varDecl.getSymbol());
+ ref = new ReferenceExp(varDecl);
+ letVariable(aliasedDecl, ref);
+ aliasedDecl.setType(this.exp2Type((Pair) declItem)); //FIXME (type ...)
+ aliasedDecl.setFlag(Declaration.TYPE_SPECIFIED);
+ }
+ else
+ {
+ error('w', "No declaration seen for `" + var + "`");
+ }
+ }
+ }
+ letEnter();
+ letexp = letDone(rewrite_body(body));
+ }
+ return letexp;
+ }
}
Index: gnu/commonlisp/lang/Symbols.java
===================================================================
--- gnu/commonlisp/lang/Symbols.java (revision 7243)
+++ gnu/commonlisp/lang/Symbols.java (working copy)
@@ -1,9 +1,14 @@
package gnu.commonlisp.lang;
import gnu.mapping.*;
-import gnu.lists.*;
-/** Support for Lisp Symbols.
- * The special symbol `nil' is actually the value gnu.lists.LList.Empty. */
+/**
+ * Support for Lisp symbols.
+ *
+ * The special symbol {@code nil} is actually the value
+ * {@link gnu.lists.LList.Empty}.
+ *
+ * @author Per Bothner
+ */
public class Symbols
{
@@ -11,12 +16,30 @@
{
}
+ /**
+ * Predicate to check whether a given object is a symbol.
+ *
+ * Used for {@code SYMBOLP}.
+ *
+ * @param val the object to check whether it's a symbol.
+ * @return true if the object is {@link String}, nil or a
+ * {@link gnu.mapping.Symbol}. Return false otherwise.
+ */
public static boolean isSymbol(Object val)
{
return val instanceof String || val == Lisp2.FALSE
|| val instanceof Symbol;
}
+ /**
+ * Predicate to check whether a symbol is bound the current environment chain.
+ *
+ * Used for {@code BOUNDP}.
+ *
+ * @param sym the object to check if bound.
+ * @return true if the if the object is bound in either the current
+ * environment, or one further up the static chain.
+ */
public static boolean isBound(Object sym)
{
if (sym == Lisp2.FALSE)
@@ -46,17 +69,46 @@
: Namespace.getDefaultSymbol((String) sym); // FIXME
}
+ /**
+ * Return a printable name for a given symbol.
+ *
+ * Used by {@code SYMBOL-NAME}.
+ *
+ * @param sym the symbol whose name shall be returned.
+ * @return {@code NIL} if {@code sym} is {@code NIL}, otherwise the printable
+ * name for {@code sym}.
+ */
public static Object getPrintName(Object sym)
{
return sym == Lisp2.FALSE ? "nil"
: Lisp2.getString(((Symbol) sym).getName());
}
+ /**
+ * Get the function binding for a given symbol in the current environment.
+ *
+ * Will throw an {@link UnboundLocationException} if no such symbol exists
+ * in the current environment.
+ *
+ * @param symbol the symbol whose function binding you seek.
+ * @return the function binding associated with this {@code symbol}.
+ */
public static Object getFunctionBinding (Object symbol)
{
return Environment.getCurrent().getFunction(getSymbol(symbol));
}
+ /**
+ * Get the function binding for a given symbol in a given environment.
+ *
+ * Will throw an {@link UnboundLocationException} if no such symbol exists
+ * in the current environment.
+ *
+ * @param environ the environment to look {@code symbol} up in.
+ * @param symbol the symbol to look up in {@code environ}.
+ * @return the function binding associated with {@code symbol} in
+ * {@code environ}.
+ */
public static Object getFunctionBinding (Environment environ, Object symbol)
{
return environ.getFunction(getSymbol(symbol));
Index: gnu/commonlisp/lang/Lisp2.java
===================================================================
--- gnu/commonlisp/lang/Lisp2.java (revision 7243)
+++ gnu/commonlisp/lang/Lisp2.java (working copy)
@@ -2,14 +2,15 @@
// This is free software; for terms and warranty disclaimer see ./COPYING.
package gnu.commonlisp.lang;
+import gnu.bytecode.Type;
import gnu.expr.*;
-import gnu.lists.*;
+import gnu.kawa.lispexpr.LangObjType;
+import gnu.kawa.lispexpr.LispLanguage;
+import gnu.kawa.lispexpr.ReadTable;
+import gnu.kawa.reflect.FieldLocation;
+import gnu.lists.FString;
+import gnu.lists.LList;
import gnu.mapping.*;
-import gnu.bytecode.CodeAttr;
-import gnu.bytecode.ClassType;
-import gnu.text.*;
-import gnu.kawa.lispexpr.*;
-import gnu.kawa.reflect.FieldLocation;
/** Abstract class for Lisp-like languages with separate namespaces. */
@@ -20,31 +21,37 @@
public static final Symbol TRUE = Namespace.getDefault().getSymbol("t");
public static final Expression nilExpr = new QuoteExp(FALSE);
+ @Override
public boolean isTrue(Object value)
{
return value != FALSE;
}
+ @Override
public Object booleanObject(boolean b)
{
if (b) return TRUE; else return FALSE;
}
+ @Override
public Object noValue()
{
return FALSE;
}
+ @Override
public boolean hasSeparateFunctionNamespace()
{
return true;
}
+ @Override
public boolean selfEvaluatingSymbol (Object obj)
{
return obj instanceof Keyword || obj == TRUE || obj == FALSE;
}
+ @Override
public Object getEnvPropertyFor (java.lang.reflect.Field fld, Object value)
{
if (Compilation.typeProcedure.getReflectClass()
@@ -154,6 +161,12 @@
tab.setInitialColonIsKeyword(true);
return tab;
}
+
+ @Override
+ public Type getNamedType (String name)
+ {
+ return LispLanguage.getNamedLispType(name);
+ }
public String getCompilationClass () { return "gnu.commonlisp.lang.Lisp2Compilation"; }
}
Property changes on: gnu/commonlisp/lisp
___________________________________________________________________
Modified: svn:ignore
- Makefile
*.class
scm-classes.stamp
+ Makefile
*.class
scm-classes.stamp
.Makefile.in.swp
.Makefile.am.swp
Index: gnu/commonlisp/lisp/PrimOps.scm
===================================================================
--- gnu/commonlisp/lisp/PrimOps.scm (revision 7243)
+++ gnu/commonlisp/lisp/PrimOps.scm (working copy)
@@ -155,5 +155,5 @@
(define (char-to-string ch)
(make <gnu.lists.FString> 1 (invoke-static <gnu.commonlisp.lang.CommonLisp> 'asChar ch)))
-(define (functionp x) |<clisp:boolean>|
+(define (functionp x) :: |clisp:boolean|
(instance? x <function>))
Index: gnu/kawa/lispexpr/LispLanguage.java
===================================================================
--- gnu/kawa/lispexpr/LispLanguage.java (revision 7243)
+++ gnu/kawa/lispexpr/LispLanguage.java (working copy)
@@ -7,9 +7,12 @@
import gnu.text.*;
import gnu.lists.*;
import gnu.bytecode.Access;
+import gnu.bytecode.ClassType;
import gnu.bytecode.Field;
+import gnu.bytecode.Type;
import gnu.mapping.EnvironmentKey;
import gnu.kawa.reflect.StaticFieldLocation;
+import java.util.HashMap;
import kawa.lang.Translator; // FIXME
import kawa.lang.Syntax; // FIXME
@@ -40,6 +43,12 @@
/** Create a fresh <code>ReadTable</code> appropriate for this language. */
public abstract ReadTable createReadTable ();
+
+ /**
+ * The global namespace for "quantities" in Kawa.
+ */
+ public static final Namespace unitNamespace =
+ Namespace.valueOf("http://kawa.gnu.org/unit";, "unit");
public LispReader getLexer(InPort inp, SourceMessages messages)
{
@@ -121,6 +130,142 @@
tr.resolveModule(tr.getModule());
}
+ static HashMap<String,Type> types;
+ static HashMap<Type,String> typeToStringMap;
+
+ public static synchronized HashMap<String,Type> getLispTypeMap () {
+ if (types == null)
+ {
+ types = new HashMap<String,Type> ();
+ types.put ("void", LangPrimType.voidType);
+ types.put ("int", LangPrimType.intType);
+ types.put ("char", LangPrimType.charType);
+ types.put ("byte", LangPrimType.byteType);
+ types.put ("short", LangPrimType.shortType);
+ types.put ("long", LangPrimType.longType);
+ types.put ("float", LangPrimType.floatType);
+ types.put ("double", LangPrimType.doubleType);
+ types.put ("never-returns", Type.neverReturnsType);
+
+ types.put ("Object", Type.objectType);
+ types.put ("String", Type.toStringType);
+
+ types.put ("object", Type.objectType);
+ types.put ("number", LangObjType.numericType);
+ types.put ("quantity", ClassType.make("gnu.math.Quantity"));
+ types.put ("complex", ClassType.make("gnu.math.Complex"));
+ types.put ("real", LangObjType.realType);
+ types.put ("rational", LangObjType.rationalType);
+ types.put ("integer", LangObjType.integerType);
+ types.put ("symbol", ClassType.make("gnu.mapping.Symbol"));
+ types.put ("namespace", ClassType.make("gnu.mapping.Namespace"));
+ types.put ("keyword", ClassType.make("gnu.expr.Keyword"));
+ types.put ("pair", ClassType.make("gnu.lists.Pair"));
+ types.put ("pair-with-position",
+ ClassType.make("gnu.lists.PairWithPosition"));
+ types.put ("constant-string", ClassType.make("java.lang.String"));
+ types.put ("abstract-string", ClassType.make("gnu.lists.CharSeq"));
+ types.put ("character", ClassType.make("gnu.text.Char"));
+ types.put ("vector", LangObjType.vectorType);
+ types.put ("string", LangObjType.stringType);
+ types.put ("empty-list", ClassType.make("gnu.lists.EmptyList"));
+ types.put ("list", LangObjType.listType);
+ types.put ("function", ClassType.make("gnu.mapping.Procedure"));
+ types.put ("procedure", LangObjType.procedureType);
+ types.put ("input-port", ClassType.make("gnu.mapping.InPort"));
+ types.put ("output-port", ClassType.make("gnu.mapping.OutPort"));
+ types.put ("string-output-port",
+ ClassType.make("gnu.mapping.CharArrayOutPort"));
+ types.put ("string-input-port",
+ ClassType.make("gnu.mapping.CharArrayInPort"));
+ types.put ("record", ClassType.make("kawa.lang.Record"));
+ types.put ("type", LangObjType.typeType);
+ types.put ("class-type", LangObjType.typeClassType);
+ types.put ("class", LangObjType.typeClass);
+ types.put ("promise", LangObjType.promiseType);
+ types.put ("document", ClassType.make("gnu.kawa.xml.KDocument"));
+ types.put ("readtable", ClassType.make("gnu.kawa.lispexpr.ReadTable"));
+ }
+ return types;
+ }
+
+ public static Type getNamedLispType (String name)
+ {
+ getLispTypeMap();
+ Type type = (Type) types.get(name);
+
+ int colon = name.indexOf(':');
+
+ if (type == null && colon > 0)
+ {
+
+ String lang = name.substring(0, colon);
+ Language interp = Language.getInstance(lang);
+ if (interp == null)
+ throw new RuntimeException("unknown type '" + name
+ + "' - unknown language '"
+ + lang + '\'');
+
+ type = interp.getNamedType(name.substring(colon + 1));
+
+ if (type != null)
+ types.put(name, type);
+ }
+
+// if (type == null
+// && (name.startsWith("elisp:") || name.startsWith("clisp:")))
+// {
+// int colon = name.indexOf(':');
+// Class clas = getNamedLispType(name.substring(colon+1)).getReflectClass();
+// String lang = name.substring(0,colon);
+// Language interp = Language.getInstance(lang);
+// if (interp == null)
+// throw new RuntimeException("unknown type '" + name
+// + "' - unknown language '"
+// + lang + '\'');
+// type = interp.getTypeFor(clas);
+// if (type != null)
+// types.put(name, type);
+// }
+ return type;
+ }
+
+ public Type getTypeFor (Class clas)
+ {
+ String name = clas.getName();
+ if (clas.isPrimitive())
+ return getNamedLispType(name);
+ if ("java.lang.String".equals(name))
+ return Type.toStringType;
+ if ("gnu.math.IntNum".equals(name))
+ return LangObjType.integerType;
+ if ("gnu.math.DFloNum".equals(name))
+ return LangObjType.dflonumType;
+ if ("gnu.math.RatNum".equals(name))
+ return LangObjType.rationalType;
+ if ("gnu.math.RealNum".equals(name))
+ return LangObjType.realType;
+ if ("gnu.math.Numeric".equals(name))
+ return LangObjType.numericType;
+ if ("gnu.lists.FVector".equals(name))
+ return LangObjType.vectorType;
+ if ("gnu.lists.LList".equals(name))
+ return LangObjType.listType;
+ if ("gnu.text.Path".equals(name))
+ return LangObjType.pathType;
+ if ("gnu.text.URIPath".equals(name))
+ return LangObjType.URIType;
+ if ("gnu.text.FilePath".equals(name))
+ return LangObjType.filepathType;
+ if ("java.lang.Class".equals(name))
+ return LangObjType.typeClass;
+ if ("gnu.bytecode.Type".equals(name))
+ return LangObjType.typeType;
+ if ("gnu.bytecode.ClassType".equals(name))
+ return LangObjType.typeClassType;
+ return Type.make(clas);
+ }
+
public Declaration declFromField (ModuleExp mod, Object fvalue, Field fld)
{
Declaration fdecl = super.declFromField(mod, fvalue, fld);