X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=2c7bb5c968129593bc05ef0f88e2234241051c10;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=72a65e05d8d3ee319669b87ff89424c67347ffd9;hpb=6f408b4ce6a2f411618fe1bebf63ee08093a7d03;p=sbcl.git

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index 72a65e0..2c7bb5c 100644
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -11,9 +11,6 @@
 ;;;; files for more information.
 
 (in-package "SB!ALIEN")
-
-(file-comment
-  "$Header$")
 
 ;;;; utility functions
 
@@ -64,7 +61,7 @@
 	(setf (gethash name *alien-type-classes*)
 	      (make-alien-type-class :name name :include include)))))
 
-(defconstant method-slot-alist
+(defparameter *method-slot-alist*
   '((:unparse . alien-type-class-unparse)
     (:type= . alien-type-class-type=)
     (:subtypep . alien-type-class-subtypep)
@@ -79,13 +76,13 @@
     (:result-tn . alien-type-class-result-tn)))
 
 (defun method-slot (method)
-  (cdr (or (assoc method method-slot-alist)
+  (cdr (or (assoc method *method-slot-alist*)
 	   (error "no method ~S" method))))
 
 ) ; EVAL-WHEN
 
-;;; We define a keyword "BOA" constructor so that we can reference the slot
-;;; names in init forms.
+;;; We define a keyword "BOA" constructor so that we can reference the
+;;; slot names in init forms.
 (def!macro def-alien-type-class ((name &key include include-args) &rest slots)
   (let ((defstruct-name
 	 (intern (concatenate 'string "ALIEN-" (symbol-name name) "-TYPE"))))
@@ -176,14 +173,14 @@
 ;;; we no longer need to make a distinction between this and
 ;;; %PARSE-ALIEN-TYPE.
 (defun parse-alien-type (type env)
-  (declare (type sb!kernel:lexenv env))
+  (declare (type (or sb!kernel:lexenv null) env))
   #!+sb-doc
   "Parse the list structure TYPE as an alien type specifier and return
    the resultant ALIEN-TYPE structure."
   (%parse-alien-type type env))
 
 (defun %parse-alien-type (type env)
-  (declare (type sb!kernel:lexenv env))
+  (declare (type (or sb!kernel:lexenv null) env))
   (if (consp type)
       (let ((translator (info :alien-type :translator (car type))))
 	(unless translator
@@ -202,7 +199,7 @@
 	 (error "unknown alien type: ~S" type)))))
 
 (defun auxiliary-alien-type (kind name env)
-  (declare (type sb!kernel:lexenv env))
+  (declare (type (or sb!kernel:lexenv null) env))
   (flet ((aux-defn-matches (x)
 	   (and (eq (first x) kind) (eq (second x) name))))
     (let ((in-auxiliaries
@@ -219,7 +216,7 @@
 	     (info :alien-type :enum name)))))))
 
 (defun (setf auxiliary-alien-type) (new-value kind name env)
-  (declare (type sb!kernel:lexenv env))
+  (declare (type (or sb!kernel:lexenv null) env))
   (flet ((aux-defn-matches (x)
 	   (and (eq (first x) kind) (eq (second x) name))))
     (when (find-if #'aux-defn-matches *new-auxiliary-types*)
@@ -614,8 +611,8 @@
   kind		; Kind of from mapping, :vector or :alist.
   offset)	; Offset to add to value for :vector from mapping.
 
-(def-alien-type-translator enum (&whole type
-				 name
+(def-alien-type-translator enum (&whole
+				 type name
 				 &rest mappings
 				 &environment env)
   (cond (mappings
@@ -772,7 +769,8 @@
   `(sap-ref-double ,sap (/ ,offset sb!vm:byte-bits)))
 
 #!+long-float
-(def-alien-type-class (long-float :include (float (:bits #!+x86 96 #!+sparc 128))
+(def-alien-type-class (long-float :include (float (:bits #!+x86 96
+							  #!+sparc 128))
 				  :include-args (type)))
 
 #!+long-float
@@ -932,7 +930,7 @@
   (parse-alien-record-type :union name fields env))
 
 (defun parse-alien-record-type (kind name fields env)
-  (declare (type sb!kernel:lexenv env))
+  (declare (type (or sb!kernel:lexenv null) env))
   (cond (fields
 	 (let* ((old (and name (auxiliary-alien-type kind name env)))
 		(old-fields (and old (alien-record-type-fields old))))