Skip to content
Snippets Groups Projects
Commit 5d3641e0 authored by wlott's avatar wlott
Browse files

More random changes to reduce the number of compiler notes/warnings.

parent 089c9d71
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.11 1992/05/15 17:54:55 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/list.lisp,v 1.12 1992/05/15 19:25:46 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -208,13 +208,13 @@ ...@@ -208,13 +208,13 @@
(cons arg others)))) (cons arg others))))
(defun make-list (size &key initial-element) (defun make-list (size &key initial-element)
(declare (fixnum size))
"Constructs a list with size elements each set to value" "Constructs a list with size elements each set to value"
(if (< size 0) (error "~S is an illegal size for MAKE-LIST." size) (declare (type index size))
(do ((count size (1- count)) (do ((count size (1- count))
(result '() (cons initial-element result))) (result '() (cons initial-element result)))
((zerop count) result) ((zerop count) result)
(declare (fixnum count))))) (declare (type index count))))
;;; The outer loop finds the first non-null list and the result is started. ;;; The outer loop finds the first non-null list and the result is started.
;;; The remaining lists in the arguments are tacked to the end of the result ;;; The remaining lists in the arguments are tacked to the end of the result
...@@ -254,7 +254,6 @@ ...@@ -254,7 +254,6 @@
;;; List Copying Functions ;;; List Copying Functions
;;; The list is copied correctly even if the list is not terminated by () ;;; The list is copied correctly even if the list is not terminated by ()
;;; The new list is built by cdr'ing splice which is always at the tail ;;; The new list is built by cdr'ing splice which is always at the tail
;;; of the new list ;;; of the new list
...@@ -262,26 +261,25 @@ ...@@ -262,26 +261,25 @@
(defun copy-list (list) (defun copy-list (list)
"Returns a new list EQUAL but not EQ to list" "Returns a new list EQUAL but not EQ to list"
(if (atom list) (if (atom list)
(if list list
(error "~S is not a list." list)) (let ((result (list (car list))))
(let ((result (cons (car list) '()) ))
(do ((x (cdr list) (cdr x)) (do ((x (cdr list) (cdr x))
(splice result (splice result
(cdr (rplacd splice (cons (car x) '() ))) )) (cdr (rplacd splice (cons (car x) '() ))) ))
((atom x) (unless (null x) ((atom x)
(rplacd splice x)) (unless (null x)
result))))) (rplacd splice x))))
result)))
(defun copy-alist (alist) (defun copy-alist (alist)
"Returns a new association list equal to alist, constructed in space" "Returns a new association list equal to alist, constructed in space"
(if (atom alist) (if (atom alist)
(if alist alist
(error "~S is not a list." alist))
(let ((result (let ((result
(cons (if (atom (car alist)) (cons (if (atom (car alist))
(car alist) (car alist)
(cons (caar alist) (cdar alist)) ) (cons (caar alist) (cdar alist)) )
'() ))) nil)))
(do ((x (cdr alist) (cdr x)) (do ((x (cdr alist) (cdr x))
(splice result (splice result
(cdr (rplacd splice (cdr (rplacd splice
...@@ -289,16 +287,19 @@ ...@@ -289,16 +287,19 @@
(if (atom (car x)) (if (atom (car x))
(car x) (car x)
(cons (caar x) (cdar x))) (cons (caar x) (cdar x)))
'() ))) )) nil)))))
;;; Non-null terminated alist done here. ;; Non-null terminated alist done here.
((atom x) (unless (null x) ((atom x)
(rplacd splice x)) (unless (null x)
result))))) (rplacd splice x))))
result)))
(defun copy-tree (object) (defun copy-tree (object)
"Copy-Tree recursively copys trees of conses." "Copy-Tree recursively copys trees of conses."
(cond ((not (consp object)) object) (if (consp object)
(T (cons (copy-tree (car object)) (copy-tree (cdr object)))) )) (cons (copy-tree (car object)) (copy-tree (cdr object)))
object))
;;; More Commonly-used List Functions ;;; More Commonly-used List Functions
...@@ -539,18 +540,18 @@ ...@@ -539,18 +540,18 @@
"Substitutes from alist into tree nondestructively." "Substitutes from alist into tree nondestructively."
(declare (inline assoc)) (declare (inline assoc))
(labels ((s (subtree) (labels ((s (subtree)
(let ((assoc (let ((assoc
(if notp (if notp
(assoc (funcall key subtree) alist :test-not test-not) (assoc (funcall key subtree) alist :test-not test-not)
(assoc (funcall key subtree) alist :test test)))) (assoc (funcall key subtree) alist :test test))))
(cond (assoc (cdr assoc)) (cond (assoc (cdr assoc))
((atom subtree) subtree) ((atom subtree) subtree)
(t (let ((car (s (car subtree))) (t (let ((car (s (car subtree)))
(cdr (s (cdr subtree)))) (cdr (s (cdr subtree))))
(if (and (eq car (car subtreE)) (if (and (eq car (car subtreE))
(eq cdr (cdr subtree))) (eq cdr (cdr subtree)))
subtree subtree
(cons car cdr)))))))) (cons car cdr))))))))
(s tree))) (s tree)))
;;; In run-time env, since can be referenced in line expansions. ;;; In run-time env, since can be referenced in line expansions.
...@@ -594,8 +595,6 @@ ...@@ -594,8 +595,6 @@
(defun member-if (test list &key (key #'identity)) (defun member-if (test list &key (key #'identity))
"Returns tail of list beginning with first element satisfying test(element)" "Returns tail of list beginning with first element satisfying test(element)"
(unless (listp list)
(error "~S is not a list." list))
(do ((list list (Cdr list))) (do ((list list (Cdr list)))
((endp list) nil) ((endp list) nil)
(if (funcall test (funcall key (car list))) (if (funcall test (funcall key (car list)))
...@@ -603,8 +602,6 @@ ...@@ -603,8 +602,6 @@
(defun member-if-not (test list &key (key #'identity)) (defun member-if-not (test list &key (key #'identity))
"Returns tail of list beginning with first element not satisfying test(el)" "Returns tail of list beginning with first element not satisfying test(el)"
(unless (listp list)
(error "~S is not a list." list))
(do ((list list (cdr list))) (do ((list list (cdr list)))
((endp list) ()) ((endp list) ())
(if (not (funcall test (funcall key (car list)))) (if (not (funcall test (funcall key (car list))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment