X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Ftime.lisp;h=98a6b898de327de01db40ef6dbf39970a243700b;hb=f7808fb1c49b729d00580321b3f8457ce4b84cf4;hp=6cd2be2a12f8f7bb2fdf1123d91aa1b9aaec8ec5;hpb=81ce38f2e03e4f569d7a95bb18efb25bb16fc269;p=sbcl.git diff --git a/src/pcl/time.lisp b/src/pcl/time.lisp index 6cd2be2..98a6b89 100644 --- a/src/pcl/time.lisp +++ b/src/pcl/time.lisp @@ -22,7 +22,7 @@ '(time-slot-value m 'plist 10000)) *tests*) (push (cons "Time unoptimized slot-value. This is case (1) from notes.text. (standard)" - '(time-slot-value m 'generic-function 10000)) + '(time-slot-value m '%generic-function 10000)) *tests*) (push (cons "Time unoptimized slot-value. This is case (1) from notes.text. (structure)" '(time-slot-value str 'slot 10000)) @@ -34,7 +34,7 @@ '(time-slot-value-function m 10000)) *tests*) (defun time-slot-value-function (object n) - (time (dotimes-fixnum (i n) (slot-value object 'function)))) + (time (dotimes-fixnum (i n) (slot-value object '%function)))) (push (cons "Time optimized slot-value outside of a defmethod. Case (2). (structure)" '(time-slot-value-slot str 10000)) @@ -75,8 +75,8 @@ (push (cons "Time default-initargs." '(time-default-initargs (find-class 'plist-mixin) 1000)) *tests*) -(defun time-default-initargs (class n) - (time (dotimes-fixnum (i n) (default-initargs class nil)))) +(defun time-default-initargs (n) + (time (dotimes-fixnum (i n) (default-initargs nil nil)))) (push (cons "Time make-instance." '(time-make-instance (find-class 'plist-mixin) 1000)) @@ -99,12 +99,8 @@ (defun expand-all-macros (form) (walk-form form nil (lambda (form context env) - (if (and (eq context :eval) - (consp form) - (symbolp (car form)) - (not (special-form-p (car form))) - (macro-function (car form))) - (values (macroexpand form env)) + (if (eq context :eval) + (values (%macroexpand form env)) form)))) (push (cons "Macroexpand meth-structure-slot-value" @@ -129,14 +125,14 @@ '(pprint (expand-all-macros (expand-defmethod-internal 'meth-standard-slot-value nil '((object standard-method)) - '((lambda () (slot-value object 'function))) + '((lambda () (slot-value object '%function))) nil)))) *tests*) (push (cons "Show code for slot-value inside a defmethod for a standard-class. Case (4)." '(disassemble (meth-standard-slot-value m))) *tests*) (defmethod meth-standard-slot-value ((object standard-method)) - (lambda () (slot-value object 'function))) + (lambda () (slot-value object '%function))) ||# (defun run-tests ()