Skip to content
Snippets Groups Projects
Commit 7e786529 authored by ram's avatar ram
Browse files

Added DECLAIM macro. Changed OPTIMIZE declaration to allow any real

instead of just rationals, anticipating a possible change to float
qualities.  Changed OPTIMIZE to recognize EXT:INHIBIT-WARNINGS as
the same as BREVITY.  Changed DEBUG-INFO default to 2.
parent c8edb7b9
No related branches found
No related tags found
No related merge requests found
...@@ -13,7 +13,14 @@ ...@@ -13,7 +13,14 @@
;;; ;;;
;;; Written by Rob MacLachlan ;;; Written by Rob MacLachlan
;;; ;;;
(in-package 'c) (in-package "C")
(in-package "EXTENSIONS")
(export '(inhibit-warnings))
(in-package "LISP")
(export '(declaim proclaim))
(in-package "C")
;;; True if the type system has been properly initialized, and thus is o.k. to ;;; True if the type system has been properly initialized, and thus is o.k. to
;;; use. ;;; use.
...@@ -38,7 +45,7 @@ ...@@ -38,7 +45,7 @@
;;; ;;;
(proclaim '(type cookie *default-cookie*)) (proclaim '(type cookie *default-cookie*))
(defvar *default-cookie* (make-cookie :safety 1 :speed 1 :space 1 :cspeed 1 (defvar *default-cookie* (make-cookie :safety 1 :speed 1 :space 1 :cspeed 1
:brevity 1 :debug 1)) :brevity 1 :debug 2))
;;; Parse-Lambda-List -- Interface ;;; Parse-Lambda-List -- Interface
...@@ -169,14 +176,14 @@ ...@@ -169,14 +176,14 @@
(dolist (quality (cdr spec)) (dolist (quality (cdr spec))
(let ((quality (if (atom quality) (list quality 3) quality))) (let ((quality (if (atom quality) (list quality 3) quality)))
(if (and (consp (cdr quality)) (null (cddr quality)) (if (and (consp (cdr quality)) (null (cddr quality))
(rationalp (second quality)) (<= 0 (second quality) 3)) (typep (second quality) 'real) (<= 0 (second quality) 3))
(let ((value (second quality))) (let ((value (rational (second quality))))
(case (first quality) (case (first quality)
(speed (setf (cookie-speed res) value)) (speed (setf (cookie-speed res) value))
(space (setf (cookie-space res) value)) (space (setf (cookie-space res) value))
(safety (setf (cookie-safety res) value)) (safety (setf (cookie-safety res) value))
(compilation-speed (setf (cookie-cspeed res) value)) (compilation-speed (setf (cookie-cspeed res) value))
(brevity (setf (cookie-brevity res) value)) ((inhibit-warnings brevity) (setf (cookie-brevity res) value))
(debug-info (setf (cookie-debug res) value)) (debug-info (setf (cookie-debug res) value))
(t (t
(compiler-warning "Unknown optimization quality ~S in ~S." (compiler-warning "Unknown optimization quality ~S in ~S."
...@@ -186,16 +193,24 @@ ...@@ -186,16 +193,24 @@
quality spec)))) quality spec))))
res)) res))
;;; DECLAIM -- Public
;;;
;;; For now, just PROCLAIM without any EVAL-WHEN.
;;;
(defmacro declaim (&rest specs)
"DECLAIM Declaration*
Do a declaration for the global environment."
`(progn ,@(mapcar #'(lambda (x)
`(proclaim ',x))
specs)))
;;; %Proclaim -- Interface ;;; %Proclaim -- Interface
;;; ;;;
;;; This function is the guts of proclaim, since it does the global ;;; This function is the guts of proclaim, since it does the global
;;; environment updating. ;;; environment updating.
;;; ;;;
;;; ### At least for now, blow off type declarations when the compiler hasn't
;;; been loaded yet. This allows us to delay putting the type system into the
;;; cold load.
;;;
(defun %proclaim (form) (defun %proclaim (form)
(unless (consp form) (unless (consp form)
(error "Malformed PROCLAIM spec: ~S." form)) (error "Malformed PROCLAIM spec: ~S." form))
......
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