diff --git a/base/lists.lisp b/base/lists.lisp index 48ed26e6cd1e62a1a7247c9e58594f54f6b113a7..dd6edf789b217b3d1c377c30524d9c7649aa6853 100644 --- a/base/lists.lisp +++ b/base/lists.lisp @@ -66,7 +66,7 @@ returning the two lists of the values returned by the function." :with link = head :for tail :on list :for elt :in list - :for i :below n :do + :count n :do (let ((cons (cons elt nil))) (rplacd link cons) (setf link cons)) diff --git a/base/macros.lisp b/base/macros.lisp index bc539f36663af56863c62129d879c577708a218a..9c34ead7a7a48bc53fbb8dc393879b723aa59f57 100644 --- a/base/macros.lisp +++ b/base/macros.lisp @@ -230,7 +230,7 @@ outputs a tag plus a list of variable and their values, returns the last value" ;"if not in debugging mode, just compute and return last value" ; #-do-test (declare (ignore tag)) #-do-test (car (last exprs)) #+do-test (let ((res (gensym))(f (gensym))) - `(let ((,res)) + `(let (,res (*print-readably* nil)) (flet ((,f (fmt &rest args) (apply #'format *error-output* fmt args))) (,f "~&~A~%" ,tag) ,@(mapcan diff --git a/base/streams.lisp b/base/streams.lisp index f05003c0ba4c1f819ca3a60717eb931e624fb6cc..6f8c2143eb58197017c188fb429ae4ddd1130d36 100644 --- a/base/streams.lisp +++ b/base/streams.lisp @@ -16,14 +16,18 @@ Otherwise, signal an error.") (with-output-to-string (s) (funcall thunk s))) (:method ((x (eql t)) thunk) (funcall thunk *standard-output*) nil) + #-genera (:method ((x stream) thunk) (funcall thunk x) nil) (:method ((x string) thunk) (assert (fill-pointer x)) (with-output-to-string (s x) (funcall thunk s))) (:method (x thunk) - (declare (ignore thunk)) - (error "not a valid stream designator ~S" x))) + (declare (ignorable thunk)) + (cond + #+genera + ((typep x 'stream) (funcall thunk x) nil) + (t (error "not a valid stream designator ~S" x))))) (def*macro with-output ((x &optional (value x)) &body body) `(call-with-output ,value #'(lambda (,x) ,@body))) @@ -58,4 +62,4 @@ Otherwise, signal an error.") (funcall fun o)))) (def*macro with-user-output-file ((s f) &body body) - `(call-with-user-output-file ,f (lambda (,s) ,@body))) + `(call-with-user-output-file ,f #'(lambda (,s) ,@body))) diff --git a/filesystem/atomic.lisp b/filesystem/atomic.lisp index 2c7dafd2924408e3fc585f376ee6ed50e90dc709..957c49c29e3dd7a4bc1b92823c5cb7c9a8e1b6e9 100644 --- a/filesystem/atomic.lisp +++ b/filesystem/atomic.lisp @@ -38,7 +38,7 @@ (defmacro with-atomic-file-creation ((s filename &optional tmpname) &body body) "create some file contents and atomically commit them to file when they are complete" - `(call-with-atomic-file-creation (lambda (,s) ,@body) ,filename ,tmpname)) + `(call-with-atomic-file-creation #'(lambda (,s) ,@body) ,filename ,tmpname)) #| There is still a small race condition, since there is a small moment just after the file is opened that we don't have protection against async signals; diff --git a/interface/eq.lisp b/interface/eq.lisp index a5380671f20f9bccafc04fafcdf4bcb03ce9a868..a6744f95abb02dfbf73ffdcc3db0357e40d48f41 100644 --- a/interface/eq.lisp +++ b/interface/eq.lisp @@ -30,7 +30,7 @@ (defclass <eq-simple> (<eq>) ()) (defmethod test-function ((i <eq-simple>)) - (lambda (x y) (== i x y))) + #'(lambda (x y) (== i x y))) (defclass <eq-slot> (<eq>) ((test :initform #'eql :initarg :test :reader test-function))) diff --git a/molicle/evaluation-time.lisp b/molicle/evaluation-time.lisp index 15329b836f082b6ac577f8eb31e63523f0b0d9b0..24abb43c0a912c3e79ded28cb024007238392ed1 100644 --- a/molicle/evaluation-time.lisp +++ b/molicle/evaluation-time.lisp @@ -41,7 +41,7 @@ (funcall thunk))) (defmacro with-evaluation-time ((time) &body body) - `(call-with-evaluation-time ,time (lambda () ,@body))) + `(call-with-evaluation-time ,time #'(lambda () ,@body))) (defmacro initialize-evaluation-time () (check-evaluation-time +coffee-time+) diff --git a/pure/alist.lisp b/pure/alist.lisp index b3504c88e480fb83276ac9bb51b36008eff9bf2a..15f1f4a7800f1a850715e69eb4ec7cb3a85537e5 100644 --- a/pure/alist.lisp +++ b/pure/alist.lisp @@ -56,11 +56,11 @@ (values (caar map) (cdar map) (not (null map)))) (defmethod fold-left ((i <alist>) map f seed) - (reduce (lambda (acc pair) (funcall f acc (car pair) (cdr pair))) + (reduce #'(lambda (acc pair) (funcall f acc (car pair) (cdr pair))) map :initial-value seed)) (defmethod fold-right ((i <alist>) map f seed) - (reduce (lambda (pair acc) (funcall f (car pair) (cdr pair) acc)) + (reduce #'(lambda (pair acc) (funcall f (car pair) (cdr pair) acc)) map :initial-value seed :from-end t)) (defmethod for-each ((i <alist>) map f) diff --git a/pure/encoded-key-map.lisp b/pure/encoded-key-map.lisp index 76075684e4c90ade6f1a45ecfe329ea56cb5cc15..93cd80237ca7e0bb05cc00a7a5b7beb9f81ac218 100644 --- a/pure/encoded-key-map.lisp +++ b/pure/encoded-key-map.lisp @@ -53,11 +53,11 @@ (defmethod decons ((i <encoded-key-map>) map) (mkvf (decons (bi) map))) (defmethod fold-left ((i <encoded-key-map>) map f seed) - (fold-left (bi) map (lambda (acc k v) (funcall f acc (decode-key i k) v)) seed)) + (fold-left (bi) map #'(lambda (acc k v) (funcall f acc (decode-key i k) v)) seed)) (defmethod fold-right ((i <encoded-key-map>) map f seed) - (fold-right (bi) map (lambda (k v acc) (funcall f (decode-key i k) v acc)) seed)) + (fold-right (bi) map #'(lambda (k v acc) (funcall f (decode-key i k) v acc)) seed)) (defmethod for-each ((i <encoded-key-map>) map f) - (for-each (bi) map (lambda (k v) (funcall f (decode-key i k) v)))) + (for-each (bi) map #'(lambda (k v) (funcall f (decode-key i k) v)))) (defmethod join ((i <encoded-key-map>) map1 map2) (join (bi) map1 map2)) (defmethod divide ((i <encoded-key-map>) map) @@ -71,8 +71,8 @@ (defmethod update-key ((i <encoded-key-map>) map key fun) (update-key (bi) map (encode-key i key) fun)) (defmethod map/2 ((i <encoded-key-map>) fun map1 map2) - (map/2 (bi) (lambda (k v1 f1 v2 f2) - (funcall fun (decode-key i k) v1 f1 v2 f2)) + (map/2 (bi) #'(lambda (k v1 f1 v2 f2) + (funcall fun (decode-key i k) v1 f1 v2 f2)) map1 map2))) (defclass <parametric-encoded-key-map> (<encoded-key-map>) diff --git a/pure/hash-table.lisp b/pure/hash-table.lisp index 582877aa51d9b375b5b36c1a901ee2a435580b28..e2ba068b735a903c8f389e8529e63e6b30083185 100644 --- a/pure/hash-table.lisp +++ b/pure/hash-table.lisp @@ -37,9 +37,9 @@ (check-invariant (hashmap-interface i) map) (for-each (hashmap-interface i) map - (lambda (hash bucket) - (declare (ignore hash)) - (check-invariant (bucketmap-interface i) bucket)))) + #'(lambda (hash bucket) + (declare (ignore hash)) + (check-invariant (bucketmap-interface i) bucket)))) (defmethod empty ((i <hash-table>)) (empty (hashmap-interface i))) @@ -102,24 +102,24 @@ (defmethod fold-left ((i <hash-table>) node f seed) (fold-left (hashmap-interface i) node - (lambda (a h bucket) - (declare (ignore h)) - (fold-left (bucketmap-interface i) bucket f a)) + #'(lambda (a h bucket) + (declare (ignore h)) + (fold-left (bucketmap-interface i) bucket f a)) seed)) (defmethod fold-right ((i <hash-table>) node f seed) (fold-right (hashmap-interface i) node - (lambda (h bucket a) - (declare (ignore h)) - (fold-right (bucketmap-interface i) bucket f a)) + #'(lambda (h bucket a) + (declare (ignore h)) + (fold-right (bucketmap-interface i) bucket f a)) seed)) (defmethod for-each ((i <hash-table>) map f) (for-each (hashmap-interface i) map - (lambda (hash bucket) - (declare (ignore hash)) - (for-each (bucketmap-interface i) bucket f)))) + #'(lambda (hash bucket) + (declare (ignore hash)) + (for-each (bucketmap-interface i) bucket f)))) (defmethod divide ((i <hash-table>) map) (if (empty-p (hashmap-interface i) map) @@ -150,6 +150,6 @@ (defmethod size ((i <hash-table>) map) (fold-left (hashmap-interface i) map - (lambda (acc hash bucket) (declare (ignore hash)) - (+ acc (size (bucketmap-interface i) bucket))) + #'(lambda (acc hash bucket) (declare (ignore hash)) + (+ acc (size (bucketmap-interface i) bucket))) 0)) diff --git a/pure/map.lisp b/pure/map.lisp index 909ac6fc146dd4a73811f2082fd25d83a6b97dd5..879904ac4ce9bee96f3238c3da7bffbbceafa437 100644 --- a/pure/map.lisp +++ b/pure/map.lisp @@ -152,7 +152,7 @@ we could have a (defclass map-simple-join () ()) (defmethod join ((i map-simple-join) map1 map2) - (fold-left i map1 (lambda (m k v) (insert i m k v)) map2)) + (fold-left i map1 #'(lambda (m k v) (insert i m k v)) map2)) (defclass map-simple-join/list () ()) @@ -191,7 +191,7 @@ we could have a (funcall (fold-left i map - (lambda (f k v) (lambda (acc) (funcall f (funcall fun k v acc)))) + #'(lambda (f k v) #'(lambda (acc) (funcall f (funcall fun k v acc)))) #'identity) seed)) @@ -200,17 +200,17 @@ we could have a (defmethod for-each ((i map-simple-for-each) map fun) (fold-left i map - (lambda (s k v) (declare (ignore s)) (funcall fun k v)) + #'(lambda (s k v) (declare (ignore s)) (funcall fun k v)) nil) (values)) (defclass map-simple-size () ()) (defmethod size ((i map-simple-size) map) - (fold-left i map (lambda (x k v) (declare (ignore k v)) (1+ x)) 0)) + (fold-left i map #'(lambda (x k v) (declare (ignore k v)) (1+ x)) 0)) (defmethod convert ((i2 <map>) (i1 <map>) map1) (fold-right i1 map1 - (lambda (k v map2) (insert i2 map2 k v)) + #'(lambda (k v map2) (insert i2 map2 k v)) (empty i2))) diff --git a/pure/updatef.lisp b/pure/updatef.lisp index bfbac3cd0f9300b2ba6e93122e781f30bcec07a8..79fbefa97cbc28b588325d2c29d471a0605d1573 100644 --- a/pure/updatef.lisp +++ b/pure/updatef.lisp @@ -60,11 +60,11 @@ An updatef expansion is an ordered collection of five objects: ,access-fn (make-instance 'updatef-expander :expander - (lambda (,envvar ,wholevar &rest ,args) - ,@(unless wholep `((declare (ignore ,wholevar)))) - ,@(unless envp `((declare (ignore ,envvar)))) - (destructuring-bind (,@destructuring-lambda-list) ,args - ,@body))))))) + #'(lambda (,envvar ,wholevar &rest ,args) + ,@(unless wholep `((declare (ignore ,wholevar)))) + ,@(unless envp `((declare (ignore ,envvar)))) + (destructuring-bind (,@destructuring-lambda-list) ,args + ,@body))))))) (defun get-updatef-expansion-tmpvars (environment args) (loop @@ -132,9 +132,9 @@ An updatef expansion is an ordered collection of five objects: ,access-fn (make-instance 'defupdatef-long-expander :n-bind-vars (length bind-vars) :expander - (lambda (,environment ,@bind-vars ,@lambda-list) - ,@(unless envp `((declare (ignore ,environment)))) - ,@body)))))))) + #'(lambda (,environment ,@bind-vars ,@lambda-list) + ,@(unless envp `((declare (ignore ,environment)))) + ,@body)))))))) (defmacro define-updatef-function (access-fn lambda-list &body body) "pure analogue to `(DEFUN (SETF ,FUNCTION) ,LAMBDA-LIST ,@BODY)" @@ -144,9 +144,9 @@ An updatef expansion is an ordered collection of five objects: ,access-fn (make-instance 'defupdatef-function-expander :expander - (lambda ,lambda-list - ,decls - (block ,access-fn ,@body)))))) + #'(lambda ,lambda-list + ,decls + (block ,access-fn ,@body)))))) (defun updatef-function (sym) (assert (symbolp sym)) @@ -159,8 +159,8 @@ An updatef expansion is an ordered collection of five objects: (defupdatef-short-expander (let ((i (updatef-expander u))) (if (and (fboundp i) (not (macro-function i))) - (lambda (v &rest args) - (apply i (append args (list v)))) + #'(lambda (v &rest args) + (apply i (append args (list v)))) (error "updatef inverse for ~S is not a function" sym)))) (t (error "Updater for symbol ~S is not a function" sym))))) diff --git a/test/functional-map.lisp b/test/functional-map.lisp index bce321591347c0f7323cff19af2e49060e52e732..f51c9079150f80f2eb452834567cfb36b2d83841 100644 --- a/test/functional-map.lisp +++ b/test/functional-map.lisp @@ -9,7 +9,7 @@ (defun sort-alist (alist) (sort (copy-seq alist) #'< :key #'car)) (defun shuffle-list (list) (mapcar #'cdr - (sort (mapcar (lambda (x) (cons (random most-positive-fixnum) x)) list) + (sort (mapcar #'(lambda (x) (cons (random most-positive-fixnum) x)) list) #'< :key #'car))) (defun make-alist (n &optional (formatter "~D")) (loop :for i :from 1 :to n :collect @@ -24,7 +24,7 @@ (defparameter *al-1* (shuffle-list *alist-100-decimal*)) (defparameter *al-2* (remove-if-not #'evenp *alist-100-decimal* :key #'car)) -(defparameter *al-3* (remove-if-not (lambda (x) (< (length x) 5)) *alist-100-latin* :key #'cdr)) +(defparameter *al-3* (remove-if-not #'(lambda (x) (< (length x) 5)) *alist-100-latin* :key #'cdr)) (defparameter *al-5* (remove-duplicates (append *al-2* *al-3*) :key #'car :from-end t)) (defun alist-from (i map) @@ -125,13 +125,13 @@ (alist-from i (fold-left i (from-alist i (make-alist 2)) - (lambda (m k v) (insert i m k v)) + #'(lambda (m k v) (insert i m k v)) (from-alist i '((20 . "20") (30 . "30"))))))) ;; fold-left and size (is (= 100 (size i (fold-left i (from-alist i *alist-100-decimal*) - (lambda (m k v) (insert i m k v)) + #'(lambda (m k v) (insert i m k v)) (from-alist i *alist-100-latin*))))) ;; fold-right @@ -142,21 +142,21 @@ (alist-from i (fold-right i (from-alist i (make-alist 2)) - (lambda (k v m) (insert i m k v)) + #'(lambda (k v m) (insert i m k v)) (from-alist i '((20 . "20") (30 . "30"))))))) ;; for-each (is (eql nil (while-collecting (c) - (for-each i (empty i) (lambda (k v) (c (cons k v))))))) + (for-each i (empty i) #'(lambda (k v) (c (cons k v))))))) (is (equal-alist *alist-10-latin* (while-collecting (c) (with-output-to-string (o) (for-each i (from-alist i *alist-10-latin*) - (lambda (k v) (c (cons k v)))))))) + #'(lambda (k v) (c (cons k v)))))))) (is (= 1129 (length (with-output-to-string (o) (for-each i (from-alist i *alist-100-english*) - (lambda (x y) + #'(lambda (x y) (format o "~A~A" x y))))))) ;; join @@ -236,8 +236,8 @@ (defparameter <denm> (<encoded-key-map> :base-interface <number-map> - :key-encoder (lambda (dk) (* dk 2)) - :key-decoder (lambda (ek) (/ ek 2)))) + :key-encoder #'(lambda (dk) (* dk 2)) + :key-decoder #'(lambda (ek) (/ ek 2)))) (deftest test-pure-map-interfaces () (dolist (i (list <alist> <number-map> <hash-table> <fmim> <denm>)) diff --git a/unbaked/msv.lisp b/unbaked/msv.lisp index e78bf29689b0830ab14f57b213ff837222e9e0b6..ac76fb0da450a41091ae64aab909007f8a767e4d 100644 --- a/unbaked/msv.lisp +++ b/unbaked/msv.lisp @@ -127,6 +127,7 @@ `(progn (flush-all-msv) (with-magic-special-variables ,@body))) +#-genera (defmethod make-load-form ((msv magic-special-variable-cell) &optional environment) (declare (ignore environment)) `(register-magic-special-variable