From c90f5bda7da9da264bfec977ea29714aa77cad50 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Fri, 15 May 1992 21:51:52 +0000 Subject: [PATCH] Bloody hell, more stupid bugs. --- code/package.lisp | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/code/package.lisp b/code/package.lisp index bdf57cad7..7b5fcc581 100644 --- a/code/package.lisp +++ b/code/package.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.21 1992/05/15 20:59:24 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.22 1992/05/15 21:51:52 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -575,7 +575,7 @@ (error "Bogus DEFPACKAGE option: ~S" option)) (case (car option) (:nicknames - (let ((new (stringify-names (cdr options) "package"))) + (let ((new (stringify-names (cdr option) "package"))) (setf nicknames (append-unique new nicknames :nicknames)))) (:size (cond (size @@ -601,7 +601,7 @@ (setf shadowing-imports (acons package-name names shadowing-imports)))))) (:use - (let ((new (stringify-names (cdr options) "package"))) + (let ((new (stringify-names (cdr option) "package"))) (setf use (append-unique new nicknames :use)) (setf use-p t))) (:import-from @@ -676,13 +676,7 @@ (dolist (simports-from shadowing-imports) (let ((other-package (package-or-lose (car simports-from)))) (dolist (sym-name (cdr simports-from)) - (let ((sym (or (find-symbol sym-name other-package) - (progn - (cerror "INTERN it." - "~A does not contain a symbol ~A" - (package-name other-package) - sym-name) - (intern sym-name other-package))))) + (let ((sym (find-or-make-symbol sym-name other-package))) (shadowing-import sym package) (setf old-shadows (remove sym old-shadows)))))) (when old-shadows @@ -702,14 +696,7 @@ (dolist (imports-from imports) (let ((other-package (package-or-lose (car imports-from)))) (dolist (sym-name (cdr imports-from)) - (import (or (find-symbol sym-name other-package) - (progn - (cerror "INTERN it." - "~A does not contain a symbol ~A" - (package-name other-package) - sym-name) - (intern sym-name other-package))) - package)))) + (import (find-or-make-symbol sym-name other-package) package)))) ;; Exports. (let ((old-exports nil)) (do-external-symbols (sym package) @@ -723,6 +710,19 @@ name old-exports))) package)) +(defun find-or-make-symbol (name package) + (multiple-value-bind + (symbol how) + (find-symbol name package) + (cond (how + symbol) + (t + (cerror "INTERN it." + "~A does not contain a symbol ~A" + (package-name package) + name) + (intern name package))))) + ;;; Enter-New-Nicknames -- Internal ;;; -- GitLab