Changeset 4199
- Timestamp:
- 10/05/03 15:09:25 (19 years ago)
- Location:
- trunk/j/src/org/armedbear/lisp
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/j/src/org/armedbear/lisp/Lisp.java
r4179 r4199 3 3 * 4 4 * Copyright (C) 2002-2003 Peter Graves 5 * $Id: Lisp.java,v 1.16 1 2003-10-03 00:23:41 piso Exp $5 * $Id: Lisp.java,v 1.162 2003-10-05 15:09:01 piso Exp $ 6 6 * 7 7 * This program is free software; you can redistribute it and/or … … 264 264 private static boolean debug = false; 265 265 266 private static final Primitive1 INTERACTIVE_EVAL = 267 new Primitive1("interactive-eval", PACKAGE_SYS, false) 268 { 269 public LispObject execute(LispObject object) throws ConditionThrowable 270 { 271 final LispThread thread = LispThread.currentThread(); 272 final Environment environment = new Environment(); 273 Symbol.MINUS.setSymbolValue(object); 274 LispObject result; 275 try { 276 result = eval(object, environment, thread); 277 } 278 catch (StackOverflowError e) { 279 if (debug) { 280 Symbol savedBacktrace = intern("*SAVED-BACKTRACE*", PACKAGE_EXT); 281 savedBacktrace.setSymbolValue(thread.backtraceAsList(0)); 282 } 283 throw new ConditionThrowable(new LispError("stack overflow")); 284 } 285 catch (ConditionThrowable t) { 286 if (debug) { 287 Symbol savedBacktrace = intern("*SAVED-BACKTRACE*", PACKAGE_EXT); 288 savedBacktrace.setSymbolValue(thread.backtraceAsList(0)); 289 } 290 throw t; 291 } 292 Debug.assertTrue(result != null); 293 Symbol.STAR_STAR_STAR.setSymbolValue(Symbol.STAR_STAR.getSymbolValue()); 294 Symbol.STAR_STAR.setSymbolValue(Symbol.STAR.getSymbolValue()); 295 Symbol.STAR.setSymbolValue(result); 296 Symbol.PLUS_PLUS_PLUS.setSymbolValue(Symbol.PLUS_PLUS.getSymbolValue()); 297 Symbol.PLUS_PLUS.setSymbolValue(Symbol.PLUS.getSymbolValue()); 298 Symbol.PLUS.setSymbolValue(Symbol.MINUS.getSymbolValue()); 299 LispObject[] values = thread.getValues(); 300 Symbol.SLASH_SLASH_SLASH.setSymbolValue(Symbol.SLASH_SLASH.getSymbolValue()); 301 Symbol.SLASH_SLASH.setSymbolValue(Symbol.SLASH.getSymbolValue()); 302 if (values != null) { 303 LispObject slash = NIL; 304 for (int i = values.length; i-- > 0;) 305 slash = new Cons(values[i], slash); 306 Symbol.SLASH.setSymbolValue(slash); 307 } else { 308 Symbol.SLASH.setSymbolValue(new Cons(result)); 309 } 310 return result; 311 } 312 }; 313 266 314 public static final LispObject eval(final LispObject obj, 267 315 final Environment env, … … 269 317 throws ConditionThrowable 270 318 { 271 try { 272 thread.clearValues(); 273 if (thread.isDestroyed()) 274 throw new ThreadDestroyed(); 275 if (obj instanceof Symbol) { 276 LispObject result = null; 277 if (obj.isSpecialVariable()) { 278 result = thread.lookupSpecial(obj); 319 thread.clearValues(); 320 if (thread.isDestroyed()) 321 throw new ThreadDestroyed(); 322 if (obj instanceof Symbol) { 323 LispObject result = null; 324 if (obj.isSpecialVariable()) { 325 result = thread.lookupSpecial(obj); 326 } else 327 result = env.lookup(obj); 328 if (result == null) { 329 result = obj.getSymbolValue(); 330 if (result == null) 331 throw new ConditionThrowable(new UnboundVariable(obj)); 332 } 333 return result; 334 } else if (obj instanceof Cons) { 335 LispObject first = obj.car(); 336 if (first instanceof Symbol) { 337 LispObject fun = env.lookupFunctional(first); 338 if (fun == null) 339 throw new ConditionThrowable(new UndefinedFunction(first)); 340 switch (fun.getFunctionalType()) { 341 case FTYPE_SPECIAL_OPERATOR: { 342 if (profiling) 343 fun.incrementCallCount(); 344 // Don't eval args! 345 return fun.execute(obj.cdr(), env); 346 } 347 case FTYPE_MACRO: 348 return eval(macroexpand(obj, env, thread), env, thread); 349 case FTYPE_AUTOLOAD: { 350 Autoload autoload = (Autoload) fun; 351 autoload.load(); 352 return eval(obj, env, thread); 353 } 354 default: { 355 if (debug) 356 return funcall(fun, 357 evalList(obj.cdr(), env, thread), 358 thread); 359 if (profiling) 360 fun.incrementCallCount(); 361 LispObject args = obj.cdr(); 362 if (args == NIL) 363 return fun.execute(); 364 LispObject arg1 = args.car(); 365 args = args.cdr(); 366 if (args == NIL) 367 return fun.execute(thread.value(eval(arg1, env, thread))); 368 LispObject arg2 = args.car(); 369 args = args.cdr(); 370 if (args == NIL) 371 return fun.execute(eval(arg1, env, thread), 372 thread.value(eval(arg2, env, thread))); 373 LispObject arg3 = args.car(); 374 args = args.cdr(); 375 if (args == NIL) 376 return fun.execute(eval(arg1, env, thread), 377 eval(arg2, env, thread), 378 thread.value(eval(arg3, env, thread))); 379 // More than 3 arguments. 380 final int length = args.length() + 3; 381 LispObject[] results = new LispObject[length]; 382 results[0] = eval(arg1, env, thread); 383 results[1] = eval(arg2, env, thread); 384 results[2] = eval(arg3, env, thread); 385 for (int i = 3; i < length; i++) { 386 results[i] = eval(args.car(), env, thread); 387 args = args.cdr(); 388 } 389 thread.clearValues(); 390 return fun.execute(results); 391 } 392 } 393 } else { 394 LispObject args = obj.cdr(); 395 if (!args.listp()) 396 throw new ConditionThrowable(new TypeError(args, "list")); 397 LispObject funcar = first.car(); 398 LispObject rest = first.cdr(); 399 Symbol symbol = checkSymbol(funcar); 400 if (symbol == Symbol.LAMBDA) { 401 Closure closure = new Closure(rest.car(), rest.cdr(), env); 402 return closure.execute(evalList(args, env, thread)); 279 403 } else 280 result = env.lookup(obj); 281 if (result == null) { 282 result = obj.getSymbolValue(); 283 if (result == null) 284 throw new ConditionThrowable(new UnboundVariable(obj)); 285 } 286 return result; 287 } else if (obj instanceof Cons) { 288 LispObject first = obj.car(); 289 if (first instanceof Symbol) { 290 LispObject fun = env.lookupFunctional(first); 291 if (fun == null) 292 throw new ConditionThrowable(new UndefinedFunction(first)); 293 switch (fun.getFunctionalType()) { 294 case FTYPE_SPECIAL_OPERATOR: { 295 if (profiling) 296 fun.incrementCallCount(); 297 // Don't eval args! 298 return fun.execute(obj.cdr(), env); 299 } 300 case FTYPE_MACRO: 301 return eval(macroexpand(obj, env, thread), env, thread); 302 case FTYPE_AUTOLOAD: { 303 Autoload autoload = (Autoload) fun; 304 autoload.load(); 305 return eval(obj, env, thread); 306 } 307 default: { 308 if (debug) 309 return funcall(fun, 310 evalList(obj.cdr(), env, thread), 311 thread); 312 if (profiling) 313 fun.incrementCallCount(); 314 LispObject args = obj.cdr(); 315 if (args == NIL) 316 return fun.execute(); 317 LispObject arg1 = args.car(); 318 args = args.cdr(); 319 if (args == NIL) 320 return fun.execute(thread.value(eval(arg1, env, thread))); 321 LispObject arg2 = args.car(); 322 args = args.cdr(); 323 if (args == NIL) 324 return fun.execute(eval(arg1, env, thread), 325 thread.value(eval(arg2, env, thread))); 326 LispObject arg3 = args.car(); 327 args = args.cdr(); 328 if (args == NIL) 329 return fun.execute(eval(arg1, env, thread), 330 eval(arg2, env, thread), 331 thread.value(eval(arg3, env, thread))); 332 // More than 3 arguments. 333 final int length = args.length() + 3; 334 LispObject[] results = new LispObject[length]; 335 results[0] = eval(arg1, env, thread); 336 results[1] = eval(arg2, env, thread); 337 results[2] = eval(arg3, env, thread); 338 for (int i = 3; i < length; i++) { 339 results[i] = eval(args.car(), env, thread); 340 args = args.cdr(); 341 } 342 thread.clearValues(); 343 return fun.execute(results); 344 } 345 } 346 } else { 347 LispObject args = obj.cdr(); 348 if (!args.listp()) 349 throw new ConditionThrowable(new TypeError(args, "list")); 350 LispObject funcar = first.car(); 351 LispObject rest = first.cdr(); 352 Symbol symbol = checkSymbol(funcar); 353 if (symbol == Symbol.LAMBDA) { 354 Closure closure = new Closure(rest.car(), rest.cdr(), env); 355 return closure.execute(evalList(args, env, thread)); 356 } else 357 throw new ConditionThrowable(new ProgramError("illegal function object: " + first)); 358 } 359 } else 360 return obj; 361 } 362 catch (StackOverflowError e) { 363 if (debug) { 364 Symbol savedBacktrace = intern("*SAVED-BACKTRACE*", PACKAGE_EXT); 365 savedBacktrace.setSymbolValue(thread.backtraceAsList(0)); 404 throw new ConditionThrowable(new ProgramError("illegal function object: " + first)); 366 405 } 367 throw new ConditionThrowable(new LispError("stack overflow")); 368 } 369 catch (ConditionThrowable t) { 370 if (debug) { 371 Symbol savedBacktrace = intern("*SAVED-BACKTRACE*", PACKAGE_EXT); 372 savedBacktrace.setSymbolValue(thread.backtraceAsList(0)); 373 } 374 throw t; 375 } 406 } else 407 return obj; 376 408 } 377 409 -
trunk/j/src/org/armedbear/lisp/top-level.lisp
r4198 r4199 2 2 ;;; 3 3 ;;; Copyright (C) 2003 Peter Graves 4 ;;; $Id: top-level.lisp,v 1. 4 2003-10-05 01:22:11piso Exp $4 ;;; $Id: top-level.lisp,v 1.5 2003-10-05 15:09:25 piso Exp $ 5 5 ;;; 6 6 ;;; This program is free software; you can redistribute it and/or … … 225 225 (defparameter *repl-read-form-fun* #'repl-read-form-fun) 226 226 227 (defun interactive-eval (form)228 (setf - form)229 (let ((results (multiple-value-list (eval form))))230 (setf /// //231 // /232 / results233 *** **234 ** *235 * (car results)))236 (setf +++ ++237 ++ +238 + -)239 (values-list /))240 241 227 (defun repl () 242 228 (loop … … 246 232 *standard-input* 247 233 *standard-output*)) 248 (results (multiple-value-list ( interactive-eval form))))234 (results (multiple-value-list (sys::interactive-eval form)))) 249 235 (dolist (result results) 250 236 (fresh-line)
Note: See TracChangeset
for help on using the changeset viewer.