1 // Copyright (c) 2001, 2004, 2005, 2012 Per M.A. Bothner 2 // This is free software; for terms and warranty disclaimer see ./COPYING. 3 4 package gnu.kawa.lispexpr; 5 import gnu.expr.*; 6 import gnu.mapping.*; 7 import gnu.lists.*; 8 import gnu.bytecode.*; 9 import gnu.mapping.EnvironmentKey; 10 import gnu.kawa.io.InPort; 11 import gnu.kawa.io.TtyInPort; 12 import gnu.kawa.reflect.StaticFieldLocation; 13 import gnu.text.Lexer; 14 import gnu.text.SourceMessages; 15 import java.util.HashMap; 16 import kawa.lang.Translator; // FIXME 17 import kawa.lang.Syntax; // FIXME 18 19 /** Language sub-class for Lisp-like languages (including Scheme). */ 20 21 public abstract class LispLanguage extends Language 22 { 23 static public final String quote_str = "quote"; 24 static public final String unquote_str = "unquote"; 25 static public final String unquotesplicing_str = "unquote-splicing"; 26 static public final String quasiquote_str = "quasiquote"; 27 public static final Symbol quasiquote_sym = 28 Namespace.EmptyNamespace.getSymbol(quasiquote_str); 29 public static final SimpleSymbol dots3_sym = Symbol.valueOf("..."); 30 static public final String splice_str = "$splice$"; 31 static public final Symbol splice_sym = Namespace.EmptyNamespace.getSymbol(splice_str); 32 static public final String splice_colon_str = "$splice-colon$"; 33 static public final Symbol splice_colon_sym = Namespace.EmptyNamespace.getSymbol(splice_colon_str); 34 /** Used for Kawa infix ':' operator. */ 35 static public final Symbol lookup_sym = Namespace.EmptyNamespace.getSymbol("$lookup$"); 36 // FUTURE: Used for: [ e1 e2 ... ] 37 // for future sequence/list constructors. 38 static public final Symbol bracket_list_sym = Namespace.EmptyNamespace.getSymbol("$bracket-list$"); 39 // FUTURE: Used for: name[ e1 e2 ... ] 40 // Needed for array types - e.g. Object[] 41 // and (possible future) parameterized types - e.g. java.util.List[integer] 42 static public final Symbol bracket_apply_sym = Namespace.EmptyNamespace.getSymbol("$bracket-apply$"); 43 44 public static StaticFieldLocation getNamedPartLocation = 45 new StaticFieldLocation("gnu.kawa.functions.GetNamedPart", "getNamedPart"); getNamedPartLocation.setProcedure()46 static { getNamedPartLocation.setProcedure(); } 47 48 /** 49 * The unit namespace contains the bindings for symbols such as `cm', 50 * `s', etc. 51 */ 52 public static final Namespace unitNamespace = 53 Namespace.valueOf("http://kawa.gnu.org/unit", "unit"); 54 55 public static final Namespace constructNamespace = 56 Namespace.valueOf("http://kawa.gnu.org/construct", "$construct$"); 57 58 public static final Namespace entityNamespace = 59 Namespace.valueOf("http://kawa.gnu.org/entity", "$entity$"); 60 61 /** The default <code>ReadTable</code> for this language. */ 62 protected ReadTable defaultReadTable; 63 64 /** Create a fresh <code>ReadTable</code> appropriate for this language. */ createReadTable()65 public abstract ReadTable createReadTable (); 66 getLexer(InPort inp, SourceMessages messages)67 public LispReader getLexer(InPort inp, SourceMessages messages) 68 { 69 return new LispReader(inp, messages); 70 } 71 getCompilationClass()72 public String getCompilationClass () { return "kawa.lang.Translator"; } 73 parse(Compilation comp, int options)74 public boolean parse (Compilation comp, int options) 75 throws java.io.IOException, gnu.text.SyntaxException 76 { 77 kawa.lang.Translator tr = (kawa.lang.Translator) comp; 78 Lexer lexer = tr.lexer; 79 ModuleExp mexp = tr.getModule(); 80 LispReader reader = (LispReader) lexer; 81 Compilation saveComp = Compilation.setSaveCurrent(tr); 82 InPort in = reader == null ? null : reader.getPort(); 83 if (in instanceof TtyInPort) 84 ((TtyInPort) in).resetAndKeep(); 85 try 86 { 87 if (tr.pendingForm != null) 88 { 89 tr.scanForm(tr.pendingForm, mexp); 90 tr.pendingForm = null; 91 } 92 for (;;) 93 { 94 if (reader == null) 95 break; 96 Object sexp = reader.readCommand(); 97 // A literal unquoted #!eof 98 if (Translator.listLength(sexp) == 2 99 && Translator.safeCar(sexp) == kawa.standard.begin.begin 100 && Translator.safeCar(Translator.safeCdr(sexp)) == Sequence.eofValue 101 && (options & (PARSE_ONE_LINE|PARSE_INTERACTIVE_MODULE)) != 0) { 102 return false; 103 } 104 if (sexp == Sequence.eofValue) 105 { 106 if ((options & PARSE_ONE_LINE) != 0) 107 return false; // FIXME 108 break; 109 } 110 int ch; 111 do { ch = lexer.read(); } 112 while (ch == ' ' || ch == '\t'|| ch == '\r'); 113 if (ch == ')') 114 lexer.fatal("An unexpected close paren was read."); 115 if (ch != '\n') 116 lexer.unread(ch); 117 tr.scanForm(sexp, mexp); 118 if ((options & PARSE_ONE_LINE) != 0) 119 { 120 // In a REPL we want to read all the forms until EOL. 121 // One reason is in case an expression reads from stdin, 122 // in which case we want to separate that. 123 // Another reason to be consistent when a UI gives 124 // a multi-line block. 125 if (ch < 0 || ch == '\n' || ! lexer.isInteractive()) 126 break; 127 } 128 else if ((options & PARSE_PROLOG) != 0 129 && tr.getState() >= Compilation.PROLOG_PARSED) 130 { 131 return true; 132 } 133 } 134 135 // Must be done before any other module imports this module. 136 tr.finishModule(mexp); 137 138 tr.setState(Compilation.BODY_PARSED); 139 } 140 finally 141 { 142 if (in instanceof TtyInPort) 143 ((TtyInPort) in).setKeepAll(false); 144 Compilation.restoreCurrent(saveComp); 145 } 146 return true; 147 } 148 149 /** Resolve names and other post-parsing processing. */ resolve(Compilation comp)150 public void resolve (Compilation comp) 151 { 152 Translator tr = (Translator) comp; 153 ModuleExp mexp = tr.getModule(); 154 tr.resolveModule(mexp); 155 if (tr.subModuleMap != null && tr.mainClass != null) { 156 String mainName = tr.mainClass.getName(); 157 ModuleInfo subinfo = tr.subModuleMap.get(mainName); 158 if (subinfo != null 159 && ! (mexp.body == QuoteExp.voidExp && mexp.firstDecl() == null)) { 160 ModuleExp submodule = subinfo.getModuleExpRaw(); 161 tr.error('e', "module has both statements and a submodule with the same name: "+tr.mainClass.getName(), 162 submodule != null ? submodule : mexp); 163 } 164 } 165 } 166 declFromField(ModuleExp mod, Object fvalue, Field fld)167 public Declaration declFromField (ModuleExp mod, Object fvalue, Field fld) 168 { 169 Declaration fdecl = super.declFromField(mod, fvalue, fld); 170 boolean isFinal = (fld.getModifiers() & Access.FINAL) != 0; 171 if (isFinal && fvalue instanceof Syntax) // FIXME - should check type? not value? 172 fdecl.setSyntax(); 173 return fdecl; 174 } 175 176 /** Declare in the current Environment a Syntax bound to a static field. 177 * @param name the procedure's source-level name. 178 * @param cname the name of the class containing the field. 179 * @param fname the name of the field, which should be a static 180 * final field whose type extends kawa.lang.Syntax. 181 */ defSntxStFld(String name, String cname, String fname)182 protected void defSntxStFld(String name, String cname, String fname) 183 { 184 Object property 185 = hasSeparateFunctionNamespace() ? EnvironmentKey.FUNCTION : null; 186 StaticFieldLocation loc = 187 StaticFieldLocation.define(environ, environ.getSymbol(name), property, 188 cname, fname); 189 loc.setSyntax(); 190 } 191 defSntxStFld(String name, String cname)192 protected void defSntxStFld(String name, String cname) 193 { 194 defSntxStFld(name, cname, Mangling.mangleField(name)); 195 } 196 197 /** 198 * Are keywords self-evaluating? 199 * True in CommonLisp. Used to be true for Scheme also, but now 200 * in Scheme literal keywords should only be used for keyword arguments; 201 * if you want a Keyword value if should be quoted. 202 * @return true if we should treat keywords as self-evaluating. 203 */ keywordsAreSelfEvaluating()204 public boolean keywordsAreSelfEvaluating() { return true; } 205 selfEvaluatingSymbol(Object obj)206 public boolean selfEvaluatingSymbol (Object obj) 207 { 208 // FUTURE: return keywordsAreSelfEvaluating() && obj instanceof Keyword; 209 return obj instanceof Keyword; 210 } 211 212 /** Convert the Language's idea of a symbol to a gnu.mapping.Symbol. */ langSymbolToSymbol(Object sym)213 public static Symbol langSymbolToSymbol (Object sym) 214 { 215 return ((LispLanguage) Language.getDefaultLanguage()).fromLangSymbol(sym); 216 } 217 fromLangSymbol(Object sym)218 protected Symbol fromLangSymbol (Object sym) 219 { 220 if (sym instanceof String) 221 return getSymbol((String) sym); 222 return (Symbol) sym; 223 } 224 225 /** The types common to Lisp-like languages. */ 226 private HashMap<String,Type> types; 227 /** The string representations of Lisp-like types. */ 228 private HashMap<Type,String> typeToStringMap; 229 getTypeMap()230 protected synchronized HashMap<String, Type> getTypeMap () { 231 if (types == null) { 232 types = new HashMap<String, Type>(64); // Plently of space. 233 types.put("void", LangPrimType.voidType); 234 types.put("int", LangPrimType.intType); 235 types.put("char", LangPrimType.charType); 236 types.put("character", LangPrimType.characterType); 237 types.put("character-or-eof", LangPrimType.characterOrEofType); 238 239 types.put("byte", LangPrimType.byteType); 240 types.put("short", LangPrimType.shortType); 241 types.put("long", LangPrimType.longType); 242 types.put("float", LangPrimType.floatType); 243 types.put("double", LangPrimType.doubleType); 244 types.put("ubyte", LangPrimType.unsignedByteType); 245 types.put("ushort", LangPrimType.unsignedShortType); 246 types.put("uint", LangPrimType.unsignedIntType); 247 types.put("ulong", LangPrimType.unsignedLongType); 248 types.put("never-returns", Type.neverReturnsType); 249 250 types.put("dynamic", LangObjType.dynamicType); 251 types.put("Object", Type.objectType); 252 types.put("String", Type.toStringType); 253 types.put("arglist", LangObjType.argListType); 254 types.put("argvector", LangObjType.argVectorType); 255 types.put("object", Type.objectType); 256 types.put("number", LangObjType.numericType); 257 types.put("quantity", ClassType.make("gnu.math.Quantity")); 258 types.put("complex", ClassType.make("gnu.math.Complex")); 259 types.put("real", LangObjType.realType); 260 types.put("rational", LangObjType.rationalType); 261 types.put("integer", LangObjType.integerType); 262 types.put("symbol", ClassType.make("gnu.mapping.Symbol")); 263 types.put("simple-symbol", ClassType.make("gnu.mapping.SimpleSymbol")); 264 types.put("namespace", ClassType.make("gnu.mapping.Namespace")); 265 types.put("keyword", ClassType.make("gnu.expr.Keyword")); 266 types.put("pair", ClassType.make("gnu.lists.Pair")); 267 types.put("pair-with-position", 268 ClassType.make("gnu.lists.PairWithPosition")); 269 // FIXME should be UNION(java.lang.String, gnu.lists.IString) 270 types.put("constant-string", ClassType.make("java.lang.CharSequence")); 271 types.put("abstract-string", ClassType.make("gnu.lists.CharSeq")); 272 types.put("vector", LangObjType.vectorType); 273 types.put("gvector", LangObjType.gvectorType); 274 types.put("string", LangObjType.stringType); 275 types.put("empty-list", ClassType.make("gnu.lists.EmptyList")); 276 types.put("sequence", LangObjType.sequenceType); 277 types.put("list", LangObjType.listType); 278 types.put("function", ClassType.make("gnu.mapping.Procedure")); 279 types.put("procedure", LangObjType.procedureType); 280 types.put("input-port", ClassType.make("gnu.kawa.io.InPort")); 281 types.put("output-port", ClassType.make("gnu.kawa.io.OutPort")); 282 types.put("string-output-port", 283 ClassType.make("gnu.kawa.io.CharArrayOutPort")); 284 types.put("string-input-port", 285 ClassType.make("gnu.kawa.io.CharArrayInPort")); 286 types.put("record", ClassType.make("kawa.lang.Record")); 287 types.put("type", LangObjType.typeType); 288 types.put("class-type", LangObjType.typeClassType); 289 types.put("class", LangObjType.typeClass); 290 types.put("promise", LangObjType.promiseType); 291 types.put("document", ClassType.make("gnu.kawa.xml.KDocument")); 292 types.put("readtable", 293 ClassType.make("gnu.kawa.lispexpr.ReadTable")); 294 types.put("string-cursor", LangPrimType.stringCursorType); 295 } 296 return types; 297 } 298 299 /** 300 * Try to get a type of the form lang:type. 301 * 302 * E.g. elisp:buffer. 303 * 304 * @param name The package-style type name as a string. 305 * @return null if no such type could be found, or the corresponding 306 * {@code Type}. 307 */ getPackageStyleType(String name)308 public Type getPackageStyleType(String name) { 309 int colon = name.indexOf(':'); 310 311 if (colon > 0) { 312 String lang = name.substring(0, colon); 313 Language interp = Language.getInstance(lang); 314 if (interp == null) 315 throw new RuntimeException("unknown type '" + name 316 + "' - unknown language '" + lang + '\''); 317 318 Type type = interp.getNamedType(name.substring(colon + 1)); 319 320 if (type != null) 321 types.put(name, type); 322 return type; 323 } 324 return null; 325 } 326 decodeArrayType(String name)327 public static Type decodeArrayType(String name) { 328 int nlen = name.length(); 329 if (nlen == 5) 330 return GenArrayType.generalInstance; 331 try { 332 int rank = Integer.parseInt(name.substring(5)); 333 if (rank >= 0) 334 return new GenArrayType(rank, Type.objectType); 335 } catch (Throwable ex) { 336 } 337 return null; 338 } 339 340 @Override 341 // FIXME: getNamedType is over-specialised.... getNamedType(String name)342 public Type getNamedType (String name) { 343 // Initialise the type map if necessary. 344 Type type = getTypeMap().get(name); 345 if (type == null && name.startsWith("array")) 346 return decodeArrayType(name); 347 return (type != null) ? type : getPackageStyleType(name); 348 } 349 getTypeFor(Object spec, boolean lenient)350 public Type getTypeFor (Object spec, boolean lenient) { 351 if (spec == String.class) 352 return LangObjType.jstringType; 353 else 354 return super.getTypeFor(spec, lenient); 355 } 356 getTypeFor(Class clas)357 public Type getTypeFor(Class clas) { 358 String name = clas.getName(); 359 if (clas.isPrimitive()) 360 return getNamedType(name); 361 if (clas.isArray()) 362 return ArrayType.make(getTypeFor(clas.getComponentType())); 363 /* #ifdef JAVA7 */ 364 ; // FIXME - FUTURE: Use a switch with string keys. 365 /* #endif */ 366 if ("java.lang.String".equals(name)) // ??? 367 return LangObjType.jstringType; 368 Type t = LangObjType.getInstanceFromClass(name); 369 if (t != null) 370 return t; 371 return super.getTypeFor(clas); 372 } 373 374 @Override getPrimaryPrompt()375 public String getPrimaryPrompt() { return "#|kawa:%N|# "; } 376 377 @Override getSecondaryPrompt()378 public String getSecondaryPrompt() { return "#|%P.%N|# "; } 379 } 380