Skip to content
Snippets Groups Projects
Commit 6d248952 authored by pfdietz's avatar pfdietz
Browse files

Added (OPTIMIZE SAFETY) declarations in a few places. Indentation changes.

parent f15eeffd
No related branches found
No related tags found
No related merge requests found
...@@ -40,18 +40,20 @@ ...@@ -40,18 +40,20 @@
warning)) warning))
(defparameter *condition-objects* (defparameter *condition-objects*
(loop for tp in *condition-types* append (locally (declare (optimize safety))
(handler-case (list (make-condition tp)) (loop for tp in *condition-types* append
(error () nil)))) (handler-case (list (make-condition tp))
(error () nil)))))
(defparameter *standard-package-names* (defparameter *standard-package-names*
'("COMMON-LISP" "COMMON-LISP-USER" "KEYWORD")) '("COMMON-LISP" "COMMON-LISP-USER" "KEYWORD"))
(defparameter *package-objects* (defparameter *package-objects*
(loop for pname in *standard-package-names* append (locally (declare (optimize safety))
(handler-case (let ((pkg (find-package pname))) (loop for pname in *standard-package-names* append
(and pkg (list pkg))) (handler-case (let ((pkg (find-package pname)))
(error () nil)))) (and pkg (list pkg)))
(error () nil)))))
(defparameter *integers* (defparameter *integers*
(remove-duplicates (remove-duplicates
...@@ -155,6 +157,7 @@ ...@@ -155,6 +157,7 @@
(defparameter *rationals* (append *integers* *ratios*)) (defparameter *rationals* (append *integers* *ratios*))
(defun try-to-read-chars (&rest namelist) (defun try-to-read-chars (&rest namelist)
(declare (optimize safety))
(loop (loop
for name in namelist append for name in namelist append
(handler-case (handler-case
...@@ -353,78 +356,85 @@ ...@@ -353,78 +356,85 @@
) )
;; The ever-popular NIL array ;; The ever-popular NIL array
(handler-case (locally (declare (optimize safety))
(list (make-array '(0) :element-type nil)) (handler-case
(error () nil)) (list (make-array '(0) :element-type nil))
(error () nil)))
;; more kinds of arrays here later? ;; more kinds of arrays here later?
)) ))
(defparameter *hash-tables* (defparameter *hash-tables*
(list (list
(make-hash-table) (make-hash-table)
(make-hash-table :test #'eq) (make-hash-table :test #'eq)
(make-hash-table :test #'eql) (make-hash-table :test #'eql)
(make-hash-table :test #'equal) (make-hash-table :test #'equal)
#-(or GCL CMU ECL) (make-hash-table :test #'equalp) #-(or GCL CMU ECL) (make-hash-table :test #'equalp)
)) ))
(defparameter *pathnames* (defparameter *pathnames*
(append (locally
(ignore-errors (list (make-pathname :name "foo"))) (declare (optimize safety))
(ignore-errors (list (make-pathname :name "FOO" :case :common))) (append
(ignore-errors (list (make-pathname :name "bar"))) (ignore-errors (list (make-pathname :name "foo")))
(ignore-errors (list (make-pathname :name "foo" :type "txt"))) (ignore-errors (list (make-pathname :name "FOO" :case :common)))
(ignore-errors (list (make-pathname :name "bar" :type "txt"))) (ignore-errors (list (make-pathname :name "bar")))
(ignore-errors (list (make-pathname :name "XYZ" :type "TXT" :case :common))) (ignore-errors (list (make-pathname :name "foo" :type "txt")))
(ignore-errors (list (make-pathname :name nil))) (ignore-errors (list (make-pathname :name "bar" :type "txt")))
(ignore-errors (list (make-pathname :name :wild))) (ignore-errors (list (make-pathname :name "XYZ" :type "TXT" :case :common)))
(ignore-errors (list (make-pathname :name nil :type "txt"))) (ignore-errors (list (make-pathname :name nil)))
(ignore-errors (list (make-pathname :name :wild :type "txt"))) (ignore-errors (list (make-pathname :name :wild)))
(ignore-errors (list (make-pathname :name :wild :type "TXT" :case :common))) (ignore-errors (list (make-pathname :name nil :type "txt")))
(ignore-errors (list (make-pathname :name :wild :type "abc" :case :common))) (ignore-errors (list (make-pathname :name :wild :type "txt")))
(ignore-errors (list (make-pathname :directory :wild))) (ignore-errors (list (make-pathname :name :wild :type "TXT" :case :common)))
(ignore-errors (list (make-pathname :type :wild))) (ignore-errors (list (make-pathname :name :wild :type "abc" :case :common)))
(ignore-errors (list (make-pathname :version :wild))) (ignore-errors (list (make-pathname :directory :wild)))
(ignore-errors (list (make-pathname :version :newest))) (ignore-errors (list (make-pathname :type :wild)))
)) (ignore-errors (list (make-pathname :version :wild)))
(ignore-errors (list (make-pathname :version :newest)))
)))
(eval-when (load eval compile) (eval-when (load eval compile)
(ignore-errors (locally
(setf (logical-pathname-translations "CLTESTROOT") (declare (optimize safety))
`(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors) (ignore-errors
:name :wild :type :wild))))) (setf (logical-pathname-translations "CLTESTROOT")
(ignore-errors `(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors)
(setf (logical-pathname-translations "CLTEST") :name :wild :type :wild)))))
`(("**;*.*.*" ,(make-pathname (ignore-errors
:directory (append (setf (logical-pathname-translations "CLTEST")
(pathname-directory `(("**;*.*.*" ,(make-pathname
(truename (make-pathname))) :directory (append
'(:wild-inferiors)) (pathname-directory
:name :wild :type :wild))))) (truename (make-pathname)))
) '(:wild-inferiors))
:name :wild :type :wild)))))
))
(defparameter *logical-pathnames* (defparameter *logical-pathnames*
(append (locally
(ignore-errors (list (logical-pathname "CLTESTROOT:"))) (declare (optimize safety))
)) (append
(ignore-errors (list (logical-pathname "CLTESTROOT:")))
)))
(defparameter *streams* (defparameter *streams*
(remove-duplicates (remove-duplicates
(remove-if (remove-if
#'null #'null
(list (list
*debug-io* *debug-io*
*error-output* *error-output*
*query-io* *query-io*
*standard-input* *standard-input*
*standard-output* *standard-output*
*terminal-io* *terminal-io*
*trace-output*)))) *trace-output*))))
(defparameter *readtables* (defparameter *readtables*
(list *readtable* (list *readtable*
(copy-readtable))) (copy-readtable)))
(defstruct foo-structure (defstruct foo-structure
x y z) x y z)
...@@ -433,11 +443,11 @@ ...@@ -433,11 +443,11 @@
x y z) x y z)
(defparameter *structures* (defparameter *structures*
(list (list
(make-foo-structure :x 1 :y 'a :z nil) (make-foo-structure :x 1 :y 'a :z nil)
(make-foo-structure :x 1 :y 'a :z nil) (make-foo-structure :x 1 :y 'a :z nil)
(make-bar-structure :x 1 :y 'a :z nil) (make-bar-structure :x 1 :y 'a :z nil)
)) ))
(defun meaningless-user-function-for-universe (x y z) (defun meaningless-user-function-for-universe (x y z)
(list (+ x 1) (+ y 2) (+ z 3))) (list (+ x 1) (+ y 2) (+ z 3)))
...@@ -468,26 +478,26 @@ ...@@ -468,26 +478,26 @@
(list (make-random-state))) (list (make-random-state)))
(defparameter *universe* (defparameter *universe*
(remove-duplicates (remove-duplicates
(append (append
*symbols* *symbols*
*numbers* *numbers*
*characters* *characters*
(mapcar #'copy-seq *strings*) (mapcar #'copy-seq *strings*)
*conses* *conses*
*condition-objects* *condition-objects*
*package-objects* *package-objects*
*arrays* *arrays*
*hash-tables* *hash-tables*
*pathnames* *pathnames*
*logical-pathnames* *logical-pathnames*
*streams* *streams*
*readtables* *readtables*
*structures* *structures*
*functions* *functions*
*random-states* *random-states*
*methods* *methods*
nil))) nil)))
(defparameter *mini-universe* (defparameter *mini-universe*
(remove-duplicates (remove-duplicates
......
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