Changeset 14543
- Timestamp:
- 06/16/13 09:17:21 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
r14445 r14543 42 42 (require "JAVA") 43 43 44 (proclaim '(optimize speed)) 44 45 45 46 (defun generate-inline-expansion (name lambda-list body … … 445 446 (defun p1-body (body) 446 447 (declare (optimize speed)) 447 (loop for form in body 448 collect (p1 form))) 448 (loop 449 for form in body 450 for processed-form = (p1 form) 451 collect processed-form 452 while (not (and (consp processed-form) 453 (memq (car processed-form) '(GO RETURN-FROM THROW)))))) 449 454 450 455 (defknown p1-default (t) t) 451 456 (declaim (inline p1-default)) 452 457 (defun p1-default (form) 453 (cons (car form) (p1-body (cdr form)))) 458 (declare (optimize speed)) 459 (cons (car form) (loop for f in (cdr form) collect (p1 f)))) 454 460 455 461 (defun let/let*-variables (block bindings) … … 635 641 (block (make-synchronized-node)) 636 642 (*block* block) 637 (*blocks* (cons block *blocks*)) 638 result) 639 (dolist (subform body) 640 (let ((op (and (consp subform) (%car subform)))) 641 (push (p1 subform) result) 642 (when (memq op '(GO RETURN-FROM THROW)) 643 (return)))) 643 (*blocks* (cons block *blocks*))) 644 644 (setf (synchronized-form block) 645 645 (list* 'threads:synchronized-on synchronized-object 646 ( nreverse result)))646 (p1-body body))) 647 647 block)) 648 648 649 649 650 (defun p1-unwind-protect (form)
Note: See TracChangeset
for help on using the changeset viewer.