Skip to content
Snippets Groups Projects
Commit 45c5ada9 authored by ram's avatar ram
Browse files

Made DEFTYPE warn if redefining a structure and flame if a primitive

type.  Fixed it to test FBOUNDP on the right symbol so that
%NOTE-TYPE-DEFINED can get called.
Changed %%DEFUN to use DEFINE-FUNCTION-NAME and also to blow away
any assumed type info.
parent b3a530fc
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.11 1990/09/06 19:43:28 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.12 1990/10/11 18:18:16 ram Exp $
;;; ;;;
;;; This file contains the macros that are part of the standard ;;; This file contains the macros that are part of the standard
;;; Spice Lisp environment. ;;; Spice Lisp environment.
...@@ -219,6 +219,13 @@ ...@@ -219,6 +219,13 @@
(member :new-compiler *features*)) (member :new-compiler *features*))
(setf (get name 'deftype-expander) (setf (get name 'deftype-expander)
expander)) expander))
(ecase (info type kind name)
(:primitive
(error "Illegal to redefine standard type: ~S." name))
(:structure
(warn "Redefining structure type ~S with DEFTYPE." name)
(c::undefine-structure (info type structure-info name)))
((nil :defined)))
(when #-new-compiler *bootstrap-deftype* #+new-compiler t (when #-new-compiler *bootstrap-deftype* #+new-compiler t
(setf (info type kind name) :defined) (setf (info type kind name) :defined)
(setf (info type expander name) expander)) (setf (info type expander name) expander))
...@@ -226,7 +233,7 @@ ...@@ -226,7 +233,7 @@
(setf (documentation name 'type) doc)) (setf (documentation name 'type) doc))
;; ### Bootstrap hack -- we need to define types before %note-type-defined ;; ### Bootstrap hack -- we need to define types before %note-type-defined
;; is defined. ;; is defined.
(when (fboundp 'c::note-type-defined) (when (fboundp 'c::%note-type-defined)
(c::%note-type-defined name)) (c::%note-type-defined name))
name) name)
...@@ -295,13 +302,11 @@ ...@@ -295,13 +302,11 @@
(if (and (consp name) (eq (first name) 'setf)) (if (and (consp name) (eq (first name) 'setf))
(setf (documentation (second name) 'setf) doc) (setf (documentation (second name) 'setf) doc)
(setf (documentation name 'function) doc))) (setf (documentation name 'function) doc)))
(c::define-function-name name)
(unless (eq (info function kind name) :function) (when (eq (info function where-from name) :assumed)
(setf (info function kind name) :function)) (setf (info function where-from name) :defined)
(when (info function assumed-type name)
(when (info function accessor-for name) (setf (info function assumed-type name) nil)))
(setf (info function accessor-for name) nil))
(when (or inline-expansion (when (or inline-expansion
(info function inline-expansion name)) (info function inline-expansion name))
(setf (info function inline-expansion name) inline-expansion)) (setf (info function inline-expansion name) inline-expansion))
......
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